diff --git a/bin/template.ml b/bin/template.ml index 2330ad2..72a33a1 100644 --- a/bin/template.ml +++ b/bin/template.ml @@ -77,17 +77,11 @@ let register_view origin user = let response = credential.response; let attestationObject = new Uint8Array(response.attestationObject); let clientDataJSON = new Uint8Array(response.clientDataJSON); - let rawId = new Uint8Array(credential.rawId); let body = JSON.stringify({ - id: credential.id, - rawId: bufferEncode(rawId), - type: credential.type, - response: { - attestationObject: bufferEncode(attestationObject), - clientDataJSON: bufferEncode(clientDataJSON), - }, + attestationObject: bufferEncode(attestationObject), + clientDataJSON: bufferEncode(clientDataJSON), }); let headers = {'Content-type': "application/json; charset=utf-8"}; @@ -142,7 +136,6 @@ let authenticate_view challenge credentials user = navigator.credentials.get({ publicKey: request_options }) .then(function (assertion) { let response = assertion.response; - let rawId = new Uint8Array(assertion.rawId); let authenticatorData = new Uint8Array(assertion.response.authenticatorData); let clientDataJSON = new Uint8Array(assertion.response.clientDataJSON); let signature = new Uint8Array(assertion.response.signature); @@ -150,20 +143,15 @@ let authenticate_view challenge credentials user = let body = JSON.stringify({ - id: assertion.id, - rawId: bufferEncode(rawId), - type: assertion.type, - response: { - authenticatorData: bufferEncode(authenticatorData), - clientDataJSON: bufferEncode(clientDataJSON), - signature: bufferEncode(signature), - userHandle: userHandle ? bufferEncode(userHandle) : null, - } + authenticatorData: bufferEncode(authenticatorData), + clientDataJSON: bufferEncode(clientDataJSON), + signature: bufferEncode(signature), + userHandle: userHandle ? bufferEncode(userHandle) : null, }); let headers = {'Content-type': "application/json; charset=utf-8"}; let username = window.location.pathname.substring("/authenticate/".length); - let request = new Request('/authenticate_finish/'+username, { method: 'POST', body: body, headers: headers } ); + let request = new Request('/authenticate_finish/'+assertion.id+'/'+username, { method: 'POST', body: body, headers: headers } ); fetch(request) .then(function (response) { if (!response.ok) { diff --git a/bin/webauthn_demo.ml b/bin/webauthn_demo.ml index 249d936..479c2e2 100644 --- a/bin/webauthn_demo.ml +++ b/bin/webauthn_demo.ml @@ -8,7 +8,7 @@ let find_username username = users None module KhPubHashtbl = Hashtbl.Make(struct - type t = Webauthn.key_handle * Mirage_crypto_ec.P256.Dsa.pub + type t = Webauthn.credential_id * Mirage_crypto_ec.P256.Dsa.pub let cs_of_pub = Mirage_crypto_ec.P256.Dsa.pub_to_cstruct let equal (kh, pub) (kh', pub') = String.equal kh kh' && Cstruct.equal (cs_of_pub pub) (cs_of_pub pub') @@ -27,25 +27,25 @@ let check_counter kh_pub counter = then KhPubHashtbl.replace counters kh_pub counter; r -let registration_challenges : (string, string * string list) Hashtbl.t = Hashtbl.create 7 +let registration_challenges : (string, string * Webauthn.challenge list) Hashtbl.t = Hashtbl.create 7 let remove_registration_challenge userid challenge = match Hashtbl.find_opt registration_challenges userid with | None -> () | Some (username, challenges) -> - let challenges = List.filter (fun c -> not (String.equal c challenge)) challenges in + let challenges = List.filter (fun c -> not (Webauthn.challenge_equal c challenge)) challenges in if challenges = [] then Hashtbl.remove registration_challenges userid else Hashtbl.replace registration_challenges userid (username, challenges) -let authentication_challenges : (string, string list) Hashtbl.t = Hashtbl.create 7 +let authentication_challenges : (string, Webauthn.challenge list) Hashtbl.t = Hashtbl.create 7 let remove_authentication_challenge userid challenge = match Hashtbl.find_opt authentication_challenges userid with | None -> () | Some challenges -> - let challenges = List.filter (fun c -> not (String.equal c challenge)) challenges in + let challenges = List.filter (fun c -> not (Webauthn.challenge_equal c challenge)) challenges in if challenges = [] then Hashtbl.remove authentication_challenges userid else @@ -75,7 +75,7 @@ let add_routes t = let registration_challenge req = let user = Dream.param "user" req in - let challenge = Cstruct.to_string (Mirage_crypto_rng.generate 16) 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, [] | Some (userid, (_, credentials)) -> userid, List.map (fun (_, cid, _) -> cid) credentials @@ -85,7 +85,6 @@ let add_routes t = Option.value ~default:[] in Hashtbl.replace registration_challenges userid (user, challenge :: challenges); - let challenge_b64 = (Base64.encode_string challenge) in let json = `Assoc [ "challenge", `String challenge_b64 ; "user", `Assoc [ @@ -109,49 +108,55 @@ let add_routes t = Logs.warn (fun m -> m "no challenge found"); Dream.respond ~status:`Bad_Request "Bad request." | Some (username, challenges) -> - match Webauthn.register_response t body with + match Webauthn.register_response_of_string body with | Error e -> Logs.warn (fun m -> m "error %a" Webauthn.pp_error e); let err = to_string e in Flash_message.put_flash "" ("Registration failed " ^ err) req; Dream.json "false" - | Ok (challenge, _aaguid, credential_id, pubkey, _client_extensions, user_present, - user_verified, sig_count, _authenticator_extensions, attestation_cert) -> - if not (List.mem challenge challenges) then begin - Logs.warn (fun m -> m "challenge invalid"); - Flash_message.put_flash "" "Registration failed: invalid challenge" req; + | Ok response -> + match Webauthn.register t response with + | Error e -> + Logs.warn (fun m -> m "error %a" Webauthn.pp_error e); + let err = to_string e in + Flash_message.put_flash "" ("Registration failed " ^ err) req; Dream.json "false" - end else begin - remove_registration_challenge userid challenge; - ignore (check_counter (credential_id, pubkey) sig_count); - Logs.info (fun m -> m "user present %B user verified %B" user_present user_verified); - Logs.app (fun m -> m "challenge for user %S" username); - match Dream.session "authenticated_as" req, Hashtbl.find_opt users userid with - | _, None -> - Logs.app (fun m -> m "registered %s: %S" username credential_id); - Hashtbl.replace users userid (username, [ (pubkey, credential_id, attestation_cert) ]); - Dream.invalidate_session req >>= fun () -> - Flash_message.put_flash "" - (Printf.sprintf "Successfully registered as %s! [authenticate]" username userid) - req; - Dream.json "true" - | Some session_user, Some (username', keys) -> - Logs.app (fun m -> m "user %S session_user %S" username session_user); - if String.equal username session_user && String.equal username username' then begin + | Ok (challenge, { user_present ; user_verified ; sign_count ; attested_credential_data ; certificate ; _ }) -> + let { Webauthn.credential_id ; public_key ; _ } = attested_credential_data in + if not (List.exists (Webauthn.challenge_equal challenge) challenges) then begin + Logs.warn (fun m -> m "challenge invalid"); + Flash_message.put_flash "" "Registration failed: invalid challenge" req; + Dream.json "false" + end else begin + remove_registration_challenge userid challenge; + ignore (check_counter (credential_id, public_key) sign_count); + Logs.info (fun m -> m "register %S user present %B user verified %B" + username user_present user_verified); + match Dream.session "authenticated_as" req, Hashtbl.find_opt users userid with + | _, None -> Logs.app (fun m -> m "registered %s: %S" username credential_id); - Hashtbl.replace users userid (username, ((pubkey, credential_id, attestation_cert) :: keys)) ; + Hashtbl.replace users userid (username, [ (public_key, credential_id, certificate) ]); Dream.invalidate_session req >>= fun () -> Flash_message.put_flash "" (Printf.sprintf "Successfully registered as %s! [authenticate]" username userid) req; Dream.json "true" - end else - (Logs.info (fun m -> m "session_user %s, user %s (user in users table %s)" session_user username username'); - Dream.json ~status:`Forbidden "false") - | None, Some _keys -> - Logs.app (fun m -> m "no session user"); - Dream.json ~status:`Forbidden "false" - end + | Some session_user, Some (username', keys) -> + if String.equal username session_user && String.equal username username' then begin + Logs.app (fun m -> m "registered %s: %S" username credential_id); + Hashtbl.replace users userid (username, ((public_key, credential_id, certificate) :: keys)) ; + Dream.invalidate_session req >>= fun () -> + Flash_message.put_flash "" + (Printf.sprintf "Successfully registered as %s! [authenticate]" username userid) + req; + Dream.json "true" + end else + (Logs.info (fun m -> m "session_user %s, user %s (user in users table %s)" session_user username username'); + Dream.json ~status:`Forbidden "false") + | None, Some _keys -> + Logs.app (fun m -> m "no session user"); + Dream.json ~status:`Forbidden "false" + end in let authenticate req = @@ -162,51 +167,69 @@ let add_routes t = Dream.respond ~status:`Bad_Request "Bad request." | Some (username, keys) -> let credentials = List.map (fun (_, c, _) -> Base64.encode_string c) keys in - let challenge = Cstruct.to_string (Mirage_crypto_rng.generate 16) in + let challenge, challenge_b64 = Webauthn.generate_challenge () in let challenges = Option.value ~default:[] (Hashtbl.find_opt authentication_challenges userid) in Hashtbl.replace authentication_challenges userid (challenge :: challenges); - Dream.html (Template.authenticate_view (Base64.encode_string challenge) credentials username) + Dream.html (Template.authenticate_view challenge_b64 credentials username) in let authenticate_finish req = - 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 authentication_challenges userid with - | None -> Dream.respond ~status:`Internal_Server_Error "Internal server error." - | Some challenges -> - match Hashtbl.find_opt users userid with - | None -> + 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 -> + Logs.err (fun m -> m "credential id (%S) is not base64 uri safe: %s" b64_credential_id err); + Dream.json ~status:`Bad_Request "credential ID decoding error" + | Ok credential_id -> + Dream.body req >>= fun body -> + Logs.debug (fun m -> m "received body: %s" body); + match Hashtbl.find_opt authentication_challenges userid, Hashtbl.find_opt users userid with + | None, _ -> Dream.respond ~status:`Internal_Server_Error "Internal server error." + | _, None -> Logs.warn (fun m -> m "no user found with id %s" userid); Dream.respond ~status:`Bad_Request "Bad request." - | Some (username, keys) -> - let cid_keys = List.map (fun (key, credential_id, _) -> credential_id, key) keys in - match Webauthn.authentication_response t cid_keys body with - | Ok (challenge, credential, _client_extensions, _user_present, _user_verified, counter, _authenticator_extensions) -> - if not (List.mem challenge challenges) then begin - Logs.warn (fun m -> m "invalid challenge"); - Flash_message.put_flash "" "Authentication failure: invalid challenge" req; + | Some challenges, Some (username, keys) -> + match List.find_opt (fun (_, cid, _) -> String.equal cid credential_id) keys with + | None -> + Logs.warn (fun m -> m "no key found with credential id %s" b64_credential_id); + Dream.respond ~status:`Bad_Request "Bad request." + | Some (pubkey, _, _) -> + match Webauthn.authenticate_response_of_string body with + | Error e -> + Logs.warn (fun m -> m "error %a" Webauthn.pp_error e); + let err = to_string e in + Flash_message.put_flash "" ("Authentication failure: " ^ err) req; Dream.json "false" - end else begin - remove_authentication_challenge userid challenge; - if check_counter credential counter - then begin - Flash_message.put_flash "" "Successfully authenticated" req; - 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! \ - Got %ld, expected >%ld. webauthn device compromised?" - (fst credential) username counter (KhPubHashtbl.find counters credential)); - Flash_message.put_flash "" "Authentication failure: key compromised?" req; + | Ok authenticate_response -> + match Webauthn.authenticate t pubkey authenticate_response with + | Ok (challenge, { user_present ; user_verified ; sign_count ; _ }) -> + Logs.info (fun m -> m "authenticate %S user present %B user verified %B" + username user_present user_verified); + if not (List.exists (Webauthn.challenge_equal challenge) challenges) then begin + Logs.warn (fun m -> m "invalid challenge"); + Flash_message.put_flash "" "Authentication failure: invalid challenge" req; + Dream.json "false" + end else begin + remove_authentication_challenge userid challenge; + if check_counter (credential_id, pubkey) sign_count + then begin + Flash_message.put_flash "" "Successfully authenticated" req; + 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! \ + Got %ld, expected >%ld. webauthn device compromised?" + b64_credential_id username sign_count (KhPubHashtbl.find counters (credential_id, pubkey))); + Flash_message.put_flash "" "Authentication failure: key compromised?" req; + Dream.json "false" + end + end + | Error e -> + Logs.warn (fun m -> m "error %a" Webauthn.pp_error e); + let err = to_string e in + Flash_message.put_flash "" ("Authentication failure: " ^ err) req; Dream.json "false" - end - end - | Error e -> - Logs.warn (fun m -> m "error %a" Webauthn.pp_error e); - let err = to_string e in - Flash_message.put_flash "" ("Authentication failure: " ^ err) req; - Dream.json "false" in let logout req = @@ -225,7 +248,7 @@ let add_routes t = Dream.get "/registration-challenge/:user" registration_challenge; Dream.post "/register_finish/:userid" register_finish; Dream.get "/authenticate/:userid" authenticate; - Dream.post "/authenticate_finish/:userid" authenticate_finish; + Dream.post "/authenticate_finish/:credential_id/:userid" authenticate_finish; Dream.post "/logout" logout; Dream.get "/static/base64.js" base64; ] diff --git a/src/webauthn.ml b/src/webauthn.ml index 5e280a7..10adc10 100644 --- a/src/webauthn.ml +++ b/src/webauthn.ml @@ -1,12 +1,13 @@ -type key_handle = string +type credential_id = string +type json_decoding_error = [ `Json_decoding of string * string * string ] type error = [ - | `Json_decoding of string * string * string + json_decoding_error | `Base64_decoding of string * string * string | `Client_data_type_mismatch of string | `Origin_mismatch of string * string | `Attestation_object of string - | `Rpid_hash_mismatch of Cstruct.t * Cstruct.t + | `Rpid_hash_mismatch of string * string | `Missing_credential_data | `Msg of string ] @@ -23,7 +24,8 @@ let pp_error ppf = function | `Attestation_object msg -> Fmt.pf ppf "attestation object error %s" msg | `Rpid_hash_mismatch (should, is) -> - Fmt.pf ppf "rpid hash mismatch: expected %a received %a" Cstruct.hexdump_pp should Cstruct.hexdump_pp is + Fmt.pf ppf "rpid hash mismatch: expected %s received %s" + (Base64.encode_string should) (Base64.encode_string is) | `Missing_credential_data -> Fmt.string ppf "missing credential data" | `Msg msg -> Fmt.pf ppf "error %s" msg @@ -33,12 +35,18 @@ type t = { type challenge = string -let b64_enc = Base64.(encode_string ~pad:false ~alphabet:uri_safe_alphabet) +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 |> Cstruct.to_string in + ch, Base64.encode_string ch -let lift_err f = function Ok _ as a -> a | Error x -> Error (f x) +let challenge_to_string c = c +let challenge_of_string s = Some s + +let challenge_equal = String.equal let b64_dec thing s = - lift_err + Result.map_error (function `Msg m -> `Base64_decoding (thing, m, s)) Base64.(decode ~pad:false ~alphabet:uri_safe_alphabet s) @@ -52,16 +60,6 @@ let base64url_string_of_yojson = function Base64.(decode ~pad:false ~alphabet:uri_safe_alphabet b64) |> Result.map_error (function `Msg m -> m) | _ -> Error "base64url_string" -let base64url_string_to_yojson s = - `String Base64.(encode_string ~pad:false ~alphabet:uri_safe_alphabet s) - -type typ = Public_key - -let typ_of_yojson = function - | `String "public-key" -> Ok Public_key - | _ -> Error "typ" - -let typ_to_yojson Public_key = `String "public-key" let extract_k_i map k : (_, string) result = Option.to_result ~none:"key not present" @@ -120,10 +118,19 @@ let parse_attested_credential_data data = cose_pubkey pubkey >>= fun pubkey -> Ok ((aaguid, cid, pubkey), Cstruct.of_string rest) +let string_keys kv = + List.fold_right (fun (k, v) acc -> + match acc, k with + | Error _ as e, _ -> e + | Ok xs, `Text t -> Ok ((t, v) :: xs) + | _, _ -> Error "Map does contain non-text keys") + kv (Ok []) + let parse_extension_data data = (try Ok (CBOR.Simple.decode_partial (Cstruct.to_string data)) with CBOR.Error m -> Error m) >>= fun (data, rest) -> extract_map data >>= fun kv -> + string_keys kv >>= fun kv -> Ok (kv, Cstruct.of_string rest) type auth_data = { @@ -132,7 +139,7 @@ type auth_data = { user_verified : bool ; sign_count : Int32.t ; attested_credential_data : (Cstruct.t * Cstruct.t * Mirage_crypto_ec.P256.Dsa.pub) option ; - extension_data : (CBOR.Simple.t * CBOR.Simple.t) list option ; + extension_data : (string * CBOR.Simple.t) list option ; } let flags byte = @@ -185,20 +192,8 @@ let parse_attestation_object data = | _ -> Error "bad attestationObject CBOR" | exception CBOR.Error m -> Error m -type response_raw = { - attestation_object : base64url_string [@key "attestationObject"]; - client_data_json : base64url_string [@key "clientDataJSON"]; -} [@@deriving of_yojson] - -type public_key_credential_raw = { - id : string; - raw_id : base64url_string [@key "rawId"]; - typ : typ [@key "type"]; - response : response_raw; -} [@@deriving of_yojson] - let of_json_or_err thing p json = - lift_err + Result.map_error (fun msg -> `Json_decoding (thing, msg, Yojson.Safe.to_string json)) (p json) @@ -218,6 +213,10 @@ let json_string thing : Yojson.Safe.t -> (string, _) result = function | `String s -> Ok s | json -> Error (`Json_decoding (thing, "non-string", Yojson.Safe.to_string json)) +let json_assoc thing : Yojson.Safe.t -> ((string * Yojson.Safe.t) list, _) result = function + | `Assoc s -> Ok s + | json -> Error (`Json_decoding (thing, "non-string", Yojson.Safe.to_string json)) + (* XXX: verify [origin] is in fact an origin *) let create origin = { origin } @@ -226,10 +225,32 @@ let rpid t = | [ _protocol ; "" ; host ] -> host | _ -> assert false -let register_response t data = - of_json "response" public_key_credential_raw_of_yojson data >>= fun credential -> +type credential_data = { + aaguid : string ; + credential_id : credential_id ; + public_key : Mirage_crypto_ec.P256.Dsa.pub ; +} + +type registration = { + user_present : bool ; + user_verified : bool ; + sign_count : Int32.t ; + attested_credential_data : credential_data ; + authenticator_extensions : (string * CBOR.Simple.t) list option ; + client_extensions : (string * Yojson.Safe.t) list ; + certificate : X509.Certificate.t option ; +} + +type register_response = { + attestation_object : base64url_string [@key "attestationObject"]; + client_data_json : base64url_string [@key "clientDataJSON"]; +} [@@deriving of_yojson] + +let register_response_of_string = + of_json "register response" register_response_of_yojson + +let register t response = (* XXX: credential.getClientExtensionResults() *) - let response = credential.response 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) @@ -245,19 +266,19 @@ let register_response t data = json_get "origin" client_data >>= json_string "origin" >>= fun origin -> guard (String.equal t.origin origin) (`Origin_mismatch (t.origin, origin)) >>= fun () -> - json_get "clientExtensions" client_data >>= fun client_extensions -> + json_get "clientExtensions" client_data >>= json_assoc "clientExtensions" >>= fun client_extensions -> Result.map_error (fun m -> `Attestation_object m) (parse_attestation_object response.attestation_object) >>= fun (auth_data, attestation_statement) -> 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 (rpid_hash, auth_data.rpid_hash)) >>= fun () -> + (`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, pubkey) -> + 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_cstruct pubkey in + 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 @@ -266,28 +287,46 @@ let register_response t data = in X509.Public_key.verify `SHA256 ~signature pk (`Message sigdata) >>= fun () -> Ok (Some cert) - end >>= fun cert -> + end >>= fun certificate -> (* check attestation cert, maybe *) (* check auth_data.attested_credential_data.credential_id is not registered ? *) - Ok (challenge, aaguid, Cstruct.to_string credential_id, pubkey, client_extensions, auth_data.user_present, auth_data.user_verified, auth_data.sign_count, auth_data.extension_data, cert) + let registration = + let attested_credential_data = { + aaguid = Cstruct.to_string aaguid ; + credential_id = Cstruct.to_string credential_id ; + public_key + } in + { + user_present = auth_data.user_present ; + user_verified = auth_data.user_verified ; + sign_count = auth_data.sign_count ; + attested_credential_data ; + authenticator_extensions = auth_data.extension_data ; + client_extensions ; + certificate ; + } + in + Ok (challenge, registration) -type auth_response_raw = { +type authentication = { + user_present : bool ; + user_verified : bool ; + sign_count : Int32.t ; + authenticator_extensions : (string * CBOR.Simple.t) list option ; + client_extensions : (string * Yojson.Safe.t) list ; +} + +type authenticate_response = { authenticator_data : base64url_string [@key "authenticatorData"]; client_data_json : base64url_string [@key "clientDataJSON"]; signature : base64url_string ; userHandle : base64url_string option ; } [@@deriving of_yojson] -type auth_assertion_raw = { - id : string; - raw_id : base64url_string [@key "rawId"]; - typ : typ [@key "type"]; - response : auth_response_raw; -} [@@deriving of_yojson] +let authenticate_response_of_string = + of_json "authenticate response" authenticate_response_of_yojson -let authentication_response t cid_keys data = - of_json "response" auth_assertion_raw_of_yojson data >>= fun assertion -> - let response = assertion.response in +let authenticate t public_key response = 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) @@ -303,16 +342,21 @@ let authentication_response t cid_keys data = json_get "origin" client_data >>= json_string "origin" >>= fun origin -> guard (String.equal t.origin origin) (`Origin_mismatch (t.origin, origin)) >>= fun () -> - json_get "clientExtensions" client_data >>= fun client_extensions -> + json_get "clientExtensions" client_data >>= json_assoc "clientExtensions" >>= fun client_extensions -> Result.map_error (fun m -> `Msg m) (parse_auth_data response.authenticator_data) >>= fun auth_data -> 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 (rpid_hash, auth_data.rpid_hash)) >>= fun () -> - Option.to_result ~none:(`Msg "no key found") - (List.assoc_opt assertion.raw_id cid_keys) >>= fun pubkey -> + (`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 - X509.Public_key.verify `SHA256 ~signature (`P256 pubkey) (`Message sigdata) >>= fun () -> - Ok (challenge, (assertion.raw_id, pubkey), client_extensions, auth_data.user_present, auth_data.user_verified, auth_data.sign_count, auth_data.extension_data) + X509.Public_key.verify `SHA256 ~signature (`P256 public_key) (`Message sigdata) >>= fun () -> + let authentication = { + user_present = auth_data.user_present ; + user_verified = auth_data.user_verified ; + sign_count = auth_data.sign_count ; + authenticator_extensions = auth_data.extension_data ; + client_extensions ; + } in + Ok (challenge, authentication) diff --git a/src/webauthn.mli b/src/webauthn.mli new file mode 100644 index 0000000..071038d --- /dev/null +++ b/src/webauthn.mli @@ -0,0 +1,65 @@ +type t + +val create : string -> t + +val rpid : t -> string + +type json_decoding_error = [ `Json_decoding of string * string * string ] + +type error = [ + json_decoding_error + | `Base64_decoding of string * string * string + | `Client_data_type_mismatch of string + | `Origin_mismatch of string * string + | `Attestation_object of string + | `Rpid_hash_mismatch of string * string + | `Missing_credential_data + | `Msg of string +] + +val pp_error : Format.formatter -> [< error ] -> unit + +type challenge + +val generate_challenge : ?size:int -> unit -> challenge * string + +val challenge_to_string : challenge -> string +val challenge_of_string : string -> challenge option +val challenge_equal : challenge -> challenge -> bool + +type credential_id = string + +type credential_data = { + aaguid : string ; + credential_id : credential_id ; + public_key : Mirage_crypto_ec.P256.Dsa.pub ; +} + +type registration = { + user_present : bool ; + user_verified : bool ; + sign_count : Int32.t ; + attested_credential_data : credential_data ; + authenticator_extensions : (string * CBOR.Simple.t) list option ; + client_extensions : (string * Yojson.Safe.t) list ; + certificate : X509.Certificate.t option ; +} + +type register_response +val register_response_of_string : string -> (register_response, json_decoding_error) result + +val register : t -> register_response -> (challenge * registration, error) result + +type authentication = { + user_present : bool ; + user_verified : bool ; + sign_count : Int32.t ; + authenticator_extensions : (string * CBOR.Simple.t) list option ; + client_extensions : (string * Yojson.Safe.t) list ; +} + +type authenticate_response +val authenticate_response_of_string : string -> (authenticate_response, json_decoding_error) result + +val authenticate : t -> Mirage_crypto_ec.P256.Dsa.pub -> authenticate_response -> + (challenge * authentication, error) result