forked from
gazagnaire.org/ocaml-crypto
upstream: https://github.com/mirage/mirage-crypto
Migrate from yojson to jsont and hkdf to kdf.hkdf
- ocaml-oci/src/spec: Convert all JSON handling from yojson to jsont
- mirage-crypto/tests/wycheproof: Replace ppx_deriving_yojson with jsont codecs
- ocaml-matter, ocaml-spake2, ocaml-hap, ocaml-csrf: Update dependency from
standalone hkdf package to kdf.hkdf (digestif-based implementation)
- ocaml-hap: Add hkdf_sha512 helper using kdf.hkdf API
- Various code cleanups for jsont compatibility
+295
-50
+1
-3
tests/wycheproof/dune
+1
-3
tests/wycheproof/dune
+262
-35
tests/wycheproof/wycheproof.ml
+262
-35
tests/wycheproof/wycheproof.ml
···
1
-
type json = Yojson.Safe.t [@@deriving of_yojson]
1
+
type json = Jsont.json
2
+
3
+
let pp_json ppf json =
4
+
match Jsont_bytesrw.encode_string Jsont.json json with
5
+
| Ok s -> Format.pp_print_string ppf s
6
+
| Error _ -> Format.pp_print_string ppf "<json>"
2
7
3
-
let pp_json = Yojson.Safe.pretty_print
8
+
type hex = string
4
9
5
-
type hex = string [@@deriving eq]
10
+
let equal_hex = String.equal
6
11
7
12
let pp_hex fmt buf =
8
13
let n = String.length buf in
···
38
43
assert (leftover = None);
39
44
Bytes.unsafe_to_string out
40
45
41
-
let hex_of_yojson json =
46
+
let hex_jsont =
42
47
let padded s = if String.length s mod 2 = 0 then s else "0" ^ s in
43
-
match [%of_yojson: string] json with
44
-
| Ok s -> Ok (hex_of_string (padded s))
45
-
| Error _ as e -> e
48
+
Jsont.map ~kind:"hex"
49
+
~dec:(fun s -> hex_of_string (padded s))
50
+
~enc:(fun h ->
51
+
(* Encode hex back to string - reverse of hex_of_string *)
52
+
let buf = Buffer.create (String.length h * 2) in
53
+
String.iter (fun c ->
54
+
Buffer.add_string buf (Printf.sprintf "%02x" (Char.code c))
55
+
) h;
56
+
Buffer.contents buf)
57
+
Jsont.string
58
+
59
+
type test_result = Valid | Acceptable | Invalid
60
+
61
+
let pp_test_result fmt = function
62
+
| Valid -> Format.pp_print_string fmt "Valid"
63
+
| Acceptable -> Format.pp_print_string fmt "Acceptable"
64
+
| Invalid -> Format.pp_print_string fmt "Invalid"
46
65
47
-
type test_result = Valid | Acceptable | Invalid [@@deriving show]
66
+
let show_test_result = function
67
+
| Valid -> "Valid"
68
+
| Acceptable -> "Acceptable"
69
+
| Invalid -> "Invalid"
48
70
49
-
let test_result_of_yojson = function
50
-
| `String "valid" -> Ok Valid
51
-
| `String "acceptable" -> Ok Acceptable
52
-
| `String "invalid" -> Ok Invalid
53
-
| _ -> Error "test_result"
71
+
let test_result_jsont =
72
+
Jsont.map ~kind:"test_result"
73
+
~dec:(function
74
+
| "valid" -> Valid
75
+
| "acceptable" -> Acceptable
76
+
| "invalid" -> Invalid
77
+
| _ -> failwith "test_result: expected valid, acceptable, or invalid")
78
+
~enc:(function
79
+
| Valid -> "valid"
80
+
| Acceptable -> "acceptable"
81
+
| Invalid -> "invalid")
82
+
Jsont.string
54
83
55
84
type ecdh_test = {
56
85
tcId : int;
57
86
comment : string;
58
-
curve : json option; [@yojson.default None]
87
+
curve : json option;
59
88
public : hex;
60
-
private_ : hex; [@yojson.key "private"]
89
+
private_ : hex;
61
90
shared : hex;
62
91
result : test_result;
63
92
flags : string list;
64
93
}
65
-
[@@deriving of_yojson, show]
94
+
95
+
let pp_ecdh_test fmt t =
96
+
Format.fprintf fmt "{ tcId = %d; comment = %S; curve = %a; public = %a; private_ = %a; shared = %a; result = %a; flags = [%s] }"
97
+
t.tcId t.comment
98
+
(Format.pp_print_option pp_json) t.curve
99
+
pp_hex t.public
100
+
pp_hex t.private_
101
+
pp_hex t.shared
102
+
pp_test_result t.result
103
+
(String.concat "; " (List.map (fun s -> "\"" ^ s ^ "\"") t.flags))
104
+
105
+
let show_ecdh_test t =
106
+
Format.asprintf "%a" pp_ecdh_test t
107
+
108
+
let ecdh_test_jsont =
109
+
Jsont.Object.map ~kind:"ecdh_test"
110
+
(fun tcId comment curve public private_ shared result flags ->
111
+
{ tcId; comment; curve; public; private_; shared; result;
112
+
flags = Option.value ~default:[] flags })
113
+
|> Jsont.Object.mem "tcId" Jsont.int ~enc:(fun t -> t.tcId)
114
+
|> Jsont.Object.mem "comment" Jsont.string ~enc:(fun t -> t.comment)
115
+
|> Jsont.Object.opt_mem "curve" Jsont.json ~enc:(fun t -> t.curve)
116
+
|> Jsont.Object.mem "public" hex_jsont ~enc:(fun t -> t.public)
117
+
|> Jsont.Object.mem "private" hex_jsont ~enc:(fun t -> t.private_)
118
+
|> Jsont.Object.mem "shared" hex_jsont ~enc:(fun t -> t.shared)
119
+
|> Jsont.Object.mem "result" test_result_jsont ~enc:(fun t -> t.result)
120
+
|> Jsont.Object.opt_mem "flags" (Jsont.list Jsont.string)
121
+
~enc:(fun t -> if t.flags = [] then None else Some t.flags)
122
+
|> Jsont.Object.skip_unknown
123
+
|> Jsont.Object.finish
66
124
67
125
let has_ignored_flag test ~ignored_flags =
68
126
List.exists
···
72
130
type ecdh_test_group = {
73
131
curve : string;
74
132
tests : ecdh_test list;
75
-
encoding : json option; [@yojson.default None]
76
-
type_ : json option; [@yojson.default None] [@yojson.key "type"]
133
+
encoding : json option;
134
+
type_ : json option;
77
135
}
78
-
[@@deriving of_yojson, show]
136
+
137
+
let pp_ecdh_test_group fmt t =
138
+
Format.fprintf fmt "{ curve = %S; tests = [%d tests]; encoding = %a; type_ = %a }"
139
+
t.curve (List.length t.tests)
140
+
(Format.pp_print_option pp_json) t.encoding
141
+
(Format.pp_print_option pp_json) t.type_
142
+
143
+
let show_ecdh_test_group t =
144
+
Format.asprintf "%a" pp_ecdh_test_group t
145
+
146
+
let ecdh_test_group_jsont =
147
+
Jsont.Object.map ~kind:"ecdh_test_group"
148
+
(fun curve tests encoding type_ ->
149
+
{ curve; tests; encoding; type_ })
150
+
|> Jsont.Object.mem "curve" Jsont.string ~enc:(fun t -> t.curve)
151
+
|> Jsont.Object.mem "tests" (Jsont.list ecdh_test_jsont) ~enc:(fun t -> t.tests)
152
+
|> Jsont.Object.opt_mem "encoding" Jsont.json ~enc:(fun t -> t.encoding)
153
+
|> Jsont.Object.opt_mem "type" Jsont.json ~enc:(fun t -> t.type_)
154
+
|> Jsont.Object.skip_unknown
155
+
|> Jsont.Object.finish
79
156
80
157
type ecdsa_key = {
81
158
curve : string;
82
159
keySize : int;
83
-
type_ : json; [@yojson.key "type"]
160
+
type_ : json;
84
161
uncompressed : hex;
85
162
wx : hex;
86
163
wy : hex;
87
164
}
88
-
[@@deriving of_yojson, show]
165
+
166
+
let pp_ecdsa_key fmt t =
167
+
Format.fprintf fmt "{ curve = %S; keySize = %d; type_ = %a; uncompressed = %a; wx = %a; wy = %a }"
168
+
t.curve t.keySize
169
+
pp_json t.type_
170
+
pp_hex t.uncompressed
171
+
pp_hex t.wx
172
+
pp_hex t.wy
173
+
174
+
let show_ecdsa_key t =
175
+
Format.asprintf "%a" pp_ecdsa_key t
176
+
177
+
let ecdsa_key_jsont =
178
+
Jsont.Object.map ~kind:"ecdsa_key"
179
+
(fun curve keySize type_ uncompressed wx wy ->
180
+
{ curve; keySize; type_; uncompressed; wx; wy })
181
+
|> Jsont.Object.mem "curve" Jsont.string ~enc:(fun t -> t.curve)
182
+
|> Jsont.Object.mem "keySize" Jsont.int ~enc:(fun t -> t.keySize)
183
+
|> Jsont.Object.mem "type" Jsont.json ~enc:(fun t -> t.type_)
184
+
|> Jsont.Object.mem "uncompressed" hex_jsont ~enc:(fun t -> t.uncompressed)
185
+
|> Jsont.Object.mem "wx" hex_jsont ~enc:(fun t -> t.wx)
186
+
|> Jsont.Object.mem "wy" hex_jsont ~enc:(fun t -> t.wy)
187
+
|> Jsont.Object.skip_unknown
188
+
|> Jsont.Object.finish
89
189
90
190
type dsa_test = {
91
191
tcId : int;
92
192
comment : string;
93
193
msg : hex;
94
-
sig_ : hex; [@yojson.key "sig"]
194
+
sig_ : hex;
95
195
result : test_result;
96
196
flags : string list;
97
197
}
98
-
[@@deriving of_yojson, show]
198
+
199
+
let pp_dsa_test fmt t =
200
+
Format.fprintf fmt "{ tcId = %d; comment = %S; msg = %a; sig_ = %a; result = %a; flags = [%s] }"
201
+
t.tcId t.comment
202
+
pp_hex t.msg
203
+
pp_hex t.sig_
204
+
pp_test_result t.result
205
+
(String.concat "; " (List.map (fun s -> "\"" ^ s ^ "\"") t.flags))
206
+
207
+
let show_dsa_test t =
208
+
Format.asprintf "%a" pp_dsa_test t
209
+
210
+
let dsa_test_jsont =
211
+
Jsont.Object.map ~kind:"dsa_test"
212
+
(fun tcId comment msg sig_ result flags ->
213
+
{ tcId; comment; msg; sig_; result;
214
+
flags = Option.value ~default:[] flags })
215
+
|> Jsont.Object.mem "tcId" Jsont.int ~enc:(fun t -> t.tcId)
216
+
|> Jsont.Object.mem "comment" Jsont.string ~enc:(fun t -> t.comment)
217
+
|> Jsont.Object.mem "msg" hex_jsont ~enc:(fun t -> t.msg)
218
+
|> Jsont.Object.mem "sig" hex_jsont ~enc:(fun t -> t.sig_)
219
+
|> Jsont.Object.mem "result" test_result_jsont ~enc:(fun t -> t.result)
220
+
|> Jsont.Object.opt_mem "flags" (Jsont.list Jsont.string)
221
+
~enc:(fun t -> if t.flags = [] then None else Some t.flags)
222
+
|> Jsont.Object.skip_unknown
223
+
|> Jsont.Object.finish
99
224
100
225
type ecdsa_test_group = {
101
226
key : ecdsa_key;
···
103
228
keyPem : string;
104
229
sha : string;
105
230
tests : dsa_test list;
106
-
type_ : json option; [@yojson.default None] [@yojson.key "type"]
231
+
type_ : json option;
107
232
}
108
-
[@@deriving of_yojson, show]
233
+
234
+
let pp_ecdsa_test_group fmt t =
235
+
Format.fprintf fmt "{ key = %a; keyDer = %S; keyPem = %S; sha = %S; tests = [%d tests]; type_ = %a }"
236
+
pp_ecdsa_key t.key
237
+
t.keyDer t.keyPem t.sha
238
+
(List.length t.tests)
239
+
(Format.pp_print_option pp_json) t.type_
240
+
241
+
let show_ecdsa_test_group t =
242
+
Format.asprintf "%a" pp_ecdsa_test_group t
243
+
244
+
let ecdsa_test_group_jsont =
245
+
Jsont.Object.map ~kind:"ecdsa_test_group"
246
+
(fun key keyDer keyPem sha tests type_ ->
247
+
{ key; keyDer; keyPem; sha; tests; type_ })
248
+
|> Jsont.Object.mem "key" ecdsa_key_jsont ~enc:(fun t -> t.key)
249
+
|> Jsont.Object.mem "keyDer" Jsont.string ~enc:(fun t -> t.keyDer)
250
+
|> Jsont.Object.mem "keyPem" Jsont.string ~enc:(fun t -> t.keyPem)
251
+
|> Jsont.Object.mem "sha" Jsont.string ~enc:(fun t -> t.sha)
252
+
|> Jsont.Object.mem "tests" (Jsont.list dsa_test_jsont) ~enc:(fun t -> t.tests)
253
+
|> Jsont.Object.opt_mem "type" Jsont.json ~enc:(fun t -> t.type_)
254
+
|> Jsont.Object.skip_unknown
255
+
|> Jsont.Object.finish
109
256
110
257
type eddsa_key = {
111
258
curve : string;
112
259
keySize : int;
113
260
pk : hex;
114
261
sk : hex;
115
-
type_ : json; [@yojson.key "type"]
262
+
type_ : json;
116
263
}
117
-
[@@deriving of_yojson, show]
264
+
265
+
let pp_eddsa_key fmt t =
266
+
Format.fprintf fmt "{ curve = %S; keySize = %d; pk = %a; sk = %a; type_ = %a }"
267
+
t.curve t.keySize
268
+
pp_hex t.pk
269
+
pp_hex t.sk
270
+
pp_json t.type_
271
+
272
+
let show_eddsa_key t =
273
+
Format.asprintf "%a" pp_eddsa_key t
274
+
275
+
let eddsa_key_jsont =
276
+
Jsont.Object.map ~kind:"eddsa_key"
277
+
(fun curve keySize pk sk type_ ->
278
+
{ curve; keySize; pk; sk; type_ })
279
+
|> Jsont.Object.mem "curve" Jsont.string ~enc:(fun t -> t.curve)
280
+
|> Jsont.Object.mem "keySize" Jsont.int ~enc:(fun t -> t.keySize)
281
+
|> Jsont.Object.mem "pk" hex_jsont ~enc:(fun t -> t.pk)
282
+
|> Jsont.Object.mem "sk" hex_jsont ~enc:(fun t -> t.sk)
283
+
|> Jsont.Object.mem "type" Jsont.json ~enc:(fun t -> t.type_)
284
+
|> Jsont.Object.skip_unknown
285
+
|> Jsont.Object.finish
118
286
119
287
type eddsa_test_group = {
120
288
jwk : json;
121
289
key : eddsa_key;
122
290
keyDer : string;
123
291
keyPem : string;
124
-
type_ : json; [@yojson.key "type"]
292
+
type_ : json;
125
293
tests : dsa_test list;
126
294
}
127
-
[@@deriving of_yojson, show]
295
+
296
+
let pp_eddsa_test_group fmt t =
297
+
Format.fprintf fmt "{ jwk = %a; key = %a; keyDer = %S; keyPem = %S; type_ = %a; tests = [%d tests] }"
298
+
pp_json t.jwk
299
+
pp_eddsa_key t.key
300
+
t.keyDer t.keyPem
301
+
pp_json t.type_
302
+
(List.length t.tests)
303
+
304
+
let show_eddsa_test_group t =
305
+
Format.asprintf "%a" pp_eddsa_test_group t
306
+
307
+
let eddsa_test_group_jsont =
308
+
Jsont.Object.map ~kind:"eddsa_test_group"
309
+
(fun jwk key keyDer keyPem type_ tests ->
310
+
{ jwk; key; keyDer; keyPem; type_; tests })
311
+
|> Jsont.Object.mem "jwk" Jsont.json ~enc:(fun t -> t.jwk)
312
+
|> Jsont.Object.mem "key" eddsa_key_jsont ~enc:(fun t -> t.key)
313
+
|> Jsont.Object.mem "keyDer" Jsont.string ~enc:(fun t -> t.keyDer)
314
+
|> Jsont.Object.mem "keyPem" Jsont.string ~enc:(fun t -> t.keyPem)
315
+
|> Jsont.Object.mem "type" Jsont.json ~enc:(fun t -> t.type_)
316
+
|> Jsont.Object.mem "tests" (Jsont.list dsa_test_jsont) ~enc:(fun t -> t.tests)
317
+
|> Jsont.Object.skip_unknown
318
+
|> Jsont.Object.finish
128
319
129
320
type test_file = {
130
321
algorithm : json;
···
135
326
schema : json;
136
327
testGroups : json list;
137
328
}
138
-
[@@deriving of_yojson, show]
139
329
140
-
let get_json = function Ok x -> x | Error s -> failwith s
330
+
let pp_test_file fmt t =
331
+
Format.fprintf fmt "{ algorithm = %a; generatorVersion = %a; header = %a; notes = %a; numberOfTests = %a; schema = %a; testGroups = [%d groups] }"
332
+
pp_json t.algorithm
333
+
pp_json t.generatorVersion
334
+
pp_json t.header
335
+
pp_json t.notes
336
+
pp_json t.numberOfTests
337
+
pp_json t.schema
338
+
(List.length t.testGroups)
339
+
340
+
let show_test_file t =
341
+
Format.asprintf "%a" pp_test_file t
342
+
343
+
let test_file_jsont =
344
+
Jsont.Object.map ~kind:"test_file"
345
+
(fun algorithm generatorVersion header notes numberOfTests schema testGroups ->
346
+
{ algorithm; generatorVersion; header; notes; numberOfTests; schema; testGroups })
347
+
|> Jsont.Object.mem "algorithm" Jsont.json ~enc:(fun t -> t.algorithm)
348
+
|> Jsont.Object.mem "generatorVersion" Jsont.json ~enc:(fun t -> t.generatorVersion)
349
+
|> Jsont.Object.mem "header" Jsont.json ~enc:(fun t -> t.header)
350
+
|> Jsont.Object.mem "notes" Jsont.json ~enc:(fun t -> t.notes)
351
+
|> Jsont.Object.mem "numberOfTests" Jsont.json ~enc:(fun t -> t.numberOfTests)
352
+
|> Jsont.Object.mem "schema" Jsont.json ~enc:(fun t -> t.schema)
353
+
|> Jsont.Object.mem "testGroups" (Jsont.list Jsont.json) ~enc:(fun t -> t.testGroups)
354
+
|> Jsont.Object.skip_unknown
355
+
|> Jsont.Object.finish
356
+
357
+
let get_result = function Ok x -> x | Error s -> failwith s
141
358
142
359
let load_file_exn path =
143
-
Yojson.Safe.from_file path |> [%of_yojson: test_file] |> get_json
360
+
let content = In_channel.with_open_bin path In_channel.input_all in
361
+
Jsont_bytesrw.decode_string test_file_jsont content |> get_result
144
362
145
-
let ecdh_test_group_exn json = [%of_yojson: ecdh_test_group] json |> get_json
363
+
let ecdh_test_group_exn json =
364
+
match Jsont_bytesrw.encode_string Jsont.json json with
365
+
| Error _ -> failwith "ecdh_test_group_exn: encode failed"
366
+
| Ok s -> Jsont_bytesrw.decode_string ecdh_test_group_jsont s |> get_result
146
367
147
-
let ecdsa_test_group_exn json = [%of_yojson: ecdsa_test_group] json |> get_json
368
+
let ecdsa_test_group_exn json =
369
+
match Jsont_bytesrw.encode_string Jsont.json json with
370
+
| Error _ -> failwith "ecdsa_test_group_exn: encode failed"
371
+
| Ok s -> Jsont_bytesrw.decode_string ecdsa_test_group_jsont s |> get_result
148
372
149
-
let eddsa_test_group_exn json = [%of_yojson: eddsa_test_group] json |> get_json
373
+
let eddsa_test_group_exn json =
374
+
match Jsont_bytesrw.encode_string Jsont.json json with
375
+
| Error _ -> failwith "eddsa_test_group_exn: encode failed"
376
+
| Ok s -> Jsont_bytesrw.decode_string eddsa_test_group_jsont s |> get_result
+32
-12
tests/wycheproof/wycheproof.mli
+32
-12
tests/wycheproof/wycheproof.mli
···
1
1
type json
2
2
3
-
type hex = string [@@deriving eq]
3
+
type hex = string
4
4
5
+
val equal_hex : hex -> hex -> bool
5
6
val pp_hex : Format.formatter -> hex -> unit
6
7
7
-
type test_result = Valid | Acceptable | Invalid [@@deriving show]
8
+
type test_result = Valid | Acceptable | Invalid
9
+
10
+
val pp_test_result : Format.formatter -> test_result -> unit
11
+
val show_test_result : test_result -> string
8
12
9
13
type ecdh_test = {
10
14
tcId : int;
···
16
20
result : test_result;
17
21
flags : string list;
18
22
}
19
-
[@@deriving show]
23
+
24
+
val pp_ecdh_test : Format.formatter -> ecdh_test -> unit
25
+
val show_ecdh_test : ecdh_test -> string
20
26
21
27
val has_ignored_flag : ecdh_test -> ignored_flags:string list -> bool
22
28
···
26
32
encoding : json option;
27
33
type_ : json option;
28
34
}
29
-
[@@deriving show]
35
+
36
+
val pp_ecdh_test_group : Format.formatter -> ecdh_test_group -> unit
37
+
val show_ecdh_test_group : ecdh_test_group -> string
30
38
31
39
type ecdsa_key = {
32
40
curve : string;
···
36
44
wx : hex;
37
45
wy : hex;
38
46
}
39
-
[@@deriving show]
47
+
48
+
val pp_ecdsa_key : Format.formatter -> ecdsa_key -> unit
49
+
val show_ecdsa_key : ecdsa_key -> string
40
50
41
51
type dsa_test = {
42
52
tcId : int;
···
46
56
result : test_result;
47
57
flags : string list;
48
58
}
49
-
[@@deriving show]
59
+
60
+
val pp_dsa_test : Format.formatter -> dsa_test -> unit
61
+
val show_dsa_test : dsa_test -> string
50
62
51
63
type ecdsa_test_group = {
52
64
key : ecdsa_key;
···
56
68
tests : dsa_test list;
57
69
type_ : json option;
58
70
}
59
-
[@@deriving show]
71
+
72
+
val pp_ecdsa_test_group : Format.formatter -> ecdsa_test_group -> unit
73
+
val show_ecdsa_test_group : ecdsa_test_group -> string
60
74
61
75
type eddsa_key = {
62
76
curve : string;
63
77
keySize : int;
64
78
pk : hex;
65
79
sk : hex;
66
-
type_ : json; [@yojson.key "type"]
80
+
type_ : json;
67
81
}
68
-
[@@deriving of_yojson, show]
82
+
83
+
val pp_eddsa_key : Format.formatter -> eddsa_key -> unit
84
+
val show_eddsa_key : eddsa_key -> string
69
85
70
86
type eddsa_test_group = {
71
87
jwk : json;
72
88
key : eddsa_key;
73
89
keyDer : string;
74
90
keyPem : string;
75
-
type_ : json; [@yojson.key "type"]
91
+
type_ : json;
76
92
tests : dsa_test list;
77
93
}
78
-
[@@deriving of_yojson, show]
94
+
95
+
val pp_eddsa_test_group : Format.formatter -> eddsa_test_group -> unit
96
+
val show_eddsa_test_group : eddsa_test_group -> string
79
97
80
98
type test_file = {
81
99
algorithm : json;
···
86
104
schema : json;
87
105
testGroups : json list;
88
106
}
89
-
[@@deriving show]
107
+
108
+
val pp_test_file : Format.formatter -> test_file -> unit
109
+
val show_test_file : test_file -> string
90
110
91
111
val load_file_exn : string -> test_file
92
112