CBOR monotone: Major type 7 is short field encoded

CHANGES.md

@@ -1,8 +0,0 @@
-## v0.2.0 (2024-09-13)
-
-* Update to `mirage-crypto*>=1.0.0` and get rid of cstruct dependency
-* Demo application is updated to dream.1.0.0~alpha7
-
-## v0.1.0 (2021-11-18)
-
-* Initial release, sponsored by skolem.tech

LICENSE.md

@@ -1,23 +0,0 @@
-Copyright (c) 2021, Reynir Björnsson and Hannes Mehnert
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without modification,
-are permitted provided that the following conditions are met:
-
-* Redistributions of source code must retain the above copyright notice, this
-  list of conditions and the following disclaimer.
-
-* Redistributions in binary form must reproduce the above copyright notice, this
-  list of conditions and the following disclaimer in the documentation and/or
-  other materials provided with the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
-ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -1,15 +1,13 @@
 ## WebAuthn - authenticating users to services using public key cryptography
 
 WebAuthn is a web standard published by the W3C. Its goal is to
-standardize an interface for authenticating users to web-based
+standardize an interfacefor authenticating users to web-based
 applications and services using public key cryptography. Modern web
 browsers support WebAuthn functionality.
 
-WebAuthn provides two functions: register and authenticate. Usually the
-public-private keypair is stored on an external device, called a security key
-(Yubikey, Trustkey etc.) or inside a platform(OS) authenticator. Platform
-authenticators are available on all modern platforms, such as Windows, Mac,
-Android and iOS. After the public key is registered, it can
+WebAuthn provides two funcitons: register and authenticate. Usually the
+public and private keypair is stored on an external token (Yuikey etc.)
+or part of the platform (TPM). After the public key is registered, it can
 be used to authenticate to the same service.
 
 This module does not preserve a database of registered public keys, their
@@ -24,7 +22,7 @@ running at [webauthn-demo.robur.coop](https://webauthn-demo.robur.coop).
 
 ## Documentation
 
-[API documentation](https://robur-coop.github.io/webauthn/doc) is available online.
+[API documentation](https://roburio.github.io/webauthn/doc) is available online.
 
 ## Installation
 

bin/template.ml

@@ -102,12 +102,7 @@ let register_view origin user =
               });
             });
           }).catch(function (err) {
-            // XXX: only if the exception came from navigator.credentials.create()
-            if (err.name === "InvalidStateError") {
-              alert("authenticator already registered");
-            } else {
             alert("exception: " + err);
-            }
             window.location = "/";
           });
       });

bin/webauthn_demo.ml

@@ -1,20 +1,5 @@
 open Lwt.Infix
 
