14 files changed, 407 insertions, 349 deletions

diff --git a/lib/Utilities.ml b/lib/Utilities.ml
index f2c96a7..9ae0119 100644
--- a/lib/Utilities.ml
+++ b/lib/Utilities.ml
@@ -2,11 +2,11 @@ module Result = struct
   let ( let* ) = Result.bind
   let fmap f m = Result.bind m f
 
-  let sequence ms =
-    List.fold_right
-      (fun m acc ->
-        let* acc = acc in
-        let* m = m in
-        Ok (m :: acc) )
-      ms (Ok [])
+  let sequence ms = List.fold_right
+                      (fun m acc ->
+                        let* acc = acc in
+                        let* m = m in
+                        Ok (m::acc))
+                      ms
+                      (Ok [])
 end
diff --git a/lib/backend/managers/Lifecycle.ml b/lib/backend/managers/Lifecycle.ml
index 5f336ef..d104249 100644
--- a/lib/backend/managers/Lifecycle.ml
+++ b/lib/backend/managers/Lifecycle.ml
@@ -79,8 +79,7 @@ let rec cascade (tree : tree) (disposals : disposal BatFingerTree.t) (path : Con
           in
           Result.bind (Object.unregister path tree) (fun tree ->
               BatFingerTree.fold_left
-                (fun acc dep ->
-                  Result.bind acc (fun (tree, disposals) -> cascade tree disposals dep) )
+                (fun acc dep -> Result.bind acc (fun (tree, disposals) -> cascade tree disposals dep))
                 (Ok (tree, disposals))
                 edges )
       end
diff --git a/lib/concepts/Branch.ml b/lib/concepts/Branch.ml
index 57c46b3..cd4213b 100644
--- a/lib/concepts/Branch.ml
+++ b/lib/concepts/Branch.ml
@@ -1,5 +1,8 @@
 type address = Hash.hash
-type t = {name: string; target: address}
+
+type t =
+  { name: string;
+    target: address }
 
 module Field = struct
   let name = "name"
@@ -19,6 +22,7 @@ module Error = struct
 end
 
 let make ~name ~target = {name; target}
+
 let name branch = branch.name
 let target branch = branch.target
 
@@ -27,10 +31,13 @@ module Body = struct
 
   let tag = 'b'
   let malformed = Error.malformed_branch
-  let equal left right = left.name = right.name && Hash.hash_equals left.target right.target
+
+  let equal left right =
+    left.name = right.name && Hash.hash_equals left.target right.target
 
   let fields branch =
-    [Field.name, Object.Field.string branch.name; Field.target, Object.Field.address branch.target]
+    [ Field.name, Object.Field.string branch.name;
+      Field.target, Object.Field.address branch.target ]
 
   let of_fields data =
     let open Utilities.Result in
diff --git a/lib/concepts/Branch.mli b/lib/concepts/Branch.mli
index 3fb6ebe..0e7e9f9 100644
--- a/lib/concepts/Branch.mli
+++ b/lib/concepts/Branch.mli
@@ -4,5 +4,6 @@ type address = Hash.hash
 include Object.S with type t := t
 
 val make : name:string -> target:address -> t
+
 val name : t -> string
 val target : t -> address
diff --git a/lib/concepts/Codec.ml b/lib/concepts/Codec.ml
index 97039c3..758d718 100644
--- a/lib/concepts/Codec.ml
+++ b/lib/concepts/Codec.ml
@@ -1,4 +1,4 @@
-module Error = struct
+ module Error = struct
   open Condition
 
   let unexpected_end =
@@ -16,19 +16,21 @@ module Error = struct
     condition "codec-string-out-of-bounds" "A string length runs past the end of input"
       ("length" |=| Value.Integer length)
 
-  let trailing_bytes = condition "codec-trailing-bytes" "Bytes remain after a complete value" empty
+  let trailing_bytes =
+    condition "codec-trailing-bytes" "Bytes remain after a complete value" empty
 
   let tag_mismatch ~expected ~actual =
     condition "codec-tag-mismatch" "A value with a different tag was expected"
-      ( "expected" |=| Value.String (String.make 1 expected)
-      & "actual" |=| Value.String (String.make 1 actual) )
+      ("expected" |=| Value.String (String.make 1 expected) &
+       "actual" |=| Value.String (String.make 1 actual))
 
   let type_mismatch ~expected =
     condition "codec-type-mismatch" "A Bencode value of a different shape was expected"
       ("expected" |=| Value.String expected)
 
   let missing_field key =
-    condition "codec-missing-field" "A required field is absent" ("field" |=| Value.String key)
+    condition "codec-missing-field" "A required field is absent"
+      ("field" |=| Value.String key)
 
   let unexpected_object ~expected ~actual =
     condition "codec-unexpected-object" "The decoded object is not of the expected kind"
@@ -47,37 +49,38 @@ end
    - List   "l" <element>* "e"
    - Dict   "d" (<String key> <value>)* "e" keys sorted on encode *)
 module Bencode = struct
-  type t =
-    | Tagged of char * t
-    | Int of int
-    | String of string
-    | List of t list
-    | Dict of (string * t) list
+  type t = Tagged of char * t | Int of int | String of string | List of t list | Dict of (string * t) list
 
   let rec encode buf = function
