Add passkey support

bin/main.ml

···
   ; (post, "/account/migrate", Api.Account_.Migrate.post_handler)
   ; (post, "/account/switch", Api.Account_.Login.switch_account_handler)
   ; (get, "/account/logout", Api.Account_.Logout.handler)
+  ; (* passkey management (authed) *)
+    (get, "/account/passkeys", Api.Account_.Passkeys.list_handler)
+  ; ( get
+    , "/account/passkeys/register/options"
+    , Api.Account_.Passkeys.register_options_handler )
+  ; ( post
+    , "/account/passkeys/register/verify"
+    , Api.Account_.Passkeys.register_verify_handler )
+  ; (delete, "/account/passkeys/:id", Api.Account_.Passkeys.delete_handler)
+  ; (post, "/account/passkeys/:id/rename", Api.Account_.Passkeys.rename_handler)
+  ; (* passkey login (unauthed) *)
+    ( get
+    , "/account/passkeys/login/options"
+    , Api.Account_.Passkeys.login_options_handler )
+  ; ( post
+    , "/account/passkeys/login/verify"
+    , Api.Account_.Passkeys.login_verify_handler )
   ; (* admin ui *)
     (get, "/admin", Api.Admin_.Index.handler)
   ; (get, "/admin/login", Api.Admin_.Login.get_handler)

dune-project

···
   (ppx_deriving_yojson (>= 3.9.1))
   ppx_rapper
   ppx_rapper_lwt
+  (webauthn (>= 0.2.0))
   (alcotest :with-test)
   crunch
   (ocamlformat-mlx :with-dev-setup)

frontend/client/WebAuthn.mlx

···
+external browserSupportsWebAuthn : unit -> bool = "browserSupportsWebAuthn"
+[@@mel.module "@simplewebauthn/browser"]
+
+external browserSupportsWebAuthnAutofill : unit -> bool Js.Promise.t
+  = "browserSupportsWebAuthnAutofill"
+[@@mel.module "@simplewebauthn/browser"]
+
+type registration_options = {optionsJSON: Js.Json.t}
+
+external startRegistration : registration_options -> Js.Json.t Js.Promise.t
+  = "startRegistration"
+[@@mel.module "@simplewebauthn/browser"]
+
+type auth_options = {optionsJSON: Js.Json.t; useBrowserAutofill: bool}
+
+external startAuthentication : auth_options -> Js.Json.t Js.Promise.t
+  = "startAuthentication"
+[@@mel.module "@simplewebauthn/browser"]
+
+external startAuthenticationSimple : Js.Json.t -> Js.Json.t Js.Promise.t
+  = "startAuthentication"
+[@@mel.module "@simplewebauthn/browser"]

frontend/src/components/AccountSidebar.mlx

···
     footer=(<a
               href=( "/account/logout?did="
                    ^ Js.Global.encodeURIComponent current_user.did )>
-              <Button kind=`Secondary className="mt-2 justify-start pl-0">
+              <Button kind=`Secondary className="mt-2 justify-start pl-0 active:shadow-none focus-visible:shadow-none">
                 (string "log out")
               </Button>
             </a>)

frontend/src/dune

···
   server-reason-react.react
   server-reason-react.reactDom
   dream
+  melange-fetch
   melange-json-native
   melange-webapi)
  (preprocess

frontend/src/templates/AccountPage.mlx

···
   {did: string; handle: string; avatar_data_uri: string option [@default None]}
 [@@deriving json]
 
+type passkey_display =
+  { id: int
+  ; name: string
+  ; created_at: int
+  ; last_used_at: int option [@default None] }
+[@@deriving json]
+
 type props =
   { current_user: actor
   ; logged_in_users: actor list
···
   ; delete_pending: bool [@default false]
   ; error: string option [@default None]
   ; success: string option [@default None]
-  ; delete_error: string option [@default None] }
+  ; delete_error: string option [@default None]
+  ; passkeys: passkey_display list [@default []] }
 [@@deriving json]
 
 let[@react.component] make
···
        ; delete_pending
        ; error
        ; success
-       ; delete_error } :
+       ; delete_error
+       ; passkeys } :
         props ) () =
   let emailModalOpen, setEmailModalOpen =
     useState (fun () -> email_change_pending)
···
   let importLoading, setImportLoading = useState (fun () -> false) in
   let importError, setImportError = useState (fun () -> None) in
   let importSuccess, setImportSuccess = useState (fun () -> false) in
+  let passkeysState, setPasskeysState = useState (fun () -> passkeys) in
+  let addingPasskey, setAddingPasskey = useState (fun () -> false) in
+  let passkeyName, setPasskeyName = useState (fun () -> "") in
+  let passkeyError, setPasskeyError = useState (fun () -> None) in
+  let webauthnSupported, setWebauthnSupported = useState (fun () -> false) in
+  let currentWebAuthnOptions = useRef None in
   let fileInputRef : Dom.element Js.nullable React.ref =
     useRef Js.Nullable.null
+  in
+  let _ =
+    React.useEffect0 (fun () ->
+        setWebauthnSupported (fun _ -> WebAuthn.browserSupportsWebAuthn ()) ;
+        None )
   in
   <div
     className="w-full h-full max-w-[816px] px-8 pt-16 mx-auto flex flex-col \
···
                               setEmailErrorState (fun _ ->
                                   Some "An error occurred. Please try again." ) ;
                               Js.Promise.resolve () ) )