-let pp_cert =
-  let pp_extensions ppf (oid, data) =
-    let fido_u2f_transport_oid_name = "id-fido-u2f-ce-transports" in
-    if Asn.OID.equal oid Webauthn.fido_u2f_transport_oid then
-      match Webauthn.decode_transport data with
-      | Error `Msg _ ->
-        Fmt.pf ppf "%s invalid-data %a" fido_u2f_transport_oid_name (Ohex.pp_hexdump ()) data
-      | Ok transports ->
-        Fmt.pf ppf "%s %a" fido_u2f_transport_oid_name
-          Fmt.(list ~sep:(any ",") Webauthn.pp_transport) transports
-    else
-      Fmt.pf ppf "unsupported %a: %a" Asn.OID.pp oid (Ohex.pp_hexdump ()) data
-  in
-  X509.Certificate.pp' pp_extensions
-
 let users : (string, string * (Mirage_crypto_ec.P256.Dsa.pub * string * X509.Certificate.t option) list) Hashtbl.t = Hashtbl.create 7
 
 let find_username username =
@@ -24,10 +9,10 @@ let find_username username =
 
 module KhPubHashtbl = Hashtbl.Make(struct
     type t = Webauthn.credential_id * Mirage_crypto_ec.P256.Dsa.pub
-    let string_of_pub = Mirage_crypto_ec.P256.Dsa.pub_to_octets
+    let cs_of_pub = Mirage_crypto_ec.P256.Dsa.pub_to_cstruct
     let equal (kh, pub) (kh', pub') =
-      String.equal kh kh' && String.equal (string_of_pub pub) (string_of_pub pub')
-    let hash (kh, pub) = Hashtbl.hash (kh, string_of_pub pub )
+      String.equal kh kh' && Cstruct.equal (cs_of_pub pub) (cs_of_pub pub')
+    let hash (kh, pub) = Hashtbl.hash (kh, Cstruct.to_string (cs_of_pub pub ))
   end)
 
 let counters = KhPubHashtbl.create 7
@@ -70,18 +55,18 @@ let to_string err = Format.asprintf "%a" Webauthn.pp_error err
 
 let gen_data ?(pad = false) ?alphabet length =
   Base64.encode_string ~pad ?alphabet
-    (Mirage_crypto_rng.generate length)
+    (Cstruct.to_string (Mirage_crypto_rng.generate length))
 
 let add_routes t =
   let main req =
-    let authenticated_as = Dream.session_field req "authenticated_as" in
+    let authenticated_as = Dream.session "authenticated_as" req in
     let flash = Flash_message.get_flash req |> List.map snd in
     Dream.html (Template.overview flash authenticated_as users)
   in
 
   let register req =
     let user =
-      match Dream.session_field req "authenticated_as" with
+      match Dream.session "authenticated_as" req with
       | None -> gen_data ~alphabet:Base64.uri_safe_alphabet 8
       | Some username -> username
     in
@@ -89,7 +74,7 @@ let add_routes t =
   in
 
   let registration_challenge req =
-    let user = Dream.param req "user" in
+    let user = Dream.param "user" req in
     let challenge, challenge_b64 = Webauthn.generate_challenge () in
     let userid, credentials = match find_username user with
       | None -> gen_data ~alphabet:Base64.uri_safe_alphabet 8, []
@@ -115,7 +100,7 @@ let add_routes t =
   in
 
   let register_finish req =
-    let userid = Dream.param req "userid" in
+    let userid = Dream.param "userid" req in
     Dream.body req >>= fun body ->
     Logs.debug (fun m -> m "received body: %s" body);
     match Hashtbl.find_opt registration_challenges userid with
@@ -154,8 +139,8 @@ let add_routes t =
               let cert_pem, cert_string, transports =
                 Option.fold ~none:("No certificate", "No certificate", Ok [])
                   ~some:(fun c ->
-                           X509.Certificate.encode_pem c,
-                           Fmt.to_to_string pp_cert c,
+                           X509.Certificate.encode_pem c |> Cstruct.to_string,
+                           Fmt.to_to_string X509.Certificate.pp c,
                            Webauthn.transports_of_cert c)
                   certificate
               in
@@ -168,7 +153,7 @@ let add_routes t =
                 req;
               Dream.json "true"
             in
-            match Dream.session_field req "authenticated_as", Hashtbl.find_opt users userid with
+            match Dream.session "authenticated_as" req, Hashtbl.find_opt users userid with
             | _, None -> registered []
             | Some session_user, Some (username', keys) ->
               if String.equal username session_user && String.equal username username' then begin
@@ -183,7 +168,7 @@ let add_routes t =
   in
 
   let authenticate req =
-    let userid = Dream.param req "userid" in
+    let userid = Dream.param "userid" req in
     match Hashtbl.find_opt users userid with
     | None ->
       Logs.warn (fun m -> m "no user found");
@@ -197,8 +182,8 @@ let add_routes t =
   in
 
   let authenticate_finish req =
-    let userid = Dream.param req "userid"
-    and b64_credential_id = Dream.param req "credential_id"
+    let userid = Dream.param "userid" req
+    and b64_credential_id = Dream.param "credential_id" req
     in
     match Base64.decode ~alphabet:Base64.uri_safe_alphabet ~pad:false b64_credential_id with
     | Error `Msg err ->
@@ -238,7 +223,7 @@ let add_routes t =
                 if check_counter (credential_id, pubkey) sign_count
                 then begin
                   Flash_message.put_flash ""  "Successfully authenticated" req;
-                  Dream.set_session_field req "authenticated_as" username >>= fun () ->
+                  Dream.put_session "authenticated_as" username req >>= fun () ->
                   Dream.json "true"
                 end else begin
                   Logs.warn (fun m -> m "credential %S for user %S: counter not strictly increasing! \
@@ -277,17 +262,18 @@ let add_routes t =
   ]
 
 
-let setup_app level port host origin tls =
+let setup_app level port host origin https =
   let level = match level with None -> None | Some Logs.Debug -> Some `Debug | Some Info -> Some `Info | Some Warning -> Some `Warning | Some Error -> Some `Error | Some App -> None in
   Dream.initialize_log ?level ();
   match Webauthn.create origin with
   | Error e -> Logs.err (fun m -> m "failed to create webauthn: %s" e); exit 1
   | Ok webauthn ->
