4 files changed, 189 insertions, 0 deletions
diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml
new file mode 100644
index 0000000..d15b65b
--- /dev/null
+++ b/lib/kernel/Initialization.ml
@@ -0,0 +1,100 @@
+type address = Concepts.Hash.hash
+
+type t =
+  { default_branch: string;
+    branches: address }
+
+let fixed_label = "rnt.boot"
+let fixed_label_address = Concepts.Hash.hash_of_bytes (Bytes.of_string fixed_label)
+
+module Field = struct
+  let default_branch = "default_branch"
+  let branches = "branches"
+end
+
+module Error = struct
+  open Concepts.Condition
+
+  let malformed_initialization () =
+    condition "initialization-malformed"
+      "An initialization representation did not conform to what was expected" empty
+
+  let malformed_hash length =
+    condition "initialization-malformed-hash"
+      "An initialization address was not a valid hash"
+      ("length" |=| Concepts.Value.Integer length)
+
+  let missing_target address =
+    condition "initialization-target-missing"
+      "The fixed initialization label points at a missing object"
+      ("address" |=| Concepts.Value.String (Concepts.Hash.to_raw_string address))
+end
+
+let make ~default_branch ~branches = {default_branch; branches}
+
+let default_branch initialization = initialization.default_branch
+let branches initialization = initialization.branches
+
+module Body = struct
+  type nonrec t = t
+
+  let tag = 'i'
+  let malformed = Error.malformed_initialization
+
+  let equal left right =
+    String.equal left.default_branch right.default_branch
+    && Concepts.Hash.hash_equals left.branches right.branches
+
+  let fields initialization =
+    [ Field.default_branch, Concepts.Object.Field.string initialization.default_branch;
+      Field.branches, Concepts.Object.Field.address initialization.branches ]
+
+  let of_fields data =
+    let open Utilities.Result in
+    let* default_branch =
+      Concepts.Object.Field.require_string Field.default_branch data
+    in
+    let* branches =
+      Concepts.Object.Field.require_address ~malformed:Error.malformed_hash Field.branches data
+    in
+    Ok {default_branch; branches}
+end
+
+include (Concepts.Object.Codec.Make (Body) : Concepts.Object.S with type t := t)
+
+let address initialization = to_blob initialization |> Concepts.Hash.hash_of_blob
+
+let address_to_blob address =
+  Concepts.Object.Field.address address |> Concepts.Codec.Bencode.to_blob
+
+let address_of_blob blob =
+  let open Utilities.Result in
+  let* data = Concepts.Codec.Bencode.of_blob blob in
+  let* raw = Concepts.Codec.Bencode.as_string data in
+  if String.length raw = Concepts.Hash.size then Ok (Concepts.Hash.of_raw_string raw)
+  else Error (Error.malformed_hash (String.length raw))
+
+module Make (Store : Abstract.Storage.STORAGE) = struct
+  let register tx initialization =
+    let open Utilities.Result in
+    let blob = to_blob initialization in
+    let initialization_address = Concepts.Hash.hash_of_blob blob in
+    let* () = Store.put tx initialization_address blob in
+    let* () = Store.put tx fixed_label_address (address_to_blob initialization_address) in
+    Ok initialization_address
+
+  let load tx =
+    let open Utilities.Result in
+    let* label = Store.get tx fixed_label_address in
+    match label with
+    | None -> Ok None
+    | Some label ->
+        let* initialization_address = address_of_blob label in
+        let* initialization = Store.get tx initialization_address in
+        begin match initialization with
+        | None -> Error (Error.missing_target initialization_address)
+        | Some initialization ->
+            let* initialization = of_blob initialization in
+            Ok (Some initialization)
+        end
+end
diff --git a/lib/kernel/Initialization.mli b/lib/kernel/Initialization.mli
new file mode 100644
index 0000000..35e6f22
--- /dev/null
+++ b/lib/kernel/Initialization.mli
@@ -0,0 +1,19 @@
+type address = Concepts.Hash.hash
+
+type t
+
+val fixed_label : string
+val fixed_label_address : address
+
+include Concepts.Object.S with type t := t
+
+val make : default_branch:string -> branches:address -> t
+
+val default_branch : t -> string
+val branches : t -> address
+val address : t -> address
+
+module Make (Store : Abstract.Storage.STORAGE) : sig
+  val register : Store.transaction -> t -> (address, Concepts.Condition.condition) result
+  val load : Store.transaction -> (t option, Concepts.Condition.condition) result
+end
diff --git a/test/test_rnt.ml b/test/test_rnt.ml
index a2a8e84..f825c51 100644
--- a/test/test_rnt.ml
+++ b/test/test_rnt.ml
@@ -1,5 +1,6 @@
 let all_suites =
   Unit.Concepts.Serialization.suites ()
