diff options
| author | Estevan Castilho <tevo@riajuu.net> | 2026-08-22 17:55:26 +0000 |
|---|---|---|
| committer | Estevan Castilho <tevo@riajuu.net> | 2026-08-23 03:06:58 +0000 |
| commit | db968eccee931abc8ad00d74d152625a2ab3174e (patch) | |
| tree | 3d5018dd9e298cfc1fb14bf404cde3fce5953fca /lib/concepts/BranchState.ml | |
| parent | b242516fc820a0a1ab00e24151a5b978f9a6f4a3 (diff) | |
| download | RNT-db968eccee931abc8ad00d74d152625a2ab3174e.tar.gz RNT-db968eccee931abc8ad00d74d152625a2ab3174e.zip | |
Tidy up
Diffstat (limited to '')
| -rw-r--r-- | lib/concepts/BranchState.ml | 87 | ||||
| -rw-r--r-- | lib/concepts/BranchState.mli | 17 |
2 files changed, 0 insertions, 104 deletions
diff --git a/lib/concepts/BranchState.ml b/lib/concepts/BranchState.ml deleted file mode 100644 index e8c6636..0000000 --- a/lib/concepts/BranchState.ml +++ /dev/null @@ -1,87 +0,0 @@ -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) diff --git a/lib/concepts/BranchState.mli b/lib/concepts/BranchState.mli deleted file mode 100644 index 45792cc..0000000 --- a/lib/concepts/BranchState.mli +++ /dev/null @@ -1,17 +0,0 @@ -type t -type address = Hash.hash - -include Object.S with type t := t - -(** Durable state of one branch head. - - [current] is the branch-visible catalog root, not the runtime namespace - rooted at [/system]. Runtime scaffolding is rebuilt during initialization. - [history] is the ordered commit-stream tree root. [tip] is absent until the - first real commit, so initialization does not create a synthetic commit just - to make the branch non-empty. *) -val make : current:address -> history:address -> tip:address option -> t - -val current : t -> address -val history : t -> address -val tip : t -> address option |
