blob: e8c66369a3736dc1228cfa33fea9608070f41602 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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)
|
