anil.recoil.org
JSON web tokens in OCaml
1(** CBOR Encoding Tests
2
3 Tests derived from RFC 8949 Appendix A (Examples of Encoded CBOR Data
4 Items). *)
5
6(* Helper to encode to hex string *)
7let encode_to_hex f =
8 let buf = Buffer.create 64 in
9 let writer = Bytesrw.Bytes.Writer.of_buffer buf in
10 let enc = Cbort.Rw.make_encoder writer in
11 f enc;
12 Cbort.Rw.flush_encoder enc;
13 let bytes = Buffer.contents buf in
14 String.concat ""
15 (List.init (String.length bytes) (fun i ->
16 Printf.sprintf "%02x" (Char.code (String.get bytes i))))
17
18(* Helper to convert hex string to bytes for comparison *)
19let hex_to_bytes hex =
20 let hex = String.lowercase_ascii hex in
21 let len = String.length hex / 2 in
22 let buf = Bytes.create len in
23 for i = 0 to len - 1 do
24 let byte = int_of_string ("0x" ^ String.sub hex (i * 2) 2) in
25 Bytes.set_uint8 buf i byte
26 done;
27 Bytes.to_string buf
28
29(* ============= Integer Tests (RFC 8949 Appendix A) ============= *)
30
31let test_uint_0 () =
32 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc 0) in
33 Alcotest.(check string) "0" "00" hex
34
35let test_uint_1 () =
36 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc 1) in
37 Alcotest.(check string) "1" "01" hex
38
39let test_uint_10 () =
40 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc 10) in
41 Alcotest.(check string) "10" "0a" hex
42
43let test_uint_23 () =
44 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc 23) in
45 Alcotest.(check string) "23" "17" hex
46
47let test_uint_24 () =
48 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc 24) in
49 Alcotest.(check string) "24" "1818" hex
50
51let test_uint_25 () =
52 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc 25) in
53 Alcotest.(check string) "25" "1819" hex
54
55let test_uint_100 () =
56 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc 100) in
57 Alcotest.(check string) "100" "1864" hex
58
59let test_uint_1000 () =
60 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc 1000) in
61 Alcotest.(check string) "1000" "1903e8" hex
62
63let test_uint_1000000 () =
64 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc 1000000) in
65 Alcotest.(check string) "1000000" "1a000f4240" hex
66
67let test_uint_1000000000000 () =
68 let hex =
69 encode_to_hex (fun enc -> Cbort.Rw.write_int64 enc 1000000000000L)
70 in
71 Alcotest.(check string) "1000000000000" "1b000000e8d4a51000" hex
72
73(* ============= Negative Integer Tests ============= *)
74
75let test_nint_minus1 () =
76 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc (-1)) in
77 Alcotest.(check string) "-1" "20" hex
78
79let test_nint_minus10 () =
80 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc (-10)) in
81 Alcotest.(check string) "-10" "29" hex
82
83let test_nint_minus100 () =
84 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc (-100)) in
85 Alcotest.(check string) "-100" "3863" hex
86
87let test_nint_minus1000 () =
88 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_int enc (-1000)) in
89 Alcotest.(check string) "-1000" "3903e7" hex
90
91(* ============= Boolean and Null Tests ============= *)
92
93let test_false () =
94 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_bool enc false) in
95 Alcotest.(check string) "false" "f4" hex
96
97let test_true () =
98 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_bool enc true) in
99 Alcotest.(check string) "true" "f5" hex
100
101let test_null () =
102 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_null enc) in
103 Alcotest.(check string) "null" "f6" hex
104
105(* ============= Float Tests ============= *)
106
107(* Note: RFC 8949 deterministic encoding uses the smallest float representation
108 that preserves the value. Values like 1.0, infinity, and NaN can be represented
109 exactly in half precision (16-bit), so they use f9 prefix. *)
110
111let test_float_1_0 () =
112 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_float enc 1.0) in
113 (* Half precision 1.0 = 0xf93c00 per RFC 8949 deterministic encoding *)
114 Alcotest.(check string) "1.0" "f93c00" hex
115
116let test_float_1_1 () =
117 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_float enc 1.1) in
118 (* 1.1 cannot be exactly represented in half precision, uses double *)
119 (* RFC: 0xfb3ff199999999999a *)
120 Alcotest.(check string) "1.1" "fb3ff199999999999a" hex
121
122let test_float_neg_4_1 () =
123 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_float enc (-4.1)) in
124 (* -4.1 cannot be exactly represented in half precision, uses double *)
125 (* RFC: 0xfbc010666666666666 *)
126 Alcotest.(check string) "-4.1" "fbc010666666666666" hex
127
128let test_float_1e300 () =
129 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_float enc 1.0e300) in
130 (* 1.0e300 exceeds half/single precision range, uses double *)
131 (* RFC: 0xfb7e37e43c8800759c *)
132 Alcotest.(check string) "1.0e+300" "fb7e37e43c8800759c" hex
133
134let test_float_infinity () =
135 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_float enc infinity) in
136 (* Half precision infinity = 0xf97c00 per RFC 8949 deterministic encoding *)
137 Alcotest.(check string) "Infinity" "f97c00" hex
138
139let test_float_neg_infinity () =
140 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_float enc neg_infinity) in
141 (* Half precision -infinity = 0xf9fc00 per RFC 8949 deterministic encoding *)
142 Alcotest.(check string) "-Infinity" "f9fc00" hex
143
144let test_float_nan () =
145 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_float enc nan) in
146 (* Half precision NaN = 0xf97e00 per RFC 8949 deterministic encoding *)
147 Alcotest.(check string) "NaN" "f97e00" hex
148
149(* ============= Text String Tests ============= *)
150
151let test_text_empty () =
152 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_text enc "") in
153 Alcotest.(check string) "empty string" "60" hex
154
155let test_text_a () =
156 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_text enc "a") in
157 Alcotest.(check string) "\"a\"" "6161" hex
158
159let test_text_ietf () =
160 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_text enc "IETF") in
161 Alcotest.(check string) "\"IETF\"" "6449455446" hex
162
163let test_text_quote_backslash () =
164 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_text enc "\"\\") in
165 Alcotest.(check string) "\"\\\"\\\\\"" "62225c" hex
166
167let test_text_utf8_umlaut () =
168 (* U+00FC = ü = 0xc3 0xbc in UTF-8 *)
169 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_text enc "\xc3\xbc") in
170 Alcotest.(check string) "ü" "62c3bc" hex
171
172let test_text_utf8_water () =
173 (* U+6C34 = 水 = 0xe6 0xb0 0xb4 in UTF-8 *)
174 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_text enc "\xe6\xb0\xb4") in
175 Alcotest.(check string) "水" "63e6b0b4" hex
176
177let test_text_utf8_emoji () =
178 (* U+10151 = 𐅑 = 0xf0 0x90 0x85 0x91 in UTF-8 *)
179 let hex =
180 encode_to_hex (fun enc -> Cbort.Rw.write_text enc "\xf0\x90\x85\x91")
181 in
182 Alcotest.(check string) "𐅑" "64f0908591" hex
183
184(* ============= Byte String Tests ============= *)
185
186let test_bytes_empty () =
187 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_bytes_header enc 0) in
188 Alcotest.(check string) "empty bytes" "40" hex
189
190let test_bytes_01020304 () =
191 let hex =
192 encode_to_hex (fun enc ->
193 Cbort.Rw.write_bytes_header enc 4;
194 Cbort.Rw.write_bytes enc (hex_to_bytes "01020304"))
195 in
196 Alcotest.(check string) "h'01020304'" "4401020304" hex
197
198(* ============= Array Tests ============= *)
199
200let test_array_empty () =
201 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_array_start enc 0) in
202 Alcotest.(check string) "[]" "80" hex
203
204let test_array_123 () =
205 let hex =
206 encode_to_hex (fun enc ->
207 Cbort.Rw.write_array_start enc 3;
208 Cbort.Rw.write_int enc 1;
209 Cbort.Rw.write_int enc 2;
210 Cbort.Rw.write_int enc 3)
211 in
212 Alcotest.(check string) "[1, 2, 3]" "83010203" hex
213
214let test_array_nested () =
215 (* [1, [2, 3], [4, 5]] *)
216 let hex =
217 encode_to_hex (fun enc ->
218 Cbort.Rw.write_array_start enc 3;
219 Cbort.Rw.write_int enc 1;
220 Cbort.Rw.write_array_start enc 2;
221 Cbort.Rw.write_int enc 2;
222 Cbort.Rw.write_int enc 3;
223 Cbort.Rw.write_array_start enc 2;
224 Cbort.Rw.write_int enc 4;
225 Cbort.Rw.write_int enc 5)
226 in
227 Alcotest.(check string) "[1, [2, 3], [4, 5]]" "8301820203820405" hex
228
229let test_array_25_items () =
230 (* [1, 2, 3, ..., 25] - requires 1-byte length encoding *)
231 let hex =
232 encode_to_hex (fun enc ->
233 Cbort.Rw.write_array_start enc 25;
234 for i = 1 to 25 do
235 Cbort.Rw.write_int enc i
236 done)
237 in
238 (* 0x98 0x19 = array with 1-byte length (25) *)
239 Alcotest.(check string)
240 "[1..25]" "98190102030405060708090a0b0c0d0e0f101112131415161718181819" hex
241
242(* ============= Map Tests ============= *)
243
244let test_map_empty () =
245 let hex = encode_to_hex (fun enc -> Cbort.Rw.write_map_start enc 0) in
246 Alcotest.(check string) "{}" "a0" hex
247
248let test_map_int_keys () =
249 (* {1: 2, 3: 4} *)
250 let hex =
251 encode_to_hex (fun enc ->
252 Cbort.Rw.write_map_start enc 2;
253 Cbort.Rw.write_int enc 1;
254 Cbort.Rw.write_int enc 2;
255 Cbort.Rw.write_int enc 3;
256 Cbort.Rw.write_int enc 4)
257 in
258 Alcotest.(check string) "{1: 2, 3: 4}" "a201020304" hex
259
260let test_map_string_keys () =
261 (* {"a": 1, "b": [2, 3]} *)
262 let hex =
263 encode_to_hex (fun enc ->
264 Cbort.Rw.write_map_start enc 2;
265 Cbort.Rw.write_text enc "a";
266 Cbort.Rw.write_int enc 1;
267 Cbort.Rw.write_text enc "b";
268 Cbort.Rw.write_array_start enc 2;
269 Cbort.Rw.write_int enc 2;
270 Cbort.Rw.write_int enc 3)
271 in
272 Alcotest.(check string) "{\"a\": 1, \"b\": [2, 3]}" "a26161016162820203" hex
273
274let test_mixed_array_map () =
275 (* ["a", {"b": "c"}] *)
276 let hex =
277 encode_to_hex (fun enc ->
278 Cbort.Rw.write_array_start enc 2;
279 Cbort.Rw.write_text enc "a";
280 Cbort.Rw.write_map_start enc 1;
281 Cbort.Rw.write_text enc "b";
282 Cbort.Rw.write_text enc "c")
283 in
284 Alcotest.(check string) "[\"a\", {\"b\": \"c\"}]" "826161a161626163" hex
285
286let test_map_5_pairs () =
287 (* {"a": "A", "b": "B", "c": "C", "d": "D", "e": "E"} *)
288 let hex =
289 encode_to_hex (fun enc ->
290 Cbort.Rw.write_map_start enc 5;
291 Cbort.Rw.write_text enc "a";
292 Cbort.Rw.write_text enc "A";
293 Cbort.Rw.write_text enc "b";
294 Cbort.Rw.write_text enc "B";
295 Cbort.Rw.write_text enc "c";
296 Cbort.Rw.write_text enc "C";
297 Cbort.Rw.write_text enc "d";
298 Cbort.Rw.write_text enc "D";
299 Cbort.Rw.write_text enc "e";
300 Cbort.Rw.write_text enc "E")
301 in
302 Alcotest.(check string)
303 "{a:A, b:B, c:C, d:D, e:E}" "a56161614161626142616361436164614461656145" hex
304
305(* ============= Tag Tests ============= *)
306
307let test_tag_epoch_timestamp () =
308 (* 1(1363896240) - epoch-based date/time *)
309 let hex =
310 encode_to_hex (fun enc ->
311 Cbort.Rw.write_type_arg enc Cbort.Rw.major_tag 1;
312 Cbort.Rw.write_int enc 1363896240)
313 in
314 Alcotest.(check string) "1(1363896240)" "c11a514b67b0" hex
315
316(* ============= Major Type Constants Test ============= *)
317
318let test_major_type_constants () =
319 Alcotest.(check int) "major_uint" 0 Cbort.Rw.major_uint;
320 Alcotest.(check int) "major_nint" 1 Cbort.Rw.major_nint;
321 Alcotest.(check int) "major_bytes" 2 Cbort.Rw.major_bytes;
322 Alcotest.(check int) "major_text" 3 Cbort.Rw.major_text;
323 Alcotest.(check int) "major_array" 4 Cbort.Rw.major_array;
324 Alcotest.(check int) "major_map" 5 Cbort.Rw.major_map;
325 Alcotest.(check int) "major_tag" 6 Cbort.Rw.major_tag;
326 Alcotest.(check int) "major_simple" 7 Cbort.Rw.major_simple
327
328let test_simple_value_constants () =
329 Alcotest.(check int) "simple_false" 20 Cbort.Rw.simple_false;
330 Alcotest.(check int) "simple_true" 21 Cbort.Rw.simple_true;
331 Alcotest.(check int) "simple_null" 22 Cbort.Rw.simple_null;
332 Alcotest.(check int) "simple_undefined" 23 Cbort.Rw.simple_undefined
333
334let test_additional_info_constants () =
335 Alcotest.(check int) "ai_1byte" 24 Cbort.Rw.ai_1byte;
336 Alcotest.(check int) "ai_2byte" 25 Cbort.Rw.ai_2byte;
337 Alcotest.(check int) "ai_4byte" 26 Cbort.Rw.ai_4byte;
338 Alcotest.(check int) "ai_8byte" 27 Cbort.Rw.ai_8byte;
339 Alcotest.(check int) "ai_indefinite" 31 Cbort.Rw.ai_indefinite
340
341(* ============= High-level Codec API Tests ============= *)
342
343(* Round-trip tests using Cbort.encode_string and Cbort.decode_string *)
344
345let test_codec_int_roundtrip () =
346 let values = [ 0; 1; 23; 24; 100; 1000; 1000000; -1; -10; -100; -1000 ] in
347 List.iter
348 (fun v ->
349 let encoded = Cbort.encode_string Cbort.int v in
350 match Cbort.decode_string Cbort.int encoded with
351 | Ok decoded -> Alcotest.(check int) (Printf.sprintf "int %d" v) v decoded
352 | Error e -> Alcotest.fail (Cbort.Error.to_string e))
353 values
354
355let test_codec_int64_roundtrip () =
356 let values = [ 0L; 1L; 1000000000000L; -1L; Int64.max_int; Int64.min_int ] in
357 List.iter
358 (fun v ->
359 let encoded = Cbort.encode_string Cbort.int64 v in
360 match Cbort.decode_string Cbort.int64 encoded with
361 | Ok decoded ->
362 Alcotest.(check int64) (Printf.sprintf "int64 %Ld" v) v decoded
363 | Error e -> Alcotest.fail (Cbort.Error.to_string e))
364 values
365
366let test_codec_bool_roundtrip () =
367 List.iter
368 (fun v ->
369 let encoded = Cbort.encode_string Cbort.bool v in
370 match Cbort.decode_string Cbort.bool encoded with
371 | Ok decoded ->
372 Alcotest.(check bool) (Printf.sprintf "bool %b" v) v decoded
373 | Error e -> Alcotest.fail (Cbort.Error.to_string e))
374 [ true; false ]
375
376let test_codec_null_roundtrip () =
377 let encoded = Cbort.encode_string Cbort.null () in
378 match Cbort.decode_string Cbort.null encoded with
379 | Ok () -> ()
380 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
381
382let test_codec_float_roundtrip () =
383 let values = [ 0.0; 1.0; -1.0; 1.5; 3.14159; 1e10; -1e-10 ] in
384 List.iter
385 (fun v ->
386 let encoded = Cbort.encode_string Cbort.float v in
387 match Cbort.decode_string Cbort.float encoded with
388 | Ok decoded ->
389 let diff = abs_float (v -. decoded) in
390 Alcotest.(check bool) (Printf.sprintf "float %g" v) true (diff < 1e-10)
391 | Error e -> Alcotest.fail (Cbort.Error.to_string e))
392 values
393
394let test_codec_string_roundtrip () =
395 let values =
396 [ ""; "a"; "hello"; "UTF-8: \xc3\xbc \xe6\xb0\xb4"; "with\nnewline" ]
397 in
398 List.iter
399 (fun v ->
400 let encoded = Cbort.encode_string Cbort.string v in
401 match Cbort.decode_string Cbort.string encoded with
402 | Ok decoded ->
403 Alcotest.(check string) (Printf.sprintf "string %S" v) v decoded
404 | Error e -> Alcotest.fail (Cbort.Error.to_string e))
405 values
406
407let test_codec_bytes_roundtrip () =
408 let values = [ ""; "\x00\x01\x02\x03"; String.make 100 '\xff' ] in
409 List.iter
410 (fun v ->
411 let encoded = Cbort.encode_string Cbort.bytes v in
412 match Cbort.decode_string Cbort.bytes encoded with
413 | Ok decoded -> Alcotest.(check string) "bytes" v decoded
414 | Error e -> Alcotest.fail (Cbort.Error.to_string e))
415 values
416
417let test_codec_array_roundtrip () =
418 let values = [ []; [ 1 ]; [ 1; 2; 3 ]; List.init 25 (fun i -> i) ] in
419 let int_list = Cbort.array Cbort.int in
420 List.iter
421 (fun v ->
422 let encoded = Cbort.encode_string int_list v in
423 match Cbort.decode_string int_list encoded with
424 | Ok decoded -> Alcotest.(check (list int)) "array" v decoded
425 | Error e -> Alcotest.fail (Cbort.Error.to_string e))
426 values
427
428let test_codec_nested_array () =
429 let nested = Cbort.array (Cbort.array Cbort.int) in
430 let v = [ [ 1; 2 ]; [ 3; 4; 5 ]; [] ] in
431 let encoded = Cbort.encode_string nested v in
432 match Cbort.decode_string nested encoded with
433 | Ok decoded -> Alcotest.(check (list (list int))) "nested array" v decoded
434 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
435
436let test_codec_string_map_roundtrip () =
437 let map = Cbort.string_map Cbort.int in
438 let v = [ ("a", 1); ("b", 2); ("c", 3) ] in
439 let encoded = Cbort.encode_string map v in
440 match Cbort.decode_string map encoded with
441 | Ok decoded ->
442 (* Maps may reorder, so sort before comparing *)
443 let sort = List.sort compare in
444 Alcotest.(check (list (pair string int)))
445 "string map" (sort v) (sort decoded)
446 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
447
448let test_codec_int_map_roundtrip () =
449 let map = Cbort.int_map Cbort.string in
450 let v = [ (1, "one"); (2, "two"); (3, "three") ] in
451 let encoded = Cbort.encode_string map v in
452 match Cbort.decode_string map encoded with
453 | Ok decoded ->
454 let sort = List.sort compare in
455 Alcotest.(check (list (pair int string)))
456 "int map" (sort v) (sort decoded)
457 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
458
459let test_codec_tuple2 () =
460 let codec = Cbort.tuple2 Cbort.string Cbort.int in
461 let v = ("hello", 42) in
462 let encoded = Cbort.encode_string codec v in
463 match Cbort.decode_string codec encoded with
464 | Ok decoded -> Alcotest.(check (pair string int)) "tuple2" v decoded
465 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
466
467let test_codec_tuple3 () =
468 let codec = Cbort.tuple3 Cbort.int Cbort.string Cbort.bool in
469 let v = (42, "hello", true) in
470 let encoded = Cbort.encode_string codec v in
471 match Cbort.decode_string codec encoded with
472 | Ok decoded ->
473 let a, b, c = decoded in
474 Alcotest.(check int) "tuple3.0" 42 a;
475 Alcotest.(check string) "tuple3.1" "hello" b;
476 Alcotest.(check bool) "tuple3.2" true c
477 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
478
479let test_codec_nullable () =
480 let codec = Cbort.nullable Cbort.int in
481 (* Test Some *)
482 let v1 = Some 42 in
483 let encoded1 = Cbort.encode_string codec v1 in
484 (match Cbort.decode_string codec encoded1 with
485 | Ok decoded -> Alcotest.(check (option int)) "nullable some" v1 decoded
486 | Error e -> Alcotest.fail (Cbort.Error.to_string e));
487 (* Test None *)
488 let v2 = None in
489 let encoded2 = Cbort.encode_string codec v2 in
490 match Cbort.decode_string codec encoded2 with
491 | Ok decoded -> Alcotest.(check (option int)) "nullable none" v2 decoded
492 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
493
494(* ============= Obj Codec Tests (Records with String Keys) ============= *)
495
496type person = { name : string; age : int; email : string option }
497
498let person_codec =
499 Cbort.Obj.finish
500 @@
501 let open Cbort.Obj in
502 let* name = mem "name" (fun p -> p.name) Cbort.string in
503 let* age = mem "age" (fun p -> p.age) Cbort.int in
504 let* email = mem_opt "email" (fun p -> p.email) Cbort.string in
505 return { name; age; email }
506
507let test_obj_codec_basic () =
508 let v = { name = "Alice"; age = 30; email = None } in
509 let encoded = Cbort.encode_string person_codec v in
510 match Cbort.decode_string person_codec encoded with
511 | Ok decoded ->
512 Alcotest.(check string) "name" v.name decoded.name;
513 Alcotest.(check int) "age" v.age decoded.age;
514 Alcotest.(check (option string)) "email" v.email decoded.email
515 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
516
517let test_obj_codec_with_optional () =
518 let v = { name = "Bob"; age = 25; email = Some "bob@example.com" } in
519 let encoded = Cbort.encode_string person_codec v in
520 match Cbort.decode_string person_codec encoded with
521 | Ok decoded ->
522 Alcotest.(check string) "name" v.name decoded.name;
523 Alcotest.(check int) "age" v.age decoded.age;
524 Alcotest.(check (option string)) "email" v.email decoded.email
525 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
526
527(* ============= Obj_int Codec Tests (Records with Integer Keys) ============= *)
528
529(* CWT-style claims with integer keys per RFC 8392:
530 1=iss, 2=sub, 3=aud, 4=exp, 5=nbf, 6=iat, 7=cti *)
531type cwt_claims = {
532 iss : string option; (* key 1 *)
533 sub : string option; (* key 2 *)
534 exp : int64 option; (* key 4 *)
535}
536
537let cwt_claims_codec =
538 Cbort.Obj_int.finish
539 @@
540 let open Cbort.Obj_int in
541 let* iss = mem_opt 1 (fun c -> c.iss) Cbort.string in
542 let* sub = mem_opt 2 (fun c -> c.sub) Cbort.string in
543 let* exp = mem_opt 4 (fun c -> c.exp) Cbort.int64 in
544 return { iss; sub; exp }
545
546let test_obj_int_codec () =
547 let v =
548 {
549 iss = Some "https://example.com";
550 sub = Some "user123";
551 exp = Some 1700000000L;
552 }
553 in
554 let encoded = Cbort.encode_string cwt_claims_codec v in
555 match Cbort.decode_string cwt_claims_codec encoded with
556 | Ok decoded ->
557 Alcotest.(check (option string)) "iss" v.iss decoded.iss;
558 Alcotest.(check (option string)) "sub" v.sub decoded.sub;
559 Alcotest.(check (option int64)) "exp" v.exp decoded.exp
560 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
561
562let test_obj_int_partial () =
563 let v = { iss = Some "issuer"; sub = None; exp = None } in
564 let encoded = Cbort.encode_string cwt_claims_codec v in
565 match Cbort.decode_string cwt_claims_codec encoded with
566 | Ok decoded ->
567 Alcotest.(check (option string)) "iss" v.iss decoded.iss;
568 Alcotest.(check (option string)) "sub" v.sub decoded.sub;
569 Alcotest.(check (option int64)) "exp" v.exp decoded.exp
570 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
571
572(* ============= Tag Tests with Codec API ============= *)
573
574let test_codec_tag () =
575 (* Tag 1 = epoch timestamp *)
576 let epoch_codec = Cbort.tag 1 Cbort.int64 in
577 let v = 1363896240L in
578 let encoded = Cbort.encode_string epoch_codec v in
579 (* Should match RFC 8949 example: c11a514b67b0 *)
580 let hex =
581 String.concat ""
582 (List.init (String.length encoded) (fun i ->
583 Printf.sprintf "%02x" (Char.code (String.get encoded i))))
584 in
585 Alcotest.(check string) "epoch tag hex" "c11a514b67b0" hex;
586 match Cbort.decode_string epoch_codec encoded with
587 | Ok decoded -> Alcotest.(check int64) "epoch value" v decoded
588 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
589
590let test_codec_tag_opt () =
591 (* Tag 32 = URI (optional) *)
592 let uri_codec = Cbort.tag_opt 32 Cbort.string in
593 let v = "https://example.com" in
594 (* Encode with tag *)
595 let encoded = Cbort.encode_string uri_codec v in
596 (match Cbort.decode_string uri_codec encoded with
597 | Ok decoded -> Alcotest.(check string) "uri tagged" v decoded
598 | Error e -> Alcotest.fail (Cbort.Error.to_string e));
599 (* Decode without tag should also work *)
600 let plain = Cbort.encode_string Cbort.string v in
601 match Cbort.decode_string uri_codec plain with
602 | Ok decoded -> Alcotest.(check string) "uri untagged" v decoded
603 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
604
605(* ============= Decode from Hex Tests ============= *)
606
607let test_decode_rfc_integers () =
608 (* RFC 8949 Appendix A test vectors *)
609 let tests =
610 [
611 ("00", 0L);
612 ("01", 1L);
613 ("0a", 10L);
614 ("17", 23L);
615 ("1818", 24L);
616 ("1819", 25L);
617 ("1864", 100L);
618 ("1903e8", 1000L);
619 ("1a000f4240", 1000000L);
620 ("1b000000e8d4a51000", 1000000000000L);
621 ("20", -1L);
622 ("29", -10L);
623 ("3863", -100L);
624 ("3903e7", -1000L);
625 ]
626 in
627 List.iter
628 (fun (hex, expected) ->
629 let bytes = hex_to_bytes hex in
630 match Cbort.decode_string Cbort.int64 bytes with
631 | Ok decoded -> Alcotest.(check int64) hex expected decoded
632 | Error e ->
633 Alcotest.fail (Printf.sprintf "%s: %s" hex (Cbort.Error.to_string e)))
634 tests
635
636let test_decode_rfc_strings () =
637 let tests =
638 [
639 ("60", "");
640 ("6161", "a");
641 ("6449455446", "IETF");
642 ("62225c", "\"\\");
643 ("62c3bc", "\xc3\xbc");
644 (* ü *)
645 ("63e6b0b4", "\xe6\xb0\xb4");
646 (* 水 *)
647 ]
648 in
649 List.iter
650 (fun (hex, expected) ->
651 let bytes = hex_to_bytes hex in
652 match Cbort.decode_string Cbort.string bytes with
653 | Ok decoded -> Alcotest.(check string) hex expected decoded
654 | Error e ->
655 Alcotest.fail (Printf.sprintf "%s: %s" hex (Cbort.Error.to_string e)))
656 tests
657
658let test_decode_rfc_arrays () =
659 let int_list = Cbort.array Cbort.int in
660 let tests = [ ("80", []); ("83010203", [ 1; 2; 3 ]) ] in
661 List.iter
662 (fun (hex, expected) ->
663 let bytes = hex_to_bytes hex in
664 match Cbort.decode_string int_list bytes with
665 | Ok decoded -> Alcotest.(check (list int)) hex expected decoded
666 | Error e ->
667 Alcotest.fail (Printf.sprintf "%s: %s" hex (Cbort.Error.to_string e)))
668 tests
669
670let test_decode_rfc_booleans () =
671 let tests = [ ("f4", false); ("f5", true) ] in
672 List.iter
673 (fun (hex, expected) ->
674 let bytes = hex_to_bytes hex in
675 match Cbort.decode_string Cbort.bool bytes with
676 | Ok decoded -> Alcotest.(check bool) hex expected decoded
677 | Error e ->
678 Alcotest.fail (Printf.sprintf "%s: %s" hex (Cbort.Error.to_string e)))
679 tests
680
681let test_decode_rfc_null () =
682 let bytes = hex_to_bytes "f6" in
683 match Cbort.decode_string Cbort.null bytes with
684 | Ok () -> ()
685 | Error e -> Alcotest.fail (Cbort.Error.to_string e)
686
687(* ============= Error Handling Tests ============= *)
688
689let test_decode_type_mismatch () =
690 (* Try to decode an integer as a string *)
691 let bytes = hex_to_bytes "01" in
692 (* integer 1 *)
693 match Cbort.decode_string Cbort.string bytes with
694 | Ok _ -> Alcotest.fail "Expected type mismatch error"
695 | Error e ->
696 let msg = Cbort.Error.to_string e in
697 Alcotest.(check bool)
698 "error contains type info" true
699 (String.length msg > 0)
700
701let test_decode_truncated () =
702 (* Truncated integer (header says 4 bytes follow but only 2 provided) *)
703 let bytes = hex_to_bytes "1a0001" in
704 match Cbort.decode_string Cbort.int bytes with
705 | Ok _ -> Alcotest.fail "Expected parse error"
706 | Error _ -> ()
707
708(* ============= Test Runner ============= *)
709
710let () =
711 Alcotest.run "Cbort"
712 [
713 (* Low-level encoding tests *)
714 ( "Unsigned Integers (RFC 8949)",
715 [
716 Alcotest.test_case "0" `Quick test_uint_0;
717 Alcotest.test_case "1" `Quick test_uint_1;
718 Alcotest.test_case "10" `Quick test_uint_10;
719 Alcotest.test_case "23" `Quick test_uint_23;
720 Alcotest.test_case "24" `Quick test_uint_24;
721 Alcotest.test_case "25" `Quick test_uint_25;
722 Alcotest.test_case "100" `Quick test_uint_100;
723 Alcotest.test_case "1000" `Quick test_uint_1000;
724 Alcotest.test_case "1000000" `Quick test_uint_1000000;
725 Alcotest.test_case "1000000000000" `Quick test_uint_1000000000000;
726 ] );
727 ( "Negative Integers (RFC 8949)",
728 [
729 Alcotest.test_case "-1" `Quick test_nint_minus1;
730 Alcotest.test_case "-10" `Quick test_nint_minus10;
731 Alcotest.test_case "-100" `Quick test_nint_minus100;
732 Alcotest.test_case "-1000" `Quick test_nint_minus1000;
733 ] );
734 ( "Booleans and Null (RFC 8949)",
735 [
736 Alcotest.test_case "false" `Quick test_false;
737 Alcotest.test_case "true" `Quick test_true;
738 Alcotest.test_case "null" `Quick test_null;
739 ] );
740 ( "Floats (RFC 8949)",
741 [
742 Alcotest.test_case "1.0" `Quick test_float_1_0;
743 Alcotest.test_case "1.1" `Quick test_float_1_1;
744 Alcotest.test_case "-4.1" `Quick test_float_neg_4_1;
745 Alcotest.test_case "1.0e+300" `Quick test_float_1e300;
746 Alcotest.test_case "Infinity" `Quick test_float_infinity;
747 Alcotest.test_case "-Infinity" `Quick test_float_neg_infinity;
748 Alcotest.test_case "NaN" `Quick test_float_nan;
749 ] );
750 ( "Text Strings (RFC 8949)",
751 [
752 Alcotest.test_case "empty" `Quick test_text_empty;
753 Alcotest.test_case "a" `Quick test_text_a;
754 Alcotest.test_case "IETF" `Quick test_text_ietf;
755 Alcotest.test_case "quote_backslash" `Quick test_text_quote_backslash;
756 Alcotest.test_case "utf8_umlaut" `Quick test_text_utf8_umlaut;
757 Alcotest.test_case "utf8_water" `Quick test_text_utf8_water;
758 Alcotest.test_case "utf8_emoji" `Quick test_text_utf8_emoji;
759 ] );
760 ( "Byte Strings (RFC 8949)",
761 [
762 Alcotest.test_case "empty" `Quick test_bytes_empty;
763 Alcotest.test_case "01020304" `Quick test_bytes_01020304;
764 ] );
765 ( "Arrays (RFC 8949)",
766 [
767 Alcotest.test_case "empty" `Quick test_array_empty;
768 Alcotest.test_case "[1,2,3]" `Quick test_array_123;
769 Alcotest.test_case "nested" `Quick test_array_nested;
770 Alcotest.test_case "25_items" `Quick test_array_25_items;
771 ] );
772 ( "Maps (RFC 8949)",
773 [
774 Alcotest.test_case "empty" `Quick test_map_empty;
775 Alcotest.test_case "int_keys" `Quick test_map_int_keys;
776 Alcotest.test_case "string_keys" `Quick test_map_string_keys;
777 Alcotest.test_case "mixed" `Quick test_mixed_array_map;
778 Alcotest.test_case "5_pairs" `Quick test_map_5_pairs;
779 ] );
780 ( "Tags (RFC 8949)",
781 [ Alcotest.test_case "epoch_timestamp" `Quick test_tag_epoch_timestamp ]
782 );
783 ( "Constants",
784 [
785 Alcotest.test_case "major_types" `Quick test_major_type_constants;
786 Alcotest.test_case "simple_values" `Quick test_simple_value_constants;
787 Alcotest.test_case "additional_info" `Quick
788 test_additional_info_constants;
789 ] );
790 (* High-level codec roundtrip tests *)
791 ( "Codec Roundtrip",
792 [
793 Alcotest.test_case "int" `Quick test_codec_int_roundtrip;
794 Alcotest.test_case "int64" `Quick test_codec_int64_roundtrip;
795 Alcotest.test_case "bool" `Quick test_codec_bool_roundtrip;
796 Alcotest.test_case "null" `Quick test_codec_null_roundtrip;
797 Alcotest.test_case "float" `Quick test_codec_float_roundtrip;
798 Alcotest.test_case "string" `Quick test_codec_string_roundtrip;
799 Alcotest.test_case "bytes" `Quick test_codec_bytes_roundtrip;
800 Alcotest.test_case "array" `Quick test_codec_array_roundtrip;
801 Alcotest.test_case "nested_array" `Quick test_codec_nested_array;
802 Alcotest.test_case "string_map" `Quick test_codec_string_map_roundtrip;
803 Alcotest.test_case "int_map" `Quick test_codec_int_map_roundtrip;
804 Alcotest.test_case "tuple2" `Quick test_codec_tuple2;
805 Alcotest.test_case "tuple3" `Quick test_codec_tuple3;
806 Alcotest.test_case "nullable" `Quick test_codec_nullable;
807 ] );
808 ( "Obj Codec (String Keys)",
809 [
810 Alcotest.test_case "basic" `Quick test_obj_codec_basic;
811 Alcotest.test_case "with_optional" `Quick test_obj_codec_with_optional;
812 ] );
813 ( "Obj_int Codec (Integer Keys)",
814 [
815 Alcotest.test_case "full" `Quick test_obj_int_codec;
816 Alcotest.test_case "partial" `Quick test_obj_int_partial;
817 ] );
818 ( "Tag Codec",
819 [
820 Alcotest.test_case "tag" `Quick test_codec_tag;
821 Alcotest.test_case "tag_opt" `Quick test_codec_tag_opt;
822 ] );
823 ( "Decode RFC Vectors",
824 [
825 Alcotest.test_case "integers" `Quick test_decode_rfc_integers;
826 Alcotest.test_case "strings" `Quick test_decode_rfc_strings;
827 Alcotest.test_case "arrays" `Quick test_decode_rfc_arrays;
828 Alcotest.test_case "booleans" `Quick test_decode_rfc_booleans;
829 Alcotest.test_case "null" `Quick test_decode_rfc_null;
830 ] );
831 ( "Error Handling",
832 [
833 Alcotest.test_case "type_mismatch" `Quick test_decode_type_mismatch;
834 Alcotest.test_case "truncated" `Quick test_decode_truncated;
835 ] );
836 ]