2 files changed, 91 insertions, 23 deletions

diff --git a/test/unit/backend/Storage.ml b/test/unit/backend/Storage.ml
index 91db411..76bda8b 100644
--- a/test/unit/backend/Storage.ml
+++ b/test/unit/backend/Storage.ml
@@ -1,21 +1,9 @@
 open Rnt
 
-module type CONFIGURATOR = sig
-  val configure : string -> Rnt.Concepts.Configuration.term
-end
-
-module Make (S : Abstract.Storage.STORAGE) (C : CONFIGURATOR) = struct
+module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = struct
   open Alcotest
 
-  let with_connection f () =
-    Helpers.with_temporary_directory "storage-test" begin fun dir ->
-        begin
-          let open Utilities.Result in
-          let* conn = S.connect (C.configure dir) in
-          Ok (f conn)
-        end
-        |> Helpers.condition_as_failure
-      end
+  module H = Helpers.Storage.Make (S) (C)
 
   let storage_and_retrieval conn =
     let key = Concepts.Hash.hash_of_value (Concepts.Value.String "value") in
@@ -38,16 +26,9 @@ module Make (S : Abstract.Storage.STORAGE) (C : CONFIGURATOR) = struct
 
   let suite prefix =
     ( "storage/" ^ prefix,
-      [test_case "storage-and-retrieval" `Quick (with_connection storage_and_retrieval)] )
-end
-
-module LMDB_Configurator : CONFIGURATOR = struct
-  let configure base =
-    let open Sexplib.Sexp in
-    List [Atom "lmdb"; List [Atom "path"; Atom base]; List [Atom "mode"; Atom "420"]]
-    |> Rnt.Concepts.Configuration.term_of_sexp
+      [test_case "storage-and-retrieval" `Quick (H.with_connection storage_and_retrieval "storage-test")] )
 end
 
-module LMDB = Make (Rnt.Backend.Storage.LMDB) (LMDB_Configurator)
+module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)
 
 let suites () = [LMDB.suite "lmdb"]
diff --git a/test/unit/kernel/Merkle.ml b/test/unit/kernel/Merkle.ml
new file mode 100644
index 0000000..f12182a
--- /dev/null
+++ b/test/unit/kernel/Merkle.ml
@@ -0,0 +1,87 @@
+open Rnt
+
+module StringKey : Rnt.Kernel.Merkle.KEY with type t = string = struct
+  type t = string
+
+  let encode s = String.to_bytes s |> Concepts.Representation.blob_of_bytes
+  let compare s1 s2 = String.compare s1 s2 |> Concepts.Ordering.of_int
+  let decode b = Concepts.Representation.bytes_of_blob b |> String.of_bytes |> Result.ok
+end
+
+module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = struct
+  open Alcotest
+
+  module H = Helpers.Storage.Make (S) (C)
+  module T = Rnt.Kernel.Merkle.Interface (S) (StringKey) (StringKey)
+
+  (* TODO: be a bit more comprehensive (ideally, we want to test splits as well) *)
+  let insert_and_lookup conn =
+    let v1, v2, v3, v3', bogus =
+      begin
+        let open Utilities.Result in
+        let* tx = S.start conn in
+        let* node = T.empty
+                    |> T.insert tx "k1" "v1"
+                    |> fmap (T.insert tx "k2" "v2")
+                    |> fmap (T.insert tx "k3" "v3")
+        in
+        let* node' = T.insert tx "k3" "toodles" node in
+        let* v1 = T.lookup tx "k1" node in
+        let* v2 = T.lookup tx "k2" node in
+        let* v3 = T.lookup tx "k3" node in
+        let* v3' = T.lookup tx "k3" node' in
+        let* bogus = T.lookup tx "fnord" node in
+        Ok (v1, v2, v3, v3', bogus)
+      end
+      |> Helpers.condition_as_failure
+    in
+    check (option string) "" (Some "v1") v1;
+    check (option string) "" (Some "v2") v2;
+    check (option string) "" (Some "v3") v3;
+    check (option string) "" (Some "toodles") v3';
+    check (option string) "" None bogus
+
+  let persistence conn =
+    let addr =
+      begin
+        let open Utilities.Result in
+        let* tx = S.start conn in
+        let* node = T.empty
+                    |> T.insert tx "k1" "v1"
+                    |> fmap (T.insert tx "k2" "v2")
+                    |> fmap (T.insert tx "k3" "v3")
+        in
+        let* () = S.commit tx in
+        Ok (T.hash_of node)
+      end
+      |> Helpers.condition_as_failure
+    in
+    let v1, v2, v3 =
+      begin
+        let open Utilities.Result in
+        let* tx = S.start conn in
+        let* node = T.find tx addr |> Result.map Option.get in
+        let* v1 = T.lookup tx "k1" node in
+        let* v2 = T.lookup tx "k2" node in
+        let* v3 = T.lookup tx "k3" node in
+        Ok (v1, v2, v3)
+      end
+      |> Helpers.condition_as_failure
+    in
+    check (option string) "" (Some "v1") v1;
+    check (option string) "" (Some "v2") v2;
+    check (option string) "" (Some "v3") v3
+
+  (* TODO: this will need `remove` *)
+  (* let determinism _conn = *)
+  (*   () *)
+
+  let suite prefix =
+    ( "merkle/" ^ prefix,
+      [test_case "insert-and-lookup" `Quick (H.with_connection insert_and_lookup "merkle-test");
+       test_case "persistence" `Quick (H.with_connection persistence "merkle-test")])
+end
+
+module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)
+
+let suites () = [LMDB.suite "lmdb"]