From c76c0d74f26c37934d9162c62baa39bc509e39ff Mon Sep 17 00:00:00 2001
From: David Florness <david@florness.com>
Date: Sun, 23 Feb 2020 08:40:56 -0700
Subject: [PATCH] First attempt at merkle tree implementation

---
 info.rkt   |  2 +-
 merkle.rkt | 43 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 44 insertions(+), 1 deletion(-)
 create mode 100644 merkle.rkt

diff --git a/info.rkt b/info.rkt
index 6cf5943..ad62add 100644
--- a/info.rkt
+++ b/info.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")
diff --git a/merkle.rkt b/merkle.rkt
new file mode 100644
index 0000000..3dac588
--- /dev/null
+++ b/merkle.rkt
@@ -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))
-- 
2.38.4