-    Dream.run ~port ~interface:host ~tls
+    Dream.run ~port ~interface:host ~https
     @@ Dream.logger
     @@ Dream.memory_sessions
     @@ Flash_message.flash_messages
     @@ add_routes webauthn
+    @@ Dream.not_found
 
 open Cmdliner
 
@@ -308,6 +294,9 @@ let tls =
   Arg.(value & flag & info [ "tls" ] ~doc)
 
 let () =
-  let term = Term.(const setup_app $ Logs_cli.level () $ port $ host $ origin $ tls) in
-  let info = Cmd.info "Webauthn app" ~doc:"Webauthn app" ~man:[] in
-  exit (Cmd.eval (Cmd.v info term))
+  let term = Term.(pure setup_app $ Logs_cli.level () $ port $ host $ origin $ tls) in
+  let info = Term.info "Webauthn app" ~doc:"Webauthn app" ~man:[] in
+  match Term.eval (term, info) with
+  | `Ok () -> exit 0
+  | `Error _ -> exit 1
+  | _ -> exit 0

cbor/CBOR.ml

@@ -0,0 +1,269 @@
+(** CBOR encoder/decoder, RFC 7049 *)
+
+open Printf
+module BE = EndianBytes.BigEndian_unsafe
+module SE = EndianString.BigEndian_unsafe
+
+exception Error of string
+
+exception Noncanonical of string
+
+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
+
+  let start () = Buffer.create 10
+
+  let init b ~maj add =
+    assert (maj >= 0 && maj < 8);
+    assert (add >= 0 && add < 32);
+    Buffer.add_char b @@ char_of_int @@ (maj lsl 5) lor add
+
+  let put_n b n f x =
+    let s = Bytes.create n in
+    f s 0 x;
+    Buffer.add_string b (Bytes.unsafe_to_string s)
+
+  let max_uint32 =
+    match Sys.word_size with
+    | 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 *)
+
+  let put b ~maj n =
+    assert (n >= 0);
+    if n < 24 then
+      init b ~maj n
+    else if n < 256 then
+      begin init b ~maj 24; Buffer.add_char b @@ char_of_int n end
+    else if n < 65536 then
+      begin init b ~maj 25; put_n b 2 BE.set_int16 n end
+    else if n <= max_uint32 then
+      begin init b ~maj 26; put_n b 4 BE.set_int32 @@ Int32.of_int n end
+    else
+      begin init b ~maj 27; put_n b 8 BE.set_int64 @@ Int64.of_int n end
+
+  let int b n =
+    let (maj,n) = if n < 0 then 1, -1 - n else 0, n in
+    put b ~maj n
+
+  let hex_char x =
+    assert (x >= 0 && x < 16);
+    if x <= 9 then Char.chr @@ Char.code '0' + x
+    else Char.chr @@ Char.code 'a' + x - 10
+
+  let to_hex s =
+    let r = Bytes.create (String.length s * 2) in
+    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+1) @@ hex_char @@ Char.code s.[i] land 0b1111;
+    done;
+    Bytes.to_string r
+
+end
+
+module Simple = struct
+
+  type t =
+    [ `Null
+    | `Undefined
+    | `Simple of int
+    | `Bool of bool
+    | `Int of int
+    | `Float of float
+    | `Bytes of string
+    | `Text of string
+    | `Array of t list
+    | `Map of (t * t) list
+    ]
+
+  let encode item =
+    let open Encode in
+    let b = start () in
+    let rec write = function
+      | `Null -> put b ~maj:7 22;
+      | `Undefined -> put b ~maj:7 23;
+      | `Bool false -> put b ~maj:7 20;
+      | `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 -> fail "encode: simple(%d)" n
+      | `Int n -> int b n
+      | `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
+      | `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
+      | `Map m -> put b ~maj:5 (List.length m); List.iter (fun (a,b) -> write a; write b) m
+    in
+    write item;
+    Buffer.contents b
+
+  let need (s,i) n =
+    if n > String.length s || !i + n > String.length s then
+      fail "truncated: len %d pos %d need %d" (String.length s) !i n;
+    let j = !i in
+    i := !i + n;
+    j
+
+  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_s (s,_ as r) n = String.sub s (need r n) n
+
+  let get_additional byte1 = byte1 land 0b11111
+  let is_indefinite byte1 = get_additional byte1 = 31
+
+  let int64_max_int = Int64.of_int max_int
+  let two_min_int32 = 2 * Int32.to_int Int32.min_int
+
+  let extract_number byte1 r =
+    let guard_min min n = if n < min
+      then noncanonical "non-compact number encoding: %d < %d" n min
+      else n
+    in
+    match get_additional byte1 with
+    | n when n < 24 -> n
+    | 24 -> guard_min 24 @@ get_byte r
+    | 25 -> guard_min 256 @@ get_n r 2 SE.get_uint16
+    | 26 ->
+      let n = guard_min (256*256) @@ Int32.to_int @@ get_n r 4 SE.get_int32 in
+      if n < 0 then n - two_min_int32 else 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 half = Char.code s.[i] lsl 8 + Char.code s.[i+1] in
+    let mant = half land 0x3ff in
+    let value =
+      match (half lsr 10) land 0x1f with (* exp *)
+      | 31 when mant = 0 -> infinity
+      | 31 -> nan
+      | 0 -> ldexp (float mant) ~-24
+      | exp -> ldexp (float @@ mant + 1024) (exp - 25)
+    in
+    if half land 0x8000 = 0 then value else ~-. value
+
+  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
+
+  exception Break
+
+  let extract_list byte1 r f =
+    if is_indefinite byte1 then
+      noncanonical "indefinite length array or map"
+    else
+      let n = extract_number byte1 r in Array.to_list @@ Array.init n (fun _ -> f r)
+
+  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 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 *)

