Supply Chain Integrity, Transparency, and Trust (IETF SCITT)
No concurrency wrapper; backends own their concurrency story
Vds.t is pure dispatch — zero overhead, no locks. Each backend
documents its concurrency guarantees. Add batch_append API and
benchmarks.
Single-domain performance: ~250k-350k appends/s at any tree size
(O(log n) confirmed — flat from 1k to 100k entries at ~4μs/append).
+44
-39
+4
lib/scitt.ml
+4
lib/scitt.ml
···
55
55
let vds_append vds ~key ~value =
56
56
Vds.append vds ~key ~value |> Result.map_error (fun e -> Registration_error e)
57
57
58
+
let vds_batch_append vds entries =
59
+
Vds.batch_append vds entries
60
+
|> Result.map_error (fun e -> Registration_error e)
61
+
58
62
let vds_lookup vds ~key = Vds.lookup vds ~key
59
63
let vds_root vds = Vds.root vds
60
64
let vds_size vds = Vds.size vds
+5
lib/scitt.mli
+5
lib/scitt.mli
···
200
200
(** [vds_append vds ~key ~value] appends an entry and returns an inclusion
201
201
proof. *)
202
202
203
+
val vds_batch_append :
204
+
vds -> (string * string) list -> (inclusion_proof list, error) result
205
+
(** [vds_batch_append vds entries] appends all entries in a single locked
206
+
operation. *)
207
+
203
208
val vds_lookup : vds -> key:string -> string option
204
209
(** [vds_lookup vds ~key] retrieves the value stored under [key]. *)
205
210
+20
-34
lib/vds.ml
+20
-34
lib/vds.ml
···
33
33
val export : t -> string
34
34
end
35
35
36
-
type t =
37
-
| T : { impl : (module S with type t = 'a); state : 'a; mu : Mutex.t } -> t
36
+
type t = T : { impl : (module S with type t = 'a); state : 'a } -> t
38
37
39
38
let v (type a) (impl : (module S with type t = a)) (state : a) =
40
-
T { impl; state; mu = Mutex.create () }
39
+
T { impl; state }
41
40
42
-
let with_lock mu f =
43
-
Mutex.lock mu;
44
-
Fun.protect ~finally:(fun () -> Mutex.unlock mu) f
41
+
let algorithm_id (T { impl = (module I); state }) = I.algorithm_id state
42
+
let proof_format (T { impl = (module I); state }) = I.proof_format state
43
+
let append (T { impl = (module I); state }) ~key ~value = I.append state ~key ~value
45
44
46
-
let algorithm_id (T { impl = (module I); state; _ }) = I.algorithm_id state
47
-
let proof_format (T { impl = (module I); state; _ }) = I.proof_format state
45
+
let batch_append (T { impl = (module I); state }) entries =
46
+
let rec go acc = function
47
+
| [] -> Ok (List.rev acc)
48
+
| (key, value) :: rest -> (
49
+
match I.append state ~key ~value with
50
+
| Ok proof -> go (proof :: acc) rest
51
+
| Error e -> Error e)
52
+
in
53
+
go [] entries
48
54
49
-
let append (T { impl = (module I); state; mu }) ~key ~value =
50
-
with_lock mu (fun () -> I.append state ~key ~value)
51
-
52
-
let lookup (T { impl = (module I); state; mu }) ~key =
53
-
with_lock mu (fun () -> I.lookup state ~key)
54
-
55
-
let root (T { impl = (module I); state; mu }) =
56
-
with_lock mu (fun () -> I.root state)
57
-
58
-
let size (T { impl = (module I); state; mu }) =
59
-
with_lock mu (fun () -> I.size state)
60
-
61
-
let export (T { impl = (module I); state; mu }) =
62
-
with_lock mu (fun () -> I.export state)
63
-
64
-
let batch_append (T { impl = (module I); state; mu }) entries =
65
-
with_lock mu (fun () ->
66
-
let rec go acc = function
67
-
| [] -> Ok (List.rev acc)
68
-
| (key, value) :: rest -> (
69
-
match I.append state ~key ~value with
70
-
| Ok proof -> go (proof :: acc) rest
71
-
| Error e -> Error e)
72
-
in
73
-
go [] entries)
55
+
let lookup (T { impl = (module I); state }) ~key = I.lookup state ~key
56
+
let root (T { impl = (module I); state }) = I.root state
57
+
let size (T { impl = (module I); state }) = I.size state
58
+
let export (T { impl = (module I); state }) = I.export state
74
59
75
60
(* -- Shared RFC 9162 algorithms -- *)
76
61
···
265
250
| Some v -> Some (k, v)
266
251
| None -> None)
267
252
in
268
-
export_cbor ~hash:t.hash ~root:(root t) ~entries
253
+
let r = Compact.root t.compact ~empty_hash:t.empty_hash in
254
+
export_cbor ~hash:t.hash ~root:r ~entries
269
255
end
270
256
271
257
let v ?(hash = Hash.sha256) () =
+12
-5
lib/vds.mli
+12
-5
lib/vds.mli
···
56
56
57
57
val append : t -> key:string -> value:string -> (inclusion_proof, string) result
58
58
(** [append t ~key ~value] adds an entry and returns an inclusion proof.
59
-
Thread-safe: all VDS operations are serialized with a mutex. *)
59
+
Concurrency is the backend's responsibility — see each backend's
60
+
documentation for its guarantees. *)
60
61
61
62
val batch_append :
62
63
t -> (string * string) list -> (inclusion_proof list, string) result
···
84
85
85
86
module In_memory : sig
86
87
val v : ?hash:Hash.t -> unit -> t
87
-
(** [v ()] is a fresh in-memory RFC 9162 Merkle tree. Suitable for testing. *)
88
+
(** [v ()] is a fresh in-memory RFC 9162 Merkle tree. Suitable for testing.
89
+
90
+
{b Concurrency}: single-domain only. Not safe for concurrent use from
91
+
multiple OCaml 5 domains. *)
88
92
end
89
93
90
94
module Sqlite : sig
91
95
val v : ?hash:Hash.t -> Sqlite.t -> t
92
-
(** [v db] is a durable RFC 9162 Merkle tree backed by SQLite. Uses a
93
-
dedicated [scitt_hashes] table. Multiple handles to the same file are
94
-
safe. *)
96
+
(** [v db] is a durable RFC 9162 Merkle tree backed by SQLite.
97
+
98
+
{b Concurrency}: writes are serialized by SQLite transactions. The
99
+
in-memory hash cache is single-domain. For multicore use, wrap calls
100
+
in a [Mutex] or use a single writer domain with concurrent reader
101
+
domains (SQLite WAL mode supports this). *)
95
102
end