-                        |> Js.Promise.catch (fun _ ->
+                        |> Js.Promise.catch (fun e ->
+                            Js.Console.error (Obj.magic e) ;
                             setEmailLoading (fun _ -> false) ;
                             setEmailErrorState (fun _ ->
                                 Some "An error occurred. Please try again." ) ;
···
                                       Some
                                         "An error occurred. Please try again." ) ;
                                   Js.Promise.resolve () ) )
-                            |> Js.Promise.catch (fun _ ->
+                            |> Js.Promise.catch (fun e ->
+                                Js.Console.error (Obj.magic e) ;
                                 setConfirmEmailLoading (fun _ -> false) ;
                                 setConfirmEmailError (fun _ ->
                                     Some "An error occurred. Please try again." ) ;
···
                                       Some "Import failed. Please try again." ) ;
                                   Js.Promise.resolve ()
                                 end )
-                            |> Js.Promise.catch (fun _ ->
+                            |> Js.Promise.catch (fun e ->
+                                Js.Console.error (Obj.magic e) ;
                                 setImportLoading (fun _ -> false) ;
                                 setImportError (fun _ ->
                                     Some "An error occurred. Please try again." ) ;
···
             </section>
             <section className="mt-8">
               <h2 className="text-xl font-serif text-mana-200 mb-1">
+                (string "passkeys")
+              </h2>
+              <p className="text-mist-100 mb-4">
+                (string
+                   "Passkeys are stored on your device, providing a more \
+                    convenient alternative to logging in with a password." )
+              </p>
+              <ClientOnly
+                fallback=(<p className="text-mist-80 text-sm">
+                            (string "Loading passkeys...")
+                          </p>)>
+                [%browser_only
+                  fun () ->
+                    let formatDate ts =
+                      let d = Js.Date.fromFloat (Float.of_int ts) in
+                      Js.Date.toLocaleDateString d
+                    in
+                    let addPasskey () =
+                      setAddingPasskey (fun _ -> true) ;
+                      setPasskeyError (fun _ -> None) ;
+                      let _ =
+                        Fetch.fetch "/account/passkeys/register/options"
+                        |> Js.Promise.then_ (fun response ->
+                            if Fetch.Response.ok response then
+                              Fetch.Response.json response
+                            else Js.Exn.raiseError "Failed to get options" )
+                        |> Js.Promise.then_ (fun options ->
+                            currentWebAuthnOptions.current <- Some options ;
+                            WebAuthn.startRegistration {optionsJSON= options} )
+                        |> Js.Promise.then_ (fun credential ->
+                            let challenge =
+                              Js.Dict.unsafeGet
+                                (Obj.magic currentWebAuthnOptions.current)
+                                "challenge"
+                            in
+                            let body =
+                              Js.Json.object_
+                                (Js.Dict.fromArray
+                                   [| ( "response"
+                                      , Js.Json.string
+                                          (Js.Json.stringify credential) )
+                                    ; ("challenge", challenge)
+                                    ; ( "name"
+                                      , Js.Json.string
+                                          ( if passkeyName = "" then "Passkey"
+                                            else passkeyName ) ) |] )
+                            in
+                            Fetch.fetchWithInit
+                              "/account/passkeys/register/verify"
+                              (Fetch.RequestInit.make ~method_:Post
+                                 ~body:
+                                   (Fetch.BodyInit.make (Js.Json.stringify body))
+                                 ~headers:
+                                   (Fetch.HeadersInit.makeWithArray
+                                      [|("Content-Type", "application/json")|] )
+                                 () ) )
+                        |> Js.Promise.then_ (fun response ->
+                            setAddingPasskey (fun _ -> false) ;
+                            if Fetch.Response.ok response then begin
+                              setPasskeyName (fun _ -> "") ;
+                              Fetch.fetch "/account/passkeys"
+                              |> Js.Promise.then_ (fun r ->
+                                  Fetch.Response.json r )
+                              |> Js.Promise.then_ (fun json ->
+                                  let pks : passkey_display list =
+                                    Js.Dict.unsafeGet (Obj.magic json)
+                                      "passkeys"
+                                    |> Obj.magic |> Array.to_list
+                                  in
+                                  setPasskeysState (fun _ -> pks) ;
+                                  Js.Promise.resolve () )
+                            end
+                            else begin
+                              setPasskeyError (fun _ ->
+                                  Some "Failed to register passkey" ) ;
+                              Fetch.Response.text response
+                              |> Js.Promise.then_ (fun e ->
+                                  Js.Console.error e ; Js.Promise.resolve () )
+                            end )
+                        |> Js.Promise.catch (fun e ->
+                            Js.Console.error (Obj.magic e) ;
+                            setAddingPasskey (fun _ -> false) ;
+                            setPasskeyError (fun _ ->
+                                Some "Passkey registration cancelled or failed" ) ;
+                            Js.Promise.resolve () )
+                      in
+                      ()
+                    in
+                    let deletePasskey id =
+                      let _ =
+                        Fetch.fetchWithInit
+                          ("/account/passkeys/" ^ string_of_int id)
+                          (Fetch.RequestInit.make ~method_:Delete ())
+                        |> Js.Promise.then_ (fun response ->
+                            if Fetch.Response.ok response then
+                              setPasskeysState (fun ps ->
+                                  List.filter (fun p -> p.id <> id) ps ) ;
+                            Js.Promise.resolve () )
+                      in
+                      ()
+                    in
+                    if not webauthnSupported then
+                      <p className="text-mist-80 text-sm">
+                        (string "Your browser doesn't support passkeys.")
+                      </p>
+                    else
+                      <div>
+                        ( if List.length passkeysState = 0 then
+                            <p className="text-mist-80 text-sm mb-4">
+                              (string "You haven't added any passkeys yet.")
+                            </p>
+                          else
+                            <ul className="mb-4 space-y-2">
+                              ( List.map
+                                  (fun (pk : passkey_display) ->
+                                    <li
+                                      key=(string_of_int pk.id)
+                                      className="flex items-center \
+                                                 justify-between p-3 border \
+                                                 border-mist-60 rounded-lg">
+                                      <div>
+                                        <span
+                                          className="font-medium text-mist-100">
+                                          (string pk.name)
+                                        </span>
+                                        <span
+                                          className="text-sm text-mist-80 ml-2">
+                                          (string
+                                             ( {js|⸱ |js}
+                                             ^ formatDate pk.created_at ) )
+                                        </span>
+                                      </div>
+                                      <button
+                                        type_="button"
+                                        className="p-1 text-phoenix-100 \
+                                                   hover:text-phoenix-200 \
+                                                   cursor-pointer"
+                                        onClick=(fun _ -> deletePasskey pk.id)>
+                                        <TrashIcon className="w-4 h-4" />
+                                      </button>
+                                    </li> )
+                                  passkeysState
+                              |> Array.of_list |> React.array )
+                            </ul> )
+                        <div className="flex flex-row gap-x-3">
+                          <div className="flex-1">
+                            <Input
+                              name="passkey_name"
+                              label="Passkey name"
+                              placeholder="My Little Passkey"
+                              showIndicator=false
+                              value=passkeyName
+                              onChange=(fun e ->
+                                           setPasskeyName (fun _ ->
+                                               (Event.Form.target e)##value ) )
+                            />
+                          </div>
+                          <div className="self-end">
+                            <Button
+                              type_="button"
+                              disabled=addingPasskey
+                              onClick=(fun _ -> addPasskey ())>
+                              (string
+                                 (if addingPasskey then "adding..." else "add") )
+                            </Button>
+                          </div>
+                        </div>
+                        ( match passkeyError with
+                        | Some err ->
+                            <span
+                              className="inline-flex items-center \
+                                         text-phoenix-100 text-sm mt-2">
+                              <CircleAlertIcon className="w-4 h-4 mr-2" />
+                              (string err)
+                            </span>
+                        | None ->
+                            null )
+                      </div>]
+              </ClientOnly>
+            </section>
+            <section className="mt-8">
+              <h2 className="text-xl font-serif text-mana-200 mb-1">
                 (string "danger zone")
               </h2>
               <p className="text-mist-100 mb-1">
···
                                 setDeleteErrorState (fun _ ->
                                     Some "An error occurred. Please try again." ) ;
                                 Js.Promise.resolve () ) )
-                          |> Js.Promise.catch (fun _ ->
+                          |> Js.Promise.catch (fun e ->
+                              Js.Console.error (Obj.magic e) ;
                               setDeleteLoading (fun _ -> false) ;
                               setDeleteErrorState (fun _ ->
                                   Some "An error occurred. Please try again." ) ;

frontend/src/templates/LoginPage.mlx

···
+[@@@ocaml.warning "-26-27"]
+
 open Melange_json.Primitives
 open React
 
···
 
 let[@react.component] make ~props:({redirect_url; csrf_token; error} : props) ()
     =
+  let passkeyError, setPasskeyError = useState (fun () -> None) in
+  let passkeyLoading, setPasskeyLoading = useState (fun () -> false) in
+  let currentOptions = useRef (None : Js.Json.t option) in
+  let _ =
+    React.useEffect0 (fun () ->
+        let _ =
+          WebAuthn.browserSupportsWebAuthnAutofill ()
+          |> Js.Promise.then_ (fun supported ->
+              if supported then begin
+                Fetch.fetch "/account/passkeys/login/options"
+                |> Js.Promise.then_ (fun response ->
+                    if Fetch.Response.ok response then
+                      Fetch.Response.json response
+                    else Js.Exn.raiseError "Failed to get options" )
+                |> Js.Promise.then_ (fun options ->
+                    currentOptions.current <- Some options ;
+                    WebAuthn.startAuthentication
+                      {optionsJSON= options; useBrowserAutofill= true} )
+                |> Js.Promise.then_ (fun credential ->
+                    setPasskeyLoading (fun _ -> true) ;
+                    let challenge =
+                      match currentOptions.current with
+                      | Some opts ->
+                          Js.Dict.unsafeGet (Obj.magic opts) "challenge"
+                      | None ->
+                          Js.Json.string ""
+                    in
+                    let body =
+                      Js.Json.object_
+                        (Js.Dict.fromArray
+                           [| ( "response"
+                              , Js.Json.string (Js.Json.stringify credential) )
+                            ; ("challenge", challenge) |] )
+                    in
+                    Fetch.fetchWithInit
+                      ( "/account/passkeys/login/verify?redirect_url="
+                      ^ Js.Global.encodeURIComponent redirect_url )
+                      (Fetch.RequestInit.make ~method_:Post
+                         ~body:(Fetch.BodyInit.make (Js.Json.stringify body))
+                         ~headers:
+                           (Fetch.HeadersInit.makeWithArray
+                              [|("Content-Type", "application/json")|] )
+                         () ) )
+                |> Js.Promise.then_ (fun response ->
+                    setPasskeyLoading (fun _ -> false) ;
+                    if Fetch.Response.ok response then
+                      Fetch.Response.json response
+                      |> Js.Promise.then_ (fun json ->
+                          let redirect =
+                            Js.Dict.unsafeGet (Obj.magic json) "redirect"
+                            |> Js.Json.decodeString
+                            |> Option.value ~default:"/account"
+                          in
+                          Webapi.Dom.(Window.setLocation window redirect) ;
+                          Js.Promise.resolve () )
+                    else begin
+                      setPasskeyError (fun _ ->
+                          Some "Passkey authentication failed" ) ;
+                      Js.Promise.resolve ()
+                    end )
+                |> Js.Promise.catch (fun _ ->
+                    (* user cancelled or error *)
+                    Js.Promise.resolve () )
+              end
+              else Js.Promise.resolve () )
+        in
+        None )
+  in
   <main className="w-full h-auto max-w-xs px-4 sm:px-0 my-auto">
     <h1 className="text-2xl font-serif text-mana-200 mb-2">
       (string "sign in")
···
     </span>
     <form className="w-full flex flex-col mt-4 mb-2 gap-y-2">
       <input type_="hidden" name="dream.csrf" value=csrf_token />
-      <Input sr_only=true name="identifier" type_="text" label="identifier" />
+      <Input
+        sr_only=true
+        name="identifier"
+        type_="text"
+        label="identifier"
+        autoComplete="username webauthn"
+      />
       <Input sr_only=true name="password" type_="password" label="password" />
       <input type_="hidden" name="redirect_url" value=redirect_url />
       ( match error with
-      | Some error ->
+      | Some err ->
           <span className="inline-flex items-center text-phoenix-100 text-sm">
-            <CircleAlertIcon className="w-4 h-4 mr-2" /> (string error)
+            <CircleAlertIcon className="w-4 h-4 mr-2" /> (string err)
+          </span>
+      | None ->
+          null )
+      ( match passkeyError with
+      | Some err ->
+          <span className="inline-flex items-center text-phoenix-100 text-sm">
+            <CircleAlertIcon className="w-4 h-4 mr-2" /> (string err)
           </span>
       | None ->
           null )
       <Button type_="submit" formMethod="post" className="mt-2">
-        (string "sign in")
+        (string (if passkeyLoading then "signing in..." else "sign in"))
       </Button>
     </form>
     <span className="text-sm text-mist-100">

package.json

···
 	"author": "",
 	"license": "ISC",
 	"dependencies": {
+		"@simplewebauthn/browser": "^11.0.0",
 		"@pedrobslisboa/react-client": "^19.1.0",
 		"react": "^19.2.0",
 		"react-aria-components": "^1.13.0",

pegasus.opam

···
   "ppx_deriving_yojson" {>= "3.9.1"}
   "ppx_rapper"
   "ppx_rapper_lwt"
+  "webauthn" {>= "0.2.0"}
   "alcotest" {with-test}
   "crunch"
   "ocamlformat-mlx" {with-dev-setup}

pegasus/lib/api/account_/index.ml

···
               let email_change_pending = has_valid_email_change_code actor in
               let pending_email = actor.pending_email in
               let delete_pending = has_valid_delete_code actor in
+              let%lwt passkeys_raw =
+                Passkey.get_credentials_for_user ~did ctx.db
+              in
+              let passkeys =
+                List.map
+                  (fun (pk : Passkey.Types.passkey) ->
+                    Frontend.AccountPage.
+                      { id= pk.id
+                      ; name= pk.name
+                      ; created_at= pk.created_at
+                      ; last_used_at= pk.last_used_at } )
+                  passkeys_raw
+              in
               Util.render_html ~title:"Account"
                 (module Frontend.AccountPage)
                 ~props:
···
                   ; delete_pending
                   ; error= None
                   ; success= None
-                  ; delete_error= None } ) )
+                  ; delete_error= None
+                  ; passkeys } ) )
 
 let post_handler =
   Xrpc.handler (fun ctx ->
···
                 let email_change_pending = has_valid_email_change_code actor in
                 let pending_email = actor.pending_email in
                 let delete_pending = has_valid_delete_code actor in
+                let%lwt passkeys_raw =
+                  Passkey.get_credentials_for_user ~did ctx.db
+                in
+                let passkeys =
+                  List.map
+                    (fun (pk : Passkey.Types.passkey) ->
+                      Frontend.AccountPage.
+                        { id= pk.id
+                        ; name= pk.name
+                        ; created_at= pk.created_at
+                        ; last_used_at= pk.last_used_at } )
+                    passkeys_raw
+                in
                 Util.render_html ~title:"Account"
                   (module Frontend.AccountPage)
                   ~props:
···
                     ; delete_pending
                     ; error
                     ; success
-                    ; delete_error }
+                    ; delete_error
+                    ; passkeys }
               in
               match%lwt Dream.form ctx.req with
               | `Ok fields -> (

pegasus/lib/api/account_/passkeys.ml

···
+type passkey_info =
+  { id: int
+  ; name: string
+  ; created_at: int
+  ; last_used_at: int option [@default None] }
+[@@deriving yojson {strict= false}]
+
+type list_response = {passkeys: passkey_info list}
+[@@deriving yojson {strict= false}]
+
+type register_request =
+  {name: string [@default "Passkey"]; response: string; challenge: string}
+[@@deriving yojson {strict= false}]
+
+type auth_request = {response: string; challenge: string}
+[@@deriving yojson {strict= false}]
+
+type success_response = {success: bool; message: string option [@default None]}
+[@@deriving yojson {strict= false}]
+
+type login_success_response = {success: bool; redirect: string}
+[@@deriving yojson {strict= false}]
+
+type error_response = {error: string} [@@deriving yojson {strict= false}]
+
+(* helper to get the current DID or return unauthorized *)
+let with_current_did ctx f =
+  match%lwt Session.Raw.get_current_did ctx.Xrpc.req with
+  | None ->
+      Errors.auth_required "not authorized"
+  | Some did ->
+      f did
+
+let list_handler =
+  Xrpc.handler (fun ctx ->
+      with_current_did ctx (fun did ->
+          let%lwt passkeys = Passkey.get_credentials_for_user ~did ctx.db in
+          let passkey_infos =
+            List.map
+              (fun (pk : Passkey.Types.passkey) ->
+                { id= pk.id
+                ; name= pk.name
+                ; created_at= pk.created_at
+                ; last_used_at= pk.last_used_at } )
+              passkeys
+          in
+          Dream.json @@ Yojson.Safe.to_string
+          @@ list_response_to_yojson {passkeys= passkey_infos} ) )
+
+let register_options_handler =
+  Xrpc.handler (fun ctx ->
+      with_current_did ctx (fun did ->
+          match%lwt Data_store.get_actor_by_identifier did ctx.db with
+          | None ->
+              Errors.auth_required "user not found"
+          | Some actor ->
+              let%lwt existing = Passkey.get_credentials_for_user ~did ctx.db in
+              let%lwt options =
+                Passkey.generate_registration_options ~did ~email:actor.email
+                  ~existing_credentials:existing ctx.db
+              in
+              Dream.json @@ Yojson.Safe.to_string options ) )
+
+let register_verify_handler =
+  Xrpc.handler (fun ctx ->
+      with_current_did ctx (fun did ->
+          let%lwt {challenge; response; name; _} =
+            Xrpc.parse_body ctx.req register_request_of_yojson
+          in
+          match%lwt Passkey.verify_registration ~challenge ~response ctx.db with
+          | Error msg ->
+              Errors.invalid_request msg
+          | Ok (credential_id, public_key) ->
+              let%lwt () =
+                Passkey.store_credential ~did ~credential_id ~public_key ~name
+                  ctx.db
+              in
+              Dream.json @@ Yojson.Safe.to_string
+              @@ success_response_to_yojson
+                   {success= true; message= Some "Passkey registered"} ) )
+
+let login_options_handler =
+  Xrpc.handler (fun ctx ->
+      let%lwt options = Passkey.generate_authentication_options ctx.db in
+      Dream.json @@ Yojson.Safe.to_string options )
+
+let login_verify_handler =
+  Xrpc.handler (fun ctx ->
+      let%lwt {challenge; response; _} =
+        Xrpc.parse_body ctx.req auth_request_of_yojson
+      in
+      match%lwt Passkey.verify_authentication ~challenge ~response ctx.db with
+      | Error msg ->
+          Errors.auth_required msg
+      | Ok did ->
+          let%lwt () = Session.log_in_did ctx.req did in
+          let redirect_url =
+            Dream.query ctx.req "redirect_url"
+            |> Option.value ~default:"/account"
+          in
+          Dream.json @@ Yojson.Safe.to_string
+          @@ login_success_response_to_yojson
+               {success= true; redirect= redirect_url} )
+
+let delete_handler =
+  Xrpc.handler (fun ctx ->
+      with_current_did ctx (fun did ->
+          let id_str = Dream.param ctx.req "id" in
+          match int_of_string_opt id_str with
+          | None ->
+              Errors.invalid_request "invalid passkey id"
+          | Some id ->
+              let%lwt _ = Passkey.delete_credential ~id ~did ctx.db in
+              Dream.json @@ Yojson.Safe.to_string
+              @@ success_response_to_yojson
+                   {success= true; message= Some "Passkey deleted"} ) )
+
+let rename_handler =
+  Xrpc.handler (fun ctx ->
+      with_current_did ctx (fun did ->
+          let id_str = Dream.param ctx.req "id" in
+          match int_of_string_opt id_str with
+          | None ->
+              Errors.invalid_request "invalid passkey id"
+          | Some id -> (
+              let%lwt body = Dream.body ctx.req in
+              let json = Yojson.Safe.from_string body in
+              match Yojson.Safe.Util.member "name" json with
+              | `String name ->
+                  let%lwt _success =
+                    Passkey.rename_credential ~id ~did ~name ctx.db
+                  in
+                  Dream.json @@ Yojson.Safe.to_string
+                  @@ success_response_to_yojson {success= true; message= None}
+              | _ ->
+                  Errors.invalid_request "missing name field" ) ) )

