Compare commits

...

3 commits

5 changed files with 1061 additions and 191 deletions

View file

@ -6,223 +6,264 @@ module SE = EndianString.BigEndian_unsafe
exception Error of string exception Error of string
let (@@) f x = f x exception Noncanonical of string
let (|>) x f = f x
let list_iteri f l = let i = ref 0 in List.iter (fun x -> f !i x; incr i) l
let fail fmt = ksprintf (fun s -> raise (Error s)) fmt let fail fmt = ksprintf (fun s -> raise (Error s)) fmt
let noncanonical fmt = ksprintf (fun s -> raise (Noncanonical s))
("noncanonical CTAP2 CBOR: " ^^ fmt)
module Encode = struct module Encode = struct
let start () = Buffer.create 10 let start () = Buffer.create 10
let init b ~maj add = let init b ~maj add =
assert (maj >= 0 && maj < 8); assert (maj >= 0 && maj < 8);
assert (add >= 0 && add < 32); assert (add >= 0 && add < 32);
Buffer.add_char b @@ char_of_int @@ (maj lsl 5) lor add Buffer.add_char b @@ char_of_int @@ (maj lsl 5) lor add
let put_n b n f x = let put_n b n f x =
let s = Bytes.create n in let s = Bytes.create n in
f s 0 x; f s 0 x;
Buffer.add_string b (Bytes.unsafe_to_string s) Buffer.add_string b (Bytes.unsafe_to_string s)
let max_uint32 = let max_uint32 =
match Sys.word_size with match Sys.word_size with
| 32 -> max_int (* max signed int, but on 32-bit this is enough *) | 32 -> max_int (* max signed int, but on 32-bit this is enough *)
| _ -> int_of_string "0xFF_FF_FF_FF" (* so that it compiles on 32-bit *) | _ -> int_of_string "0xFF_FF_FF_FF" (* so that it compiles on 32-bit *)
let put b ~maj n = let put b ~maj n =
assert (n >= 0); assert (n >= 0);
if n < 24 then if n < 24 then
init b ~maj n init b ~maj n
else if n < 256 then else if n < 256 then
begin init b ~maj 24; Buffer.add_char b @@ char_of_int n end begin init b ~maj 24; Buffer.add_char b @@ char_of_int n end
else if n < 65536 then else if n < 65536 then
begin init b ~maj 25; put_n b 2 BE.set_int16 n end begin init b ~maj 25; put_n b 2 BE.set_int16 n end
else if n <= max_uint32 then else if n <= max_uint32 then
begin init b ~maj 26; put_n b 4 BE.set_int32 @@ Int32.of_int n end begin init b ~maj 26; put_n b 4 BE.set_int32 @@ Int32.of_int n end
else else
begin init b ~maj 27; put_n b 8 BE.set_int64 @@ Int64.of_int n end begin init b ~maj 27; put_n b 8 BE.set_int64 @@ Int64.of_int n end
let int b n = let int b n =
let (maj,n) = if n < 0 then 1, -1 - n else 0, n in let (maj,n) = if n < 0 then 1, -1 - n else 0, n in
put b ~maj n put b ~maj n
let hex_char x = let hex_char x =
assert (x >= 0 && x < 16); assert (x >= 0 && x < 16);
if x <= 9 then Char.chr @@ Char.code '0' + x if x <= 9 then Char.chr @@ Char.code '0' + x
else Char.chr @@ Char.code 'a' + x - 10 else Char.chr @@ Char.code 'a' + x - 10
let to_hex s = let to_hex s =
let r = Bytes.create (String.length s * 2) in let r = Bytes.create (String.length s * 2) in
for i = 0 to String.length s - 1 do for i = 0 to String.length s - 1 do
Bytes.set r (i*2) @@ hex_char @@ Char.code s.[i] lsr 4; Bytes.set r (i*2) @@ hex_char @@ Char.code s.[i] lsr 4;
Bytes.set r (i*2+1) @@ hex_char @@ Char.code s.[i] land 0b1111; Bytes.set r (i*2+1) @@ hex_char @@ Char.code s.[i] land 0b1111;
done; done;
Bytes.to_string r Bytes.to_string r
end end
module Simple = struct module Simple = struct
type t = type t =
[ `Null [ `Null
| `Undefined | `Undefined
| `Simple of int | `Simple of int
| `Bool of bool | `Bool of bool
| `Int of int | `Int of int
| `Float of float | `Float of float
| `Bytes of string | `Bytes of string
| `Text of string | `Text of string
| `Array of t list | `Array of t list
| `Map of (t * t) list | `Map of (t * t) list
] ]
let encode item = let encode item =
let open Encode in let open Encode in
let b = start () in let b = start () in
let rec write = function let rec write = function
| `Null -> put b ~maj:7 22; | `Null -> put b ~maj:7 22;
| `Undefined -> put b ~maj:7 23; | `Undefined -> put b ~maj:7 23;
| `Bool false -> put b ~maj:7 20; | `Bool false -> put b ~maj:7 20;
| `Bool true -> put b ~maj:7 21; | `Bool true -> put b ~maj:7 21;
| `Simple n when (n >= 0 && n <= 23) || (n >= 32 && n <= 255) -> put b ~maj:7 n | `Simple n when (n >= 0 && n <= 23) || (n >= 32 && n <= 255) -> put b ~maj:7 n
| `Simple n -> fail "encode: simple(%d)" n | `Simple n -> fail "encode: simple(%d)" n
| `Int n -> int b n | `Int n -> int b n
| `Float f -> init b ~maj:7 27; put_n b 8 BE.set_double f | `Float f -> init b ~maj:7 27; put_n b 8 BE.set_double f
| `Bytes s -> put b ~maj:2 (String.length s); Buffer.add_string b s | `Bytes s -> put b ~maj:2 (String.length s); Buffer.add_string b s
| `Text s -> put b ~maj:3 (String.length s); Buffer.add_string b s | `Text s -> put b ~maj:3 (String.length s); Buffer.add_string b s
| `Array l -> put b ~maj:4 (List.length l); List.iter write l | `Array l -> put b ~maj:4 (List.length l); List.iter write l
| `Map m -> put b ~maj:5 (List.length m); List.iter (fun (a,b) -> write a; write b) m | `Map m -> put b ~maj:5 (List.length m); List.iter (fun (a,b) -> write a; write b) m
in in
write item; write item;
Buffer.contents b Buffer.contents b
let need (s,i) n = let need (s,i) n =
if n > String.length s || !i + n > String.length s then if n > String.length s || !i + n > String.length s then
fail "truncated: len %d pos %d need %d" (String.length s) !i n; fail "truncated: len %d pos %d need %d" (String.length s) !i n;
let j = !i in let j = !i in
i := !i + n; i := !i + n;
j j
let get_byte (s,_ as r) = int_of_char @@ s.[need r 1] let get_byte (s,_ as r) = int_of_char @@ s.[need r 1]
let get_n (s,_ as r) n f = f s @@ need r n let get_n (s,_ as r) n f = f s @@ need r n
let get_s (s,_ as r) n = String.sub s (need r n) n let get_s (s,_ as r) n = String.sub s (need r n) n
let get_additional byte1 = byte1 land 0b11111 let get_additional byte1 = byte1 land 0b11111
let is_indefinite byte1 = get_additional byte1 = 31 let is_indefinite byte1 = get_additional byte1 = 31
let int64_max_int = Int64.of_int max_int let int64_max_int = Int64.of_int max_int
let two_min_int32 = 2 * Int32.to_int Int32.min_int let two_min_int32 = 2 * Int32.to_int Int32.min_int
let extract_number byte1 r = let extract_number byte1 r =
match get_additional byte1 with let guard_min min n = if n < min
| n when n < 24 -> n then noncanonical "non-compact number encoding: %d < %d" n min
| 24 -> get_byte r else n
| 25 -> get_n r 2 SE.get_uint16 in
| 26 -> match get_additional byte1 with
let n = Int32.to_int @@ get_n r 4 SE.get_int32 in | n when n < 24 -> n
if n < 0 then n - two_min_int32 else n | 24 -> guard_min 24 @@ get_byte r
| 27 -> | 25 -> guard_min 256 @@ get_n r 2 SE.get_uint16
let n = get_n r 8 SE.get_int64 in | 26 ->
if n > int64_max_int || n < 0L then fail "extract_number: %Lu" n; let n = guard_min (256*256) @@ Int32.to_int @@ get_n r 4 SE.get_int32 in
Int64.to_int n if n < 0 then n - two_min_int32 else n
| n -> fail "bad additional %d" n | 27 ->
let n = get_n r 8 SE.get_int64 in
if n > int64_max_int || n < 0L then fail "extract_number: %Lu" n;
if Int64.compare n 0x1_0000_0000L < 0
then noncanonical "non-compact number encoding: %Ld < %Ld" n 0x1_0000_0000L;
Int64.to_int n
| n -> fail "bad additional %d" n
let get_float16 s i = let get_float16 s i =
let half = Char.code s.[i] lsl 8 + Char.code s.[i+1] in let half = Char.code s.[i] lsl 8 + Char.code s.[i+1] in
let mant = half land 0x3ff in let mant = half land 0x3ff in
let value = let value =
match (half lsr 10) land 0x1f with (* exp *) match (half lsr 10) land 0x1f with (* exp *)
| 31 when mant = 0 -> infinity | 31 when mant = 0 -> infinity
| 31 -> nan | 31 -> nan
| 0 -> ldexp (float mant) ~-24 | 0 -> ldexp (float mant) ~-24
| exp -> ldexp (float @@ mant + 1024) (exp - 25) | exp -> ldexp (float @@ mant + 1024) (exp - 25)
in in
if half land 0x8000 = 0 then value else ~-. value if half land 0x8000 = 0 then value else ~-. value
exception Break let monotonic s s' =
let major_typ s = int_of_char s.[0] lsr 5 in
let get_number s = match get_additional (int_of_char s.[0]) with
| n when n < 24 -> 1, Int64.of_int n
| 24 -> 2, Int64.of_int (int_of_char s.[1])
| 25 -> 3, Int64.of_int (SE.get_uint16 s 1)
| 26 -> 5, Int64.logand 0xFFFFFFFFL (Int64.of_int32 (SE.get_int32 s 1))
| 27 -> 9, SE.get_int64 s 1
| _ -> assert false
in
major_typ s < major_typ s' ||
major_typ s = major_typ s' &&
let off, n = get_number s and _, n' = get_number s' in
Int64.unsigned_compare n n' < 0 ||
Int64.unsigned_compare n n' = 0 &&
begin
List.mem (major_typ s) [2; 3; 4; 5] &&
let len = Int64.to_int n in
String.sub s off len < String.sub s' off len
end
let extract_list byte1 r f = exception Break
if is_indefinite byte1 then
let l = ref [] in
try while true do l := f r :: !l done; assert false with Break -> List.rev !l
else
let n = extract_number byte1 r in Array.to_list @@ Array.init n (fun _ -> f r)
let rec extract_pair r = let extract_list byte1 r f =
let a = extract r in if is_indefinite byte1 then
let b = try extract r with Break -> fail "extract_pair: unexpected break" in noncanonical "indefinite length array or map"
a,b else
and extract_string byte1 r f = let n = extract_number byte1 r in Array.to_list @@ Array.init n (fun _ -> f r)
if is_indefinite byte1 then
let rec extract_pair ((s, i) as r) =
let start = !i in
let a = extract r in
let finish = !i in
let raw = String.sub s start (finish - start) in
let b = try extract r with Break -> fail "extract_pair: unexpected break" in
raw, (a,b)
and extract_map byte1 r =
let kvs = extract_list byte1 r extract_pair in
let _, kvs =
List.fold_right (fun (curr, kv) (next, acc) ->
match next with
| None -> (Some curr, kv :: acc)
| Some next ->
if not (monotonic curr next) then noncanonical "unsorted map";
(Some curr, kv :: acc))
kvs (None, [])
in
kvs
and extract_string byte1 r =
if is_indefinite byte1 then
noncanonical "indefinite length string"
else
let n = extract_number byte1 r in get_s r n
and extract r =
let byte1 = get_byte r in
match byte1 lsr 5 with
| 0 -> `Int (extract_number byte1 r)
| 1 -> `Int (-1 - extract_number byte1 r)
| 2 -> `Bytes (extract_string byte1 r)
| 3 -> `Text (extract_string byte1 r)
| 4 -> `Array (extract_list byte1 r extract)
| 5 -> `Map (extract_map byte1 r)
| 6 -> noncanonical "tagged value"
| 7 ->
begin match get_additional byte1 with
| n when n < 20 -> `Simple n
| 20 -> `Bool false
| 21 -> `Bool true
| 22 -> `Null
| 23 -> `Undefined
| 24 -> `Simple (get_byte r)
| 25 -> `Float (get_n r 2 get_float16)
| 26 -> `Float (get_n r 4 SE.get_float)
| 27 -> `Float (get_n r 8 SE.get_double)
| 31 -> raise Break
| a -> fail "extract: (7,%d)" a
end
| _ -> assert false
let decode_partial s =
let i = ref 0 in
let x = try extract (s,i) with Break -> fail "decode: unexpected break" in
x, String.sub s !i (String.length s - !i)
let decode s : t =
let x, rest = decode_partial s in
if rest = "" then x
else fail "decode: extra data: len %d pos %d" (String.length s) (String.length s - String.length rest)
let to_diagnostic item =
let b = Buffer.create 10 in let b = Buffer.create 10 in
try while true do Buffer.add_string b (f @@ extract r) done; assert false with Break -> Buffer.contents b let put = Buffer.add_string b in
else let rec write = function
let n = extract_number byte1 r in get_s r n | `Null -> put "null"
and extract r = | `Bool false -> put "false"
let byte1 = get_byte r in | `Bool true -> put "true"
match byte1 lsr 5 with | `Simple n -> bprintf b "simple(%d)" n
| 0 -> `Int (extract_number byte1 r) | `Undefined -> put "undefined"
| 1 -> `Int (-1 - extract_number byte1 r) | `Int n -> bprintf b "%d" n
| 2 -> `Bytes (extract_string byte1 r (function `Bytes s -> s | _ -> fail "extract: not a bytes chunk")) | `Float f ->
| 3 -> `Text (extract_string byte1 r (function `Text s -> s | _ -> fail "extract: not a text chunk")) begin match classify_float f with
| 4 -> `Array (extract_list byte1 r extract) | FP_nan -> put "NaN"
| 5 -> `Map (extract_list byte1 r extract_pair) | FP_infinite -> put (if f < 0. then "-Infinity" else "Infinity")
| 6 -> let _tag = extract_number byte1 r in extract r | FP_zero | FP_normal | FP_subnormal -> bprintf b "%g" f
| 7 -> end
begin match get_additional byte1 with | `Bytes s -> bprintf b "h'%s'" (Encode.to_hex s)
| n when n < 20 -> `Simple n | `Text s -> bprintf b "\"%s\"" s
| 20 -> `Bool false | `Array l ->
| 21 -> `Bool true put "[";
| 22 -> `Null l |> List.iteri (fun i x -> if i <> 0 then put ", "; write x);
| 23 -> `Undefined put "]"
| 24 -> `Simple (get_byte r) | `Map m ->
| 25 -> `Float (get_n r 2 get_float16) put "{";
| 26 -> `Float (get_n r 4 SE.get_float) m |> List.iteri (fun i (k,v) -> if i <> 0 then put ", "; write k; put ": "; write v);
| 27 -> `Float (get_n r 8 SE.get_double) put "}"
| 31 -> raise Break in
| a -> fail "extract: (7,%d)" a write item;
end Buffer.contents b
| _ -> assert false
let decode_partial s =
let i = ref 0 in
let x = try extract (s,i) with Break -> fail "decode: unexpected break" in
x, String.sub s !i (String.length s - !i)
let decode s : t =
let x, rest = decode_partial s in
if rest = "" then x
else fail "decode: extra data: len %d pos %d" (String.length s) (String.length s - String.length rest)
let to_diagnostic item =
let b = Buffer.create 10 in
let put = Buffer.add_string b in
let rec write = function
| `Null -> put "null"
| `Bool false -> put "false"
| `Bool true -> put "true"
| `Simple n -> bprintf b "simple(%d)" n
| `Undefined -> put "undefined"
| `Int n -> bprintf b "%d" n
| `Float f ->
begin match classify_float f with
| FP_nan -> put "NaN"
| FP_infinite -> put (if f < 0. then "-Infinity" else "Infinity")
| FP_zero | FP_normal | FP_subnormal -> bprintf b "%g" f
end
| `Bytes s -> bprintf b "h'%s'" (Encode.to_hex s)
| `Text s -> bprintf b "\"%s\"" s
| `Array l ->
put "[";
l |> list_iteri (fun i x -> if i <> 0 then put ", "; write x);
put "]"
| `Map m ->
put "{";
m |> list_iteri (fun i (k,v) -> if i <> 0 then put ", "; write k; put ": "; write v);
put "}"
in
write item;
Buffer.contents b
end (* Simple *) end (* Simple *)

