Multigroup objects

1 files changed, 21 insertions, 7 deletions

diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml
index f44ab6e..64f9689 100644
--- a/lib/kernel/Branch.ml
+++ b/lib/kernel/Branch.ml
@@ -1,5 +1,3 @@
-module Multigroup = Merkle.StringKey (* FIXME *)
-
 module Make (S : Abstract.Storage.STORAGE) = struct
   (* Branch has a name, a set of multigroups, and a backlink to the previous state
      multigroup has a name and a set of schemas
@@ -10,7 +8,16 @@ module Make (S : Abstract.Storage.STORAGE) = struct
 
   module SI = Storage.Make (S)
 
-  module MultigroupM = Merkle.Interface (S) (Merkle.StringKey) (Multigroup)
+  module M = Multigroup.Make (S)
+  module MultigroupM = Merkle.Interface (S) (Merkle.StringKey) (M)
+  module MMDirectory = Prototype.Directory.OfTree (S) (Merkle.StringKey) (M)
+
+  module Error = struct
+    open Concepts.Condition
+
+    let incomplete_branch addr = condition "incomplete-branch" "A stored branch is missing part of its expected structure. Is your storage corrupted?"
+                                   ("address" |=| Concepts.Value.String (Concepts.Hash.to_hum_string addr))
+  end
 
   type t = {
     multigroups : MultigroupM.address;
@@ -52,13 +59,19 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       Ok { multigroups; previous }
   end
 
-  class branch storage value = object
+  class branch storage value node = object
     inherit Lifecycle.null
 
     val storage : S.connection = storage
     val branch : t = value
+    val node = node (* FIXME: can we not place this inside `t`? *)
 
-    method protocols : Protocols.Handle.protocol list = []
+    method protocols : Protocols.Handle.protocol list =
+      [ Prototype.Directory.of_properties
+          [ "multigroup", Prototype.mixture
+                            [ MMDirectory.make
+                                ~storage ~node
+                                ~constructor:(M.wrap storage) ] ] ]
 
     method hash =
       Representation.to_blob branch
@@ -69,7 +82,8 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     let open Utilities.Result in
     let* data = SI.get_req tx (S.Hash addr) in
     let* branch = Representation.of_blob data in
-    Ok (new branch conn branch |> Protocols.Handle.make)
+    let* node = MultigroupM.find tx branch.multigroups |> fmap (Option.to_result ~none:(Error.incomplete_branch branch.multigroups)) in
+    Ok (new branch conn branch node |> Protocols.Handle.make)
 
   let make conn =
     let open Utilities.Result in
@@ -77,5 +91,5 @@ module Make (S : Abstract.Storage.STORAGE) = struct
         let* empty = MultigroupM.empty_under tx in
         let branch = { multigroups = empty; previous = None } in
         let* _ = SI.store_blob tx (Representation.to_blob branch) in
-        Ok (new branch conn branch |> Protocols.Handle.make))
+        Ok (new branch conn branch MultigroupM.empty |> Protocols.Handle.make))
 end