-    | Tagged (tag, value) -> Buffer.add_char buf 't'; Buffer.add_char buf tag; encode buf value
+    | Tagged (tag, value) ->
+       Buffer.add_char buf 't';
+       Buffer.add_char buf tag;
+       encode buf value
     | Int n ->
-        Buffer.add_char buf 'i';
-        Buffer.add_string buf (string_of_int n);
-        Buffer.add_char buf 'e'
+       Buffer.add_char buf 'i';
+       Buffer.add_string buf (string_of_int n);
+       Buffer.add_char buf 'e'
     | String s ->
-        Buffer.add_string buf (string_of_int (String.length s));
-        Buffer.add_char buf ':';
-        Buffer.add_string buf s
+       Buffer.add_string buf (string_of_int (String.length s));
+       Buffer.add_char buf ':';
+       Buffer.add_string buf s
     | List xs ->
-        Buffer.add_char buf 'l';
-        List.iter (encode buf) xs;
-        Buffer.add_char buf 'e'
+       Buffer.add_char buf 'l';
+       List.iter (encode buf) xs;
+       Buffer.add_char buf 'e'
     | Dict kvs ->
-        Buffer.add_char buf 'd';
-        List.iter
-          (fun (k, v) -> encode buf (String k); encode buf v)
-          (List.sort (fun (a, _) (b, _) -> String.compare a b) kvs);
-        Buffer.add_char buf 'e'
+       Buffer.add_char buf 'd';
+       List.iter
+         (fun (k, v) ->
+           encode buf (String k);
+           encode buf v )
+         (List.sort (fun (a, _) (b, _) -> String.compare a b) kvs);
+       Buffer.add_char buf 'e'
 
   let to_bytes (value : t) : bytes =
     let buf = Buffer.create 256 in
-    encode buf value; Buffer.to_bytes buf
+    encode buf value;
+    Buffer.to_bytes buf
 
   let as_string = function String s -> Ok s | _ -> Error (Error.type_mismatch ~expected:"string")
   let as_int = function Int n -> Ok n | _ -> Error (Error.type_mismatch ~expected:"integer")
@@ -89,7 +92,7 @@ module Bencode = struct
     let s = Bytes.to_string bytes in
     let n = String.length s in
     let pos = ref 0 in
-    let peek () = if !pos >= n then Error Error.unexpected_end else Ok s.[!pos] in
+    let peek () = if !pos >= n then Error (Error.unexpected_end) else Ok (s.[!pos]) in
     let advance () = incr pos in
     (* Read the decimal run up to (and consuming) [term]. *)
     let read_int_from start term =
@@ -103,7 +106,8 @@ module Bencode = struct
           | None -> Error (Error.malformed_integer digits)
         end
         else begin
-          advance (); scan ()
+          advance ();
+          scan ()
         end
       in
       scan ()
@@ -111,44 +115,43 @@ module Bencode = struct
     let read_int term = read_int_from !pos term in
     let read_char () =
       let* c = peek () in
-      advance (); Ok c
+      advance ();
+      Ok c
     in
     let rec parse () =
       let* c = peek () in
       advance ();
       match c with
       | 't' ->
-          let* tag = read_char () in
-          let* data = parse () in
-          Ok (Tagged (tag, data))
+         let* tag = read_char () in
+         let* data = parse () in
+         Ok (Tagged (tag, data))
       | 'i' ->
-          let* n = read_int 'e' in
-          Ok (Int n)
+         let* n = read_int 'e' in
+         Ok (Int n)
       | 'l' -> parse_list []
       | 'd' -> parse_dict []
       | c when c >= '0' && c <= '9' -> parse_string_from (!pos - 1)
       | c -> Error (Error.unexpected_byte c)
-    and parse_string () = parse_string_from !pos
+    and parse_string () =
+      parse_string_from !pos
     and parse_string_from start =
       let* len = read_int_from start ':' in
-      if len < 0 || !pos + len > n then Error (Error.string_out_of_bounds len)
+      if len < 0 || !pos + len > n then
+        Error (Error.string_out_of_bounds len)
       else
         let str = String.sub s !pos len in
         pos := !pos + len;
         Ok (String str)
     and parse_list acc =
       let* c = peek () in
-      if c = 'e' then (
-        advance ();
-        Ok (List (List.rev acc)) )
+      if c = 'e' then (advance (); Ok (List (List.rev acc)))
       else
         let* result = parse () in
         parse_list (result :: acc)
     and parse_dict acc =
       let* c = peek () in
-      if c = 'e' then (
-        advance ();
-        Ok (Dict (List.rev acc)) )
+      if c = 'e' then (advance (); Ok (Dict (List.rev acc)))
       else
         let* key = parse_string () in
         let* key = as_string key in
@@ -156,17 +159,24 @@ module Bencode = struct
         parse_dict ((key, value) :: acc)
     in
     let* value = parse () in
-    if !pos <> n then Error Error.trailing_bytes else Ok value
+    if !pos <> n then Error Error.trailing_bytes else
+      Ok value
 
   let to_blob x = to_bytes x |> Representation.blob_of_bytes
   let of_blob b = Representation.bytes_of_blob b |> of_bytes
 
   let with_tag t = function
