upstream: https://github.com/mirage/mirage-crypto
feat(dupfind): add show command, normalize tests, and structural hashing
- Add `dupfind show HASH` to display normalized AST for a hash cluster
- Add pp_expr pretty-printer for the internal AST
- Replace Marshal-based hashing with structural tag-length-value encoding
- Add expr_size and sub_hashes for fingerprinting support
- Add normalize unit tests for alpha-equivalence verification
- Add missing .mli files for test modules
+19
-20
+19
-20
tests/wycheproof/wycheproof.ml
+19
-20
tests/wycheproof/wycheproof.ml
···
14
14
let bbuf = Bytes.unsafe_of_string buf in
15
15
for i = n - 1 downto 0 do
16
16
let byte = Bytes.get_uint8 bbuf i in
17
-
Format.fprintf fmt "%02x" byte
17
+
Fmt.pf fmt "%02x" byte
18
18
done
19
19
20
20
let hex_of_string s =
···
52
52
(* Encode hex back to string - reverse of hex_of_string *)
53
53
let buf = Buffer.create (String.length h * 2) in
54
54
String.iter
55
-
(fun c -> Buffer.add_string buf (Printf.sprintf "%02x" (Char.code c)))
55
+
(fun c -> Buffer.add_string buf (Fmt.str "%02x" (Char.code c)))
56
56
h;
57
57
Buffer.contents buf)
58
58
Jsont.string
···
92
92
}
93
93
94
94
let pp_ecdh_test fmt t =
95
-
Format.fprintf fmt
95
+
Fmt.pf fmt
96
96
"{ tc_id = %d; comment = %S; curve = %a; public = %a; private_ = %a; \
97
97
shared = %a; result = %a; flags = [%s] }"
98
98
t.tc_id t.comment
···
101
101
t.result
102
102
(String.concat "; " (List.map (fun s -> "\"" ^ s ^ "\"") t.flags))
103
103
104
-
let show_ecdh_test t = Format.asprintf "%a" pp_ecdh_test t
104
+
let show_ecdh_test t = Fmt.str "%a" pp_ecdh_test t
105
105
106
106
let ecdh_test_jsont =
107
107
Jsont.Object.map ~kind:"ecdh_test"
···
140
140
}
141
141
142
142
let pp_ecdh_test_group fmt t =
143
-
Format.fprintf fmt
144
-
"{ curve = %S; tests = [%d tests]; encoding = %a; type_ = %a }" t.curve
145
-
(List.length t.tests)
143
+
Fmt.pf fmt "{ curve = %S; tests = [%d tests]; encoding = %a; type_ = %a }"
144
+
t.curve (List.length t.tests)
146
145
(Format.pp_print_option pp_json)
147
146
t.encoding
148
147
(Format.pp_print_option pp_json)
149
148
t.type_
150
149
151
-
let show_ecdh_test_group t = Format.asprintf "%a" pp_ecdh_test_group t
150
+
let show_ecdh_test_group t = Fmt.str "%a" pp_ecdh_test_group t
152
151
153
152
let ecdh_test_group_jsont =
154
153
Jsont.Object.map ~kind:"ecdh_test_group" (fun curve tests encoding type_ ->
···
170
169
}
171
170
172
171
let pp_ecdsa_key fmt t =
173
-
Format.fprintf fmt
172
+
Fmt.pf fmt
174
173
"{ curve = %S; key_size = %d; type_ = %a; uncompressed = %a; wx = %a; wy = \
175
174
%a }"
176
175
t.curve t.key_size pp_json t.type_ pp_hex t.uncompressed pp_hex t.wx pp_hex
177
176
t.wy
178
177
179
-
let show_ecdsa_key t = Format.asprintf "%a" pp_ecdsa_key t
178
+
let show_ecdsa_key t = Fmt.str "%a" pp_ecdsa_key t
180
179
181
180
let ecdsa_key_jsont =
182
181
Jsont.Object.map ~kind:"ecdsa_key"
···
200
199
}
201
200
202
201
let pp_dsa_test fmt t =
203
-
Format.fprintf fmt
202
+
Fmt.pf fmt
204
203
"{ tc_id = %d; comment = %S; msg = %a; sig_ = %a; result = %a; flags = \
205
204
[%s] }"
206
205
t.tc_id t.comment pp_hex t.msg pp_hex t.sig_ pp_test_result t.result
207
206
(String.concat "; " (List.map (fun s -> "\"" ^ s ^ "\"") t.flags))
208
207
209
-
let show_dsa_test t = Format.asprintf "%a" pp_dsa_test t
208
+
let show_dsa_test t = Fmt.str "%a" pp_dsa_test t
210
209
211
210
let dsa_test_jsont =
212
211
Jsont.Object.map ~kind:"dsa_test" (fun tc_id comment msg sig_ result flags ->
···
237
236
}
238
237
239
238
let pp_ecdsa_test_group fmt t =
240
-
Format.fprintf fmt
239
+
Fmt.pf fmt
241
240
"{ key = %a; key_der = %S; key_pem = %S; sha = %S; tests = [%d tests]; \
242
241
type_ = %a }"
243
242
pp_ecdsa_key t.key t.key_der t.key_pem t.sha (List.length t.tests)
244
243
(Format.pp_print_option pp_json)
245
244
t.type_
246
245
247
-
let show_ecdsa_test_group t = Format.asprintf "%a" pp_ecdsa_test_group t
246
+
let show_ecdsa_test_group t = Fmt.str "%a" pp_ecdsa_test_group t
248
247
249
248
let ecdsa_test_group_jsont =
250
249
Jsont.Object.map ~kind:"ecdsa_test_group"
···
268
267
}
269
268
270
269
let pp_eddsa_key fmt t =
271
-
Format.fprintf fmt
270
+
Fmt.pf fmt
272
271
"{ curve = %S; key_size = %d; pk = %a; sk = %a; type_ = %a }" t.curve
273
272
t.key_size pp_hex t.pk pp_hex t.sk pp_json t.type_
274
273
275
-
let show_eddsa_key t = Format.asprintf "%a" pp_eddsa_key t
274
+
let show_eddsa_key t = Fmt.str "%a" pp_eddsa_key t
276
275
277
276
let eddsa_key_jsont =
278
277
Jsont.Object.map ~kind:"eddsa_key" (fun curve key_size pk sk type_ ->
···
294
293
}
295
294
296
295
let pp_eddsa_test_group fmt t =
297
-
Format.fprintf fmt
296
+
Fmt.pf fmt
298
297
"{ jwk = %a; key = %a; key_der = %S; key_pem = %S; type_ = %a; tests = [%d \
299
298
tests] }"
300
299
pp_json t.jwk pp_eddsa_key t.key t.key_der t.key_pem pp_json t.type_
301
300
(List.length t.tests)
302
301
303
-
let show_eddsa_test_group t = Format.asprintf "%a" pp_eddsa_test_group t
302
+
let show_eddsa_test_group t = Fmt.str "%a" pp_eddsa_test_group t
304
303
305
304
let eddsa_test_group_jsont =
306
305
Jsont.Object.map ~kind:"eddsa_test_group"
···
326
325
}
327
326
328
327
let pp_test_file fmt t =
329
-
Format.fprintf fmt
328
+
Fmt.pf fmt
330
329
"{ algorithm = %a; generator_version = %a; header = %a; notes = %a; \
331
330
number_of_tests = %a; schema = %a; test_groups = [%d groups] }"
332
331
pp_json t.algorithm pp_json t.generator_version pp_json t.header pp_json
333
332
t.notes pp_json t.number_of_tests pp_json t.schema
334
333
(List.length t.test_groups)
335
334
336
-
let show_test_file t = Format.asprintf "%a" pp_test_file t
335
+
let show_test_file t = Fmt.str "%a" pp_test_file t
337
336
338
337
let test_file_jsont =
339
338
Jsont.Object.map ~kind:"test_file"