robur/webauthn
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

provide a webauthn.mli, adapt the demo application

Browse source
This commit is contained in:
Robur 2021-10-05 15:56:20 +00:00
parent 8bf98cf42b
commit b6f99bfb16
4 changed files with 270 additions and 150 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
bin/template.ml
View file

@ -77,17 +77,11 @@ let register_view origin user =
let response = credential.response; let response = credential.response;
let attestationObject = new Uint8Array(response.attestationObject); let attestationObject = new Uint8Array(response.attestationObject);
let clientDataJSON = new Uint8Array(response.clientDataJSON); let clientDataJSON = new Uint8Array(response.clientDataJSON);
let rawId = new Uint8Array(credential.rawId);
let body = let body =
JSON.stringify({ JSON.stringify({
id: credential.id, attestationObject: bufferEncode(attestationObject),
rawId: bufferEncode(rawId), clientDataJSON: bufferEncode(clientDataJSON),
type: credential.type,
response: {
attestationObject: bufferEncode(attestationObject),
clientDataJSON: bufferEncode(clientDataJSON),
},
}); });
let headers = {'Content-type': "application/json; charset=utf-8"}; 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 }) navigator.credentials.get({ publicKey: request_options })
.then(function (assertion) { .then(function (assertion) {
let response = assertion.response; let response = assertion.response;
let rawId = new Uint8Array(assertion.rawId);
let authenticatorData = new Uint8Array(assertion.response.authenticatorData); let authenticatorData = new Uint8Array(assertion.response.authenticatorData);
let clientDataJSON = new Uint8Array(assertion.response.clientDataJSON); let clientDataJSON = new Uint8Array(assertion.response.clientDataJSON);
let signature = new Uint8Array(assertion.response.signature); let signature = new Uint8Array(assertion.response.signature);
@ -150,20 +143,15 @@ let authenticate_view challenge credentials user =
let body = let body =
JSON.stringify({ JSON.stringify({
id: assertion.id, authenticatorData: bufferEncode(authenticatorData),
rawId: bufferEncode(rawId), clientDataJSON: bufferEncode(clientDataJSON),
type: assertion.type, signature: bufferEncode(signature),
response: { 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 headers = {'Content-type': "application/json; charset=utf-8"};
let username = window.location.pathname.substring("/authenticate/".length); 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) fetch(request)
.then(function (response) { .then(function (response) {
if (!response.ok) { if (!response.ok) {

173
bin/webauthn_demo.ml
View file

@ -8,7 +8,7 @@ let find_username username =
users None users None
module KhPubHashtbl = Hashtbl.Make(struct 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 cs_of_pub = Mirage_crypto_ec.P256.Dsa.pub_to_cstruct
let equal (kh, pub) (kh', pub') = let equal (kh, pub) (kh', pub') =
String.equal kh kh' && Cstruct.equal (cs_of_pub pub) (cs_of_pub 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; then KhPubHashtbl.replace counters kh_pub counter;
r 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 = let remove_registration_challenge userid challenge =
match Hashtbl.find_opt registration_challenges userid with match Hashtbl.find_opt registration_challenges userid with
| None -> () | None -> ()
| Some (username, challenges) -> | 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 if challenges = [] then
Hashtbl.remove registration_challenges userid Hashtbl.remove registration_challenges userid
else else
Hashtbl.replace registration_challenges userid (username, challenges) 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 = let remove_authentication_challenge userid challenge =
match Hashtbl.find_opt authentication_challenges userid with match Hashtbl.find_opt authentication_challenges userid with
| None -> () | None -> ()
| Some challenges -> | 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 if challenges = [] then
Hashtbl.remove authentication_challenges userid Hashtbl.remove authentication_challenges userid
else else
@ -75,7 +75,7 @@ let add_routes t =
let registration_challenge req = let registration_challenge req =
let user = Dream.param "user" req in 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 let userid, credentials = match find_username user with
| None -> gen_data ~alphabet:Base64.uri_safe_alphabet 8, [] | None -> gen_data ~alphabet:Base64.uri_safe_alphabet 8, []
| Some (userid, (_, credentials)) -> userid, List.map (fun (_, cid, _) -> cid) credentials | Some (userid, (_, credentials)) -> userid, List.map (fun (_, cid, _) -> cid) credentials
@ -85,7 +85,6 @@ let add_routes t =
Option.value ~default:[] Option.value ~default:[]
in in
Hashtbl.replace registration_challenges userid (user, challenge :: challenges); Hashtbl.replace registration_challenges userid (user, challenge :: challenges);
let challenge_b64 = (Base64.encode_string challenge) in
let json = `Assoc [ let json = `Assoc [
"challenge", `String challenge_b64 ; "challenge", `String challenge_b64 ;
"user", `Assoc [ "user", `Assoc [
@ -109,49 +108,55 @@ let add_routes t =
Logs.warn (fun m -> m "no challenge found"); Logs.warn (fun m -> m "no challenge found");
Dream.respond ~status:`Bad_Request "Bad request." Dream.respond ~status:`Bad_Request "Bad request."
| Some (username, challenges) -> | Some (username, challenges) ->
match Webauthn.register_response t body with match Webauthn.register_response_of_string body with
| Error e -> | Error e ->
Logs.warn (fun m -> m "error %a" Webauthn.pp_error e); Logs.warn (fun m -> m "error %a" Webauthn.pp_error e);
let err = to_string e in let err = to_string e in
Flash_message.put_flash "" ("Registration failed " ^ err) req; Flash_message.put_flash "" ("Registration failed " ^ err) req;
Dream.json "false" Dream.json "false"
| Ok (challenge, _aaguid, credential_id, pubkey, _client_extensions, user_present, | Ok response ->
user_verified, sig_count, _authenticator_extensions, attestation_cert) -> match Webauthn.register t response with
if not (List.mem challenge challenges) then begin | Error e ->
Logs.warn (fun m -> m "challenge invalid"); Logs.warn (fun m -> m "error %a" Webauthn.pp_error e);
Flash_message.put_flash "" "Registration failed: invalid challenge" req; let err = to_string e in
Flash_message.put_flash "" ("Registration failed " ^ err) req;
Dream.json "false" Dream.json "false"
end else begin | Ok (challenge, { user_present ; user_verified ; sign_count ; attested_credential_data ; certificate ; _ }) ->
remove_registration_challenge userid challenge; let { Webauthn.credential_id ; public_key ; _ } = attested_credential_data in
ignore (check_counter (credential_id, pubkey) sig_count); if not (List.exists (Webauthn.challenge_equal challenge) challenges) then begin
Logs.info (fun m -> m "user present %B user verified %B" user_present user_verified); Logs.warn (fun m -> m "challenge invalid");
Logs.app (fun m -> m "challenge for user %S" username); Flash_message.put_flash "" "Registration failed: invalid challenge" req;
match Dream.session "authenticated_as" req, Hashtbl.find_opt users userid with Dream.json "false"
| _, None -> end else begin
Logs.app (fun m -> m "registered %s: %S" username credential_id); remove_registration_challenge userid challenge;
Hashtbl.replace users userid (username, [ (pubkey, credential_id, attestation_cert) ]); ignore (check_counter (credential_id, public_key) sign_count);
Dream.invalidate_session req >>= fun () -> Logs.info (fun m -> m "register %S user present %B user verified %B"
Flash_message.put_flash "" username user_present user_verified);
(Printf.sprintf "Successfully registered as %s! <a href=\"/authenticate/%s\">[authenticate]</a>" username userid) match Dream.session "authenticated_as" req, Hashtbl.find_opt users userid with
req; | _, None ->
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
Logs.app (fun m -> m "registered %s: %S" username credential_id); 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 () -> Dream.invalidate_session req >>= fun () ->
Flash_message.put_flash "" Flash_message.put_flash ""
(Printf.sprintf "Successfully registered as %s! <a href=\"/authenticate/%s\">[authenticate]</a>" username userid) (Printf.sprintf "Successfully registered as %s! <a href=\"/authenticate/%s\">[authenticate]</a>" username userid)
req; req;
Dream.json "true" Dream.json "true"
end else | Some session_user, Some (username', keys) ->
(Logs.info (fun m -> m "session_user %s, user %s (user in users table %s)" session_user username username'); if String.equal username session_user && String.equal username username' then begin
Dream.json ~status:`Forbidden "false") Logs.app (fun m -> m "registered %s: %S" username credential_id);
| None, Some _keys -> Hashtbl.replace users userid (username, ((public_key, credential_id, certificate) :: keys)) ;
Logs.app (fun m -> m "no session user"); Dream.invalidate_session req >>= fun () ->
Dream.json ~status:`Forbidden "false" Flash_message.put_flash ""
end (Printf.sprintf "Successfully registered as %s! <a href=\"/authenticate/%s\">[authenticate]</a>" 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 in
let authenticate req = let authenticate req =
@ -162,51 +167,69 @@ let add_routes t =
Dream.respond ~status:`Bad_Request "Bad request." Dream.respond ~status:`Bad_Request "Bad request."
| Some (username, keys) -> | Some (username, keys) ->
let credentials = List.map (fun (_, c, _) -> Base64.encode_string c) keys in 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 let challenges = Option.value ~default:[] (Hashtbl.find_opt authentication_challenges userid) in
Hashtbl.replace authentication_challenges userid (challenge :: challenges); 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 in
let authenticate_finish req = let authenticate_finish req =
let userid = Dream.param "userid" req in let userid = Dream.param "userid" req
Dream.body req >>= fun body -> and b64_credential_id = Dream.param "credential_id" req
Logs.debug (fun m -> m "received body: %s" body); in
match Hashtbl.find_opt authentication_challenges userid with match Base64.decode ~alphabet:Base64.uri_safe_alphabet ~pad:false b64_credential_id with
| None -> Dream.respond ~status:`Internal_Server_Error "Internal server error." | Error `Msg err ->
| Some challenges -> Logs.err (fun m -> m "credential id (%S) is not base64 uri safe: %s" b64_credential_id err);
match Hashtbl.find_opt users userid with Dream.json ~status:`Bad_Request "credential ID decoding error"
| None -> | 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); Logs.warn (fun m -> m "no user found with id %s" userid);
Dream.respond ~status:`Bad_Request "Bad request." Dream.respond ~status:`Bad_Request "Bad request."
| Some (username, keys) -> | Some challenges, Some (username, keys) ->
let cid_keys = List.map (fun (key, credential_id, _) -> credential_id, key) keys in match List.find_opt (fun (_, cid, _) -> String.equal cid credential_id) keys with
match Webauthn.authentication_response t cid_keys body with | None ->
| Ok (challenge, credential, _client_extensions, _user_present, _user_verified, counter, _authenticator_extensions) -> Logs.warn (fun m -> m "no key found with credential id %s" b64_credential_id);
if not (List.mem challenge challenges) then begin Dream.respond ~status:`Bad_Request "Bad request."
Logs.warn (fun m -> m "invalid challenge"); | Some (pubkey, _, _) ->
Flash_message.put_flash "" "Authentication failure: invalid challenge" req; 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" Dream.json "false"
end else begin | Ok authenticate_response ->
remove_authentication_challenge userid challenge; match Webauthn.authenticate t pubkey authenticate_response with
if check_counter credential counter | Ok (challenge, { user_present ; user_verified ; sign_count ; _ }) ->
then begin Logs.info (fun m -> m "authenticate %S user present %B user verified %B"
Flash_message.put_flash "" "Successfully authenticated" req; username user_present user_verified);
Dream.put_session "authenticated_as" username req >>= fun () -> if not (List.exists (Webauthn.challenge_equal challenge) challenges) then begin
Dream.json "true" Logs.warn (fun m -> m "invalid challenge");
end else begin Flash_message.put_flash "" "Authentication failure: invalid challenge" req;
Logs.warn (fun m -> m "credential %S for user %S: counter not strictly increasing! \ Dream.json "false"
Got %ld, expected >%ld. webauthn device compromised?" end else begin
(fst credential) username counter (KhPubHashtbl.find counters credential)); remove_authentication_challenge userid challenge;
Flash_message.put_flash "" "Authentication failure: key compromised?" req; 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" 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 in
let logout req = let logout req =
@ -225,7 +248,7 @@ let add_routes t =
Dream.get "/registration-challenge/:user" registration_challenge; Dream.get "/registration-challenge/:user" registration_challenge;
Dream.post "/register_finish/:userid" register_finish; Dream.post "/register_finish/:userid" register_finish;
Dream.get "/authenticate/:userid" authenticate; 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.post "/logout" logout;
Dream.get "/static/base64.js" base64; Dream.get "/static/base64.js" base64;
] ]

156
src/webauthn.ml
View file

@ -1,12 +1,13 @@
type key_handle = string type credential_id = string
type json_decoding_error = [ `Json_decoding of string * string * string ]
type error = [ type error = [
| `Json_decoding of string * string * string json_decoding_error
| `Base64_decoding of string * string * string | `Base64_decoding of string * string * string
| `Client_data_type_mismatch of string | `Client_data_type_mismatch of string
| `Origin_mismatch of string * string | `Origin_mismatch of string * string
| `Attestation_object of string | `Attestation_object of string
| `Rpid_hash_mismatch of Cstruct.t * Cstruct.t | `Rpid_hash_mismatch of string * string
| `Missing_credential_data | `Missing_credential_data
| `Msg of string | `Msg of string
] ]
@ -23,7 +24,8 @@ let pp_error ppf = function
| `Attestation_object msg -> | `Attestation_object msg ->
Fmt.pf ppf "attestation object error %s" msg Fmt.pf ppf "attestation object error %s" msg
| `Rpid_hash_mismatch (should, is) -> | `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" | `Missing_credential_data -> Fmt.string ppf "missing credential data"
| `Msg msg -> Fmt.pf ppf "error %s" msg | `Msg msg -> Fmt.pf ppf "error %s" msg
@ -33,12 +35,18 @@ type t = {
type challenge = string 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 = let b64_dec thing s =
lift_err Result.map_error
(function `Msg m -> `Base64_decoding (thing, m, s)) (function `Msg m -> `Base64_decoding (thing, m, s))
Base64.(decode ~pad:false ~alphabet:uri_safe_alphabet 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) Base64.(decode ~pad:false ~alphabet:uri_safe_alphabet b64)
|> Result.map_error (function `Msg m -> m) |> Result.map_error (function `Msg m -> m)
| _ -> Error "base64url_string" | _ -> 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 = let extract_k_i map k : (_, string) result =
Option.to_result ~none:"key not present" Option.to_result ~none:"key not present"
@ -120,10 +118,19 @@ let parse_attested_credential_data data =
cose_pubkey pubkey >>= fun pubkey -> cose_pubkey pubkey >>= fun pubkey ->
Ok ((aaguid, cid, pubkey), Cstruct.of_string rest) 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 = let parse_extension_data data =
(try Ok (CBOR.Simple.decode_partial (Cstruct.to_string data)) (try Ok (CBOR.Simple.decode_partial (Cstruct.to_string data))
with CBOR.Error m -> Error m) >>= fun (data, rest) -> with CBOR.Error m -> Error m) >>= fun (data, rest) ->
extract_map data >>= fun kv -> extract_map data >>= fun kv ->
string_keys kv >>= fun kv ->
Ok (kv, Cstruct.of_string rest) Ok (kv, Cstruct.of_string rest)
type auth_data = { type auth_data = {
@ -132,7 +139,7 @@ type auth_data = {
user_verified : bool ; user_verified : bool ;
sign_count : Int32.t ; sign_count : Int32.t ;
attested_credential_data : (Cstruct.t * Cstruct.t * Mirage_crypto_ec.P256.Dsa.pub) option ; 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 = let flags byte =
@ -185,20 +192,8 @@ let parse_attestation_object data =
| _ -> Error "bad attestationObject CBOR" | _ -> Error "bad attestationObject CBOR"
| exception CBOR.Error m -> Error m | 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 = let of_json_or_err thing p json =
lift_err Result.map_error
(fun msg -> `Json_decoding (thing, msg, Yojson.Safe.to_string json)) (fun msg -> `Json_decoding (thing, msg, Yojson.Safe.to_string json))
(p json) (p json)
@ -218,6 +213,10 @@ let json_string thing : Yojson.Safe.t -> (string, _) result = function
| `String s -> Ok s | `String s -> Ok s
| json -> Error (`Json_decoding (thing, "non-string", Yojson.Safe.to_string json)) | 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 *) (* XXX: verify [origin] is in fact an origin *)
let create origin = { origin } let create origin = { origin }
@ -226,10 +225,32 @@ let rpid t =
| [ _protocol ; "" ; host ] -> host | [ _protocol ; "" ; host ] -> host
| _ -> assert false | _ -> assert false
let register_response t data = type credential_data = {
of_json "response" public_key_credential_raw_of_yojson data >>= fun credential -> 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() *) (* XXX: credential.getClientExtensionResults() *)
let response = credential.response in
let client_data_hash = Mirage_crypto.Hash.SHA256.digest let client_data_hash = Mirage_crypto.Hash.SHA256.digest
(Cstruct.of_string response.client_data_json) in (Cstruct.of_string response.client_data_json) in
begin try Ok (Yojson.Safe.from_string response.client_data_json) 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 -> json_get "origin" client_data >>= json_string "origin" >>= fun origin ->
guard (String.equal t.origin origin) guard (String.equal t.origin origin)
(`Origin_mismatch (t.origin, origin)) >>= fun () -> (`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) Result.map_error (fun m -> `Attestation_object m)
(parse_attestation_object response.attestation_object) >>= fun (auth_data, attestation_statement) -> (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 let rpid_hash = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string (rpid t)) in
guard (Cstruct.equal auth_data.rpid_hash rpid_hash) 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 *) (* verify user present, user verified flags in auth_data.flags *)
Option.to_result ~none:`Missing_credential_data 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 begin match attestation_statement with
| None -> Ok None | None -> Ok None
| Some (cert, signature) -> | 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 [ let sigdata = Cstruct.concat [
Cstruct.create 1 ; rpid_hash ; client_data_hash ; credential_id ; pub_cs Cstruct.create 1 ; rpid_hash ; client_data_hash ; credential_id ; pub_cs
] in ] in
@ -266,28 +287,46 @@ let register_response t data =
in in
X509.Public_key.verify `SHA256 ~signature pk (`Message sigdata) >>= fun () -> X509.Public_key.verify `SHA256 ~signature pk (`Message sigdata) >>= fun () ->
Ok (Some cert) Ok (Some cert)
end >>= fun cert -> end >>= fun certificate ->
(* check attestation cert, maybe *) (* check attestation cert, maybe *)
(* check auth_data.attested_credential_data.credential_id is not registered ? *) (* 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"]; authenticator_data : base64url_string [@key "authenticatorData"];
client_data_json : base64url_string [@key "clientDataJSON"]; client_data_json : base64url_string [@key "clientDataJSON"];
signature : base64url_string ; signature : base64url_string ;
userHandle : base64url_string option ; userHandle : base64url_string option ;
} [@@deriving of_yojson] } [@@deriving of_yojson]
type auth_assertion_raw = { let authenticate_response_of_string =
id : string; of_json "authenticate response" authenticate_response_of_yojson
raw_id : base64url_string [@key "rawId"];
typ : typ [@key "type"];
response : auth_response_raw;
} [@@deriving of_yojson]
let authentication_response t cid_keys data = let authenticate t public_key response =
of_json "response" auth_assertion_raw_of_yojson data >>= fun assertion ->
let response = assertion.response in
let client_data_hash = Mirage_crypto.Hash.SHA256.digest let client_data_hash = Mirage_crypto.Hash.SHA256.digest
(Cstruct.of_string response.client_data_json) in (Cstruct.of_string response.client_data_json) in
begin try Ok (Yojson.Safe.from_string response.client_data_json) 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 -> json_get "origin" client_data >>= json_string "origin" >>= fun origin ->
guard (String.equal t.origin origin) guard (String.equal t.origin origin)
(`Origin_mismatch (t.origin, origin)) >>= fun () -> (`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) Result.map_error (fun m -> `Msg m)
(parse_auth_data response.authenticator_data) >>= fun auth_data -> (parse_auth_data response.authenticator_data) >>= fun auth_data ->
let rpid_hash = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string (rpid t)) in let rpid_hash = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string (rpid t)) in
guard (Cstruct.equal auth_data.rpid_hash rpid_hash) 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 () ->
Option.to_result ~none:(`Msg "no key found")
(List.assoc_opt assertion.raw_id cid_keys) >>= fun pubkey ->
let sigdata = Cstruct.concat [ Cstruct.of_string response.authenticator_data ; client_data_hash ] let sigdata = Cstruct.concat [ Cstruct.of_string response.authenticator_data ; client_data_hash ]
and signature = Cstruct.of_string response.signature and signature = Cstruct.of_string response.signature
in in
X509.Public_key.verify `SHA256 ~signature (`P256 pubkey) (`Message sigdata) >>= fun () -> X509.Public_key.verify `SHA256 ~signature (`P256 public_key) (`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) 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)

65
src/webauthn.mli Normal file
View file

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