-    | Tagged (t', v) -> if t = t' then Ok v else Error (Error.tag_mismatch ~expected:t ~actual:t')
+    | Tagged (t', v) ->
+       if t = t' then
+         Ok v
+       else
+         Error (Error.tag_mismatch ~expected:t ~actual:t')
     | _ -> Error (Error.type_mismatch ~expected:"tagged")
 
   let field key = function
     | Dict kvs -> (
-      match List.assoc_opt key kvs with Some v -> Ok v | None -> Error (Error.missing_field key) )
+      match List.assoc_opt key kvs with
+      | Some v -> Ok v
+      | None -> Error (Error.missing_field key) )
     | _ -> Error (Error.type_mismatch ~expected:"dict")
 end
diff --git a/lib/concepts/Hash.ml b/lib/concepts/Hash.ml
index a84c60d..aac7428 100644
--- a/lib/concepts/Hash.ml
+++ b/lib/concepts/Hash.ml
@@ -2,16 +2,22 @@
 
 type hash = Digestif.SHA256.t
 
-let size = 256 / 8
-let compare h1 h2 = Digestif.SHA256.unsafe_compare h1 h2 |> Ordering.of_int
+let size = 256/8
+
+let compare h1 h2 = Digestif.SHA256.unsafe_compare h1 h2
+                    |> Ordering.of_int
 
 let hash_of_value (v : Value.value) =
   Representation.(blob_of_value v |> bytes_of_blob) |> Digestif.SHA256.digest_bytes
 
 let hash_of_bytes bytes = Digestif.SHA256.digest_bytes bytes
+
 let hash_of_blob blob = Representation.bytes_of_blob blob |> Digestif.SHA256.digest_bytes
+
 let to_raw_string hash = Digestif.SHA256.to_raw_string hash
+
 let of_raw_string str = Digestif.SHA256.of_raw_string str
+
 let hash_equals = Digestif.SHA256.equal
 let bytes_of_hash (h : hash) = Bytes.of_string (Digestif.SHA256.to_raw_string h)
 
diff --git a/lib/concepts/Multigroup.ml b/lib/concepts/Multigroup.ml
index b8fc743..863cd26 100644
--- a/lib/concepts/Multigroup.ml
+++ b/lib/concepts/Multigroup.ml
@@ -1,5 +1,8 @@
 type address = Hash.hash
-type t = {name: string; relations: address}
+
+type t =
+  { name: string;
+    relations: address }
 
 module Field = struct
   let name = "name"
@@ -19,6 +22,7 @@ module Error = struct
 end
 
 let make ~name ~relations = {name; relations}
+
 let name multigroup = multigroup.name
 let relations multigroup = multigroup.relations
 
@@ -27,7 +31,9 @@ module Body = struct
 
   let tag = 'm'
   let malformed = Error.malformed_multigroup
-  let equal left right = left.name = right.name && Hash.hash_equals left.relations right.relations
+
+  let equal left right =
+    left.name = right.name && Hash.hash_equals left.relations right.relations
 
   let fields multigroup =
     [ Field.name, Object.Field.string multigroup.name;
diff --git a/lib/concepts/Multigroup.mli b/lib/concepts/Multigroup.mli
index ef0f8ea..1a76dce 100644
--- a/lib/concepts/Multigroup.mli
+++ b/lib/concepts/Multigroup.mli
@@ -4,5 +4,6 @@ type address = Hash.hash
 include Object.S with type t := t
 
 val make : name:string -> relations:address -> t
+
 val name : t -> string
 val relations : t -> address
diff --git a/lib/concepts/Object.ml b/lib/concepts/Object.ml
index aacbda6..22fb14a 100644
--- a/lib/concepts/Object.ml
+++ b/lib/concepts/Object.ml
@@ -6,10 +6,13 @@ module type S = sig
   type t
 
   val equal : t -> t -> bool
+
   val to_bencode : t -> bencode
   val of_bencode : bencode -> (t, Condition.condition) result
+
   val to_blob : t -> Representation.blob
   val of_blob : Representation.blob -> (t, Condition.condition) result
+
   val to_bytes : t -> bytes
   val of_bytes : bytes -> (t, Condition.condition) result
 end
@@ -48,11 +51,13 @@ module Codec = struct
     let to_bencode object_ = Bencode.Tagged (B.tag, Bencode.Dict (B.fields object_))
 
     let of_bencode = function
-      | Bencode.Tagged (tag, (Bencode.Dict _ as data)) when Char.equal tag B.tag -> B.of_fields data
+      | Bencode.Tagged (tag, (Bencode.Dict _ as data)) when Char.equal tag B.tag ->
+          B.of_fields data
       | _ -> Error (B.malformed ())
 
     let to_blob object_ = to_bencode object_ |> Bencode.to_blob
     let of_blob blob = Bencode.of_blob blob |> Utilities.Result.fmap of_bencode
+
     let to_bytes object_ = to_blob object_ |> Representation.bytes_of_blob
     let of_bytes bytes = Bencode.of_bytes bytes |> Utilities.Result.fmap of_bencode
   end
diff --git a/lib/concepts/Object.mli b/lib/concepts/Object.mli
index 7b0c4fd..e132673 100644
--- a/lib/concepts/Object.mli
+++ b/lib/concepts/Object.mli
@@ -4,10 +4,13 @@ module type S = sig
   type t
 
   val equal : t -> t -> bool
+
   val to_bencode : t -> bencode
   val of_bencode : bencode -> (t, Condition.condition) result
+
   val to_blob : t -> Representation.blob
   val of_blob : Representation.blob -> (t, Condition.condition) result
+
   val to_bytes : t -> bytes
   val of_bytes : bytes -> (t, Condition.condition) result
 end
@@ -17,6 +20,7 @@ module type OBJECT = S
 module Field : sig
   val string : string -> bencode
   val address : Hash.hash -> bencode
+
   val require_string : string -> bencode -> (string, Condition.condition) result
 
   val require_address :
diff --git a/lib/concepts/Ordering.ml b/lib/concepts/Ordering.ml
index 8952b41..42b20e5 100644
--- a/lib/concepts/Ordering.ml
+++ b/lib/concepts/Ordering.ml
@@ -1,3 +1,4 @@
 type ordering = Equal | Smaller | Greater
 
-let of_int x = if x < 0 then Smaller else if x > 0 then Greater else Equal
+let of_int x =
+  if x < 0 then Smaller else if x > 0 then Greater else Equal
diff --git a/lib/concepts/Relation.ml b/lib/concepts/Relation.ml
index 1194804..a4fb341 100644
--- a/lib/concepts/Relation.ml
+++ b/lib/concepts/Relation.ml
@@ -1,6 +1,10 @@
 type address = Hash.hash
 type schema = string BatMap.String.t
-type t = {name: string; tuples: address; schema: schema}
+
+type t =
+  { name: string;
+    tuples: address;
+    schema: schema }
 
 module Field = struct
   let name = "name"
@@ -21,27 +25,31 @@ module Error = struct
 end
 
 let make ~name ~tuples ~schema = {name; tuples; schema}
+
 let name relation = relation.name
 let tuples relation = relation.tuples
 let schema relation = relation.schema
+
 let schema_empty = BatMap.String.empty
 
 let schema_of_list fields =
-  List.fold_left (fun acc (name, domain) -> BatMap.String.add name domain acc) schema_empty fields
+  List.fold_left (fun acc (name, domain) -> BatMap.String.add name domain acc) schema_empty
+    fields
 
 let schema_to_list schema = BatMap.String.bindings schema
 
 let schema_to_bencode schema =
   Codec.Bencode.Dict
-    (schema_to_list schema |> List.map (fun (name, domain) -> name, Codec.Bencode.String domain))
+    (schema_to_list schema
+    |> List.map (fun (name, domain) -> name, Codec.Bencode.String domain) )
 
 let schema_of_bencode value =
   let open Utilities.Result in
   let* fields = Codec.Bencode.as_dict value in
   fields
   |> List.map (fun (name, domain) ->
-      let* domain = Codec.Bencode.as_string domain in
-      Ok (name, domain) )
+         let* domain = Codec.Bencode.as_string domain in
+         Ok (name, domain) )
   |> sequence
   |> Result.map schema_of_list
 
diff --git a/lib/concepts/Relation.mli b/lib/concepts/Relation.mli
index d370578..5319a3d 100644
--- a/lib/concepts/Relation.mli
+++ b/lib/concepts/Relation.mli
@@ -5,9 +5,11 @@ type schema
 include Object.S with type t := t
 
 val make : name:string -> tuples:address -> schema:schema -> t
+
 val name : t -> string
 val tuples : t -> address
 val schema : t -> schema
+
 val schema_empty : schema
 val schema_of_list : (string * string) list -> schema
 val schema_to_list : schema -> (string * string) list
diff --git a/lib/kernel/Merkle.ml b/lib/kernel/Merkle.ml
index 913c9f1..5bd427f 100644
--- a/lib/kernel/Merkle.ml
+++ b/lib/kernel/Merkle.ml
@@ -13,188 +13,191 @@ end
 
 module type TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> sig
   type address = Concepts.Hash.hash
+
   type node
 
   val find : S.transaction -> address -> (node option, Concepts.Condition.condition) result
+
   val empty : node
+
   val hash_of : node -> address
-  val persist : S.transaction -> node -> (address, Concepts.Condition.condition) result
 
-  val insert :
-    S.transaction -> K.t -> address -> node -> (node, Concepts.Condition.condition) result
+  val persist : S.transaction -> node -> (address, Concepts.Condition.condition) result
 
+  val insert : S.transaction -> K.t -> address -> node -> (node, Concepts.Condition.condition) result
   val remove : S.transaction -> K.t -> node -> (node, Concepts.Condition.condition) result
   val lookup : S.transaction -> K.t -> node -> (address option, Concepts.Condition.condition) result
 end
 
-module Make : TREE =
-functor
-  (S : Abstract.Storage.STORAGE)
-  (K : KEY)
-  ->
-  struct
-    type address = Concepts.Hash.hash
-
-    module Error = struct
-      open Concepts.Condition
-
-      let malformed_node () =
-        condition "malformed-node" "A node representation did not conform to what was expected"
-          empty
-    end
-
-    type node =
-      | Leaf of {keys: K.t BatFingerTree.t; values: address BatFingerTree.t}
-      | Trunk of {keys: K.t BatFingerTree.t; children: address BatFingerTree.t}
-
-    let empty = Leaf {keys= BatFingerTree.empty; values= BatFingerTree.empty}
-
-    let rec lookup1' keys key bottom top =
-      let open Concepts.Ordering in
-      if bottom >= top then bottom, false
-      else
-        let mid = bottom + ((top - bottom) / 2) in
-        let node = BatFingerTree.get keys mid in
-        match K.compare node key with
-        | Equal -> mid, true
-        | Greater -> lookup1' keys key bottom mid
-        | Smaller -> lookup1' keys key (mid + 1) top
-
-    let lookup1 keys key = lookup1' keys key 0 (BatFingerTree.size keys)
-    let keys_of = function Leaf {keys; _} -> keys | Trunk {keys; _} -> keys
-
-    let of_bencode =
-      let open Concepts.Codec.Bencode in
-      let open Utilities.Result in
-      (* This is terrible *)
-      let decode_key t =
-        as_string t
-        |> Result.map String.to_bytes
-        |> Result.map Concepts.Representation.blob_of_bytes
-        |> fmap K.decode
-      in
-      let decode_value t = as_string t |> Result.map Concepts.Hash.of_raw_string in
-      let decode_list f data =
-        data
-        |> fmap as_list
-        |> Result.map (List.map f)
-        |> fmap sequence
-        |> Result.map BatFingerTree.of_list
-      in
-      function
-      | Tagged ('!', (Dict _ as data)) ->
-          let* keys = field "keys" data |> decode_list decode_key in
-          let* values = field "values" data |> decode_list decode_value in
-          Ok (Leaf {keys; values})
-      | Tagged ('#', (Dict _ as data)) ->
-          let* keys = field "keys" data |> decode_list decode_key in
-          let* children = field "children" data |> decode_list decode_value in
-          Ok (Trunk {keys; children})
-      | _ -> Error (Error.malformed_node ())
-
-    let from_blob blob = Concepts.Codec.Bencode.of_blob blob |> Utilities.Result.fmap of_bencode
-
-    let to_bencode =
-      let open Concepts.Codec.Bencode in
-      (* Ditto. *)
-      let bencode_key k =
-        K.encode k |> Concepts.Representation.bytes_of_blob |> String.of_bytes |> fun s -> String s
-      in
-      let bencode_hash h = String (Concepts.Hash.to_raw_string h) in
-      function
-      | Leaf {keys; values} ->
-          Tagged
-            ( '!',
-              Dict
-                [ "keys", List (BatFingerTree.to_list keys |> List.map bencode_key);
-                  "values", List (BatFingerTree.to_list values |> List.map bencode_hash) ] )
-      | Trunk {keys; children} ->
-          Tagged
-            ( '#',
-              Dict
-                [ "keys", List (BatFingerTree.to_list keys |> List.map bencode_key);
-                  "children", List (BatFingerTree.to_list children |> List.map bencode_hash) ] )
-
-    let to_blob node = to_bencode node |> Concepts.Codec.Bencode.to_blob
-
-    (* TODO: we should probably cache this inside the node itself rather
+module Make : TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> struct
+  type address = Concepts.Hash.hash
+
+  module Error = struct
+    open Concepts.Condition
+
+    let malformed_node () = condition "malformed-node" "A node representation did not conform to what was expected" empty
+  end
+
+  type node =
+    Leaf of
+      { keys : K.t BatFingerTree.t;
+        values : address BatFingerTree.t }
+  | Trunk of
+      { keys : K.t BatFingerTree.t;
+        children : address BatFingerTree.t }
+
+  let empty = Leaf { keys = BatFingerTree.empty; values = BatFingerTree.empty }
+
+  let rec lookup1' keys key bottom top =
+    let open Concepts.Ordering in
+    if bottom >= top then (bottom, false)
+    else
+      let mid = bottom + (top - bottom) / 2 in
+      let node = BatFingerTree.get keys mid in
+      match K.compare node key with
+      | Equal -> (mid, true)
+      | Greater -> lookup1' keys key bottom mid
+      | Smaller -> lookup1' keys key (mid + 1) top
+
+  let lookup1 keys key = lookup1' keys key 0 (BatFingerTree.size keys)
+
+  let keys_of = function
+    | Leaf { keys; _ } -> keys
+    | Trunk { keys; _ } -> keys
+
+  let of_bencode =
+    let open Concepts.Codec.Bencode in
+    let open Utilities.Result in
+    (* This is terrible *)
+    let decode_key t = as_string t
+                       |> Result.map String.to_bytes
+                       |> Result.map Concepts.Representation.blob_of_bytes
+                       |> fmap K.decode in
+    let decode_value t = as_string t |> Result.map Concepts.Hash.of_raw_string in
+    let decode_list f data = data
+                             |> fmap as_list
+                             |> Result.map (List.map f)
+                             |> fmap sequence
+                             |> Result.map BatFingerTree.of_list in
+    function
+    | Tagged ('!', (Dict _ as data)) ->
+       let* keys = field "keys" data |> decode_list decode_key in
+       let* values = field "values" data |> decode_list decode_value in
+       Ok (Leaf { keys; values })
+    | Tagged ('#', (Dict _ as data)) ->
+       let* keys = field "keys" data |> decode_list decode_key in
+       let* children = field "children" data |> decode_list decode_value in
+       Ok (Trunk { keys; children })
+    | _ -> Error (Error.malformed_node ())
+
+  let from_blob blob = Concepts.Codec.Bencode.of_blob blob
+                       |> Utilities.Result.fmap of_bencode
+
+  let to_bencode =
+    let open Concepts.Codec.Bencode in
+    (* Ditto. *)
+    let bencode_key k = K.encode k
+                        |> Concepts.Representation.bytes_of_blob
+                        |> String.of_bytes
+                        |> (fun s -> String s) in
+    let bencode_hash h = String (Concepts.Hash.to_raw_string h) in
+    function
+    | Leaf { keys; values } ->
+       Tagged ('!', Dict [("keys", List (BatFingerTree.to_list keys |> List.map bencode_key));
+                          ("values", List (BatFingerTree.to_list values |> List.map bencode_hash))])
+    | Trunk { keys; children } ->
+       Tagged ('#', Dict [("keys", List (BatFingerTree.to_list keys |> List.map bencode_key));
+                          ("children", List (BatFingerTree.to_list children |> List.map bencode_hash))])
+
+  let to_blob node = to_bencode node |> Concepts.Codec.Bencode.to_blob
+
+  (* TODO: we should probably cache this inside the node itself rather
      than recalculating it every time. We could also allow the user to
      create "uninterned" nodes that are not storage-backed, that could
      be used for intermediates and the like. *)
-    let hash_of node = to_blob node |> Concepts.Hash.hash_of_blob
-
-    let find tx node =
-      let open Utilities.Result in
-      let* data = S.get tx node in
-      match data with
-      | None -> Ok None
-      | Some data ->
-          let* node = from_blob data in
-          Ok (Some node)
-
-    let find' tx node =
-      let open Utilities.Result in
-      let* child = find tx node in
-      match child with
-      | Some child -> Ok child
-      | None ->
-          failwith
-            "A child node was not found on the underlying storage. Either your database is \
-             corrupted, or this is a bug on RNT!"
-
-    let rec lookup tx key node =
-      let open Utilities.Result in
-      let i, found = lookup1 (keys_of node) key in
-      match node with
-      | Leaf {values; _} -> if found then Ok (Some (BatFingerTree.get values i)) else Ok None
-      | Trunk {children; _} ->
-          let* child = BatFingerTree.get children (if found then i + 1 else i) |> find' tx in
-          lookup tx key child
-
-    let persist tx node =
-      let open Utilities.Result in
-      let data = to_blob node in
-      let addr = Concepts.Hash.hash_of_blob data in
-      let* () = S.put tx addr data in
-      Ok addr
-
-    type op = Update of address * node | Split of address * K.t * address
-
-    let emplace i v ft =
-      let size = BatFingerTree.size ft in
-      if i < 0 || i > size then invalid_arg "Merkle.emplace: index out of bounds"
-      else if size = 0 then BatFingerTree.singleton v
-      else if i = size then BatFingerTree.snoc ft v
-      else
-        let fl, fr = BatFingerTree.split_at ft i in
-        BatFingerTree.singleton v |> BatFingerTree.append fl |> (Fun.flip BatFingerTree.append) fr
-
-    let insert1 key value node =
-      let i, present = lookup1 (keys_of node) key in
-      match node with
-      | Leaf ({keys; values} as leaf) ->
-          if present then Leaf {leaf with values= BatFingerTree.set values i value}
-          else Leaf {keys= emplace i key keys; values= emplace i value values}
-      (* When in danger or in doubt: run in circles, scream and shout. *)
-      | Trunk _ -> failwith "Cannot insert a value on a trunk node. This is a bug in RNT!"
-
-    let pivot_at ft i =
-      let l, r' = BatFingerTree.split_at ft i in
-      let r, p = BatFingerTree.front_exn r' in
-      l, p, r
-
-    let split_at pivot = function
-      | Leaf {keys; values} ->
-          let kl, kr = BatFingerTree.split_at keys pivot in
-          let vl, vr = BatFingerTree.split_at values pivot in
-          let p = BatFingerTree.get kr 0 in
-          Leaf {keys= kl; values= vl}, p, Leaf {keys= kr; values= vr}
-      | Trunk {keys; children} ->
-          let kl, kp, kr = pivot_at keys pivot in
-          let cl, cr = BatFingerTree.split_at children (pivot + 1) in
-          Trunk {keys= kl; children= cl}, kp, Trunk {keys= kr; children= cr}
-
-    (* FIXME: this works out to a geometric distribution with roughly 64
+  let hash_of node = to_blob node |> Concepts.Hash.hash_of_blob
+
+  let find tx node =
+    let open Utilities.Result in
+    let* data = S.get tx node in
+    match data with
+    | None -> Ok None
+    | Some data ->
+       let* node = from_blob data in
+       Ok (Some node)
+
+  let find' tx node =
+    let open Utilities.Result in
+    let* child = find tx node in
+    match child with
+    | Some child -> Ok child
+    | None -> failwith "A child node was not found on the underlying storage. Either your database is corrupted, or this is a bug on RNT!"
+
+  let rec lookup tx key node =
+    let open Utilities.Result in
+    let i, found = lookup1 (keys_of node) key in
+    match node with
+    | Leaf { values; _ } ->
+       if found then Ok (Some (BatFingerTree.get values i)) else Ok None
+    | Trunk { children; _ } ->
+       let* child = BatFingerTree.get children (if found then i+1 else i) |> find' tx in
+       lookup tx key child
+
+  let persist tx node =
+    let open Utilities.Result in
+    let data = to_blob node in
+    let addr = Concepts.Hash.hash_of_blob data in
+    let* () = S.put tx addr data in
+    Ok addr
+
+  type op = Update of address * node | Split of address * K.t * address
+
+  let emplace i v ft =
+    let size = BatFingerTree.size ft in
+    if i < 0 || i > size then
+      invalid_arg "Merkle.emplace: index out of bounds"
+    else if size = 0 then
+      BatFingerTree.singleton v
+    else if i = size then
+      BatFingerTree.snoc ft v
+    else
+      let fl, fr = BatFingerTree.split_at ft i in
+      BatFingerTree.singleton v
+      |> BatFingerTree.append fl
+      |> (Fun.flip BatFingerTree.append) fr
+
+  let insert1 key value node =
+    let i, present = lookup1 (keys_of node) key in
+    match node with
+    | Leaf ({ keys; values } as leaf) ->
+       if present then
+         Leaf { leaf with values = BatFingerTree.set values i value }
+       else
+         Leaf { keys = emplace i key keys; values = emplace i value values }
+    (* When in danger or in doubt: run in circles, scream and shout. *)
+    | Trunk _ -> failwith "Cannot insert a value on a trunk node. This is a bug in RNT!"
+
+  let pivot_at ft i =
+    let l, r' = BatFingerTree.split_at ft i in
+    let r, p = BatFingerTree.front_exn r' in
+    l, p, r
+
+  let split_at pivot = function
+    | Leaf { keys; values } ->
+       let kl, kr = BatFingerTree.split_at keys pivot in
+       let vl, vr = BatFingerTree.split_at values pivot in
+       let p = BatFingerTree.get kr 0 in
+       Leaf { keys = kl; values = vl },
+       p,
+       Leaf { keys = kr; values = vr }
+    | Trunk { keys; children } ->
+       let kl, kp, kr = pivot_at keys pivot in
+       let cl, cr = BatFingerTree.split_at children (pivot + 1) in
+       Trunk { keys = kl; children = cl },
+       kp,
+       Trunk { keys = kr; children = cr }
+
+  (* FIXME: this works out to a geometric distribution with roughly 64
      keys per node. Some of the consequences of this are that:
      - most of our nodes will end up with one or a few elements, which
        would make our trees taller than they would normally need to be
@@ -205,128 +208,133 @@ functor
      node size. See
      https://www.dolthub.com/docs/architecture/storage-engine/prolly-tree/#controlling-chunk-size
    *)
-    let should_split = Concepts.Hash.pick 6
-
-    let hash_of_keys ks =
-      let buffer = Buffer.create 1024 in
-      BatFingerTree.iter
-        (fun k -> K.encode k |> Concepts.Representation.bytes_of_blob |> Buffer.add_bytes buffer)
-        ks;
-      Concepts.Hash.hash_of_bytes (Buffer.to_bytes buffer)
-
-    let split_position keys =
-      let rec loop left right =
-        match BatFingerTree.front right with
-        | None -> None
-        | Some (tail, head) ->
-            (* TODO: rolling hash *)
-            let left' = BatFingerTree.snoc left head in
-            let hash = hash_of_keys left' in
-            if should_split hash then Some (BatFingerTree.size left) else loop left' tail
-      in
-      loop BatFingerTree.empty keys
-
-    let commit_node tx node =
-      let open Utilities.Result in
-      match split_position (keys_of node) with
-      | Some i ->
-          let l, p, r = split_at i node in
-          let* l_addr = persist tx l in
-          let* r_addr = persist tx r in
-          Ok (Split (l_addr, p, r_addr))
-      | None ->
-          let* addr = persist tx node in
-          Ok (Update (addr, node))
-
-    let rec insert' tx key value node =
-      let open Utilities.Result in
-      match node with
-      | Leaf _ -> insert1 key value node |> commit_node tx
-      | Trunk {keys; children} -> (
-          let i, found = lookup1 keys key in
-          let i = if found then i + 1 else i in
-          let* child = BatFingerTree.get children i |> find' tx in
-          let* r = insert' tx key value child in
-          match r with
-          | Update (addr, _) ->
-              Trunk {keys; children= BatFingerTree.set children i addr} |> commit_node tx
-          | Split (l, p, r) ->
-              Trunk
-                { keys= emplace i p keys;
-                  children= BatFingerTree.set children i l |> emplace (i + 1) r }
-              |> commit_node tx )
-
-    let insert tx key value node =
-      let open Utilities.Result in
-      let* op = insert' tx key value node in
-      match op with
-      | Update (_, node) -> Ok node
-      | Split (l, p, r) ->
-          let new_root =
-            Trunk
-              { keys= BatFingerTree.singleton p;
-                children=
-                  BatFingerTree.empty
-                  |> (Fun.flip BatFingerTree.snoc) l
-                  |> (Fun.flip BatFingerTree.snoc) r }
-          in
-          let* _ = persist tx new_root in
-          Ok new_root
-
-    let remove tx key node = failwith "TODO" [@@warning "-27"]
-  end
+  let should_split = Concepts.Hash.pick 6
+
+  let hash_of_keys ks =
+    let buffer = Buffer.create 1024 in
+    BatFingerTree.iter
+      (fun k ->
+        K.encode k
+        |> Concepts.Representation.bytes_of_blob
+        |> Buffer.add_bytes buffer)
+      ks;
+    Concepts.Hash.hash_of_bytes (Buffer.to_bytes buffer)
+
+  let split_position keys =
+    let rec loop left right =
+      match BatFingerTree.front right with
+      | None -> None
+      | Some (tail, head) ->
+         (* TODO: rolling hash *)
+         let left' = BatFingerTree.snoc left head in
+         let hash = hash_of_keys left' in
+         if should_split hash then
+           Some (BatFingerTree.size left)
+         else
+           loop left' tail
+    in
+    loop BatFingerTree.empty keys
+
+  let commit_node tx node =
+    let open Utilities.Result in
+    match split_position (keys_of node) with
+    | Some i ->
+       let l, p, r = split_at i node in
+       let* l_addr = persist tx l in
+       let* r_addr = persist tx r in
+       Ok (Split (l_addr, p, r_addr))
+    | None ->
+       let* addr = persist tx node in
+       Ok (Update (addr, node))
+
+  let rec insert' tx key value node =
+    let open Utilities.Result in
+    match node with
+    | Leaf _ ->
+       insert1 key value node
+       |> commit_node tx
+    | Trunk { keys; children } ->
+       let i, found = lookup1 keys key in
+       let i = if found then i+1 else i in
+       let* child = BatFingerTree.get children i |> find' tx in
+       let* r = insert' tx key value child in
+       match r with
+       | Update (addr, _) ->
+          Trunk { keys; children = BatFingerTree.set children i addr }
+          |> commit_node tx
+       | Split (l, p, r) ->
+          Trunk { keys = emplace i p keys;
+                  children = BatFingerTree.set children i l |> emplace (i + 1) r }
+          |> commit_node tx
+
+  let insert tx key value node =
+    let open Utilities.Result in
+    let* op = insert' tx key value node in
+    match op with
+    | Update (_, node) -> Ok node
+    | Split (l, p, r) ->
+       let new_root =
+         Trunk { keys = BatFingerTree.singleton p;
+                 children = BatFingerTree.empty
+                            |> (Fun.flip BatFingerTree.snoc) l
+                            |> (Fun.flip BatFingerTree.snoc) r } in
+       let* _ = persist tx new_root in
+       Ok new_root
+
+  let remove tx key node = failwith "TODO" [@@warning "-27"]
+end
 
 module type INTERFACE = functor (S : Abstract.Storage.STORAGE) (K : KEY) (V : VALUE) -> sig
   type address
   type node
 
   val find : S.transaction -> address -> (node option, Concepts.Condition.condition) result
+
   val empty : node
+
   val hash_of : node -> address
+
   val insert : S.transaction -> K.t -> V.t -> node -> (node, Concepts.Condition.condition) result
   val remove : S.transaction -> K.t -> node -> (node, Concepts.Condition.condition) result
   val lookup : S.transaction -> K.t -> node -> (V.t option, Concepts.Condition.condition) result
 end
 
-module Interface : INTERFACE =
-functor
-  (S : Abstract.Storage.STORAGE)
-  (K : KEY)
-  (V : VALUE)
-  ->
-  struct
-    module T = Make (S) (K)
-
-    type address = T.address
-    type node = T.node
-
-    open Utilities.Result
-
-    let intern tx v =
-      let data = V.encode v in
-      let addr = Concepts.Hash.hash_of_blob data in
-      let* () = S.put tx addr data in
-      Ok addr
-
-    let retrieve tx addr =
-      let* data = S.get tx addr in
-      match data with
-      | None -> Ok None
-      | Some data ->
-          let* v = V.decode data in
-          Ok (Some v)
-
-    let find = T.find
-    let empty = T.empty
-    let hash_of = T.hash_of
-
-    let insert tx k v node =
-      let* addr = intern tx v in
-      T.insert tx k addr node
-
-    let remove = T.remove
-
-    let lookup tx k node =
-      let* addr = T.lookup tx k node in
-      match addr with None -> Ok None | Some addr -> retrieve tx addr
-  end
+module Interface : INTERFACE = functor (S : Abstract.Storage.STORAGE) (K : KEY) (V : VALUE) -> struct
+  module T = Make (S) (K)
+
+  type address = T.address
+  type node = T.node
+
+  open Utilities.Result
+
+  let intern tx v =
+    let data = V.encode v in
+    let addr = Concepts.Hash.hash_of_blob data in
+    let* () = S.put tx addr data in
+    Ok addr
+
+  let retrieve tx addr =
+    let* data = S.get tx addr in
+    match data with
+    | None -> Ok None
+    | Some data ->
+       let* v = V.decode data in
+       Ok (Some v)
+
+  let find = T.find
+  let empty = T.empty
+  let hash_of = T.hash_of
+
+  let insert tx k v node =
+    let* addr = intern tx v in
+    T.insert tx k addr node
+
+  let remove = T.remove
+
+  let lookup tx k node =
+    let* addr = T.lookup tx k node in
+    match addr with
+    | None -> Ok None
+    | Some addr -> retrieve tx addr
+
+end