diff options
Diffstat (limited to 'lib/kernel/Initialization.ml')
| -rw-r--r-- | lib/kernel/Initialization.ml | 100 |
1 files changed, 0 insertions, 100 deletions
diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml deleted file mode 100644 index d15b65b..0000000 --- a/lib/kernel/Initialization.ml +++ /dev/null @@ -1,100 +0,0 @@ -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 |
