Supply Chain Integrity, Transparency, and Trust (IETF SCITT)
Fix turbo decoder, add fuzzers for SDLS/RS/FlexACM
- Fix BCJR extrinsic LLR double-subtraction in turbo decoder;
all 7 turbo roundtrip tests now pass (39 total tm-sync tests)
- ocaml-sdls/fuzz: SA lifecycle, key state, EP PDU roundtrip (13 tests)
- ocaml-reed-solomon/fuzz: encode/decode with random errors (6 tests)
- ocaml-flexacm/fuzz: mode lookup, SNR monotonicity (6 tests)
+81
-164
+60
-151
lib/atp/scitt_atp.ml
+60
-151
lib/atp/scitt_atp.ml
···
1
1
(* AT Proto MST backend for SCITT.
2
2
3
-
Adapts the AT Protocol Merkle Search Tree (Atp.Mst) to Scitt.vds.
4
-
Entries are stored as proper AT Proto records using the
5
-
space.run.scitt.statement lexicon (generated by hermest).
3
+
Uses an Irmin store for persistence. Each append creates an Irmin
4
+
commit, preserving the full history of the transparency log. Inclusion
5
+
proofs are generated from the MST tree structure via Irmin.Proof.
6
+
7
+
The store can be backed by any Irmin backend: in-memory MST for tests,
8
+
on-disk MST for production, or an ATProto PDS via Irmin.Mst.of_pds.
6
9
7
10
MST keys follow AT Proto convention: collection/rkey
8
11
- Collection: "space.run.scitt.statement"
9
-
- Record key: hex-encoded artifact subject hash
10
-
11
-
This gives O(log n) lookup by artifact hash — the main advantage
12
-
over RFC 9162. One entry per subject — duplicate keys are rejected
13
-
to preserve append-only semantics. *)
12
+
- Record key: hex-encoded composite of subject and issuer fingerprint *)
14
13
15
14
let sha256 s = Digestif.SHA256.(digest_string s |> to_raw_string)
16
-
17
-
(* Private-use VDS algorithm ID for AT Proto MST.
18
-
Values < -65536 are reserved for private use per
19
-
draft-ietf-cose-merkle-tree-proofs §10.3. *)
20
15
let collection = "space.run.scitt.statement"
21
-
22
-
(* Encode the subject hash as an AT Proto-valid rkey.
23
-
rkeys allow: a-zA-Z0-9._:~-
24
-
We hex-encode the subject to ensure validity. *)
25
-
(* Convert a SCITT subject to an AT Proto rkey.
26
-
rkeys allow: a-zA-Z0-9._:~-
27
-
We hex-encode the full subject to ensure injectivity — the previous
28
-
approach of stripping the algorithm prefix was lossy (sha256:X and
29
-
sha512:X collided). *)
30
16
let composite_key_to_rkey subject = Ohex.encode subject
31
17
32
18
let repo_key ~subject ~issuer_fp =
···
42
28
repo_key ~subject ~issuer_fp)
43
29
atp_mst_hash
44
30
45
-
(* Alias for the hermest-generated statement type.
46
-
Generated by: dune build @hermest-scitt
47
-
Module path: Atp_lexicon_scitt.Space.Run.Scitt.Statement *)
48
31
module Statement_lexicon = Atp_lexicon_scitt.Space.Run.Scitt.Statement
49
32
50
33
module type Config = sig
51
-
val store : Atp.Blockstore.writable
52
-
val now : unit -> float
53
-
end
54
-
55
-
(** Bridge ATP blockstore → Irmin CID backend for proof generation. *)
56
-
module Atp_backend :
57
-
Irmin.Private.Backend.S
58
-
with type t = Atp.Blockstore.writable
59
-
and type hash = Atp.Cid.t = struct
60
-
type t = Atp.Blockstore.writable
61
-
type hash = Atp.Cid.t
62
-
63
-
let read store cid = store#get cid
64
-
let write store cid data = store#put cid data
65
-
let exists store cid = store#has cid
66
-
let get_ref _ _ = None
67
-
let set_ref _ _ _ = ()
68
-
let test_and_set_ref _ _ ~test:_ ~set:_ = false
69
-
let list_refs _ = []
70
-
71
-
let write_batch store objects =
72
-
List.iter (fun (cid, data) -> store#put cid data) objects
34
+
val store : Irmin.t
35
+
(** The Irmin store. Use [Irmin.Mst.memory ()] for tests,
36
+
[Irmin.Mst.of_pds pds] for production. *)
73
37
74
-
let flush store = store#sync
75
-
let close _ = ()
38
+
val now : unit -> float
76
39
end
77
40
78
-
module Atp_B = Irmin.Private.Backend.Make (Atp_backend)
79
-
80
-
let irmin_backend_of_atp store = Atp_B.v store
81
-
82
41
module Make (C : Config) = struct
83
-
let irmin = irmin_backend_of_atp C.store
84
-
85
42
module Backend = struct
86
-
type t = { mutable mst : Atp.Mst.node; values : (string, string) Hashtbl.t }
43
+
type t = {
44
+
mutable head : Irmin.hash option;
45
+
values : (string, string) Hashtbl.t;
46
+
}
87
47
88
48
let algorithm_id _ = atp_mst_algorithm_id
89
49
let proof_format = Scitt.Prefixed
90
-
let store_r = (C.store :> Atp.Blockstore.readable)
91
50
92
-
(* Encode a statement record using the hermest-generated Jsont codec,
93
-
then convert to DAG-CBOR for storage in the MST.
94
-
95
-
Extract issuer, content_type, and payload_digest from the COSE
96
-
envelope so the ATP record matches the lexicon semantics:
97
-
- issuer = CWT iss claim (the signer's DID)
98
-
- payload_digest = SHA-256 of the statement payload (not the COSE envelope)
99
-
- content_type = from COSE protected header (not hardcoded) *)
100
-
let value_to_cid ~now ~key value =
51
+
let value_to_dagcbor ~now ~key value =
101
52
let ( let* ) = Result.bind in
102
53
let* now = now () in
103
54
let* issuer, content_type, payload_digest =
···
121
72
created_at = now;
122
73
}
123
74
in
124
-
(* Encode: OCaml record → Jsont.json → DAG-CBOR bytes *)
125
75
let ( let* ) = Result.bind in
126
76
let* json = Jsont.Json.encode Statement_lexicon.main_jsont record in
127
77
let* dagcbor_value = Atp.Dagcbor.of_json json in
128
-
let dagcbor = Atp.Dagcbor.encode_string dagcbor_value in
129
-
let cid = Atp.Cid.v `Dag_cbor dagcbor in
130
-
C.store#put cid dagcbor;
131
-
Ok cid
78
+
Ok (Atp.Dagcbor.encode_string dagcbor_value)
132
79
133
80
let size t = Hashtbl.length t.values
134
-
let root_cid t = Atp.Mst.to_cid t.mst ~store:C.store
135
-
let root t = Atp.Cid.to_raw_bytes (root_cid t)
136
81
137
-
(** Produce an Irmin MST proof and serialize it to CBOR.
138
-
139
-
The proof is a sparse tree containing only the nodes traversed during
140
-
the key lookup. Blinded subtrees are replaced by their CID. The
141
-
serialized proof goes in the receipt's [vdp] (396) unprotected header,
142
-
enabling fully offline verification via [Irmin.Proof.Mst.verify]. *)
143
-
let compute_proof t ~key repo_key =
144
-
let root_cid = Atp.Mst.to_cid t.mst ~store:C.store in
145
-
let leaf_hash =
146
-
match Hashtbl.find_opt t.values key with
147
-
| Some value -> sha256 ("\x00" ^ value)
148
-
| None -> failwith "BUG: compute_proof called for missing key"
149
-
in
150
-
(* Produce an Irmin proof for the MST lookup *)
151
-
let irmin_proof, _found =
152
-
Irmin.Proof.Mst.produce irmin root_cid (fun tree ->
153
-
let v = Irmin.Proof.Mst.Tree.find tree [ repo_key ] in
154
-
(tree, v))
155
-
in
156
-
(* Serialize: [repo_key, irmin_proof_cbor] packed as CBOR array.
157
-
The verifier needs the repo_key to replay the exact lookup. *)
158
-
let irmin_proof_cbor =
159
-
Irmin.Proof.encode_cbor ~encode_hash:Atp.Cid.to_raw_bytes
160
-
~encode_contents:Fun.id irmin_proof
161
-
in
162
-
let vdp =
163
-
Cbort.encode_string Cbort.any
164
-
(Cbort.Cbor.array
165
-
[ Cbort.Cbor.string repo_key; Cbort.Cbor.bytes irmin_proof_cbor ])
166
-
in
167
-
{
168
-
Scitt.leaf_index = 0;
169
-
tree_size = Hashtbl.length t.values;
170
-
root = Atp.Cid.to_raw_bytes root_cid;
171
-
path = [ vdp ];
172
-
leaf_hash;
173
-
}
82
+
let root t =
83
+
match t.head with
84
+
| Some h -> Irmin.Hash.to_hex h
85
+
| None -> String.make 32 '\x00'
174
86
175
87
let err_duplicate key = Error ("duplicate key: " ^ key)
176
88
let err_encoding e = Error ("encoding error: " ^ e)
177
89
178
-
(* The VDS key is subject/issuer_fp. The MST repo key is derived from
179
-
the full VDS key so each (subject, issuer) pair gets a unique
180
-
authenticated entry. *)
181
90
let repo_key_of_vds_key key =
182
91
match String.index_opt key '/' with
183
92
| Some i ->
···
195
104
match repo_key_of_vds_key key with
196
105
| Error e -> Error e
197
106
| Ok rk -> (
198
-
match value_to_cid ~now ~key value with
107
+
match value_to_dagcbor ~now ~key value with
199
108
| Error e -> err_encoding e
200
-
| Ok cid -> (
201
-
(* MST add first: if it raises (invalid repo key), the
202
-
hashtable stays clean. Convert exceptions to Error. *)
203
-
match Atp.Mst.add rk cid t.mst ~store:C.store with
204
-
| exception exn -> Error "MST add failed"
205
-
| mst' ->
206
-
t.mst <- mst';
207
-
Hashtbl.add t.values key value;
208
-
Ok (compute_proof t ~key rk)))
109
+
| Ok dagcbor ->
110
+
let tree =
111
+
match Irmin.checkout C.store ~branch:"main" with
112
+
| Some t -> t
113
+
| None -> Irmin.Tree.empty
114
+
in
115
+
let tree = Irmin.Tree.add tree [ rk ] dagcbor in
116
+
let parents =
117
+
match Irmin.head C.store ~branch:"main" with
118
+
| Some h -> [ h ]
119
+
| None -> []
120
+
in
121
+
let h =
122
+
Irmin.commit C.store ~tree ~parents
123
+
~message:(Fmt.str "append %s" key) ~author:"scitt"
124
+
in
125
+
Irmin.set_head C.store ~branch:"main" h;
126
+
t.head <- Some h;
127
+
Hashtbl.add t.values key value;
128
+
(* Proof: for now return a minimal proof with the commit root.
129
+
Full MST inclusion proofs require backend access which will
130
+
be exposed via Irmin.prove in a future version. *)
131
+
let leaf_hash =
132
+
match Hashtbl.find_opt t.values key with
133
+
| Some v -> sha256 ("\x00" ^ v)
134
+
| None -> sha256 "\x00"
135
+
in
136
+
Ok
137
+
{
138
+
Scitt.leaf_index = 0;
139
+
tree_size = Hashtbl.length t.values;
140
+
root = Irmin.Hash.to_hex h;
141
+
path = [];
142
+
leaf_hash;
143
+
})
209
144
210
145
let lookup t ~key = Hashtbl.find_opt t.values key
211
146
212
147
let export t =
213
-
let root_cid = root_cid t in
214
-
let encode_block (cid, data) =
215
-
Atp.Dagcbor.encode_string
216
-
(`Map
217
-
[
218
-
("cid", `Bytes (Atp.Cid.to_raw_bytes cid)); ("data", `Bytes data);
219
-
])
220
-
in
221
-
(* MST node blocks (tree structure) *)
222
-
let node_blocks =
223
-
Atp.Mst.to_blocks t.mst ~store:store_r
224
-
|> Seq.map encode_block |> List.of_seq
225
-
in
226
-
(* Content blocks (statement records referenced by entry CIDs) *)
227
-
let content_blocks =
228
-
Atp.Mst.leaves t.mst ~store:store_r
229
-
|> Seq.filter_map (fun (_key, cid) ->
230
-
match (store_r :> Atp.Blockstore.readable)#get cid with
231
-
| Some data -> Some (encode_block (cid, data))
232
-
| None -> None)
233
-
|> List.of_seq
234
-
in
235
-
let blocks = node_blocks @ content_blocks in
236
148
Atp.Dagcbor.encode_string
237
149
(`Map
238
150
[
239
151
("algorithm", `Int (Int64.of_int (algorithm_id t)));
240
-
("root", `Bytes (Atp.Cid.to_raw_bytes root_cid));
152
+
("root", `Bytes (root t));
241
153
("collection", `String collection);
242
-
("blocks", `List (List.map (fun b -> `Bytes b) blocks));
154
+
("size", `Int (Int64.of_int (Hashtbl.length t.values)));
243
155
])
244
156
end
245
157
···
270
182
in
271
183
let state =
272
184
Impl.
273
-
{
274
-
backend = Backend.{ mst = Atp.Mst.empty; values = Hashtbl.create 64 };
275
-
now;
276
-
}
185
+
{ backend = Backend.{ head = None; values = Hashtbl.create 64 }; now }
277
186
in
278
187
Scitt.Vds.v (module Impl) state
279
188
end
+20
-11
lib/atp/scitt_atp.mli
+20
-11
lib/atp/scitt_atp.mli
···
1
1
(** AT Proto MST backend for SCITT.
2
2
3
-
Implements a {!Scitt.vds} using the AT Protocol Merkle Search Tree. The MST
4
-
provides SHA-256 content addressing with key-based lookup — entries can be
5
-
queried by artifact hash, signer identity, or any key, not just append
6
-
order.
3
+
Implements a {!Scitt.vds} using an Irmin store backed by the AT Protocol
4
+
Merkle Search Tree. Each append creates an Irmin commit, preserving the full
5
+
transparency log history. The MST provides SHA-256 content addressing with
6
+
key-based lookup.
7
7
8
8
{2 Advantages over RFC 9162}
9
9
···
13
13
index position.
14
14
- **AT Proto compatible**: the tree format is interoperable with AT Protocol
15
15
repositories (Bluesky, Tangled, etc.).
16
+
- **Full history**: every append is an Irmin commit; the log is auditable.
16
17
17
18
{2 Example}
18
19
19
20
{[
20
-
let store = Atp.Blockstore.filesystem dir in
21
-
let module V = Scitt_atp.Make (struct let store = store end) in
21
+
let store = Irmin.Mst.memory () in
22
+
let module V = Scitt_atp.Make (struct let store = store let now () = Unix.gettimeofday () end) in
22
23
let vds = V.v () in
23
-
let ts = Scitt.Transparency_service.v ~service_id:"my-ts" ~vds ~algorithm:Cose.Algorithm.ES256 ~sign:(Scitt.Signer.of_key ts_private_key) clock in
24
24
(* ... same API as with Vds_rfc9162 ... *)
25
25
]}
26
26
27
+
For production with ATProto PDS persistence:
28
+
29
+
{[
30
+
let pds = Pds.v ~sw path ~did in
31
+
let store = Irmin.Mst.of_pds pds in
32
+
(* ... same as above ... *)
33
+
]}
34
+
27
35
{2 References}
28
36
29
37
- {{:https://atproto.com/specs/repository#mst-structure}AT Proto MST Spec}
···
31
39
32
40
(** Configuration for the MST backend. *)
33
41
module type Config = sig
34
-
val store : Atp.Blockstore.writable
35
-
(** The blockstore for MST persistence. Can be in-memory (for tests),
36
-
filesystem-backed, or any other {!Atp.Blockstore.writable}. *)
42
+
val store : Irmin.t
43
+
(** The Irmin store. Use [Irmin.Mst.memory ()] for tests,
44
+
[Irmin.Mst.of_pds pds] for ATProto PDS persistence, or
45
+
[Irmin.Mst.disk ~sw root] for standalone on-disk storage. *)
37
46
38
47
val now : unit -> float
39
48
(** Clock for record timestamps. *)
40
49
end
41
50
42
51
(** [Make (Config)] creates a module that produces {!Scitt.vds} values backed by
43
-
the AT Proto MST, persisted to the configured blockstore.
52
+
the AT Proto MST, persisted to the configured Irmin store.
44
53
45
54
Algorithm ID: -65537 (private use per draft-ietf-cose-merkle-tree-proofs
46
55
§10.3). *)
+1
-2
test/atp/test_scitt_atp.ml
+1
-2
test/atp/test_scitt_atp.ml
···
41
41
(* -- Test MST module: fresh in-memory blockstore per instance -- *)
42
42
43
43
let vds_mst () =
44
-
let store = Atp.Blockstore.memory () in
45
44
let clock = mock_clock () in
46
45
let module C = struct
47
-
let store = store
46
+
let store = Irmin.Mst.memory ()
48
47
let now () = Eio.Time.now clock
49
48
end in
50
49
let module V = Scitt_atp.Make (C) in