Do not assume that the hash of an object is its storage address

2 files changed, 20 insertions, 9 deletions

diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml
index 64f9689..3832a07 100644
--- a/lib/kernel/Branch.ml
+++ b/lib/kernel/Branch.ml
@@ -59,7 +59,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct
       Ok { multigroups; previous }
   end
 
-  class branch storage value node = object
+  class branch storage value node = object (self)
     inherit Lifecycle.null
 
     val storage : S.connection = storage
@@ -67,15 +67,18 @@ module Make (S : Abstract.Storage.STORAGE) = struct
     val node = node (* FIXME: can we not place this inside `t`? *)
 
     method protocols : Protocols.Handle.protocol list =
-      [ Prototype.Directory.of_properties
-          [ "multigroup", Prototype.mixture
-                            [ MMDirectory.make
-                                ~storage ~node
-                                ~constructor:(M.wrap storage) ] ] ]
+      Protocols.[ Addressable.make self;
+                  Prototype.Directory.of_properties
+                    [ "multigroup", Prototype.mixture
+                                      [ MMDirectory.make
+                                          ~storage ~node
+                                          ~constructor:(M.wrap storage) ] ] ]
 
     method hash =
       Representation.to_blob branch
       |> Concepts.Hash.hash_of_blob
+
+    method address = self#hash
   end
 
   let load tx conn addr =
diff --git a/lib/kernel/BranchManager.ml b/lib/kernel/BranchManager.ml
index 016f75a..1162b40 100644
--- a/lib/kernel/BranchManager.ml
+++ b/lib/kernel/BranchManager.ml
@@ -51,13 +51,21 @@ module Make (S : Abstract.Storage.STORAGE) = struct
 
     method update key reference value =
       let open Utilities.Result in
+      let open Protocols in
       SI.with_transaction storage (fun tx ->
           match
             Utilities.Atomic.mswap head (fun head ->
+                let address_of h =
+                  let* i = Handle.require Addressable.from h in
+                  Ok (Addressable.address i)
+                in
                 let* branch = M.lookup tx key head |> Result.map_error (fun e -> Some e) in
-                (* FIXME: we should have an addressable protocol rather than assuming the hash is the content store address *)
-                let reference = Option.map Protocols.Handle.hash reference in
-                let value = Option.map Protocols.Handle.hash value in
+                let* reference = Option.map address_of reference
+                                 |> Utilities.Option.sequence
+                                 |> Result.map_error (fun e -> Some e) in
+                let* value = Option.map address_of value
+                             |> Utilities.Option.sequence
+                             |> Result.map_error (fun e -> Some e) in
                 if branch = reference then
                   begin
                     let* new_head = match value with