cbor/CBOR.mli

@@ -0,0 +1,28 @@
+(** CBOR encoder/decoder, RFC 7049 *)
+
+exception Error of string
+
+exception Noncanonical of string
+
+module Simple : sig
+
+type t =
+[ `Null
+| `Undefined
+| `Simple of int
+| `Bool of bool
+| `Int of int
+| `Float of float
+| `Bytes of string
+| `Text of string
+| `Array of t list
+| `Map of (t * t) list
+]
+
+val encode : t -> string
+val decode : string -> t
+val decode_partial : string -> t * string
+
+val to_diagnostic : t -> string
+
+end

cbor/appendix_a.json

@@ -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
+  }
+]

cbor/dune

@@ -0,0 +1,16 @@
+(library
+ (name cbor)
+ (public_name webauthn.cbor)
+ (modules CBOR)
+ (wrapped false)
+ (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)))

cbor/test.ml

@@ -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

flash_message/flash_message.ml

@@ -3,7 +3,7 @@ open Lwt.Syntax
 let five_minutes = 5. *. 60.
 
 
-let storage = Dream.new_field ~name:"dream.flash_message" ()
+let storage = Dream.new_local ~name:"dream.flash_message" ()
 
 
 let flash_cookie = "dream.flash_message"
@@ -11,14 +11,13 @@ let flash_cookie = "dream.flash_message"
 
 let flash_messages inner_handler request =
   let outbox = ref [] in