View file

@ -2,6 +2,8 @@
exception Error of string exception Error of string
exception Noncanonical of string
module Simple : sig module Simple : sig
type t = type t =

720
cbor/appendix_a.json Normal file
View file

@ -0,0 +1,720 @@
[
{
"cbor": "AA==",
"hex": "00",
"roundtrip": true,
"decoded": 0
},
{
"cbor": "AQ==",
"hex": "01",
"roundtrip": true,
"decoded": 1
},
{
"cbor": "Cg==",
"hex": "0a",
"roundtrip": true,
"decoded": 10
},
{
"cbor": "Fw==",
"hex": "17",
"roundtrip": true,
"decoded": 23
},
{
"cbor": "GBg=",
"hex": "1818",
"roundtrip": true,
"decoded": 24
},
{
"cbor": "GBk=",
"hex": "1819",
"roundtrip": true,
"decoded": 25
},
{
"cbor": "GGQ=",
"hex": "1864",
"roundtrip": true,
"decoded": 100
},
{
"cbor": "GQPo",
"hex": "1903e8",
"roundtrip": true,
"decoded": 1000
},
{
"cbor": "GgAPQkA=",
"hex": "1a000f4240",
"roundtrip": true,
"decoded": 1000000
},
{
"cbor": "GwAAAOjUpRAA",
"hex": "1b000000e8d4a51000",
"roundtrip": true,
"decoded": 1000000000000
},
{
"cbor": "G///////////",
"hex": "1bffffffffffffffff",
"roundtrip": true,
"decoded": 18446744073709551615
},
{
"cbor": "wkkBAAAAAAAAAAA=",
"hex": "c249010000000000000000",
"roundtrip": true,
"noncanonical": true,
"decoded": 18446744073709551616
},
{
"cbor": "O///////////",
"hex": "3bffffffffffffffff",
"roundtrip": true,
"decoded": -18446744073709551616
},
{
"cbor": "w0kBAAAAAAAAAAA=",
"hex": "c349010000000000000000",
"roundtrip": true,
"noncanonical": true,
"decoded": -18446744073709551617
},
{
"cbor": "IA==",
"hex": "20",
"roundtrip": true,
"decoded": -1
},
{
"cbor": "KQ==",
"hex": "29",
"roundtrip": true,
"decoded": -10
},
{
"cbor": "OGM=",
"hex": "3863",
"roundtrip": true,
"decoded": -100
},
{
"cbor": "OQPn",
"hex": "3903e7",
"roundtrip": true,
"decoded": -1000
},
{
"cbor": "+QAA",
"hex": "f90000",
"roundtrip": true,
"decoded": 0.0
},
{
"cbor": "+YAA",
"hex": "f98000",
"roundtrip": true,
"decoded": -0.0
},
{
"cbor": "+TwA",
"hex": "f93c00",
"roundtrip": true,
"decoded": 1.0
},
{
"cbor": "+z/xmZmZmZma",
"hex": "fb3ff199999999999a",
"roundtrip": true,
"decoded": 1.1
},
{
"cbor": "+T4A",
"hex": "f93e00",
"roundtrip": true,
"decoded": 1.5
},
{
"cbor": "+Xv/",
"hex": "f97bff",
"roundtrip": true,
"decoded": 65504.0
},
{
"cbor": "+kfDUAA=",
"hex": "fa47c35000",
"roundtrip": true,
"decoded": 100000.0
},
{
"cbor": "+n9///8=",
"hex": "fa7f7fffff",
"roundtrip": true,
"decoded": 3.4028234663852886e+38
},
{
"cbor": "+3435DyIAHWc",
"hex": "fb7e37e43c8800759c",
"roundtrip": true,
"decoded": 1.0e+300
},
{
"cbor": "+QAB",
"hex": "f90001",
"roundtrip": true,
"decoded": 5.960464477539063e-08
},
{
"cbor": "+QQA",
"hex": "f90400",
"roundtrip": true,
"decoded": 6.103515625e-05
},
{
"cbor": "+cQA",
"hex": "f9c400",
"roundtrip": true,
"decoded": -4.0
},
{
"cbor": "+8AQZmZmZmZm",
"hex": "fbc010666666666666",
"roundtrip": true,
"decoded": -4.1
},
{
"cbor": "+XwA",
"hex": "f97c00",
"roundtrip": true,
"diagnostic": "Infinity"
},
{
"cbor": "+X4A",
"hex": "f97e00",
"roundtrip": true,
"diagnostic": "NaN"
},
{
"cbor": "+fwA",
"hex": "f9fc00",
"roundtrip": true,
"diagnostic": "-Infinity"
},
{
"cbor": "+n+AAAA=",
"hex": "fa7f800000",
"roundtrip": false,
"diagnostic": "Infinity"
},
{
"cbor": "+n/AAAA=",
"hex": "fa7fc00000",
"roundtrip": false,
"diagnostic": "NaN"
},
{
"cbor": "+v+AAAA=",
"hex": "faff800000",
"roundtrip": false,
"diagnostic": "-Infinity"
},
{
"cbor": "+3/wAAAAAAAA",
"hex": "fb7ff0000000000000",
"roundtrip": false,
"diagnostic": "Infinity"
},
{
"cbor": "+3/4AAAAAAAA",
"hex": "fb7ff8000000000000",
"roundtrip": false,
"diagnostic": "NaN"
},
{
"cbor": "+//wAAAAAAAA",
"hex": "fbfff0000000000000",
"roundtrip": false,
"diagnostic": "-Infinity"
},
{
"cbor": "9A==",
"hex": "f4",
"roundtrip": true,
"decoded": false
},
{
"cbor": "9Q==",
"hex": "f5",
"roundtrip": true,
"decoded": true
},
{
"cbor": "9g==",
"hex": "f6",
"roundtrip": true,
"decoded": null
},
{
"cbor": "9w==",
"hex": "f7",
"roundtrip": true,
"diagnostic": "undefined"
},
{
"cbor": "8A==",
"hex": "f0",
"roundtrip": true,
"diagnostic": "simple(16)"
},
{
"cbor": "+Bg=",
"hex": "f818",
"roundtrip": true,
"diagnostic": "simple(24)"
},
{
"cbor": "+P8=",
"hex": "f8ff",
"roundtrip": true,
"diagnostic": "simple(255)"
},
{
"cbor": "wHQyMDEzLTAzLTIxVDIwOjA0OjAwWg==",
"hex": "c074323031332d30332d32315432303a30343a30305a",
"roundtrip": true,
"noncanonical": true,
"diagnostic": "0(\"2013-03-21T20:04:00Z\")"
},
{
"cbor": "wRpRS2ew",
"hex": "c11a514b67b0",
"roundtrip": true,
"noncanonical": true,
"diagnostic": "1(1363896240)"
},
{
"cbor": "wftB1FLZ7CAAAA==",
"hex": "c1fb41d452d9ec200000",
"roundtrip": true,
"noncanonical": true,
"diagnostic": "1(1363896240.5)"
},
{
"cbor": "10QBAgME",
"hex": "d74401020304",
"roundtrip": true,
"noncanonical": true,
"diagnostic": "23(h'01020304')"
},
{
"cbor": "2BhFZElFVEY=",
"hex": "d818456449455446",
"roundtrip": true,
"noncanonical": true,
"diagnostic": "24(h'6449455446')"
},
{
"cbor": "2CB2aHR0cDovL3d3dy5leGFtcGxlLmNvbQ==",
"hex": "d82076687474703a2f2f7777772e6578616d706c652e636f6d",
"roundtrip": true,
"noncanonical": true,
"diagnostic": "32(\"http://www.example.com\")"
},
{
"cbor": "QA==",
"hex": "40",
"roundtrip": true,
"diagnostic": "h''"
},
{
"cbor": "RAECAwQ=",
"hex": "4401020304",
"roundtrip": true,
"diagnostic": "h'01020304'"
},
{
"cbor": "YA==",
"hex": "60",
"roundtrip": true,
"decoded": ""
},
{
"cbor": "YWE=",
"hex": "6161",
"roundtrip": true,
"decoded": "a"
},
{
"cbor": "ZElFVEY=",
"hex": "6449455446",
"roundtrip": true,
"decoded": "IETF"
},
{
"cbor": "YiJc",
"hex": "62225c",
"roundtrip": true,
"decoded": "\"\\"
},
{
"cbor": "YsO8",
"hex": "62c3bc",
"roundtrip": true,
"decoded": "ü"
},
{
"cbor": "Y+awtA==",
"hex": "63e6b0b4",
"roundtrip": true,
"decoded": "水"
},
{
"cbor": "ZPCQhZE=",
"hex": "64f0908591",
"roundtrip": true,
"decoded": "𐅑"
},
{
"cbor": "gA==",
"hex": "80",
"roundtrip": true,
"decoded": [
]
},
{
"cbor": "gwECAw==",
"hex": "83010203",
"roundtrip": true,
"decoded": [
1,
2,
3
]
},
{
"cbor": "gwGCAgOCBAU=",
"hex": "8301820203820405",
"roundtrip": true,
"decoded": [
1,
[
2,
3
],
[
4,
5
]
]
},
{
"cbor": "mBkBAgMEBQYHCAkKCwwNDg8QERITFBUWFxgYGBk=",
"hex": "98190102030405060708090a0b0c0d0e0f101112131415161718181819",
"roundtrip": true,
"decoded": [
1,
2,
3,
4,
5,
6,
7,
8,
9,
10,
11,
12,
13,
14,
15,
16,
17,
18,
19,
20,
21,
22,
23,
24,
25
]
},
{
"cbor": "oA==",
"hex": "a0",
"roundtrip": true,
"decoded": {
}
},
{
"cbor": "ogECAwQ=",
"hex": "a201020304",
"roundtrip": true,
"diagnostic": "{1: 2, 3: 4}"
},
{
"cbor": "omFhAWFiggID",
"hex": "a26161016162820203",
"roundtrip": true,
"decoded": {
"a": 1,
"b": [
2,
3
]
}
},
{
"cbor": "gmFhoWFiYWM=",
"hex": "826161a161626163",
"roundtrip": true,
"decoded": [
"a",
{
"b": "c"
}
]
},
{
"cbor": "pWFhYUFhYmFCYWNhQ2FkYURhZWFF",
"hex": "a56161614161626142616361436164614461656145",
"roundtrip": true,
"decoded": {
"a": "A",
"b": "B",
"c": "C",
"d": "D",
"e": "E"
}
},
{
"cbor": "X0IBAkMDBAX/",
"hex": "5f42010243030405ff",
"roundtrip": false,
"noncanonical": true,
"diagnostic": "(_ h'0102', h'030405')"
},
{
"cbor": "f2VzdHJlYWRtaW5n/w==",
"hex": "7f657374726561646d696e67ff",
"roundtrip": false,
"noncanonical": true,
"decoded": "streaming"
},
{
"cbor": "n/8=",
"hex": "9fff",
"roundtrip": false,
"noncanonical": true,
"decoded": [
]
},
{
"cbor": "nwGCAgOfBAX//w==",
"hex": "9f018202039f0405ffff",
"roundtrip": false,
"noncanonical": true,
"decoded": [
1,
[
2,
3
],
[
4,
5
]
]
},
{
"cbor": "nwGCAgOCBAX/",
"hex": "9f01820203820405ff",
"roundtrip": false,
"noncanonical": true,
"decoded": [
1,
[
2,
3
],
[
4,
5
]
]
},
{
"cbor": "gwGCAgOfBAX/",
"hex": "83018202039f0405ff",
"roundtrip": false,
"noncanonical": true,
"decoded": [
1,
[
2,
3
],
[
4,
5
]
]
},
{
"cbor": "gwGfAgP/ggQF",
"hex": "83019f0203ff820405",
"roundtrip": false,
"noncanonical": true,
"decoded": [
1,
[
2,
3
],
[
4,
5
]
]
},
{
"cbor": "nwECAwQFBgcICQoLDA0ODxAREhMUFRYXGBgYGf8=",
"hex": "9f0102030405060708090a0b0c0d0e0f101112131415161718181819ff",
"roundtrip": false,
"noncanonical": true,
"decoded": [
1,
2,
3,
4,
5,
6,
7,
8,
9,
10,
11,
12,
13,
14,
15,
16,
17,
18,
19,
20,
21,
22,
23,
24,
25
]
},
{
"cbor": "v2FhAWFinwID//8=",
"hex": "bf61610161629f0203ffff",
"roundtrip": false,
"noncanonical": true,
"decoded": {
"a": 1,
"b": [
2,
3
]
}
},
{
"cbor": "gmFhv2FiYWP/",
"hex": "826161bf61626163ff",
"roundtrip": false,
"noncanonical": true,
"decoded": [
"a",
{
"b": "c"
}
]
},
{
"cbor": "v2NGdW71Y0FtdCH/",
"hex": "bf6346756ef563416d7421ff",
"roundtrip": false,
"noncanonical": true,
"decoded": {
"Fun": true,
"Amt": -2
}
},
{
"cbor": "pGJya/VidXD1ZHBsYXT0aWNsaWVudFBpbvU=",
"hex": "a462726bf5627570f564706c6174f469636c69656e7450696ef5",
"roundtrip": false,
"decoded": {
"rk": true,
"up": true,
"plat": false,
"clientPin": true
}
},
{
"cbor": "pGRwbGF09GJya/VpY2xpZW50UGlu9WJ1cPU=",
"hex": "a464706c6174f462726bf569636c69656e7450696ef5627570f5",
"roundtrip": false,
"noncanonical": true,
"decoded": {
"up": true,
"clientPin": true,
"rk": true,
"plat": false
}
},
{
"cbor": "GAE=",
"hex": "1801",
"roundtrip": false,
"noncanonical": true,
"decoded": 1
},
{
"cbor": "GQAB",
"hex": "190001",
"roundtrip": false,
"noncanonical": true,
"decoded": 1
},
{
"cbor": "GgAAAAE=",
"hex": "1a00000001",
"roundtrip": false,
"noncanonical": true,
"decoded": 1
},
{
"cbor": "GwAAAAAAAAAB",
"hex": "1b0000000000000001",
"roundtrip": false,
"noncanonical": true,
"decoded": 1
},
{
"cbor": "OAA=",
"hex": "3800",
"roundtrip": false,
"noncanonical": true,
"decoded": -1
},
{
"cbor": "OwAAAAAAAQRp",
"hex": "3B0000000000010469",
"roundtrip": false,
"noncanonical": true,
"decoded": -66666
}
]

