Supply Chain Integrity, Transparency, and Trust (IETF SCITT)
cbor: rename from cbort (partial downstream)
Drops the "t" suffix. Internal raw CBOR module moves to Value (was
Cbor in lib/cbor.ml), matching the value/codec/<pkg> layout from the
other codec packages. Low-level byte R/W moved to lib/binary.ml (was
lib/cbor_rw.ml). Library name cbor; main module Cbor via lib/cbor.ml
(was cbort.ml).
Downstream packages (ocaml-bundle, ocaml-cose, ocaml-bpsec, ocaml-scitt,
ocaml-crow, irmin) partially migrated: Cbort.Cbor -> Cbor.Value, the
internal Cbor alias shadowing in each file renamed to V to free the
top-level Cbor for the library facade. Some downstream build errors
remain because many callsites conflated raw value constructors
(Cbor.int, Cbor.int64) with schema codecs and need manual triage.
The lib/binary.ml R/W primitives are NOT re-exported through Cbor.Binary
due to OCaml's lazy module alias elision when the aliased module isn't
referenced by any type/value in the parent signature. A separate
cbor.bytesrw library (ocaml-cbor/lib/bytesrw/) is the right home for
that, matching json.bytesrw / toml.bytesrw; left as a follow-up.
+173
-173
+1
atp-lexicon-scitt.opam
+1
atp-lexicon-scitt.opam
···
9
9
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
10
10
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
11
11
license: "MIT"
12
+
tags: ["org:blacksun" "atproto" "aerospace" "codec"]
12
13
homepage: "https://tangled.org/gazagnaire.org/ocaml-scitt"
13
14
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-scitt/issues"
14
15
depends: [
+1
-1
dune-project
+1
-1
dune-project
···
57
57
(package
58
58
(name atp-lexicon-scitt)
59
59
(synopsis "AT Proto lexicons for SCITT (space.run.scitt.*)")
60
-
(tags (org:blacksun atproto aerospace codec))
60
+
(tags (org:blacksun atproto aerospace codec encoding))
61
61
(description
62
62
"AT Protocol lexicon type definitions and Jsont codecs for SCITT records:
63
63
statements, receipts, transparent statements, inclusion proofs, and
+1
-1
fuzz/dune
+1
-1
fuzz/dune
+11
-11
lib/atp/scitt_atp.ml
+11
-11
lib/atp/scitt_atp.ml
···
183
183
in
184
184
(* Encode proof as CBOR: [repo_key, [before, after, [[cid, block], ...]]] *)
185
185
let proof_cbor =
186
-
Cbort.Cbor.array
186
+
Cbor.Value.array
187
187
[
188
-
Cbort.Cbor.bytes (Atp.Cid.to_raw_bytes proof.before);
189
-
Cbort.Cbor.bytes (Atp.Cid.to_raw_bytes proof.after);
190
-
Cbort.Cbor.array
188
+
Cbor.Value.bytes (Atp.Cid.to_raw_bytes proof.before);
189
+
Cbor.Value.bytes (Atp.Cid.to_raw_bytes proof.after);
190
+
Cbor.Value.array
191
191
(List.map
192
192
(fun (cid, data) ->
193
-
Cbort.Cbor.array
193
+
Cbor.Value.array
194
194
[
195
-
Cbort.Cbor.bytes (Atp.Cid.to_raw_bytes cid);
196
-
Cbort.Cbor.bytes data;
195
+
Cbor.Value.bytes (Atp.Cid.to_raw_bytes cid);
196
+
Cbor.Value.bytes data;
197
197
])
198
198
(List.of_seq (Irmin.Heap.to_seq proof.heap)));
199
199
]
200
200
in
201
-
let encoded_proof = Cbort.encode_string Cbort.any proof_cbor in
201
+
let encoded_proof = Cbor.encode_string Cbor.any proof_cbor in
202
202
let vdp_cbor =
203
-
Cbort.Cbor.array
204
-
[ Cbort.Cbor.string rk; Cbort.Cbor.bytes encoded_proof ]
203
+
Cbor.Value.array
204
+
[ Cbor.Value.string rk; Cbor.Value.bytes encoded_proof ]
205
205
in
206
-
let vdp_bytes = Cbort.encode_string Cbort.any vdp_cbor in
206
+
let vdp_bytes = Cbor.encode_string Cbor.any vdp_cbor in
207
207
let root_raw = Atp.Cid.to_raw_bytes tree_root in
208
208
Ok
209
209
{
+1
-1
lib/dune
+1
-1
lib/dune
+12
-12
lib/proof.ml
+12
-12
lib/proof.ml
···
101
101
102
102
(* Decode a [[cid, block]; ...] CBOR list into proof heap entries. *)
103
103
let decode_blocks blocks_cbor =
104
-
match Cbort.Cbor.to_array blocks_cbor with
104
+
match Cbor.Value.to_array blocks_cbor with
105
105
| None -> []
106
106
| Some items ->
107
107
List.filter_map
108
108
(fun item ->
109
-
match Cbort.Cbor.to_array item with
109
+
match Cbor.Value.to_array item with
110
110
| Some [ cid_cbor; data_cbor ] ->
111
111
let cid_bytes =
112
-
Option.value ~default:"" (Cbort.Cbor.to_bytes cid_cbor)
112
+
Option.value ~default:"" (Cbor.Value.to_bytes cid_cbor)
113
113
in
114
114
let data =
115
-
Option.value ~default:"" (Cbort.Cbor.to_bytes data_cbor)
115
+
Option.value ~default:"" (Cbor.Value.to_bytes data_cbor)
116
116
in
117
117
Some (Atp.Cid.of_raw_bytes cid_bytes, data)
118
118
| _ -> None)
···
142
142
(* Verify the inner [before, after, blocks] proof structure once we already
143
143
know [repo_key] matches expectations. *)
144
144
let verify_mst_inner ~hash ~expected_leaf ~root ~repo_key proof_bytes =
145
-
match Cbort.decode_string Cbort.any proof_bytes with
145
+
match Cbor.decode_string Cbor.any proof_bytes with
146
146
| Error _ -> Error "MST proof: invalid CBOR"
147
147
| Ok proof_arr -> (
148
-
match Cbort.Cbor.to_array proof_arr with
148
+
match Cbor.Value.to_array proof_arr with
149
149
| Some [ before_cbor; after_cbor; blocks_cbor ] -> (
150
150
let before_bytes =
151
-
Option.value ~default:"" (Cbort.Cbor.to_bytes before_cbor)
151
+
Option.value ~default:"" (Cbor.Value.to_bytes before_cbor)
152
152
in
153
153
let after_bytes =
154
-
Option.value ~default:"" (Cbort.Cbor.to_bytes after_cbor)
154
+
Option.value ~default:"" (Cbor.Value.to_bytes after_cbor)
155
155
in
156
156
let before = Atp.Cid.of_raw_bytes before_bytes in
157
157
let after = Atp.Cid.of_raw_bytes after_bytes in
···
171
171
let verify_mst ~hash ~expected_leaf ~expected_repo_key ~root path =
172
172
match path with
173
173
| [ vdp_data ] -> (
174
-
match Cbort.decode_string Cbort.any vdp_data with
174
+
match Cbor.decode_string Cbor.any vdp_data with
175
175
| Error _ -> Error "MST vdp: invalid CBOR"
176
176
| Ok vdp_cbor -> (
177
-
match Cbort.Cbor.to_array vdp_cbor with
177
+
match Cbor.Value.to_array vdp_cbor with
178
178
| Some [ key_cbor; proof_cbor ] ->
179
179
let repo_key =
180
-
Option.value ~default:"" (Cbort.Cbor.to_text key_cbor)
180
+
Option.value ~default:"" (Cbor.Value.to_text key_cbor)
181
181
in
182
182
if not (Eqaf.equal repo_key expected_repo_key) then
183
183
Error "MST proof repo_key mismatch"
184
184
else
185
185
let proof_bytes =
186
-
Option.value ~default:"" (Cbort.Cbor.to_bytes proof_cbor)
186
+
Option.value ~default:"" (Cbor.Value.to_bytes proof_cbor)
187
187
in
188
188
verify_mst_inner ~hash ~expected_leaf ~root ~repo_key
189
189
proof_bytes
+48
-48
lib/scitt.ml
+48
-48
lib/scitt.ml
···
103
103
Catches duplicates regardless of CBOR major type. *)
104
104
let cbor_check_unique_keys pairs =
105
105
let key_bytes =
106
-
List.map (fun (k, _) -> Cbort.encode_string Cbort.any k) pairs
106
+
List.map (fun (k, _) -> Cbor.encode_string Cbor.any k) pairs
107
107
in
108
108
let unique = List.sort_uniq String.compare key_bytes in
109
109
if List.length key_bytes <> List.length unique then
···
113
113
(** Extract a CBOR map with text keys, rejecting duplicates across all key
114
114
types. *)
115
115
let cbor_unique_text_map cbor =
116
-
match Cbort.Cbor.to_map cbor with
116
+
match Cbor.Value.to_map cbor with
117
117
| None -> Error "not a CBOR map"
118
118
| Some pairs -> cbor_check_unique_keys pairs
119
119
120
120
(** Extract a CBOR map with integer keys, rejecting duplicates across all key
121
121
types. *)
122
122
let cbor_unique_int_map cbor =
123
-
match Cbort.Cbor.to_map cbor with
123
+
match Cbor.Value.to_map cbor with
124
124
| None -> Error "not a CBOR map"
125
125
| Some pairs -> cbor_check_unique_keys pairs
126
126
127
127
let text_key key pairs =
128
-
List.find_opt (fun (label, _) -> Cbort.Cbor.to_text label = Some key) pairs
128
+
List.find_opt (fun (label, _) -> Cbor.Value.to_text label = Some key) pairs
129
129
|> Option.map snd
130
130
131
131
let algorithm_of_key ~algorithm key =
···
170
170
171
171
let sign ?algorithm ~key (stmt : Statement.t) =
172
172
let cwt_claims =
173
-
Cbort.Cbor.map
173
+
Cbor.Value.map
174
174
[
175
-
(Cbort.Cbor.int cwt_iss, Cbort.Cbor.string stmt.issuer);
176
-
(Cbort.Cbor.int cwt_sub, Cbort.Cbor.string stmt.subject);
175
+
(Cbor.Value.int cwt_iss, Cbor.Value.string stmt.issuer);
176
+
(Cbor.Value.int cwt_sub, Cbor.Value.string stmt.subject);
177
177
]
178
178
in
179
179
let algorithm = algorithm_of_key ~algorithm key in
···
204
204
let find_cwt_text key pairs =
205
205
match
206
206
List.find_opt
207
-
(fun (k, _) -> Cbort.Cbor.to_int k = Some (Z.of_int key))
207
+
(fun (k, _) -> Cbor.Value.to_int k = Some (Z.of_int key))
208
208
pairs
209
209
with
210
-
| Some (_, v) -> Cbort.Cbor.to_text v
210
+
| Some (_, v) -> Cbor.Value.to_text v
211
211
| None -> None
212
212
in
213
213
let* issuer, subject =
···
252
252
let cbor_map_require_int name pairs =
253
253
match
254
254
Option.bind (cbor_map_find name pairs) (fun v ->
255
-
Option.bind (Cbort.Cbor.to_int v) (fun z ->
255
+
Option.bind (Cbor.Value.to_int v) (fun z ->
256
256
if Z.fits_int z then Some (Z.to_int z) else None))
257
257
with
258
258
| Some v -> Ok v
···
264
264
let rec go acc = function
265
265
| [] -> Ok (List.rev acc)
266
266
| item :: rest -> (
267
-
match Cbort.Cbor.to_bytes item with
267
+
match Cbor.Value.to_bytes item with
268
268
| Some b -> go (b :: acc) rest
269
269
| None -> Error (Invalid_receipt "proof path contains non-bytes entry"))
270
270
in
271
271
go [] items
272
272
273
273
let cbor_map_require_timestamp pairs =
274
-
match Option.bind (cbor_map_find "ts" pairs) Cbort.Cbor.to_text with
274
+
match Option.bind (cbor_map_find "ts" pairs) Cbor.Value.to_text with
275
275
| Some s -> (
276
276
match Ptime.of_rfc3339 s with
277
277
| Ok (t, _, _) -> Ok t
···
286
286
let ( let* ) = Result.bind in
287
287
let* leaf_index = cbor_map_require_int "index" pairs in
288
288
let* tree_size = cbor_map_require_int "size" pairs in
289
-
let* root = cbor_map_require "root" Cbort.Cbor.to_bytes pairs in
290
-
let* leaf_hash = cbor_map_require "leaf" Cbort.Cbor.to_bytes pairs in
289
+
let* root = cbor_map_require "root" Cbor.Value.to_bytes pairs in
290
+
let* leaf_hash = cbor_map_require "leaf" Cbor.Value.to_bytes pairs in
291
291
let* path =
292
-
match Option.bind (cbor_map_find "path" pairs) Cbort.Cbor.to_array with
292
+
match Option.bind (cbor_map_find "path" pairs) Cbor.Value.to_array with
293
293
| Some items ->
294
294
if List.length items > Vds.max_proof_path_length then
295
295
Error
···
334
334
match Cose.Header.find receipt_vds_label protected with
335
335
| Some cbor -> (
336
336
match
337
-
Option.bind (Cbort.Cbor.to_int cbor) (fun z ->
337
+
Option.bind (Cbor.Value.to_int cbor) (fun z ->
338
338
if Z.fits_int z then Some (Z.to_int z) else None)
339
339
with
340
340
| Some id -> Ok id
···
388
388
receipt_payload r =
389
389
let ( let* ) = Result.bind in
390
390
let* cbor =
391
-
Cbort.decode_string Cbort.any receipt_payload
391
+
Cbor.decode_string Cbor.any receipt_payload
392
392
|> Result.map_error (fun _ -> Invalid_receipt "bad receipt payload CBOR")
393
393
in
394
394
(* Parse and validate the CBOR map once, then extract all fields from
···
398
398
cbor_unique_text_map cbor |> Result.map_error (fun e -> Invalid_receipt e)
399
399
in
400
400
let find_bytes name =
401
-
match Option.bind (text_key name pairs) Cbort.Cbor.to_bytes with
401
+
match Option.bind (text_key name pairs) Cbor.Value.to_bytes with
402
402
| Some v -> Ok v
403
403
| None -> Error (Invalid_receipt ("receipt payload missing " ^ name))
404
404
in
405
405
let find_text name =
406
-
match Option.bind (text_key name pairs) Cbort.Cbor.to_text with
406
+
match Option.bind (text_key name pairs) Cbor.Value.to_text with
407
407
| Some v -> Ok v
408
408
| None -> Error (Invalid_receipt ("receipt payload missing " ^ name))
409
409
in
410
410
let find_int name =
411
411
match
412
412
Option.bind (text_key name pairs) (fun v ->
413
-
Option.bind (Cbort.Cbor.to_int v) (fun z ->
413
+
Option.bind (Cbor.Value.to_int v) (fun z ->
414
414
if Z.fits_int z then Some (Z.to_int z) else None))
415
415
with
416
416
| Some v -> Ok v
···
587
587
~encoded_signed receipts
588
588
589
589
let encode t =
590
-
let signed_cbor = Cbort.Cbor.bytes (Signed_statement.encode t.signed) in
590
+
let signed_cbor = Cbor.Value.bytes (Signed_statement.encode t.signed) in
591
591
let receipts_cbor =
592
-
Cbort.Cbor.array
592
+
Cbor.Value.array
593
593
(List.map
594
-
(fun (_, _, cose) -> Cbort.Cbor.bytes (Cose.Sign1.encode cose))
594
+
(fun (_, _, cose) -> Cbor.Value.bytes (Cose.Sign1.encode cose))
595
595
t.receipts)
596
596
in
597
-
Cbort.encode_string Cbort.any
598
-
(Cbort.Cbor.array [ signed_cbor; receipts_cbor ])
597
+
Cbor.encode_string Cbor.any
598
+
(Cbor.Value.array [ signed_cbor; receipts_cbor ])
599
599
600
600
let decode s =
601
601
let ( let* ) = Result.bind in
602
602
let* cbor =
603
-
Cbort.decode_string Cbort.any s
603
+
Cbor.decode_string Cbor.any s
604
604
|> Result.map_error (fun e ->
605
-
Invalid_statement (Fmt.str "%a" Cbort.Error.pp e))
605
+
Invalid_statement (Fmt.str "%a" Cbor.Error.pp e))
606
606
in
607
607
let* signed_cbor, receipts_cbor =
608
-
match Cbort.Cbor.to_array cbor with
608
+
match Cbor.Value.to_array cbor with
609
609
| Some [ s; r ] -> Ok (s, r)
610
610
| _ -> Error (Invalid_statement "expected [signed, [receipts]]")
611
611
in
612
612
let* signed_bytes =
613
-
match Cbort.Cbor.to_bytes signed_cbor with
613
+
match Cbor.Value.to_bytes signed_cbor with
614
614
| Some b -> Ok b
615
615
| None -> Error (Invalid_statement "signed statement not bstr")
616
616
in
617
617
let* signed = Signed_statement.decode signed_bytes in
618
618
let* items =
619
-
match Cbort.Cbor.to_array receipts_cbor with
619
+
match Cbor.Value.to_array receipts_cbor with
620
620
| Some items ->
621
621
if List.length items > 1024 then
622
622
Error (Invalid_receipt "too many receipts (max 1024)")
···
626
626
let rec decode_receipts acc = function
627
627
| [] -> Ok (List.rev acc)
628
628
| item :: rest -> (
629
-
match Cbort.Cbor.to_bytes item with
629
+
match Cbor.Value.to_bytes item with
630
630
| None -> Error (Invalid_receipt "receipt item not bstr")
631
631
| Some bytes -> (
632
632
match Receipt.decode bytes with
···
754
754
let* ts = monotonic_now t in
755
755
let ts_str = Fmt.str "%a" (Ptime.pp_rfc3339 ()) ts in
756
756
let receipt_payload =
757
-
Cbort.encode_string Cbort.any
758
-
(Cbort.Cbor.map
757
+
Cbor.encode_string Cbor.any
758
+
(Cbor.Value.map
759
759
[
760
-
(Cbort.Cbor.string "subject", Cbort.Cbor.string subject);
761
-
(Cbort.Cbor.string "root", Cbort.Cbor.bytes proof.root);
762
-
(Cbort.Cbor.string "size", Cbort.Cbor.int proof.tree_size);
763
-
(Cbort.Cbor.string "leaf", Cbort.Cbor.bytes proof.leaf_hash);
764
-
(Cbort.Cbor.string "ts", Cbort.Cbor.string ts_str);
760
+
(Cbor.Value.string "subject", Cbor.Value.string subject);
761
+
(Cbor.Value.string "root", Cbor.Value.bytes proof.root);
762
+
(Cbor.Value.string "size", Cbor.Value.int proof.tree_size);
763
+
(Cbor.Value.string "leaf", Cbor.Value.bytes proof.leaf_hash);
764
+
(Cbor.Value.string "ts", Cbor.Value.string ts_str);
765
765
])
766
766
in
767
767
let proof_cbor =
768
-
Cbort.Cbor.map
768
+
Cbor.Value.map
769
769
[
770
-
(Cbort.Cbor.string "index", Cbort.Cbor.int proof.leaf_index);
771
-
(Cbort.Cbor.string "size", Cbort.Cbor.int proof.tree_size);
772
-
(Cbort.Cbor.string "root", Cbort.Cbor.bytes proof.root);
773
-
(Cbort.Cbor.string "leaf", Cbort.Cbor.bytes proof.leaf_hash);
774
-
( Cbort.Cbor.string "path",
775
-
Cbort.Cbor.array (List.map Cbort.Cbor.bytes proof.path) );
776
-
( Cbort.Cbor.string "ts",
777
-
Cbort.Cbor.string (Fmt.str "%a" (Ptime.pp_rfc3339 ()) ts) );
770
+
(Cbor.Value.string "index", Cbor.Value.int proof.leaf_index);
771
+
(Cbor.Value.string "size", Cbor.Value.int proof.tree_size);
772
+
(Cbor.Value.string "root", Cbor.Value.bytes proof.root);
773
+
(Cbor.Value.string "leaf", Cbor.Value.bytes proof.leaf_hash);
774
+
( Cbor.Value.string "path",
775
+
Cbor.Value.array (List.map Cbor.Value.bytes proof.path) );
776
+
( Cbor.Value.string "ts",
777
+
Cbor.Value.string (Fmt.str "%a" (Ptime.pp_rfc3339 ()) ts) );
778
778
]
779
779
in
780
780
let vds_id = Vds.algorithm_id t.vds in
781
781
let header =
782
782
Cose.Header.v ~algorithm:t.algorithm ~key_id:t.service_id
783
-
~extra:[ (receipt_vds_label, Cbort.Cbor.int vds_id) ]
783
+
~extra:[ (receipt_vds_label, Cbor.Value.int vds_id) ]
784
784
()
785
785
in
786
786
match t.sign ~protected_header:header ~payload:receipt_payload with
+17
-17
lib/vds.ml
+17
-17
lib/vds.ml
···
310
310
311
311
let export_cbor ~hash ~root ~entries =
312
312
let entries_cbor =
313
-
Cbort.Cbor.array
313
+
Cbor.Value.array
314
314
(List.map
315
315
(fun (k, v) ->
316
-
Cbort.Cbor.array [ Cbort.Cbor.string k; Cbort.Cbor.bytes v ])
316
+
Cbor.Value.array [ Cbor.Value.string k; Cbor.Value.bytes v ])
317
317
entries)
318
318
in
319
-
Cbort.encode_string Cbort.any
320
-
(Cbort.Cbor.map
319
+
Cbor.encode_string Cbor.any
320
+
(Cbor.Value.map
321
321
[
322
-
(Cbort.Cbor.string "version", Cbort.Cbor.int 1);
323
-
(Cbort.Cbor.string "algorithm", Cbort.Cbor.int (Hash.id hash));
324
-
(Cbort.Cbor.string "root", Cbort.Cbor.bytes root);
325
-
(Cbort.Cbor.string "entries", entries_cbor);
322
+
(Cbor.Value.string "version", Cbor.Value.int 1);
323
+
(Cbor.Value.string "algorithm", Cbor.Value.int (Hash.id hash));
324
+
(Cbor.Value.string "root", Cbor.Value.bytes root);
325
+
(Cbor.Value.string "entries", entries_cbor);
326
326
])
327
327
328
328
(* -- In_memory backend -- *)
···
547
547
let rec parse acc = function
548
548
| [] -> Ok (List.rev acc)
549
549
| item :: rest -> (
550
-
match Cbort.Cbor.to_array item with
550
+
match Cbor.Value.to_array item with
551
551
| Some [ k; v ] -> (
552
-
match (Cbort.Cbor.to_text k, Cbort.Cbor.to_bytes v) with
552
+
match (Cbor.Value.to_text k, Cbor.Value.to_bytes v) with
553
553
| Some key, Some value -> parse ((key, value) :: acc) rest
554
554
| _ -> Error "import: entry has invalid key/value")
555
555
| _ -> Error "import: entry is not a [key, value] pair")
···
557
557
parse [] items
558
558
559
559
let require_unique_cbor_map cbor =
560
-
match Cbort.Cbor.to_map cbor with
560
+
match Cbor.Value.to_map cbor with
561
561
| None -> Error "import: not a CBOR map"
562
562
| Some pairs ->
563
563
let key_bytes =
564
-
List.map (fun (k, _) -> Cbort.encode_string Cbort.any k) pairs
564
+
List.map (fun (k, _) -> Cbor.encode_string Cbor.any k) pairs
565
565
in
566
566
let unique = List.sort_uniq String.compare key_bytes in
567
567
if List.length key_bytes <> List.length unique then
···
571
571
let parse_import_header data =
572
572
let ( let* ) = Result.bind in
573
573
let* cbor =
574
-
Cbort.decode_string Cbort.any data
574
+
Cbor.decode_string Cbor.any data
575
575
|> Result.map_error (fun _ -> "import: invalid CBOR")
576
576
in
577
577
let* pairs = require_unique_cbor_map cbor in
578
578
let find_text k =
579
-
List.find_opt (fun (label, _) -> Cbort.Cbor.to_text label = Some k) pairs
579
+
List.find_opt (fun (label, _) -> Cbor.Value.to_text label = Some k) pairs
580
580
|> Option.map snd
581
581
in
582
582
let find_int k =
583
583
Option.bind (find_text k) (fun v ->
584
-
Option.bind (Cbort.Cbor.to_int v) (fun z ->
584
+
Option.bind (Cbor.Value.to_int v) (fun z ->
585
585
if Z.fits_int z then Some (Z.to_int z) else None))
586
586
in
587
587
let* () =
···
600
600
| Some h -> Ok h
601
601
| None -> err_unknown_algorithm algorithm_id
602
602
in
603
-
let expected_root = Option.bind (find_text "root") Cbort.Cbor.to_bytes in
603
+
let expected_root = Option.bind (find_text "root") Cbor.Value.to_bytes in
604
604
let* entries =
605
-
match Option.bind (find_text "entries") Cbort.Cbor.to_array with
605
+
match Option.bind (find_text "entries") Cbor.Value.to_array with
606
606
| None -> Error "import: missing entries field"
607
607
| Some items -> parse_cbor_entries items
608
608
in
+1
scitt-atp.opam
+1
scitt-atp.opam
···
8
8
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
9
9
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
10
10
license: "MIT"
11
+
tags: ["org:blacksun" "atproto" "aerospace" "storage" "merkle"]
11
12
homepage: "https://tangled.org/gazagnaire.org/ocaml-scitt"
12
13
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-scitt/issues"
13
14
depends: [
+1
-1
scitt.opam
+1
-1
scitt.opam
+1
-1
test/atp/dune
+1
-1
test/atp/dune
+6
-6
test/atp/test_scitt_atp.ml
+6
-6
test/atp/test_scitt_atp.ml
···
486
486
let proof = Scitt.Receipt.inclusion_proof receipt in
487
487
match proof.path with
488
488
| [ vdp_data ] -> (
489
-
match Cbort.decode_string Cbort.any vdp_data with
489
+
match Cbor.decode_string Cbor.any vdp_data with
490
490
| Error _ -> Alcotest.fail "vdp decode failed"
491
491
| Ok cbor -> (
492
-
match Cbort.Cbor.to_array cbor with
492
+
match Cbor.Value.to_array cbor with
493
493
| Some (key_cbor :: _) -> (
494
494
let repo_key =
495
-
Option.value ~default:"" (Cbort.Cbor.to_text key_cbor)
495
+
Option.value ~default:"" (Cbor.Value.to_text key_cbor)
496
496
in
497
497
(* repo_key should be collection/hex(subject) *)
498
498
let has_prefix s prefix =
···
529
529
let proof = Scitt.Receipt.inclusion_proof receipt in
530
530
match proof.path with
531
531
| [ vdp ] -> (
532
-
match Cbort.decode_string Cbort.any vdp with
532
+
match Cbor.decode_string Cbor.any vdp with
533
533
| Ok cbor -> (
534
-
match Cbort.Cbor.to_array cbor with
535
-
| Some (k :: _) -> Option.value ~default:"" (Cbort.Cbor.to_text k)
534
+
match Cbor.Value.to_array cbor with
535
+
| Some (k :: _) -> Option.value ~default:"" (Cbor.Value.to_text k)
536
536
| _ -> "")
537
537
| _ -> "")
538
538
| _ -> ""
+1
-1
test/dune
+1
-1
test/dune
+1
-1
test/gen/dune
+1
-1
test/gen/dune
+12
-14
test/gen/interop_check.ml
+12
-14
test/gen/interop_check.ml
···
34
34
(match Cose.Header.find 395 p with
35
35
| Some cbor ->
36
36
Fmt.pr " vds(395): %s\n"
37
-
(match Cbort.Cbor.to_int cbor with
37
+
(match Cbor.Value.to_int cbor with
38
38
| Some z -> Z.to_string z
39
39
| None -> "?")
40
40
| None -> Fmt.pr " vds(395): NONE\n");
···
42
42
match Cose.Header.find 396 u with
43
43
| None -> Fmt.pr " vdp(396): NONE\n"
44
44
| Some vdp -> (
45
-
match Cbort.Cbor.to_map vdp with
45
+
match Cbor.Value.to_map vdp with
46
46
| None -> Fmt.pr " vdp(396): not a map\n"
47
47
| Some pairs -> (
48
48
Fmt.pr "\nUnprotected header vdp(396):\n";
49
49
List.iter
50
50
(fun (k, _) ->
51
51
Fmt.pr " key: %s\n"
52
-
(match Cbort.Cbor.to_int k with
52
+
(match Cbor.Value.to_int k with
53
53
| Some z -> Z.to_string z
54
54
| None -> "?"))
55
55
pairs;
56
56
let incl =
57
57
List.find_opt
58
-
(fun (k, _) -> Cbort.Cbor.to_int k = Some (Z.of_int (-1)))
58
+
(fun (k, _) -> Cbor.Value.to_int k = Some (Z.of_int (-1)))
59
59
pairs
60
60
in
61
61
match incl with
62
62
| None -> Fmt.pr " no inclusion proof (label -1)\n"
63
63
| Some (_, arr) -> (
64
-
match Cbort.Cbor.to_array arr with
64
+
match Cbor.Value.to_array arr with
65
65
| None -> Fmt.pr " inclusion not array\n"
66
66
| Some items ->
67
67
Fmt.pr " inclusion proofs: %d\n" (List.length items);
68
68
List.iter
69
69
(fun item ->
70
-
match Cbort.Cbor.to_bytes item with
70
+
match Cbor.Value.to_bytes item with
71
71
| None -> Fmt.pr " not bstr\n"
72
72
| Some proof_bstr -> (
73
73
Fmt.pr " proof bstr (%d bytes)\n"
74
74
(String.length proof_bstr);
75
-
match
76
-
Cbort.decode_string Cbort.any proof_bstr
77
-
with
75
+
match Cbor.decode_string Cbor.any proof_bstr with
78
76
| Error _ -> Fmt.pr " CBOR decode failed\n"
79
77
| Ok proof_cbor -> (
80
-
match Cbort.Cbor.to_array proof_cbor with
78
+
match Cbor.Value.to_array proof_cbor with
81
79
| None -> Fmt.pr " proof not an array\n"
82
80
| Some fields ->
83
81
let tree_size =
84
82
Option.bind (List.nth_opt fields 0)
85
83
(fun v ->
86
84
Option.map Z.to_int
87
-
(Cbort.Cbor.to_int v))
85
+
(Cbor.Value.to_int v))
88
86
in
89
87
let leaf_index =
90
88
Option.bind (List.nth_opt fields 1)
91
89
(fun v ->
92
90
Option.map Z.to_int
93
-
(Cbort.Cbor.to_int v))
91
+
(Cbor.Value.to_int v))
94
92
in
95
93
Fmt.pr " tree_size: %s\n"
96
94
(match tree_size with
···
103
101
let path =
104
102
match List.nth_opt fields 2 with
105
103
| Some p -> (
106
-
match Cbort.Cbor.to_array p with
104
+
match Cbor.Value.to_array p with
107
105
| Some hs ->
108
106
List.filter_map
109
-
Cbort.Cbor.to_bytes hs
107
+
Cbor.Value.to_bytes hs
110
108
| None -> [])
111
109
| None -> []
112
110
in
+53
-53
test/test_scitt.ml
+53
-53
test/test_scitt.ml
···
556
556
String.sub receipt_bytes 0 (String.length receipt_bytes / 2)
557
557
in
558
558
(* Build a transparent statement CBOR with the truncated receipt *)
559
-
let signed_cbor = Cbort.Cbor.bytes (Scitt.Signed_statement.encode signed) in
560
-
let receipts_cbor = Cbort.Cbor.array [ Cbort.Cbor.bytes truncated ] in
561
-
let ts_cbor = Cbort.Cbor.array [ signed_cbor; receipts_cbor ] in
562
-
let ts_bytes = Cbort.encode_string Cbort.any ts_cbor in
559
+
let signed_cbor = Cbor.Value.bytes (Scitt.Signed_statement.encode signed) in
560
+
let receipts_cbor = Cbor.Value.array [ Cbor.Value.bytes truncated ] in
561
+
let ts_cbor = Cbor.Value.array [ signed_cbor; receipts_cbor ] in
562
+
let ts_bytes = Cbor.encode_string Cbor.any ts_cbor in
563
563
match Scitt.Transparent_statement.decode ts_bytes with
564
564
| Ok _ -> Alcotest.fail "should reject truncated receipt"
565
565
| Error _ -> ()
···
573
573
~extra:
574
574
[
575
575
( 15,
576
-
Cbort.Cbor.map
576
+
Cbor.Value.map
577
577
[
578
-
(Cbort.Cbor.int 1, Cbort.Cbor.string "");
579
-
(Cbort.Cbor.int 2, Cbort.Cbor.string "");
578
+
(Cbor.Value.int 1, Cbor.Value.string "");
579
+
(Cbor.Value.int 2, Cbor.Value.string "");
580
580
] );
581
581
]
582
582
()
···
1442
1442
(* Check vds = 1 (RFC9162_SHA256) *)
1443
1443
let vds_val =
1444
1444
match Cose.Header.find 395 protected with
1445
-
| Some cbor -> Option.map Z.to_int (Cbort.Cbor.to_int cbor)
1445
+
| Some cbor -> Option.map Z.to_int (Cbor.Value.to_int cbor)
1446
1446
| None -> None
1447
1447
in
1448
1448
Alcotest.(check (option int)) "vds" (Some 1) vds_val;
···
1451
1451
match Cose.Header.find 396 unprotected with
1452
1452
| None -> Alcotest.fail "no vdp in unprotected header"
1453
1453
| Some vdp_cbor -> (
1454
-
match Cbort.Cbor.to_map vdp_cbor with
1454
+
match Cbor.Value.to_map vdp_cbor with
1455
1455
| None -> Alcotest.fail "vdp not a map"
1456
1456
| Some pairs -> (
1457
1457
(* Find inclusion proof (label -1) *)
1458
1458
let inclusion =
1459
1459
List.find_opt
1460
1460
(fun (label, _) ->
1461
-
Cbort.Cbor.to_int label = Some (Z.of_int (-1)))
1461
+
Cbor.Value.to_int label = Some (Z.of_int (-1)))
1462
1462
pairs
1463
1463
|> Option.map snd
1464
1464
in
1465
1465
match inclusion with
1466
1466
| None -> Alcotest.fail "no inclusion proof in vdp"
1467
1467
| Some arr -> (
1468
-
match Cbort.Cbor.to_array arr with
1468
+
match Cbor.Value.to_array arr with
1469
1469
| None -> Alcotest.fail "inclusion not an array"
1470
1470
| Some [ proof_bstr ] -> (
1471
-
match Cbort.Cbor.to_bytes proof_bstr with
1471
+
match Cbor.Value.to_bytes proof_bstr with
1472
1472
| None -> Alcotest.fail "proof not bstr"
1473
1473
| Some proof_bytes -> (
1474
-
match Cbort.decode_string Cbort.any proof_bytes with
1474
+
match Cbor.decode_string Cbor.any proof_bytes with
1475
1475
| Error _ -> Alcotest.fail "proof CBOR decode failed"
1476
1476
| Ok proof_cbor -> (
1477
-
match Cbort.Cbor.to_array proof_cbor with
1477
+
match Cbor.Value.to_array proof_cbor with
1478
1478
| None -> Alcotest.fail "proof not array"
1479
1479
| Some items ->
1480
1480
let size =
1481
1481
Option.map Z.to_int
1482
1482
(Option.bind (List.nth_opt items 0)
1483
-
Cbort.Cbor.to_int)
1483
+
Cbor.Value.to_int)
1484
1484
in
1485
1485
let leaf =
1486
1486
Option.map Z.to_int
1487
1487
(Option.bind (List.nth_opt items 1)
1488
-
Cbort.Cbor.to_int)
1488
+
Cbor.Value.to_int)
1489
1489
in
1490
1490
Alcotest.(check (option int))
1491
1491
"tree_size" (Some 5) size;
···
1494
1494
let path =
1495
1495
match List.nth_opt items 2 with
1496
1496
| Some p -> (
1497
-
match Cbort.Cbor.to_array p with
1497
+
match Cbor.Value.to_array p with
1498
1498
| Some hashes ->
1499
-
List.filter_map Cbort.Cbor.to_bytes
1499
+
List.filter_map Cbor.Value.to_bytes
1500
1500
hashes
1501
1501
| None -> [])
1502
1502
| None -> []
···
1642
1642
(* Innermost value: unsigned int 0 = 0x00 *)
1643
1643
Buffer.add_char buf '\x00';
1644
1644
let data = Buffer.contents buf in
1645
-
match Cbort.decode_string Cbort.any data with
1645
+
match Cbor.decode_string Cbor.any data with
1646
1646
| Ok _ -> Alcotest.fail "should reject deeply nested CBOR"
1647
1647
| Error _ -> ()
1648
1648
···
1651
1651
rejected before allocating that many list cells. *)
1652
1652
(* Major 4 (array), additional 26 (4-byte length), then 0x10000000 = 268M *)
1653
1653
let header = "\x9a\x10\x00\x00\x00" in
1654
-
match Cbort.decode_string Cbort.any header with
1654
+
match Cbor.decode_string Cbor.any header with
1655
1655
| Ok _ -> Alcotest.fail "should reject oversized array"
1656
1656
| Error _ -> ()
1657
1657
···
1672
1672
(* Exported CBOR should contain all subjects *)
1673
1673
(* Exported should be non-empty and decodable *)
1674
1674
Alcotest.(check bool) "export non-empty" true (String.length exported > 0);
1675
-
match Cbort.decode_string Cbort.any exported with
1675
+
match Cbor.decode_string Cbor.any exported with
1676
1676
| Error _ -> Alcotest.fail "export is not valid CBOR"
1677
1677
| Ok cbor -> (
1678
-
match Cbort.Cbor.to_map cbor with
1678
+
match Cbor.Value.to_map cbor with
1679
1679
| None -> Alcotest.fail "export is not a CBOR map"
1680
1680
| Some pairs -> (
1681
1681
let entries =
1682
1682
List.find_opt
1683
-
(fun (k, _) -> Cbort.Cbor.to_text k = Some "entries")
1683
+
(fun (k, _) -> Cbor.Value.to_text k = Some "entries")
1684
1684
pairs
1685
1685
in
1686
1686
match entries with
1687
1687
| None -> Alcotest.fail "export missing 'entries' field"
1688
1688
| Some (_, entries_cbor) -> (
1689
-
match Cbort.Cbor.to_array entries_cbor with
1689
+
match Cbor.Value.to_array entries_cbor with
1690
1690
| None -> Alcotest.fail "entries is not a CBOR array"
1691
1691
| Some items ->
1692
1692
Alcotest.(check int)
···
1698
1698
let _ = Scitt.vds_append vds ~key:"k1" ~value:"v1" in
1699
1699
let _ = Scitt.vds_append vds ~key:"k2" ~value:"v2" in
1700
1700
let exported = Scitt.vds_export vds in
1701
-
match Cbort.decode_string Cbort.any exported with
1701
+
match Cbor.decode_string Cbor.any exported with
1702
1702
| Error _ -> Alcotest.fail "decode failed"
1703
1703
| Ok cbor -> (
1704
-
match Cbort.Cbor.to_map cbor with
1704
+
match Cbor.Value.to_map cbor with
1705
1705
| Some pairs -> (
1706
1706
let algo =
1707
1707
List.find_opt
1708
-
(fun (k, _) -> Cbort.Cbor.to_text k = Some "algorithm")
1708
+
(fun (k, _) -> Cbor.Value.to_text k = Some "algorithm")
1709
1709
pairs
1710
1710
in
1711
1711
(match algo with
1712
1712
| Some (_, v) ->
1713
1713
Alcotest.(check bool)
1714
1714
"algorithm is int" true
1715
-
(Option.is_some (Cbort.Cbor.to_int v))
1715
+
(Option.is_some (Cbor.Value.to_int v))
1716
1716
| None -> Alcotest.fail "missing algorithm");
1717
1717
match
1718
1718
List.find_opt
1719
-
(fun (k, _) -> Cbort.Cbor.to_text k = Some "entries")
1719
+
(fun (k, _) -> Cbor.Value.to_text k = Some "entries")
1720
1720
pairs
1721
1721
with
1722
1722
| Some (_, entries_cbor) -> (
1723
-
match Cbort.Cbor.to_array entries_cbor with
1723
+
match Cbor.Value.to_array entries_cbor with
1724
1724
| Some items ->
1725
1725
Alcotest.(check int) "2 entries" 2 (List.length items);
1726
1726
List.iter
1727
1727
(fun item ->
1728
-
match Cbort.Cbor.to_array item with
1728
+
match Cbor.Value.to_array item with
1729
1729
| Some [ k; v ] ->
1730
1730
Alcotest.(check bool)
1731
1731
"key is string" true
1732
-
(Option.is_some (Cbort.Cbor.to_text k));
1732
+
(Option.is_some (Cbor.Value.to_text k));
1733
1733
Alcotest.(check bool)
1734
1734
"value is bytes" true
1735
-
(Option.is_some (Cbort.Cbor.to_bytes v))
1735
+
(Option.is_some (Cbor.Value.to_bytes v))
1736
1736
| _ -> Alcotest.fail "entry not [key, value]")
1737
1737
items
1738
1738
| None -> Alcotest.fail "entries not array")
···
1746
1746
let test_import_missing_entries () =
1747
1747
(* An export blob with no "entries" field must be rejected. *)
1748
1748
let blob =
1749
-
Cbort.encode_string Cbort.any
1750
-
(Cbort.Cbor.map
1749
+
Cbor.encode_string Cbor.any
1750
+
(Cbor.Value.map
1751
1751
[
1752
-
(Cbort.Cbor.string "version", Cbort.Cbor.int 1);
1753
-
(Cbort.Cbor.string "algorithm", Cbort.Cbor.int 1);
1752
+
(Cbor.Value.string "version", Cbor.Value.int 1);
1753
+
(Cbor.Value.string "algorithm", Cbor.Value.int 1);
1754
1754
])
1755
1755
in
1756
1756
match
···
1764
1764
(* An entry that is not a [key, value] pair must be rejected,
1765
1765
not silently dropped. *)
1766
1766
let blob =
1767
-
Cbort.encode_string Cbort.any
1768
-
(Cbort.Cbor.map
1767
+
Cbor.encode_string Cbor.any
1768
+
(Cbor.Value.map
1769
1769
[
1770
-
(Cbort.Cbor.string "version", Cbort.Cbor.int 1);
1771
-
(Cbort.Cbor.string "algorithm", Cbort.Cbor.int 1);
1772
-
( Cbort.Cbor.string "entries",
1773
-
Cbort.Cbor.array
1770
+
(Cbor.Value.string "version", Cbor.Value.int 1);
1771
+
(Cbor.Value.string "algorithm", Cbor.Value.int 1);
1772
+
( Cbor.Value.string "entries",
1773
+
Cbor.Value.array
1774
1774
[
1775
-
Cbort.Cbor.array
1776
-
[ Cbort.Cbor.string "good"; Cbort.Cbor.bytes "data" ];
1777
-
Cbort.Cbor.string "not-a-pair";
1775
+
Cbor.Value.array
1776
+
[ Cbor.Value.string "good"; Cbor.Value.bytes "data" ];
1777
+
Cbor.Value.string "not-a-pair";
1778
1778
] );
1779
1779
])
1780
1780
in
···
1793
1793
let _ = Scitt.vds_append vds ~key:"k2" ~value:"v2" in
1794
1794
let exported = Scitt.vds_export vds in
1795
1795
(* Parse, drop second entry, re-encode *)
1796
-
match Cbort.decode_string Cbort.any exported with
1796
+
match Cbor.decode_string Cbor.any exported with
1797
1797
| Error _ -> Alcotest.fail "export decode failed"
1798
1798
| Ok cbor -> (
1799
-
match Cbort.Cbor.to_map cbor with
1799
+
match Cbor.Value.to_map cbor with
1800
1800
| None -> Alcotest.fail "export not a map"
1801
1801
| Some pairs -> (
1802
1802
let tampered =
1803
1803
List.map
1804
1804
(fun (k, v) ->
1805
-
if Cbort.Cbor.to_text k = Some "entries" then
1806
-
match Cbort.Cbor.to_array v with
1805
+
if Cbor.Value.to_text k = Some "entries" then
1806
+
match Cbor.Value.to_array v with
1807
1807
| Some (_ :: _rest) ->
1808
1808
(* Keep only the first entry *)
1809
1809
( k,
1810
-
Cbort.Cbor.array
1811
-
[ List.hd (Option.get (Cbort.Cbor.to_array v)) ] )
1810
+
Cbor.Value.array
1811
+
[ List.hd (Option.get (Cbor.Value.to_array v)) ] )
1812
1812
| _ -> (k, v)
1813
1813
else (k, v))
1814
1814
pairs
1815
1815
in
1816
1816
let tampered_blob =
1817
-
Cbort.encode_string Cbort.any (Cbort.Cbor.map tampered)
1817
+
Cbor.encode_string Cbor.any (Cbor.Value.map tampered)
1818
1818
in
1819
1819
(* Import rejects because root hash mismatch — the export includes
1820
1820
the original root, but replaying only 1 entry produces a different
+5
-5
test/test_vds.ml
+5
-5
test/test_vds.ml
···
58
58
59
59
let test_import_rejects_bad_version () =
60
60
let bad =
61
-
Cbort.encode_string Cbort.any
62
-
(Cbort.Cbor.map
61
+
Cbor.encode_string Cbor.any
62
+
(Cbor.Value.map
63
63
[
64
-
(Cbort.Cbor.string "version", Cbort.Cbor.int 99);
65
-
(Cbort.Cbor.string "algorithm", Cbort.Cbor.int 1);
66
-
(Cbort.Cbor.string "entries", Cbort.Cbor.array []);
64
+
(Cbor.Value.string "version", Cbor.Value.int 99);
65
+
(Cbor.Value.string "algorithm", Cbor.Value.int 1);
66
+
(Cbor.Value.string "entries", Cbor.Value.array []);
67
67
])
68
68
in
69
69
match