-  Dream.set_field request storage outbox;
+  let request = Dream.with_local storage outbox request in
   let* response = inner_handler request in
   Lwt.return(
     let entries = List.rev !outbox in
     let content = List.fold_right (fun (x,y) a -> `String x :: `String y :: a) entries [] in
     let value = `List content |> Yojson.Basic.to_string in
-    Dream.set_cookie response request flash_cookie value ~max_age:five_minutes;
-    response
+    Dream.set_cookie flash_cookie value request response ~max_age:five_minutes
   )
 
 
@@ -34,7 +33,7 @@ let get_flash request =
   let unpack u = match u with
       | `String x -> x
       | _ -> failwith "Bad flash message content" in
-  let x = Dream.cookie request flash_cookie
+  let x = Dream.cookie flash_cookie request
           |>? fun value ->
           match Yojson.Basic.from_string value with
           | `List y -> Some (group @@ List.map unpack y)
@@ -43,7 +42,7 @@ let get_flash request =
 
 
 let put_flash category message request =
-  let outbox = match Dream.field request storage with
+  let outbox = match Dream.local storage request with
   | Some outbox -> outbox
   | None ->
     let message = "Missing flash message middleware" in

misc/rc.d/webauthn_demo

@@ -1,23 +0,0 @@
-#!/bin/sh
-
-. /etc/rc.subr
-
-name="webauthn_demo"
-title="webauthn-demo"
-rcvar="${name}_enable"
-
-pidfile="/var/run/${name}.pid"
-# Change this if you place the demo binary elsewhere
-exec_path="/home/builder/webauthn/${name}.exe"
-
-load_rc_config "$name"
-
-: ${webauthn_demo_enable:="NO"}
-# We can't use $webauthn_demo_user as otherwise daemon(8) will run unprivileged
-# and can't create the pidfile and drop privileges
-: ${webauthn_demo_runas:="builder"}
-
-command="/usr/sbin/daemon"
-command_args="-r -S -t ${title} -P ${pidfile} -u ${webauthn_demo_runas} ${exec_path}"
-
-run_rc_command "$1"

src/dune

@@ -3,4 +3,4 @@
  (public_name webauthn)
  (preprocess
   (pps ppx_deriving_yojson))
- (libraries mirage-crypto-rng yojson mirage-crypto-ec x509 base64 cbor))
+ (libraries mirage-crypto-rng yojson mirage-crypto-ec x509 base64 webauthn.cbor))

src/webauthn.ml

@@ -7,7 +7,7 @@ type decoding_error = [
   | `Base64_decoding of string * string * string
   | `CBOR_decoding of string * string * string
   | `Unexpected_CBOR of string * string * CBOR.Simple.t
-  | `Binary_decoding of string * string * string
+  | `Binary_decoding of string * string * Cstruct.t
   | `Attestation_object_decoding of string * string * string
 ]
 
@@ -35,7 +35,7 @@ let pp_error ppf = function
   | `Unexpected_CBOR (ctx, msg, data) ->
     Fmt.pf ppf "unexpected cbor in %s: %s (data: %s)" ctx msg (CBOR.Simple.to_diagnostic data)
   | `Binary_decoding (ctx, msg, data) ->
-    Fmt.pf ppf "binary decoding error in %s: %s (data: %a)" ctx msg (Ohex.pp_hexdump ()) data
+    Fmt.pf ppf "binary decoding error in %s: %s (data: %a)" ctx msg Cstruct.hexdump_pp data
   | `Attestation_object_decoding (ctx, msg, data) ->
     Fmt.pf ppf "attestation object decoding error in %s: %s (data: %s)" ctx msg data
   | `Unsupported_key_type i ->
@@ -67,7 +67,7 @@ type challenge = string
 
 let generate_challenge ?(size = 32) () =
   if size < 16 then invalid_arg "size must be at least 16 bytes";
-  let ch = Mirage_crypto_rng.generate size in
+  let ch = Mirage_crypto_rng.generate size |> Cstruct.to_string in
   ch, Base64.encode_string ch
 
 let challenge_to_string c = c
@@ -131,10 +131,11 @@ let cose_pubkey cbor_data =
    guard (crv = 1) (`Unsupported_elliptic_curve crv) >>= fun () ->
    extract_k_i "cose pubkey x" kv (-2) >>= extract_bytes "cose pubkey x" >>= fun x ->
    extract_k_i "cose pubkey y" kv (-3) >>= extract_bytes "cose pubkey y" >>= fun y ->
-   let str = String.concat "" [ "\004" ; x ; y ] in
+   let four = Cstruct.create 1 in Cstruct.set_uint8 four 0 4;
+   let cs = Cstruct.concat [ four ; Cstruct.of_string x ; Cstruct.of_string y ] in
    Result.map_error
      (fun e -> `Invalid_public_key (Fmt.to_to_string Mirage_crypto_ec.pp_error e))
-     (Mirage_crypto_ec.P256.Dsa.pub_of_octets str)
+     (Mirage_crypto_ec.P256.Dsa.pub_of_cstruct cs)
 
 let decode_partial_cbor ctx data =
   try Ok (CBOR.Simple.decode_partial data)
@@ -144,23 +145,20 @@ let decode_cbor ctx data =
   try Ok (CBOR.Simple.decode data)
   with CBOR.Error m -> Error (`CBOR_decoding (ctx, "failed to decode CBOR " ^ m, data))
 
-let guard_length ctx len str =
-  guard (String.length str >= len)
-    (`Binary_decoding (ctx, "too short (< " ^ string_of_int len ^ ")", str))
+let guard_length ctx len cs =
+  guard (Cstruct.length cs >= len)
+    (`Binary_decoding (ctx, "too short (< " ^ string_of_int len ^ ")", cs))
 
 let parse_attested_credential_data data =
   guard_length "attested credential data" 18 data >>= fun () ->
-  let aaguid = String.sub data 0 16 in
-  let cid_len = String.get_uint16_be data 16 in
-  let rest = String.sub data 18 (String.length data - 18) in
+  let aaguid = Cstruct.sub data 0 16 in
+  let cid_len = Cstruct.BE.get_uint16 data 16 in
+  let rest = Cstruct.shift data 18 in
   guard_length "attested credential data" cid_len rest >>= fun () ->
