Plaster

common-lisp
(in-package #:cl-user) (defpackage #:misc-code/merkle (:use #:cl) (:local-nicknames (#:flex #:flexi-streams) (#:ironclad #:ironclad)) (:export #:+sha256-digest-length+ #:node #:make-node #:hash-data #:hash-expr #:calculate-node-size #:create-leaf #:create-parent-node #:build-merkle-level #:build-merkle-tree #:write-node-size #:serialize-node #:serialize-tree #:write-merkle-tree-to-disk #:read-node-size #:deserialize-node #:deserialize-tree #:load-merkle-tree-from-disk #:main)) (in-package #:misc-code/merkle) (defparameter +sha256-digest-length+ 32) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defstruct (node (:constructor make-node (&key hash left right size))) (size 0 :type integer :read-only t) ; size in bytes, calculated during creation hash ; stores the hash for this node left ; left child (another node or nil) right) ; right child (another node or nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun hash-data (array) (let ((digester (ironclad:make-digest :sha256))) (ironclad:update-digest digester array) (ironclad:produce-digest digester))) (defun hash-expr (expr) (hash-data (flex:string-to-octets (princ-to-string expr)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun calculate-node-size (hash left right) "Calculate the size in bytes of a node, including hash, child pointers, and flags." (declare (ignore hash)) ; ??? (let ((hash-size +sha256-digest-length+) ; Assuming 32 bytes for the hash (pointer-size 0) ; Estimate 8 bytes for each child pointer (platform-dependent) (flag-size 1)) ; 1 byte per child presence flag (+ hash-size (* (if left 1 0) pointer-size) (* (if right 1 0) pointer-size) (* 2 flag-size)))) ; Two flags for left and right child presence (defun create-leaf (data) "Create a leaf node with a hash of the data and calculated size." (let ((hash (hash-expr data))) (format t "CREATE-LEAF: ~a~%" hash) (make-node :hash hash :size (calculate-node-size hash nil nil)))) (defun create-parent-node (left right) "Create a parent node by combining two child nodes and calculating the size." (let* ((combined-hash (hash-expr (concatenate 'string (princ-to-string (node-hash left)) (princ-to-string (node-hash right))))) (node-size (calculate-node-size combined-hash left right))) (format t "CREATE-PARENT-NODE: ~a~%" combined-hash) (make-node :hash combined-hash :left left :right right :size node-size))) (defun build-merkle-level (nodes) "Given a list of nodes, combine them in pairs to form the next level up." (if (= (length nodes) 1) (first nodes) ; Root node reached (loop for (left right) on nodes by #'cddr collect (create-parent-node left (or right left))))) ; Duplicate last if odd (defun build-merkle-tree (data-blocks) "Main function to build the tree from data blocks." (let ((leaves (mapcar #'create-leaf data-blocks))) (loop while (> (length leaves) 1) do (setf leaves (build-merkle-level leaves))) (first leaves))) ; Root of the Merkle tree ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun write-node-size (node stream) (let ((node-size (node-size node))) (write-byte (ldb (byte 8 24) node-size) stream) (write-byte (ldb (byte 8 16) node-size) stream) (write-byte (ldb (byte 8 8) node-size) stream) (write-byte (ldb (byte 8 0) node-size) stream))) (defun serialize-node (node stream) "Serialize a Merkle tree node and write it to the binary stream." ;; Write the node's size as a 4-byte integer (write-node-size node stream) ;; Write the hash as a fixed 32-byte binary string (let ((hash-bytes (node-hash node))) (write-sequence hash-bytes stream)) ;; Write presence flags for left and right children (1 byte each) (write-byte (if (node-left node) 1 0) stream) ; Left child presence flag (write-byte (if (node-right node) 1 0) stream)) ; Right child presence flag (defun serialize-tree (node stream) "Serialize a Merkle tree by recursively writing each node to the stream." (when node (serialize-node node stream) ; Write the current node (serialize-tree (node-left node) stream) ; Serialize left child (serialize-tree (node-right node) stream))) ; Serialize right child (defun write-merkle-tree-to-disk (root filepath) "Write the Merkle tree starting at ROOT to a binary file at FILEPATH." (with-open-file (stream filepath :direction :output :element-type '(unsigned-byte 8) :if-exists :supersede :if-does-not-exist :create) (serialize-tree root stream))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun read-node-size (stream) "Read the 4-byte size field from STREAM." (+ (ash (read-byte stream) 24) (ash (read-byte stream) 16) (ash (read-byte stream) 8) (read-byte stream))) (defun deserialize-node (stream) "Deserialize a single node from the binary STREAM." (let* ((size (read-node-size stream)) (hash-bytes (make-array +sha256-digest-length+ :element-type '(unsigned-byte 8)))) ;; Read the 32-byte hash directly into the array - how many bytes ;; to read? NODE-SIZE is the total size of the node. Do we store ;; the hash size too? (read-sequence hash-bytes stream :end +sha256-digest-length+) ;; Create a node with the read values, but without linking children yet (destructuring-bind (left-flag right-flag) (list (read-byte stream) (read-byte stream)) (make-node :size size :hash hash-bytes :left (if (= left-flag 1) :placeholder nil) :right (if (= right-flag 1) :placeholder nil))))) (defun deserialize-tree (stream) "Deserialize the entire Merkle tree from a binary stream recursively." (labels ((deserialize-recursive () ;; Deserialize a node from the stream (let ((node (deserialize-node stream))) (when node ;; Recursively deserialize and assign left and right children if placeholders (when (eq (node-left node) :placeholder) (setf (node-left node) (deserialize-recursive))) (when (eq (node-right node) :placeholder) (setf (node-right node) (deserialize-recursive))) node)))) (deserialize-recursive))) (defun load-merkle-tree-from-disk (filepath) "Load the Merkle tree from a binary file at FILEPATH." (with-open-file (stream filepath :direction :input :element-type '(unsigned-byte 8)) (deserialize-tree stream))) (defun main () (let* ((data '("data1" "data2" "data3" "data4" '(data5 data6))) (file-path "merkle_tree.bin") (root (build-merkle-tree data))) (write-merkle-tree-to-disk root file-path) (load-merkle-tree-from-disk file-path)))