pegasus/lib/dune

···
   timedesc
   uri
   uuidm
+  webauthn
   yojson
   hermes_ppx
   lwt_ppx

pegasus/lib/migrations/data_store/005_passkeys.sql

···
+CREATE TABLE IF NOT EXISTS passkeys (
+  id INTEGER PRIMARY KEY,
+  did TEXT NOT NULL,
+  credential_id TEXT NOT NULL UNIQUE,
+  public_key BLOB NOT NULL,
+  sign_count INTEGER NOT NULL DEFAULT 0,
+  name TEXT NOT NULL DEFAULT 'Passkey',
+  created_at INTEGER NOT NULL,
+  last_used_at INTEGER,
+  FOREIGN KEY (did) REFERENCES actors(did) ON DELETE CASCADE
+);
+
+CREATE INDEX IF NOT EXISTS passkeys_did_idx ON passkeys(did);
+CREATE INDEX IF NOT EXISTS passkeys_credential_id_idx ON passkeys(credential_id);
+
+CREATE TABLE IF NOT EXISTS passkey_challenges (
+  challenge TEXT PRIMARY KEY,
+  did TEXT,
+  challenge_type TEXT NOT NULL,
+  expires_at INTEGER NOT NULL,
+  created_at INTEGER NOT NULL
+);
+
+CREATE INDEX IF NOT EXISTS passkey_challenges_expires_idx ON passkey_challenges(expires_at);
+
+CREATE TRIGGER IF NOT EXISTS cleanup_expired_passkey_challenges
+AFTER INSERT ON passkey_challenges
+BEGIN
+  DELETE FROM passkey_challenges WHERE expires_at < unixepoch() * 1000;
+END;

