2 files changed, 44 insertions(+), 1 deletions(-)

M info.rkt
A merkle.rkt

@@ 1,6 1,6 @@
 #lang info
 (define collection "tallyard")
-(define deps '("base" "crypto" "simple-http" "sugar"))
+(define deps '("base" "crypto" "sha" "simple-http" "sugar"))
 (define build-deps '("scribble-lib" "racket-doc" "rackunit-lib"))
 (define scribblings '(("scribblings/tallyard.scrbl" ())))
 (define pkg-desc "Description Here")

@@ 0,0 1,43 @@
+#lang typed/racket/base
+(require/typed sha [sha256 (-> Bytes Bytes)])
+
+(struct merkle-tree
+  ([root        : merkle-node]
+   [leaves      : (Vectorof merkle-node)]))
+
+(struct merkle-node
+  ([parent : (Option merkle-node)]
+   [hsh    : Bytes]
+   [C      : (Option Bytes)])
+  #:mutable
+  #:transparent)
+
+(define (merkle [content : (Vectorof Bytes)])
+  (let* ([n (vector-length content)]
+         [leaves
+          (build-vector (+ n (modulo n 2))
+                        (λ ([i : Natural])
+                          (let ([bstr
+                                 (vector-ref content (min i (sub1 n)))])
+                            (merkle-node #f (sha256 bstr) bstr))))])
+    (let build-level : merkle-tree
+         ([nodes : (Vectorof merkle-node)
+                 leaves])
+         (let ([n (vector-length nodes)])
+           (if (> n 1)
+               (build-level
+                (for/vector : (Vectorof merkle-node)
+                    ([left (in-vector nodes 0 n 2)]
+                             [right (in-vector nodes 1 n 2)])
+                  (let ([new-node
+                         (merkle-node
+                          #f
+                          (sha256 (bytes-append (merkle-node-hsh left)
+                                                (merkle-node-hsh right)))
+                          #f)])
+                    (set-merkle-node-parent! left new-node)
+                    (set-merkle-node-parent! right new-node)
+                    new-node)))
+               (merkle-tree (vector-ref nodes 0) leaves))))))
+
+(provide (all-defined-out))