-  let cid, pubkey =
-    String.sub rest 0 cid_len,
-    String.sub rest cid_len (String.length rest - cid_len)
-  in
-  decode_partial_cbor "public key" pubkey >>= fun (pubkey, rest) ->
+  let cid, pubkey = Cstruct.split rest cid_len in
+  decode_partial_cbor "public key" (Cstruct.to_string pubkey) >>= fun (pubkey, rest) ->
   cose_pubkey pubkey >>= fun pubkey ->
-  Ok ((aaguid, cid, pubkey), rest)
+  Ok ((aaguid, cid, pubkey), Cstruct.of_string rest)
 
 let string_keys ctx kv =
   List.fold_right (fun (k, v) acc ->
@@ -171,17 +169,17 @@ let string_keys ctx kv =
     kv (Ok [])
 
 let parse_extension_data data =
-   decode_partial_cbor "extension data" data >>= fun (data, rest) ->
+   decode_partial_cbor "extension data" (Cstruct.to_string data) >>= fun (data, rest) ->
    extract_map "extension data" data >>= fun kv ->
    string_keys "extension data" kv >>= fun kv ->
-   Ok (kv, rest)
+   Ok (kv, Cstruct.of_string rest)
 
 type auth_data = {
-  rpid_hash : string ;
+  rpid_hash : Cstruct.t ;
   user_present : bool ;
   user_verified : bool ;
   sign_count : Int32.t ;
-  attested_credential_data : (string * string * Mirage_crypto_ec.P256.Dsa.pub) option ;
+  attested_credential_data : (Cstruct.t * Cstruct.t * Mirage_crypto_ec.P256.Dsa.pub) option ;
   extension_data : (string * CBOR.Simple.t) list option ;
 }
 
@@ -190,20 +188,21 @@ let flags byte =
   b 0, b 2, b 6, b 7
 
 let parse_auth_data data =
+  let data = Cstruct.of_string data in
   guard_length "authenticator data" 37 data >>= fun () ->
-  let rpid_hash = String.sub data 0 32 in
+  let rpid_hash = Cstruct.sub data 0 32 in
   let user_present, user_verified, attested_data_included, extension_data_included =
-    flags (String.get_uint8 data 32)
+    flags (Cstruct.get_uint8 data 32)
   in
-  let sign_count = String.get_int32_be data 33 in
-  let rest = String.sub data 37 (String.length data - 37) in
+  let sign_count = Cstruct.BE.get_uint32 data 33 in
+  let rest = Cstruct.shift data 37 in
   (if attested_data_included then
      Result.map (fun (d, r) -> Some d, r) (parse_attested_credential_data rest)
    else Ok (None, rest)) >>= fun (attested_credential_data, rest) ->
   (if extension_data_included then
      Result.map (fun (d, r) -> Some d, r) (parse_extension_data rest)
    else Ok (None, rest)) >>= fun (extension_data, rest) ->
-  guard (String.length rest = 0) (`Binary_decoding ("authenticator data", "leftover", rest)) >>= fun () ->
+  guard (Cstruct.length rest = 0) (`Binary_decoding ("authenticator data", "leftover", rest)) >>= fun () ->
   Ok { rpid_hash ; user_present ; user_verified ; sign_count ; attested_credential_data ; extension_data }
 
 let parse_attestation_statement fmt data =
@@ -218,7 +217,7 @@ let parse_attestation_statement fmt data =
         extract_bytes "attestation statement x5c" c >>= fun c ->
         Result.map_error
           (function `Msg m -> `Attestation_object_decoding ("attestation statement x5c", m, String.escaped c))
-          (X509.Certificate.decode_der c)
+          (X509.Certificate.decode_der (Cstruct.of_string c))
       | cs -> Error (`Attestation_object_decoding ("attestation statement x5c", "expected single certificate", String.concat "," (List.map CBOR.Simple.to_diagnostic cs)))
     end >>= fun cert ->
     Ok (Some (cert, signature))
@@ -312,9 +311,8 @@ let register_response_of_string =
 
 let register t response =
   (* XXX: credential.getClientExtensionResults() *)
-  let client_data_hash =
-    Digestif.SHA256.(to_raw_string (digest_string response.client_data_json))
-  in
+  let client_data_hash = Mirage_crypto.Hash.SHA256.digest
+    (Cstruct.of_string response.client_data_json) in
   begin try Ok (Yojson.Safe.from_string response.client_data_json)
     with Yojson.Json_error msg ->
       Error (`Json_decoding ("clientDataJSON", msg, response.client_data_json))
@@ -337,21 +335,22 @@ let register t response =
       Ok None
   end >>= fun client_extensions ->
   parse_attestation_object response.attestation_object >>= fun (auth_data, attestation_statement) ->
-  let rpid_hash =
-    Digestif.SHA256.(to_raw_string (digest_string (rpid t))) in
-  guard (String.equal auth_data.rpid_hash rpid_hash)
-    (`Rpid_hash_mismatch (rpid_hash, auth_data.rpid_hash)) >>= fun () ->
+  let rpid_hash = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string (rpid t)) in
+  guard (Cstruct.equal auth_data.rpid_hash rpid_hash)
+    (`Rpid_hash_mismatch (Cstruct.to_string rpid_hash, Cstruct.to_string auth_data.rpid_hash)) >>= fun () ->
   (* verify user present, user verified flags in auth_data.flags *)
   Option.to_result ~none:`Missing_credential_data
     auth_data.attested_credential_data >>= fun (aaguid, credential_id, public_key) ->
   begin match attestation_statement with
    | None -> Ok None
    | Some (cert, signature) ->
-     let pub_cs = Mirage_crypto_ec.P256.Dsa.pub_to_octets public_key in
-     let sigdata = String.concat "" [
-       "\000" ; rpid_hash ; client_data_hash ; credential_id ; pub_cs
+     let pub_cs = Mirage_crypto_ec.P256.Dsa.pub_to_cstruct public_key in
+     let sigdata = Cstruct.concat [
+       Cstruct.create 1 ; rpid_hash ; client_data_hash ; credential_id ; pub_cs
      ] in
-     let pk = X509.Certificate.public_key cert in
+     let pk = X509.Certificate.public_key cert
+     and signature = Cstruct.of_string signature
+     in
      Result.map_error (function `Msg m -> `Signature_verification m)
        (X509.Public_key.verify `SHA256 ~signature pk (`Message sigdata)) >>= fun () ->
      Ok (Some cert)
@@ -360,8 +359,8 @@ let register t response =
   (* check auth_data.attested_credential_data.credential_id is not registered ? *)
   let registration =
     let attested_credential_data = {
-      aaguid ;
-      credential_id ;
+      aaguid = Cstruct.to_string aaguid ;
+      credential_id = Cstruct.to_string credential_id ;
       public_key
     } in
     {
@@ -395,9 +394,8 @@ let authenticate_response_of_string =
   of_json "authenticate response" authenticate_response_of_yojson
 
 let authenticate t public_key response =
-  let client_data_hash =
-    Digestif.SHA256.(to_raw_string (digest_string response.client_data_json))
-  in
+  let client_data_hash = Mirage_crypto.Hash.SHA256.digest
+    (Cstruct.of_string response.client_data_json) in
   begin try Ok (Yojson.Safe.from_string response.client_data_json)
     with Yojson.Json_error msg ->
       Error (`Json_decoding ("clientDataJSON", msg, response.client_data_json))
@@ -420,11 +418,12 @@ let authenticate t public_key response =
       Ok None
   end >>= fun client_extensions ->
   parse_auth_data response.authenticator_data >>= fun auth_data ->
-  let rpid_hash = Digestif.SHA256.(to_raw_string (digest_string (rpid t))) in
-  guard (String.equal auth_data.rpid_hash rpid_hash)
-    (`Rpid_hash_mismatch (rpid_hash, auth_data.rpid_hash)) >>= fun () ->
-  let sigdata =  response.authenticator_data ^ client_data_hash
-  and signature = response.signature in
+  let rpid_hash = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string (rpid t)) in
+  guard (Cstruct.equal auth_data.rpid_hash rpid_hash)
+    (`Rpid_hash_mismatch (Cstruct.to_string rpid_hash, Cstruct.to_string auth_data.rpid_hash)) >>= fun () ->
+  let sigdata = Cstruct.concat [ Cstruct.of_string response.authenticator_data ; client_data_hash ]
+  and signature = Cstruct.of_string response.signature
+  in
   Result.map_error (function `Msg m -> `Signature_verification m)
     (X509.Public_key.verify `SHA256 ~signature (`P256 public_key) (`Message sigdata)) >>= fun () ->
   let authentication = {
@@ -448,11 +447,11 @@ type transport = [
 ]
 
 let pp_transport ppf = function
-  | `Bluetooth_classic -> Fmt.string ppf "BluetoothClassic"
-  | `Bluetooth_low_energy -> Fmt.string ppf "BluetoothLowEnergy"
+  | `Bluetooth_classic -> Fmt.string ppf "Bluetooth classic"
+  | `Bluetooth_low_energy -> Fmt.string ppf "Bluetooth low energy"
   | `Usb -> Fmt.string ppf "USB"
   | `Nfc -> Fmt.string ppf "NFC"
-  | `Usb_internal -> Fmt.string ppf "USBInternal"
+  | `Usb_internal -> Fmt.string ppf "USB internal"
 
 let transports =
   let opts = [
@@ -467,7 +466,7 @@ let transports =
 let decode_strict codec cs =
   match Asn.decode codec cs with
   | Ok (a, cs) ->
-    guard (String.length cs = 0) (`Msg "trailing bytes") >>= fun () ->
+    guard (Cstruct.length cs = 0) (`Msg "trailing bytes") >>= fun () ->
     Ok a
   | Error (`Parse msg) -> Error (`Msg msg)
 

src/webauthn.mli

@@ -48,7 +48,7 @@ type decoding_error = [
   | `Base64_decoding of string * string * string
   | `CBOR_decoding of string * string * string
   | `Unexpected_CBOR of string * string * CBOR.Simple.t
-  | `Binary_decoding of string * string * string
+  | `Binary_decoding of string * string * Cstruct.t
   | `Attestation_object_decoding of string * string * string
 ]
 
@@ -168,14 +168,6 @@ type transport = [
 (** [pp_transport ppf tranport] pretty-prints the [transport] on [ppf]. *)
 val pp_transport : Format.formatter -> transport -> unit
 
-(** [fido_u2f_transport_oid] is the OID 1.3.6.1.4.1.45724.2.1.1 for
-    certificate authenticator transports extensions. *)
-val fido_u2f_transport_oid : Asn.oid
-
-(** [decode_transport data] decodes the [fido_u2f_transport_oid] certificate
-    extension data. *)
-val decode_transport : string -> (transport list, [> `Msg of string ]) result
-
 (** [transports_of_cert certficate] attempts to extract the FIDO U2F
     authenticator transports extension (OID 1.3.6.1.4.1.45724.2.1.1) from the
     [certificate].  *)