View file

@ -1,5 +1,16 @@
(library (library
(name cbor) (name cbor)
(public_name webauthn.cbor) (public_name webauthn.cbor)
(modules CBOR)
(wrapped false) (wrapped false)
(libraries ocplib-endian)) (libraries ocplib-endian))
(executable
(name test)
(modules test)
(libraries webauthn.cbor yojson))
(rule
(alias runtest)
(deps test.exe appendix_a.json)
(action (run ./test.exe appendix_a.json)))

96
cbor/test.ml Normal file
View file

@ -0,0 +1,96 @@
type result = Decoded of Yojson.Basic.t | Diagnostic of string
type test = {
cbor : string;
result : result;
noncanonical : bool;
}
let (@@) f x = f x
let (|>) x f = f x
let eprintfn fmt = Printf.ksprintf prerr_endline fmt
let fail fmt = Printf.ksprintf failwith fmt
let of_hex s =
assert (String.length s mod 2 = 0);
let n = String.length s / 2 in
let r = Bytes.create n in
for i = 0 to pred n do
Bytes.set r i @@ Char.chr @@ int_of_string ("0x" ^ String.sub s (i*2) 2)
done;
Bytes.to_string r
let read file =
let open Yojson.Basic in
Yojson.Safe.from_file file (* large ints *)
|> Yojson.Safe.to_basic
|> Util.to_list
|> List.map begin function
| `Assoc a ->
let cbor = of_hex @@ Util.to_string @@ List.assoc "hex" a in
let result =
try
Diagnostic (Util.to_string @@ List.assoc "diagnostic" a)
with Not_found ->
Decoded (List.assoc "decoded" a)
in
let noncanonical = try
Util.to_bool @@ List.assoc "noncanonical" a
with Not_found -> false
in
{ cbor; result; noncanonical }
| _ -> assert false
end
let rec json_of_cbor : CBOR.Simple.t -> Yojson.Basic.t = function
| (`Null | `Bool _ | `Int _ | `Float _ as x) -> x
| `Undefined | `Simple _ -> `Null
| `Bytes x -> `String x
| `Text x -> `String x
| `Array x -> `List (List.map json_of_cbor x)
| `Map x -> `Assoc (List.map (fun (k,v) ->
match k with
| `Text s -> s, json_of_cbor v
| _ -> fail "json_of_cbor: expected string key") x)
let () =
match List.tl @@ Array.to_list Sys.argv with
| file::[] ->
eprintfn "I: running tests from %s" file;
let tests = read file in
eprintfn "I: total tests = %d" (List.length tests);
let ok = ref 0 in
let failed = ref 0 in
let ignored = ref 0 in
let nr = ref (-1) in
tests |> List.iter begin fun test ->
try
incr nr;
if test.noncanonical then
try let cbor = CBOR.Simple.decode test.cbor in
fail "expected reject noncanonical CBOR, got %s"
(CBOR.Simple.to_diagnostic cbor)
with CBOR.Noncanonical _ -> incr ok
else
let cbor = CBOR.Simple.decode test.cbor in
let diag = CBOR.Simple.to_diagnostic cbor in
let () = match test.result with
| Diagnostic s ->
if s <> diag then fail "expected %s, got %s" s diag
| Decoded json ->
let json' = json_of_cbor cbor in
if json <> json' then fail "expected %s, got %s, aka %s"
(Yojson.Basic.to_string json) (Yojson.Basic.to_string json') diag
in
incr ok
with exn ->
let ignore = List.mem !nr [10; 12] in
eprintfn "%s test %d: %s"
(if ignore then "W: ignoring" else "E:") !nr (match exn with Failure s -> s | _ -> Printexc.to_string exn);
incr (if ignore then ignored else failed)
end;
eprintfn "I: finished. tests ok = %d failed = %d ignored = %d" !ok !failed !ignored;
exit (if !failed = 0 then 0 else 1)
| _ ->
eprintfn "E: no test file given";
exit 2