+  @ Unit.Kernel.Initialization.suites ()
   @ Unit.Backend.Storage.suites ()
   @ Unit.Backend.Lifecycle.suites ()
 
diff --git a/test/unit/kernel/Initialization.ml b/test/unit/kernel/Initialization.ml
new file mode 100644
index 0000000..c0e9c17
--- /dev/null
+++ b/test/unit/kernel/Initialization.ml
@@ -0,0 +1,69 @@
+open Rnt
+
+module Hash = Concepts.Hash
+module Initialization = Rnt.Kernel.Initialization
+
+module Memory_storage = struct
+  type connection = (Hash.hash, Concepts.Representation.blob) Hashtbl.t
+  type transaction = connection
+
+  let connect _ = Ok (Hashtbl.create 16)
+  let start conn = Ok conn
+  let commit _ = Ok ()
+  let abort _ = Ok ()
+  let get tx address = Ok (Hashtbl.find_opt tx address)
+  let put tx address blob = Hashtbl.replace tx address blob; Ok ()
+end
+
+module Store_initialization = Initialization.Make (Memory_storage)
+
+let fail_condition c = Alcotest.fail (Concepts.Condition.to_string_hum c)
+let hash text = Hash.hash_of_bytes (Bytes.of_string text)
+
+let check_hash label expected actual =
+  Alcotest.(check bool) label true (Hash.hash_equals expected actual)
+
+let test_initialization_round_trips () =
+  let expected =
+    Initialization.make ~default_branch:"master" ~branches:(hash "branch-index")
+  in
+  match Initialization.(expected |> to_bytes |> of_bytes) with
+  | Ok actual ->
+      Alcotest.(check string)
+        "default branch"
+        (Initialization.default_branch expected)
+        (Initialization.default_branch actual);
+      check_hash "branches" (Initialization.branches expected) (Initialization.branches actual)
+  | Error c -> fail_condition c
+
+let test_registers_under_fixed_label () =
+  let tx = Hashtbl.create 16 in
+  let expected =
+    Initialization.make ~default_branch:"master" ~branches:(hash "branch-index")
+  in
+  let before, registered, after =
+    begin
+      let open Utilities.Result in
+      let* before = Store_initialization.load tx in
+      let* registered = Store_initialization.register tx expected in
+      let* after = Store_initialization.load tx in
+      Ok (before, registered, after)
+    end
+    |> Helpers.condition_as_failure
+  in
+  Alcotest.(check (option bool))
+    "missing before registration" None (Option.map (Fun.const true) before);
+  check_hash "registered address" (Initialization.address expected) registered;
+  Alcotest.(check bool)
+    "fixed label exists" true
+    (Hashtbl.mem tx Initialization.fixed_label_address);
+  match after with
+  | Some actual -> Alcotest.(check bool) "loaded object" true (Initialization.equal expected actual)
+  | None -> Alcotest.fail "expected initialization object after registration"
+
+let suites () =
+  [ ( "kernel/initialization",
+      [ Alcotest.test_case "initialization round-trips" `Quick
+          test_initialization_round_trips;
+        Alcotest.test_case "registers under fixed label" `Quick
+          test_registers_under_fixed_label ] ) ]