Tidy up

4 files changed, 22 insertions, 63 deletions

diff --git a/lib/kernel/BranchManager.ml b/lib/kernel/BranchManager.ml
index 80e32a4..03a2765 100644
--- a/lib/kernel/BranchManager.ml
+++ b/lib/kernel/BranchManager.ml
@@ -1,5 +1,3 @@
-type branch = string
-
 module Error = struct
   open Concepts.Condition
 
@@ -7,6 +5,10 @@ module Error = struct
     condition "invalid-root" "The root hash for the database state is missing from the backend. Either your storage is corrupted, or this is a bug in RNT!"
       ("hash" |=| (Concepts.Value.String (Concepts.Hash.to_hum_string head)))
 
+  let no_such_branch branch_name =
+    condition "no-such-branch" "A branch with the specified name was not found"
+      ("branch"    |=| Concepts.Value.String branch_name)
+
   let comparison_failed branch_name reference head =
     condition "comparison-failed" "The HEAD of the branch did not match what was expected"
       ("branch"    |=| Concepts.Value.String branch_name &
@@ -44,16 +46,18 @@ module Make (S : Abstract.Storage.STORAGE) = struct
         let head = Atomic.get head in
         M.lookup tx branch_name head)
 
-  let update ({ storage; head; label } as manager) branch_name reference new_branch =
+  let update { storage; head; label } branch_name reference new_branch =
     let open Utilities.Result in
     let* _ = SI.with_transaction storage (fun tx ->
                  Utilities.Atomic.mswap head (fun head ->
-                     let* branch = M.lookup tx branch_name head in
+                     let* branch = M.lookup tx branch_name head
+                                   |> Result.map (Option.to_result ~none:(Error.no_such_branch branch_name))
+                                   |> Result.join in
                      if branch = reference then
                        let* new_head = M.insert tx label new_branch head in
-                       new_head
+                       Ok new_head
                      else
-                       Error.comparison_failed branch_name reference branch)) in
+                       Error (Error.comparison_failed branch_name reference branch))) in
     Ok ()
 
 end
diff --git a/lib/kernel/Merkle.ml b/lib/kernel/Merkle.ml
index 60a10a7..c2c2932 100644
--- a/lib/kernel/Merkle.ml
+++ b/lib/kernel/Merkle.ml
@@ -1,8 +1,8 @@
 module type VALUE = sig
   type t
 
-  val encode : t -> Concepts.Representation.blob
-  val decode : Concepts.Representation.blob -> (t, Concepts.Condition.condition) result
+  val encode : t -> Concepts.Blob.t
+  val decode : Concepts.Blob.t -> (t, Concepts.Condition.condition) result
 end
 
 module type KEY = sig
@@ -65,12 +65,12 @@ module Make : TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> struct
     | Trunk { keys; _ } -> keys
 
   let of_bencode =
-    let open Concepts.Codec.Bencode in
+    let open Concepts.Encoding.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
+                       |> Result.map Concepts.Blob.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
@@ -89,14 +89,14 @@ module Make : TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> struct
        Ok (Trunk { keys; children })
     | _ -> Error (Error.malformed_node ())
 
-  let from_blob blob = Concepts.Codec.Bencode.of_blob blob
+  let from_blob blob = Concepts.Encoding.Bencode.of_blob blob
                        |> Utilities.Result.fmap of_bencode
 
   let to_bencode =
-    let open Concepts.Codec.Bencode in
+    let open Concepts.Encoding.Bencode in
     (* Ditto. *)
     let bencode_key k = K.encode k
-                        |> Concepts.Representation.bytes_of_blob
+                        |> Concepts.Blob.bytes_of_blob
                         |> String.of_bytes
                         |> (fun s -> String s) in
     let bencode_hash h = String (Concepts.Hash.to_raw_string h) in
@@ -108,7 +108,7 @@ module Make : TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> struct
        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
+  let to_blob node = to_bencode node |> Concepts.Encoding.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
@@ -216,7 +216,7 @@ module Make : TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> struct
     BatFingerTree.iter
       (fun k ->
         K.encode k
-        |> Concepts.Representation.bytes_of_blob
+        |> Concepts.Blob.bytes_of_blob
         |> Buffer.add_bytes buffer)
       ks;
     Concepts.Hash.hash_of_bytes (Buffer.to_bytes buffer)
@@ -343,7 +343,7 @@ end
 module StringKey : KEY with type t = string = struct
   type t = string
 
-  let encode s = String.to_bytes s |> Concepts.Representation.blob_of_bytes
+  let encode s = String.to_bytes s |> Concepts.Blob.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
+  let decode b = Concepts.Blob.bytes_of_blob b |> String.of_bytes |> Result.ok
 end
diff --git a/lib/kernel/Runtime.ml b/lib/kernel/Runtime.ml
deleted file mode 100644
index aa69791..0000000
--- a/lib/kernel/Runtime.ml
+++ /dev/null
@@ -1,45 +0,0 @@
-module Error = struct
-  open Concepts.Condition
-
-  let registry_conflict () =
-    condition "registry-object-update-conflict" "Failed to update the in-memory object registry"
-      empty
-end
-
-module CAS : Backend.Managers.Object.RUNTIME_STRATEGY = struct
-  type 'a state = 'a Atomic.t
-  type 'a token = 'a
-
-  let create = Atomic.make
-
-  let acquire state =
-    let photograph = Atomic.get state in
-    photograph, photograph
-
-  let publish state token next =
-    if Atomic.compare_and_set state token next then Ok () else Error (Error.registry_conflict ())
-end
-
-(* module MVCC : REGISTRY_STRATEGY = struct end *)
-(* module RCU : REGISTRY_STRATEGY = struct end *)
-
-module Make (Strategy : Backend.Managers.Object.RUNTIME_STRATEGY) (Store : Abstract.Storage.STORAGE) =
-struct
-  module Init = Initialization.Make (Store)
-  module Objects = Backend.Managers.Object.Make (Strategy)
-
-  type t = {connection: Store.connection; objects: Objects.t}
-
-  let initialize configuration : (t, Concepts.Condition.condition) result =
-    let open Utilities.Result in
-    let* connection = Store.connect configuration in
-    let* branch_index_root = Init.initialize connection in
-    (* Registry reconstruction from the branch index is the loader boundary.
-       Until that loader exists, publish only the permanent /system namespace;
-       importantly, the discovered root remains part of the photograph. *)
-    let objects = Objects.create ~branch_index_root ~registry:Backend.Managers.Object.root in
-    Ok {connection; objects}
-
-  let connection runtime = runtime.connection
-  let objects runtime = runtime.objects
-end
diff --git a/lib/kernel/Storage.mli b/lib/kernel/Storage.mli
index 3ef1ffc..1148fba 100644
--- a/lib/kernel/Storage.mli
+++ b/lib/kernel/Storage.mli
@@ -1,5 +1,5 @@
 module Make : functor (S : Abstract.Storage.STORAGE) -> sig
   val finish : S.transaction -> ('a, Concepts.Condition.condition) result -> ('a, Concepts.Condition.condition) result
   val with_transaction : S.connection -> (S.transaction -> ('a, Concepts.Condition.condition) result) -> ('a, Concepts.Condition.condition) result
-  val store_blob : S.transaction -> Concepts.Representation.blob -> (Concepts.Hash.hash, Concepts.Condition.condition) result
+  val store_blob : S.transaction -> Concepts.Blob.t -> (Concepts.Hash.hash, Concepts.Condition.condition) result
 end