From ab360c794849300792b2dc5c9ff6354621040e2f Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Sat, 1 Aug 2026 14:22:05 -0300 Subject: Initialization with Branch State and Index --- lib/concepts/BranchState.ml | 87 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) create mode 100644 lib/concepts/BranchState.ml (limited to 'lib/concepts/BranchState.ml') diff --git a/lib/concepts/BranchState.ml b/lib/concepts/BranchState.ml new file mode 100644 index 0000000..e8c6636 --- /dev/null +++ b/lib/concepts/BranchState.ml @@ -0,0 +1,87 @@ +type address = Hash.hash + +(* A branch state records durable branch data only. The runtime registry paths + mounted around it, such as /system/branches/master, are derived at + initialization and should not be persisted as part of [current]. *) +type t = {current: address; history: address; tip: address option} + +module Field = struct + let current = "current" + let history = "history" + let tip = "tip" +end + +module Error = struct + open Condition + + let malformed_branch_state () = + condition "branch-state-malformed" + "A branch state representation did not conform to what was expected" empty + + let malformed_hash length = + condition "branch-state-malformed-hash" "A branch state address was not a valid hash" + ("length" |=| Value.Integer length) +end + +let make ~current ~history ~tip = {current; history; tip} +let current branch_state = branch_state.current +let history branch_state = branch_state.history +let tip branch_state = branch_state.tip +let address_bencode address = Object.Field.address address + +let address_option_bencode = function + | None -> Codec.Bencode.List [] + | Some address -> Codec.Bencode.List [address_bencode address] + +let require_address_bencode = function + | Codec.Bencode.String raw -> + if String.length raw = Hash.size then Ok (Hash.of_raw_string raw) + else Error (Error.malformed_hash (String.length raw)) + | _ -> Error (Error.malformed_branch_state ()) + +let require_address_option key data = + let open Utilities.Result in + let* value = Codec.Bencode.field key data in + let* entries = Codec.Bencode.as_list value in + match entries with + | [] -> Ok None + | [value] -> + let* address = require_address_bencode value in + Ok (Some address) + | _ -> Error (Error.malformed_branch_state ()) + +let equal_address_option left right = + match left, right with + | None, None -> true + | Some left, Some right -> Hash.hash_equals left right + | _ -> false + +module Body = struct + type nonrec t = t + + let tag = 's' + let malformed = Error.malformed_branch_state + + let equal left right = + Hash.hash_equals left.current right.current + && Hash.hash_equals left.history right.history + && equal_address_option left.tip right.tip + + let fields branch_state = + [ Field.current, address_bencode branch_state.current; + Field.history, address_bencode branch_state.history; + Field.tip, address_option_bencode branch_state.tip ] + + let of_fields data = + let open Utilities.Result in + let* current = + Object.Field.require_address ~malformed:Error.malformed_hash Field.current data + in + let* history = + Object.Field.require_address ~malformed:Error.malformed_hash Field.history data + in + let* tip = require_address_option Field.tip data in + Ok {current; history; tip} +end + +include (Object.Codec.Make (Body) : Object.S with type t := t) -- cgit v1.2.3