Supply Chain Integrity, Transparency, and Trust (IETF SCITT)
ocaml-scitt: replace Vds.Make functor with let v ~heap ~now in atp backend
+31
-57
+24
-31
lib/atp/scitt_atp.ml
+24
-31
lib/atp/scitt_atp.ml
···
58
58
let ( => ) = S.( => )
59
59
let repo_schema = S.fix (fun _self -> mst_node [ "*" => S.opaque ])
60
60
61
-
module type Config = sig
62
-
val heap : (Atp.Cid.t, string) Irmin.Heap.t
63
-
val now : unit -> float
64
-
end
65
-
66
-
module Make (C : Config) = struct
67
-
module Backend = struct
61
+
let v ~heap ~now:clock =
62
+
let module Backend = struct
68
63
type t = {
69
64
mutable head : Atp.Cid.t option;
70
65
values : (string, string) Hashtbl.t;
···
98
93
}
99
94
in
100
95
let ( let* ) = Result.bind in
101
-
let* json = Json.encode Statement_lexicon.main_jsont record in
96
+
let* json =
97
+
Json.encode Statement_lexicon.main_json record
98
+
|> Result.map_error Json.Error.to_string
99
+
in
102
100
let* dagcbor_value = Atp.Dagcbor.of_json json in
103
101
Ok (Atp.Dagcbor.encode_string dagcbor_value)
104
102
···
135
133
(* Add record to MST via Atp.Mst *)
136
134
let bs = Atp.Blockstore.memory () in
137
135
let mst =
138
-
match S.head C.heap ~branch:"main" with
136
+
match S.head heap ~branch:"main" with
139
137
| Some tree_root ->
140
138
(* Copy blocks from heap to local blockstore *)
141
139
let rec copy_block cid =
142
-
match Irmin.Heap.find C.heap cid with
140
+
match Irmin.Heap.find heap cid with
143
141
| Some data -> (
144
142
bs#put cid data;
145
143
(* Try to decode as MST node and copy subtrees *)
···
160
158
in
161
159
(* Write the record blob *)
162
160
let record_cid = Atp.Cid.v `Dag_cbor dagcbor in
163
-
Irmin.Heap.put C.heap record_cid dagcbor;
161
+
Irmin.Heap.put heap record_cid dagcbor;
164
162
bs#put record_cid dagcbor;
165
163
(* Add to MST *)
166
164
let mst = Atp.Mst.add rk record_cid mst ~store:bs in
167
165
let tree_root = Atp.Mst.to_cid mst ~store:bs in
168
166
(* Copy MST blocks back to heap *)
169
167
Atp.Mst.to_blocks mst ~store:(bs :> Atp.Blockstore.readable)
170
-
|> Seq.iter (fun (cid, data) -> Irmin.Heap.put C.heap cid data);
168
+
|> Seq.iter (fun (cid, data) -> Irmin.Heap.put heap cid data);
171
169
(* Update branch ref *)
172
-
S.set_head C.heap ~branch:"main" tree_root;
170
+
S.set_head heap ~branch:"main" tree_root;
173
171
t.head <- Some tree_root;
174
172
Hashtbl.add t.values key value;
175
173
let leaf_hash = sha256 ("\x00" ^ value) in
176
174
(* Produce inclusion proof *)
177
175
let proof, _value =
178
-
S.produce C.heap repo_schema tree_root (fun c ->
176
+
S.produce heap repo_schema tree_root (fun c ->
179
177
match S.step_any c rk with
180
178
| Some (S.Step (sc, leaf)) ->
181
179
(S.Step (sc, leaf), S.get_block leaf)
···
225
223
("collection", `String collection);
226
224
("size", `Int (Int64.of_int (Hashtbl.length t.values)));
227
225
])
228
-
end
229
-
230
-
module Impl = struct
226
+
end in
227
+
let module Impl = struct
231
228
type nonrec t = {
232
229
backend : Backend.t;
233
230
now : unit -> (string, string) result;
···
244
241
Error "consistency proofs not supported for MST backend"
245
242
246
243
let export t = Backend.export t.backend
247
-
end
248
-
249
-
let v () : Scitt.vds =
250
-
let now () =
251
-
match Ptime.of_float_s (C.now ()) with
252
-
| Some p -> Ok (Ptime.to_rfc3339 p)
253
-
| None -> Error "clock returned invalid time"
254
-
in
255
-
let state =
256
-
Impl.
257
-
{ backend = Backend.{ head = None; values = Hashtbl.create 64 }; now }
258
-
in
259
-
Scitt.Vds.v (module Impl) state
260
-
end
244
+
end in
245
+
let now () =
246
+
match Ptime.of_float_s (clock ()) with
247
+
| Some p -> Ok (Ptime.to_rfc3339 p)
248
+
| None -> Error "clock returned invalid time"
249
+
in
250
+
let state =
251
+
Impl.{ backend = Backend.{ head = None; values = Hashtbl.create 64 }; now }
252
+
in
253
+
Scitt.Vds.v (module Impl) state
+6
-19
lib/atp/scitt_atp.mli
+6
-19
lib/atp/scitt_atp.mli
···
5
5
updates the branch ref.
6
6
7
7
{[
8
-
let module Heap_b = Irmin.Heap.Make (...) in
9
8
let heap = Heap_b.v (Atp.Blockstore.memory ()) in
10
-
let module V = Scitt_atp.Make (struct
11
-
let heap = heap
12
-
let now () = Unix.gettimeofday ()
13
-
end) in
14
-
let vds = V.v ()
9
+
let vds = Scitt_atp.v ~heap ~now:Unix.gettimeofday
15
10
]} *)
16
11
17
-
(** Configuration for the MST backend. *)
18
-
module type Config = sig
19
-
val heap : (Atp.Cid.t, string) Irmin.Heap.t
20
-
(** The heap. *)
21
-
22
-
val now : unit -> float
23
-
(** Clock for record timestamps. *)
24
-
end
25
-
26
-
module Make (C : Config) : sig
27
-
val v : unit -> Scitt.vds
28
-
(** [v ()] creates a new ATProto-backed verifiable data structure. *)
29
-
end
12
+
val v :
13
+
heap:(Atp.Cid.t, string) Irmin.Heap.t -> now:(unit -> float) -> Scitt.vds
14
+
(** [v ~heap ~now] creates a new ATProto-backed verifiable data structure.
15
+
[heap] stores the MST blocks and record blobs keyed by CID; [now] yields
16
+
the time used for the per-record [createdAt] timestamp. *)
+1
-6
test/atp/test_scitt_atp.ml
+1
-6
test/atp/test_scitt_atp.ml
···
67
67
let vds_mst () =
68
68
let clock = mock_clock () in
69
69
let heap = Atp_heap.v (Atp.Blockstore.memory ()) in
70
-
let module C = struct
71
-
let heap = heap
72
-
let now () = Eio.Time.now clock
73
-
end in
74
-
let module V = Scitt_atp.Make (C) in
75
-
V.v ()
70
+
Scitt_atp.v ~heap ~now:(fun () -> Eio.Time.now clock)
76
71
77
72
(* -- Helpers -- *)
78
73