pegasus/lib/passkey.ml

···
+open Util.Rapper
+
+let challenge_expiry_ms = 5 * 60 * 1000
+
+module Types = struct
+  type passkey =
+    { id: int
+    ; did: string
+    ; credential_id: string
+    ; public_key: bytes
+    ; sign_count: int
+    ; name: string
+    ; created_at: int
+    ; last_used_at: int option }
+
+  type challenge =
+    { challenge: string
+    ; did: string option
+    ; challenge_type: string
+    ; expires_at: int
+    ; created_at: int }
+
+  type passkey_display =
+    { id: int
+    ; name: string
+    ; created_at: int
+    ; last_used_at: int option [@default None] }
+  [@@deriving yojson {strict= false}]
+end
+
+open Types
+
+module Queries = struct
+  let insert_passkey =
+    [%rapper
+      execute
+        {sql| INSERT INTO passkeys (did, credential_id, public_key, sign_count, name, created_at)
+              VALUES (%string{did}, %string{credential_id}, %Blob{public_key}, %int{sign_count}, %string{name}, %int{created_at})
+        |sql}]
+
+  let get_passkeys_by_did did =
+    [%rapper
+      get_many
+        {sql| SELECT @int{id}, @string{did}, @string{credential_id}, @Blob{public_key},
+                     @int{sign_count}, @string{name}, @int{created_at}, @int?{last_used_at}
+              FROM passkeys WHERE did = %string{did}
+              ORDER BY created_at DESC
+        |sql}
+        record_out]
+      did
+
+  let get_passkey_by_credential_id credential_id =
+    [%rapper
+      get_opt
+        {sql| SELECT @int{id}, @string{did}, @string{credential_id}, @Blob{public_key},
+                     @int{sign_count}, @string{name}, @int{created_at}, @int?{last_used_at}
+              FROM passkeys WHERE credential_id = %string{credential_id}
+        |sql}
+        record_out]
+      credential_id
+
+  let update_passkey_sign_count =
+    [%rapper
+      execute
+        {sql| UPDATE passkeys SET sign_count = %int{sign_count}, last_used_at = %int{last_used_at}
+              WHERE credential_id = %string{credential_id}
+        |sql}]
+
+  let delete_passkey =
+    [%rapper
+      execute
+        {sql| DELETE FROM passkeys WHERE id = %int{id} AND did = %string{did}
+        |sql}]
+
+  let rename_passkey =
+    [%rapper
+      execute
+        {sql| UPDATE passkeys SET name = %string{name} WHERE id = %int{id} AND did = %string{did}
+        |sql}]
+
+  let insert_challenge =
+    [%rapper
+      execute
+        {sql| INSERT INTO passkey_challenges (challenge, did, challenge_type, expires_at, created_at)
+              VALUES (%string{challenge}, %string?{did}, %string{challenge_type}, %int{expires_at}, %int{created_at})
+        |sql}]
+
+  let get_challenge challenge now =
+    [%rapper
+      get_opt
+        {sql| SELECT @string{challenge}, @string?{did}, @string{challenge_type},
+                     @int{expires_at}, @int{created_at}
+              FROM passkey_challenges
+              WHERE challenge = %string{challenge} AND expires_at > %int{now}
+        |sql}
+        record_out]
+      ~challenge ~now
+
+  let delete_challenge =
+    [%rapper
+      execute
+        {sql| DELETE FROM passkey_challenges WHERE challenge = %string{challenge}
+        |sql}]
+end
+
+let webauthn_instance : Webauthn.t option ref = ref None
+
+let webauthn () =
+  match !webauthn_instance with
+  | Some t ->
+      t
+  | None -> (
+    match Webauthn.create Env.host_endpoint with
+    | Ok t ->
+        webauthn_instance := Some t ;
+        t
+    | Error msg ->
+        failwith ("Failed to initialize WebAuthn: " ^ msg) )
+
+let serialize_pubkey (pk : Mirage_crypto_ec.P256.Dsa.pub) : bytes =
+  Bytes.of_string (Mirage_crypto_ec.P256.Dsa.pub_to_octets pk)
+
+let deserialize_pubkey (b : bytes) : Mirage_crypto_ec.P256.Dsa.pub option =
+  Mirage_crypto_ec.P256.Dsa.pub_of_octets (Bytes.to_string b)
+  |> Result.to_option
+
+let create_challenge ?did ~challenge_type db =
+  let _challenge_obj, challenge_b64 = Webauthn.generate_challenge () in
+  let now = Util.now_ms () in
+  let expires_at = now + challenge_expiry_ms in
+  let challenge_type_str =
+    match challenge_type with
+    | `Register ->
+        "register"
+    | `Authenticate ->
+        "authenticate"
+  in
+  let%lwt () =
+    Util.use_pool db
+    @@ Queries.insert_challenge ~challenge:challenge_b64 ~did
+         ~challenge_type:challenge_type_str ~expires_at ~created_at:now
+  in
+  Lwt.return challenge_b64
+
+let verify_challenge ~challenge ~challenge_type db =
+  let now = Util.now_ms () in
+  let expected_type =
+    match challenge_type with
+    | `Register ->
+        "register"
+    | `Authenticate ->
+        "authenticate"
+  in
+  match%lwt Util.use_pool db @@ Queries.get_challenge challenge now with
+  | Some c when c.challenge_type = expected_type ->
+      Lwt.return_some c
+  | _ ->
+      Lwt.return_none
+
+let delete_challenge ~challenge db =
+  Util.use_pool db @@ Queries.delete_challenge ~challenge
+
+let store_credential ~did ~credential_id ~public_key ~name db =
+  let now = Util.now_ms () in
+  Util.use_pool db
+  @@ Queries.insert_passkey ~did ~credential_id ~public_key ~sign_count:0 ~name
+       ~created_at:now
+
+let get_credentials_for_user ~did db =
+  Util.use_pool db @@ Queries.get_passkeys_by_did ~did
+
+let get_credential_by_id ~credential_id db =
+  Util.use_pool db @@ Queries.get_passkey_by_credential_id ~credential_id
+
+let update_sign_count ~credential_id ~sign_count db =
+  let now = Util.now_ms () in
+  Util.use_pool db
+  @@ Queries.update_passkey_sign_count ~credential_id ~sign_count
+       ~last_used_at:now
+
+let delete_credential ~id ~did db =
+  let%lwt () = Util.use_pool db @@ Queries.delete_passkey ~id ~did in
+  Lwt.return_true
+
+let rename_credential ~id ~did ~name db =
+  let%lwt () = Util.use_pool db @@ Queries.rename_passkey ~id ~did ~name in
+  Lwt.return_true
+
+let generate_registration_options ~did ~email ~existing_credentials db =
+  let%lwt challenge = create_challenge ~did ~challenge_type:`Register db in
+  let exclude_credentials =
+    List.map
+      (fun (pk : passkey) ->
+        `Assoc
+          [ ("id", `String pk.credential_id)
+          ; ("type", `String "public-key")
+          ; ("transports", `List [`String "internal"; `String "hybrid"]) ] )
+      existing_credentials
+  in
+  let user_id =
+    Base64.(encode_string ~alphabet:uri_safe_alphabet ~pad:false did)
+  in
+  Lwt.return
+  @@ `Assoc
+       [ ("challenge", `String challenge)
+       ; ( "rp"
+         , `Assoc [("name", `String "Pegasus PDS"); ("id", `String Env.hostname)]
+         )
+       ; ( "user"
+         , `Assoc
+             [ ("id", `String user_id)
+             ; ("name", `String email)
+             ; ("displayName", `String email) ] )
+       ; ( "pubKeyCredParams"
+         , `List [`Assoc [("alg", `Int (-7)); ("type", `String "public-key")]]
+         )
+       ; ("timeout", `Int 300000)
+       ; ("attestation", `String "none")
+       ; ("excludeCredentials", `List exclude_credentials)
+       ; ( "authenticatorSelection"
+         , `Assoc
+             [ ("residentKey", `String "preferred")
+             ; ("userVerification", `String "preferred") ] ) ]
+
+let verify_registration ~challenge ~response db =
+  match%lwt verify_challenge ~challenge ~challenge_type:`Register db with
+  | None ->
+      Lwt.return_error "Invalid or expired challenge"
+  | Some _ -> (
+      let%lwt () = delete_challenge ~challenge db in
+      let credential_json = Yojson.Safe.from_string response in
+      let credential_id =
+        match credential_json with
+        | `Assoc fields -> (
+          match List.assoc_opt "id" fields with
+          | Some (`String id) ->
+              id
+          | _ ->
+              "" )
+        | _ ->
+            ""
+      in
+      let inner_response =
+        match credential_json with
+        | `Assoc fields -> (
+          match List.assoc_opt "response" fields with
+          | Some (`Assoc r) -> (
+            match
+              (* need to extract these fields only, extra fields will cause
+                 register_response_of_string to error *)
+              ( List.assoc_opt "attestationObject" r
+              , List.assoc_opt "clientDataJSON" r )
+            with
+            | Some ao, Some cd ->
+                Yojson.Safe.to_string
+                  (`Assoc [("attestationObject", ao); ("clientDataJSON", cd)])
+            | _ ->
+                "" )
+          | _ ->
+              "" )
+        | _ ->
+            ""
+      in
+      if String.length credential_id = 0 || String.length inner_response = 0
+      then Lwt.return_error "invalid credential format"
+      else
+        match Webauthn.register_response_of_string inner_response with
+        | Error e ->
+            let err = Format.asprintf "%a" Webauthn.pp_error e in
+            Lwt.return_error ("invalid registration response: " ^ err)
+        | Ok reg_response -> (
+          match Webauthn.register (webauthn ()) reg_response with
+          | Error e ->
+              let err = Format.asprintf "%a" Webauthn.pp_error e in
+              Lwt.return_error ("registration verification failed: " ^ err)
+          | Ok (_returned_challenge, registration) ->
+              let public_key =
+                serialize_pubkey
+                  registration.attested_credential_data.public_key
+              in
+              Lwt.return_ok (credential_id, public_key) ) )
+
+let generate_authentication_options ?did:_did db =
+  let%lwt challenge = create_challenge ~challenge_type:`Authenticate db in
+  (* for conditional UI, we use empty allowCredentials *)
+  Lwt.return
+  @@ `Assoc
+       [ ("challenge", `String challenge)
+       ; ("timeout", `Int 300000)
+       ; ("rpId", `String Env.hostname)
+       ; ("userVerification", `String "preferred")
+       ; ("allowCredentials", `List []) ]
+
+let verify_authentication ~challenge ~response db =
+  match%lwt verify_challenge ~challenge ~challenge_type:`Authenticate db with
+  | None ->
+      Lwt.return_error "invalid or expired challenge"
+  | Some _ -> (
+      let%lwt () = delete_challenge ~challenge db in
+      let credential_json = Yojson.Safe.from_string response in
+      let credential_id =
+        match credential_json with
+        | `Assoc fields -> (
+          match List.assoc_opt "id" fields with
+          | Some (`String id) ->
+              id
+          | _ ->
+              "" )
+        | _ ->
+            ""
+      in
+      let inner_response =
+        match credential_json with
+        | `Assoc fields -> (
+          match List.assoc_opt "response" fields with
+          | Some (`Assoc r) -> (
+            match
+              (* need to extract these fields only, extra fields will cause
+                 register_response_of_string to error *)
+              ( List.assoc_opt "authenticatorData" r
+              , List.assoc_opt "clientDataJSON" r
+              , List.assoc_opt "signature" r
+              , List.assoc_opt "userHandle" r )
+            with
+            | Some ad, Some cd, Some sgn, uh ->
+                Yojson.Safe.to_string
+                  (`Assoc
+                     ( ( match uh with
+                         | Some uh ->
+                             [("userHandle", uh)]
+                         | None ->
+                             [] )
+                     @ [ ("authenticatorData", ad)
+                       ; ("clientDataJSON", cd)
+                       ; ("signature", sgn) ] ) )
+            | _ ->
+                "" )
+          | _ ->
+              "" )
+        | _ ->
+            ""
+      in
+      if String.length credential_id = 0 || String.length inner_response = 0
+      then Lwt.return_error "invalid credential format"
+      else
+        match Webauthn.authenticate_response_of_string inner_response with
+        | Error _ ->
+            Lwt.return_error "invalid authentication response"
+        | Ok auth_response -> (
+          match%lwt get_credential_by_id ~credential_id db with
+          | None ->
+              Lwt.return_error "unknown credential"
+          | Some passkey -> (
+            match deserialize_pubkey passkey.public_key with
+            | None ->
+                Lwt.return_error "invalid stored public key"
+            | Some pubkey -> (
+              match
+                Webauthn.authenticate (webauthn ()) pubkey auth_response
+              with
+              | Error _ ->
+                  Lwt.return_error "authentication verification failed"
+              | Ok (_returned_challenge, auth) ->
+                  let sign_count = Int32.to_int auth.sign_count in
+                  let%lwt () =
+                    update_sign_count ~credential_id ~sign_count db
+                  in
+                  Lwt.return_ok passkey.did ) ) ) )

pnpm-lock.yaml

···
       '@pedrobslisboa/react-client':
         specifier: ^19.1.0
         version: 19.1.0(react@19.2.0)
+      '@simplewebauthn/browser':
+        specifier: ^11.0.0
+        version: 11.0.0
       react:
         specifier: ^19.2.0
         version: 19.2.0
···
     resolution: {integrity: sha512-k+/Rkcyx//P6fetPoLMb8pBeqJBNGx81uuf7iljX9++yNBVRDQgD04L+SVXmXmh5ZP4/WOp4mWF0kmi06PW2tA==}
     cpu: [x64]
     os: [win32]
+
+  '@simplewebauthn/browser@11.0.0':
+    resolution: {integrity: sha512-KEGCStrl08QC2I561BzxqGiwoknblP6O1YW7jApdXLPtIqZ+vgJYAv8ssLCdm1wD8HGAHd49CJLkUF8X70x/pg==}
+
+  '@simplewebauthn/types@11.0.0':
+    resolution: {integrity: sha512-b2o0wC5u2rWts31dTgBkAtSNKGX0cvL6h8QedNsKmj8O4QoLFQFR3DBVBUlpyVEhYKA+mXGUaXbcOc4JdQ3HzA==}
+    deprecated: Package no longer supported. Contact Support at https://www.npmjs.com/support for more info.
 
   '@swc/helpers@0.5.17':
     resolution: {integrity: sha512-5IKx/Y13RsYd+sauPb2x+U/xZikHjolzfuDgTAl/Tdf3Q8rslRvC19NKDLgAJQ6wsqADk10ntlv08nPFw/gO/A==}
···
 
   '@rollup/rollup-win32-x64-msvc@4.53.2':
     optional: true
+
+  '@simplewebauthn/browser@11.0.0':
+    dependencies:
+      '@simplewebauthn/types': 11.0.0
+
+  '@simplewebauthn/types@11.0.0': {}
 
   '@swc/helpers@0.5.17':
     dependencies: