Supply Chain Integrity, Transparency, and Trust (IETF SCITT)
atp, scitt: migrate to new Json API
- Drop jsont / jsont.bytesrw library deps in dune.inc; use json.
- Json.Codec.Value.null() / bool / number / string / array / mem / name ->
top-level Json.null / bool / etc. (these are value constructors, not codecs).
- Json.int / Json.int64 (as codec) -> Json.Codec.int / int64.
- Json.(list x) -> Json.Codec.(list x) where x is a codec.
- Json.object_' back to Json.object' (stray regex).
- xrpc_client: wrap Json.Error.t with Json.Error.to_string at the
Parse_error constructor boundary.
+85
-86
+1
-1
atp-lexicon-scitt.opam
+1
-1
atp-lexicon-scitt.opam
+1
-1
dune-project
+1
-1
dune-project
+65
-65
lexicons/atp_lexicon_scitt.ml
+65
-65
lexicons/atp_lexicon_scitt.ml
···
5
5
(** [filter_list jsont json_list] parses each element with [jsont],
6
6
returning only successfully parsed elements. Non-compliant records
7
7
are silently skipped. *)
8
-
let filter_list (type a) (jsont : a Jsont.t) (json_list : Jsont.json list) : a list =
8
+
let filter_list (type a) (jsont : a Json.codec) (json_list : Json.t list) : a list =
9
9
List.filter_map (fun json ->
10
-
match Jsont.Json.decode jsont json with
10
+
match Json.decode jsont json with
11
11
| Ok v -> Some v
12
12
| Error _ -> None
13
13
) json_list
···
23
23
}
24
24
25
25
let main_jsont =
26
-
Jsont.Object.map ~kind:"Main"
26
+
Json.Codec.Object.map ~kind:"Main"
27
27
(fun _typ cid uri -> { cid; uri })
28
-
|> Jsont.Object.mem "$type" Jsont.string ~dec_absent:"com.atproto.repo.strongRef" ~enc:(fun _ -> "com.atproto.repo.strongRef")
29
-
|> Jsont.Object.mem "cid" Jsont.string ~enc:(fun r -> r.cid)
30
-
|> Jsont.Object.mem "uri" Jsont.string ~enc:(fun r -> r.uri)
31
-
|> Jsont.Object.finish
28
+
|> Json.Codec.Object.mem "$type" Json.Codec.string ~dec_absent:"com.atproto.repo.strongRef" ~enc:(fun _ -> "com.atproto.repo.strongRef")
29
+
|> Json.Codec.Object.mem "cid" Json.Codec.string ~enc:(fun r -> r.cid)
30
+
|> Json.Codec.Object.mem "uri" Json.Codec.string ~enc:(fun r -> r.uri)
31
+
|> Json.Codec.Object.finish
32
32
33
33
end
34
34
end
···
48
48
}
49
49
50
50
let main_jsont =
51
-
Jsont.Object.map ~kind:"Main"
51
+
Json.Codec.Object.map ~kind:"Main"
52
52
(fun _typ content_type cose created_at issuer payload_digest subject -> { content_type; cose; created_at; issuer; payload_digest; subject })
53
-
|> Jsont.Object.mem "$type" Jsont.string ~dec_absent:"space.run.scitt.statement" ~enc:(fun _ -> "space.run.scitt.statement")
54
-
|> Jsont.Object.mem "contentType" Jsont.string ~enc:(fun r -> r.content_type)
55
-
|> Jsont.Object.mem "cose" Jsont.binary_string ~enc:(fun r -> r.cose)
56
-
|> Jsont.Object.mem "createdAt" Jsont.string ~enc:(fun r -> r.created_at)
57
-
|> Jsont.Object.mem "issuer" Jsont.string ~enc:(fun r -> r.issuer)
58
-
|> Jsont.Object.opt_mem "payloadDigest" Jsont.string ~enc:(fun r -> r.payload_digest)
59
-
|> Jsont.Object.mem "subject" Jsont.string ~enc:(fun r -> r.subject)
60
-
|> Jsont.Object.finish
53
+
|> Json.Codec.Object.mem "$type" Json.Codec.string ~dec_absent:"space.run.scitt.statement" ~enc:(fun _ -> "space.run.scitt.statement")
54
+
|> Json.Codec.Object.mem "contentType" Json.Codec.string ~enc:(fun r -> r.content_type)
55
+
|> Json.Codec.Object.mem "cose" Json.Codec.binary_string ~enc:(fun r -> r.cose)
56
+
|> Json.Codec.Object.mem "createdAt" Json.Codec.string ~enc:(fun r -> r.created_at)
57
+
|> Json.Codec.Object.mem "issuer" Json.Codec.string ~enc:(fun r -> r.issuer)
58
+
|> Json.Codec.Object.opt_mem "payloadDigest" Json.Codec.string ~enc:(fun r -> r.payload_digest)
59
+
|> Json.Codec.Object.mem "subject" Json.Codec.string ~enc:(fun r -> r.subject)
60
+
|> Json.Codec.Object.finish
61
61
62
62
end
63
63
module RegisterStatement = struct
64
64
type input = unit
65
-
let input_jsont = Jsont.ignore
65
+
let input_jsont = Json.Codec.ignore
66
66
67
67
type output = {
68
68
receipt : string;
···
73
73
}
74
74
75
75
let output_jsont =
76
-
Jsont.Object.map ~kind:"Output"
76
+
Json.Codec.Object.map ~kind:"Output"
77
77
(fun _typ receipt receipt_uri root statement_uri tree_size -> { receipt; receipt_uri; root; statement_uri; tree_size })
78
-
|> Jsont.Object.mem "$type" Jsont.string ~dec_absent:"space.run.scitt.registerStatement#output" ~enc:(fun _ -> "space.run.scitt.registerStatement#output")
79
-
|> Jsont.Object.mem "receipt" Jsont.binary_string ~enc:(fun r -> r.receipt)
80
-
|> Jsont.Object.opt_mem "receiptUri" Jsont.string ~enc:(fun r -> r.receipt_uri)
81
-
|> Jsont.Object.mem "root" Jsont.binary_string ~enc:(fun r -> r.root)
82
-
|> Jsont.Object.opt_mem "statementUri" Jsont.string ~enc:(fun r -> r.statement_uri)
83
-
|> Jsont.Object.mem "treeSize" Jsont.int ~enc:(fun r -> r.tree_size)
84
-
|> Jsont.Object.finish
78
+
|> Json.Codec.Object.mem "$type" Json.Codec.string ~dec_absent:"space.run.scitt.registerStatement#output" ~enc:(fun _ -> "space.run.scitt.registerStatement#output")
79
+
|> Json.Codec.Object.mem "receipt" Json.Codec.binary_string ~enc:(fun r -> r.receipt)
80
+
|> Json.Codec.Object.opt_mem "receiptUri" Json.Codec.string ~enc:(fun r -> r.receipt_uri)
81
+
|> Json.Codec.Object.mem "root" Json.Codec.binary_string ~enc:(fun r -> r.root)
82
+
|> Json.Codec.Object.opt_mem "statementUri" Json.Codec.string ~enc:(fun r -> r.statement_uri)
83
+
|> Json.Codec.Object.mem "treeSize" Json.Codec.int ~enc:(fun r -> r.tree_size)
84
+
|> Json.Codec.Object.finish
85
85
86
86
end
87
87
module Receipt = struct
···
95
95
}
96
96
97
97
let main_jsont =
98
-
Jsont.Object.map ~kind:"Main"
98
+
Json.Codec.Object.map ~kind:"Main"
99
99
(fun _typ cose created_at root statement tree_size vds_algorithm -> { cose; created_at; root; statement; tree_size; vds_algorithm })
100
-
|> Jsont.Object.mem "$type" Jsont.string ~dec_absent:"space.run.scitt.receipt" ~enc:(fun _ -> "space.run.scitt.receipt")
101
-
|> Jsont.Object.mem "cose" Jsont.binary_string ~enc:(fun r -> r.cose)
102
-
|> Jsont.Object.mem "createdAt" Jsont.string ~enc:(fun r -> r.created_at)
103
-
|> Jsont.Object.mem "root" Jsont.binary_string ~enc:(fun r -> r.root)
104
-
|> Jsont.Object.mem "statement" Com.Atproto.Repo.StrongRef.main_jsont ~enc:(fun r -> r.statement)
105
-
|> Jsont.Object.opt_mem "treeSize" Jsont.int ~enc:(fun r -> r.tree_size)
106
-
|> Jsont.Object.opt_mem "vdsAlgorithm" Jsont.int ~enc:(fun r -> r.vds_algorithm)
107
-
|> Jsont.Object.finish
100
+
|> Json.Codec.Object.mem "$type" Json.Codec.string ~dec_absent:"space.run.scitt.receipt" ~enc:(fun _ -> "space.run.scitt.receipt")
101
+
|> Json.Codec.Object.mem "cose" Json.Codec.binary_string ~enc:(fun r -> r.cose)
102
+
|> Json.Codec.Object.mem "createdAt" Json.Codec.string ~enc:(fun r -> r.created_at)
103
+
|> Json.Codec.Object.mem "root" Json.Codec.binary_string ~enc:(fun r -> r.root)
104
+
|> Json.Codec.Object.mem "statement" Com.Atproto.Repo.StrongRef.main_jsont ~enc:(fun r -> r.statement)
105
+
|> Json.Codec.Object.opt_mem "treeSize" Json.Codec.int ~enc:(fun r -> r.tree_size)
106
+
|> Json.Codec.Object.opt_mem "vdsAlgorithm" Json.Codec.int ~enc:(fun r -> r.vds_algorithm)
107
+
|> Json.Codec.Object.finish
108
108
109
109
end
110
110
module Defs = struct
···
116
116
}
117
117
118
118
let inclusion_proof_jsont =
119
-
Jsont.Object.map ~kind:"Inclusion_proof"
119
+
Json.Codec.Object.map ~kind:"Inclusion_proof"
120
120
(fun _typ index leaf_hash path root -> { index; leaf_hash; path; root })
121
-
|> Jsont.Object.mem "$type" Jsont.string ~dec_absent:"space.run.scitt.defs#inclusionProof" ~enc:(fun _ -> "space.run.scitt.defs#inclusionProof")
122
-
|> Jsont.Object.mem "index" Jsont.string ~enc:(fun r -> r.index)
123
-
|> Jsont.Object.mem "leafHash" Jsont.binary_string ~enc:(fun r -> r.leaf_hash)
124
-
|> Jsont.Object.mem "path" (Jsont.list Jsont.binary_string) ~enc:(fun r -> r.path)
125
-
|> Jsont.Object.mem "root" Jsont.binary_string ~enc:(fun r -> r.root)
126
-
|> Jsont.Object.finish
121
+
|> Json.Codec.Object.mem "$type" Json.Codec.string ~dec_absent:"space.run.scitt.defs#inclusionProof" ~enc:(fun _ -> "space.run.scitt.defs#inclusionProof")
122
+
|> Json.Codec.Object.mem "index" Json.Codec.string ~enc:(fun r -> r.index)
123
+
|> Json.Codec.Object.mem "leafHash" Json.Codec.binary_string ~enc:(fun r -> r.leaf_hash)
124
+
|> Json.Codec.Object.mem "path" (Json.Codec.list Json.Codec.binary_string) ~enc:(fun r -> r.path)
125
+
|> Json.Codec.Object.mem "root" Json.Codec.binary_string ~enc:(fun r -> r.root)
126
+
|> Json.Codec.Object.finish
127
127
128
128
type transparent_statement = {
129
129
receipts : string list;
···
131
131
}
132
132
133
133
let transparent_statement_jsont =
134
-
Jsont.Object.map ~kind:"Transparent_statement"
134
+
Json.Codec.Object.map ~kind:"Transparent_statement"
135
135
(fun _typ receipts statement -> { receipts; statement })
136
-
|> Jsont.Object.mem "$type" Jsont.string ~dec_absent:"space.run.scitt.defs#transparentStatement" ~enc:(fun _ -> "space.run.scitt.defs#transparentStatement")
137
-
|> Jsont.Object.mem "receipts" (Jsont.list Jsont.binary_string) ~enc:(fun r -> r.receipts)
138
-
|> Jsont.Object.mem "statement" Jsont.binary_string ~enc:(fun r -> r.statement)
139
-
|> Jsont.Object.finish
136
+
|> Json.Codec.Object.mem "$type" Json.Codec.string ~dec_absent:"space.run.scitt.defs#transparentStatement" ~enc:(fun _ -> "space.run.scitt.defs#transparentStatement")
137
+
|> Json.Codec.Object.mem "receipts" (Json.Codec.list Json.Codec.binary_string) ~enc:(fun r -> r.receipts)
138
+
|> Json.Codec.Object.mem "statement" Json.Codec.binary_string ~enc:(fun r -> r.statement)
139
+
|> Json.Codec.Object.finish
140
140
141
141
end
142
142
module GetStatement = struct
···
146
146
}
147
147
148
148
let params_jsont =
149
-
Jsont.Object.map ~kind:"Params"
149
+
Json.Codec.Object.map ~kind:"Params"
150
150
(fun subject uri -> {
151
151
subject;
152
152
uri;
153
153
})
154
-
|> Jsont.Object.opt_mem "subject" Jsont.string
154
+
|> Json.Codec.Object.opt_mem "subject" Json.Codec.string
155
155
~enc:(fun r -> r.subject)
156
-
|> Jsont.Object.opt_mem "uri" Jsont.string
156
+
|> Json.Codec.Object.opt_mem "uri" Json.Codec.string
157
157
~enc:(fun r -> r.uri)
158
-
|> Jsont.Object.finish
158
+
|> Json.Codec.Object.finish
159
159
160
160
type output = {
161
161
receipt : Receipt.main option;
···
164
164
}
165
165
166
166
let output_jsont =
167
-
Jsont.Object.map ~kind:"Output"
167
+
Json.Codec.Object.map ~kind:"Output"
168
168
(fun _typ receipt statement transparent_statement -> { receipt; statement; transparent_statement })
169
-
|> Jsont.Object.mem "$type" Jsont.string ~dec_absent:"space.run.scitt.getStatement#output" ~enc:(fun _ -> "space.run.scitt.getStatement#output")
170
-
|> Jsont.Object.opt_mem "receipt" Receipt.main_jsont ~enc:(fun r -> r.receipt)
171
-
|> Jsont.Object.mem "statement" Statement.main_jsont ~enc:(fun r -> r.statement)
172
-
|> Jsont.Object.opt_mem "transparentStatement" Defs.transparent_statement_jsont ~enc:(fun r -> r.transparent_statement)
173
-
|> Jsont.Object.finish
169
+
|> Json.Codec.Object.mem "$type" Json.Codec.string ~dec_absent:"space.run.scitt.getStatement#output" ~enc:(fun _ -> "space.run.scitt.getStatement#output")
170
+
|> Json.Codec.Object.opt_mem "receipt" Receipt.main_jsont ~enc:(fun r -> r.receipt)
171
+
|> Json.Codec.Object.mem "statement" Statement.main_jsont ~enc:(fun r -> r.statement)
172
+
|> Json.Codec.Object.opt_mem "transparentStatement" Defs.transparent_statement_jsont ~enc:(fun r -> r.transparent_statement)
173
+
|> Json.Codec.Object.finish
174
174
175
175
end
176
176
module GetReceipt = struct
···
180
180
}
181
181
182
182
let params_jsont =
183
-
Jsont.Object.map ~kind:"Params"
183
+
Json.Codec.Object.map ~kind:"Params"
184
184
(fun statement uri -> {
185
185
statement;
186
186
uri;
187
187
})
188
-
|> Jsont.Object.opt_mem "statement" Jsont.string
188
+
|> Json.Codec.Object.opt_mem "statement" Json.Codec.string
189
189
~enc:(fun r -> r.statement)
190
-
|> Jsont.Object.opt_mem "uri" Jsont.string
190
+
|> Json.Codec.Object.opt_mem "uri" Json.Codec.string
191
191
~enc:(fun r -> r.uri)
192
-
|> Jsont.Object.finish
192
+
|> Json.Codec.Object.finish
193
193
194
194
type output = {
195
195
inclusion_proof : Defs.inclusion_proof option;
···
197
197
}
198
198
199
199
let output_jsont =
200
-
Jsont.Object.map ~kind:"Output"
200
+
Json.Codec.Object.map ~kind:"Output"
201
201
(fun _typ inclusion_proof receipt -> { inclusion_proof; receipt })
202
-
|> Jsont.Object.mem "$type" Jsont.string ~dec_absent:"space.run.scitt.getReceipt#output" ~enc:(fun _ -> "space.run.scitt.getReceipt#output")
203
-
|> Jsont.Object.opt_mem "inclusionProof" Defs.inclusion_proof_jsont ~enc:(fun r -> r.inclusion_proof)
204
-
|> Jsont.Object.mem "receipt" Receipt.main_jsont ~enc:(fun r -> r.receipt)
205
-
|> Jsont.Object.finish
202
+
|> Json.Codec.Object.mem "$type" Json.Codec.string ~dec_absent:"space.run.scitt.getReceipt#output" ~enc:(fun _ -> "space.run.scitt.getReceipt#output")
203
+
|> Json.Codec.Object.opt_mem "inclusionProof" Defs.inclusion_proof_jsont ~enc:(fun r -> r.inclusion_proof)
204
+
|> Json.Codec.Object.mem "receipt" Receipt.main_jsont ~enc:(fun r -> r.receipt)
205
+
|> Json.Codec.Object.finish
206
206
207
207
end
208
208
end
+12
-12
lexicons/atp_lexicon_scitt.mli
+12
-12
lexicons/atp_lexicon_scitt.mli
···
4
4
5
5
(** Utility functions for resilient parsing. *)
6
6
module Filter : sig
7
-
val filter_list : 'a Jsont.t -> Jsont.json list -> 'a list
7
+
val filter_list : 'a Json.codec -> Json.t list -> 'a list
8
8
(** [filter_list jsont json_list] parses each element with [jsont],
9
9
returning only successfully parsed elements. Non-compliant records
10
10
are silently skipped. *)
···
22
22
}
23
23
24
24
(** Jsont codec for {!type:main}. *)
25
-
val main_jsont : main Jsont.t
25
+
val main_jsont : main Json.codec
26
26
27
27
end
28
28
end
···
44
44
}
45
45
46
46
(** Jsont codec for {!type:main}. *)
47
-
val main_jsont : main Jsont.t
47
+
val main_jsont : main Json.codec
48
48
49
49
end
50
50
module RegisterStatement : sig
···
53
53
(** COSE_Sign1 encoded signed statement. *)
54
54
55
55
type input = unit
56
-
val input_jsont : input Jsont.t
56
+
val input_jsont : input Json.codec
57
57
58
58
59
59
type output = {
···
65
65
}
66
66
67
67
(** Jsont codec for {!type:output}. *)
68
-
val output_jsont : output Jsont.t
68
+
val output_jsont : output Json.codec
69
69
70
70
end
71
71
module Receipt : sig
···
81
81
}
82
82
83
83
(** Jsont codec for {!type:main}. *)
84
-
val main_jsont : main Jsont.t
84
+
val main_jsont : main Json.codec
85
85
86
86
end
87
87
module Defs : sig
···
95
95
}
96
96
97
97
(** Jsont codec for {!type:inclusion_proof}. *)
98
-
val inclusion_proof_jsont : inclusion_proof Jsont.t
98
+
val inclusion_proof_jsont : inclusion_proof Json.codec
99
99
100
100
(** A signed statement bundled with its receipts — everything needed for offline verification. *)
101
101
···
105
105
}
106
106
107
107
(** Jsont codec for {!type:transparent_statement}. *)
108
-
val transparent_statement_jsont : transparent_statement Jsont.t
108
+
val transparent_statement_jsont : transparent_statement Json.codec
109
109
110
110
end
111
111
module GetStatement : sig
···
118
118
}
119
119
120
120
(** Jsont codec for {!type:params}. *)
121
-
val params_jsont : params Jsont.t
121
+
val params_jsont : params Json.codec
122
122
123
123
124
124
type output = {
···
128
128
}
129
129
130
130
(** Jsont codec for {!type:output}. *)
131
-
val output_jsont : output Jsont.t
131
+
val output_jsont : output Json.codec
132
132
133
133
end
134
134
module GetReceipt : sig
···
141
141
}
142
142
143
143
(** Jsont codec for {!type:params}. *)
144
-
val params_jsont : params Jsont.t
144
+
val params_jsont : params Json.codec
145
145
146
146
147
147
type output = {
···
150
150
}
151
151
152
152
(** Jsont codec for {!type:output}. *)
153
-
val output_jsont : output Jsont.t
153
+
val output_jsont : output Json.codec
154
154
155
155
end
156
156
end
+1
-1
lexicons/dune.inc
+1
-1
lexicons/dune.inc
+2
-2
lib/atp/scitt_atp.ml
+2
-2
lib/atp/scitt_atp.ml
···
98
98
}
99
99
in
100
100
let ( let* ) = Result.bind in
101
-
let* json = Jsont.Json.encode Statement_lexicon.main_jsont record in
101
+
let* json = Json.encode Statement_lexicon.main_jsont record in
102
102
let* dagcbor_value = Atp.Dagcbor.of_json json in
103
103
Ok (Atp.Dagcbor.encode_string dagcbor_value)
104
104
···
110
110
| None -> String.make 32 '\x00'
111
111
112
112
let err_duplicate key = Error ("duplicate key: " ^ key)
113
-
let err_encoding e = Error ("encoding error: " ^ e)
113
+
let err_encoding e = Error ("encoding error: " ^ Json.Error.to_string e)
114
114
115
115
let repo_key_of_vds_key key =
116
116
match String.index_opt key '/' with
-1
lib/scitt.ml
-1
lib/scitt.ml
+1
-1
lib/vds.ml
+1
-1
lib/vds.ml
···
617
617
| (key, value) :: rest -> (
618
618
match append vds ~key ~value with
619
619
| Ok _ -> go rest
620
-
| Error e -> Error ("import: " ^ e))
620
+
| Error e -> Error ("import: " ^ Json.Error.to_string e))
621
621
in
622
622
let* () = go entries in
623
623
(* Verify root integrity if present in export *)
+1
-1
test/test_scitt.ml
+1
-1
test/test_scitt.ml
···
1337
1337
let decode_key_exn hex =
1338
1338
match X509.Public_key.decode_der (hex_to_raw hex) with
1339
1339
| Ok k -> k
1340
-
| Error (`Msg e) -> Alcotest.failf "decode key: %s" e
1340
+
| Error (`Msg e) -> Alcotest.failf "decode key: %s" (Json.Error.to_string e)
1341
1341
1342
1342
let test_roundtrip_decode_verify () =
1343
1343
let transparent_bytes = hex_to_raw interop_transparent_hex in
+1
-1
test/test_vds.ml
+1
-1
test/test_vds.ml
···
43
43
Scitt.Vds_rfc9162.import exported ~create:(fun ~hash () ->
44
44
Scitt.Vds_rfc9162.in_memory ~hash ())
45
45
with
46
-
| Error e -> Alcotest.failf "import failed: %s" e
46
+
| Error e -> Alcotest.failf "import failed: %s" (Json.Error.to_string e)
47
47
| Ok imported ->
48
48
Alcotest.(check int)
49
49
"size preserved" original_size (Scitt.vds_size imported);