webauthn.opam

@@ -1,8 +1,8 @@
 opam-version: "2.0"
-homepage: "https://github.com/robur-coop/webauthn"
-dev-repo: "git+https://github.com/robur-coop/webauthn.git"
-bug-reports: "https://github.com/robur-coop/webauthn/issues"
-doc: "https://robur-coop.github.io/webauthn/doc"
+homepage: "https://github.com/roburio/webauthn"
+dev-repo: "git+https://github.com/roburio/webauthn.git"
+bug-reports: "https://github.com/roburio/webauthn/issues"
+doc: "https://roburio.github.io/webauthn/doc"
 maintainer: [ "team@robur.coop" ]
 authors: [ "Reynir Björnsson <reynir@reynir.dk>" "Hannes Mehnert <hannes@mehnert.org>" ]
 license: "BSD-2-Clause"
@@ -16,25 +16,19 @@ build: [
 depends: [
   "ocaml" {>= "4.08.0"}
   "dune" {>= "2.7"}
-  "dream" {dev & >= "1.0.0~alpha7"}
-  "ppx_blob" {dev & >= "0.9.0"}
-  "cmdliner" {dev & >= "1.1.0"}
+  "dream" {dev}
+  "ppx_blob" {dev}
+  "cmdliner" {dev}
   "logs" {dev}
   "lwt" {dev}
   "yojson"
   "ppx_deriving_yojson"
-  "digestif"
-  "mirage-crypto-ec" {>= "1.1.0"}
-  "mirage-crypto-rng" {>= "1.1.0"}
+  "mirage-crypto-ec"
+  "mirage-crypto-rng"
   "ocplib-endian"
-  "x509" {>= "1.0.4"}
+  "x509" {>= "0.13.0"}
   "base64" {>= "3.1.0"}
-  "cbor" {>= "0.5"}
-  "ohex" {>= "0.2.0"}
-]
-
-conflicts: [
-  "result" {< "1.5"}
+  "cstruct" {>= "6.0.0"}
 ]
 
 synopsis: "WebAuthn - authenticating users to services using public key cryptography"