diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,33 @@ +# Changelog for shomei-webauthn + +All notable changes to `shomei-webauthn` are documented here. This package adheres to the +[PVP](https://pvp.haskell.org/) and is versioned independently of the other +Shōmei packages. + +## 0.3.0.0 — 2026-11-05 + +- **Breaking:** internal dependency bounds follow the 0.3 API series. +- First Hackage publication; earlier version sections describe repository development milestones. +- Require released [`webauthn >=0.12 && <0.13`](mori://tweag/webauthn/packages/webauthn); the compatible upstream release replaces the development fork. +- The workspace permits `time` 1.14 through a version-scoped `allow-newer` override; this project setting is not part of the published package's dependency metadata. + +- **Breaking:** remove `VerifiedAuthentication.cloneWarning`; cloned/regressed counters return `WebAuthnCounterCloned` through the MFA failure/audit path. +- Add deterministic signed ES256 registration/assertion wire fixtures and real-verifier workflow tests. +- Document that direct attestation requests evidence without enforcing device trust (ADR-25). + +## 0.2.0.0 — 2026-08-27 + +Not yet published to Hackage: the library depends on a fork of `webauthn` +that builds against GHC 9.12.4, `crypton >= 1.1`, and `jose 0.13`. Upstream +`webauthn` 0.11.0.0 constrains `base < 4.20` and `jose < 0.12`. This package +ships once a compatible `webauthn` is on Hackage. + +Initial release contents: + +- Empty WebAuthn origin sets fail closed with a typed ceremony error instead of calling the partial + `NonEmpty.fromList` constructor. +- Interprets Shōmei's passkey ceremony port with the `webauthn` library: + challenge generation, attestation and assertion verification, origin and + relying-party checks, and signature-counter handling. +- Backs passkey enrollment, passwordless login, and password-then-passkey + step-up. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2026 Nadeem Bitar + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/shomei-webauthn.cabal b/shomei-webauthn.cabal new file mode 100644 --- /dev/null +++ b/shomei-webauthn.cabal @@ -0,0 +1,96 @@ +cabal-version: 3.0 +name: shomei-webauthn +version: 0.3.0.0 +synopsis: + WebAuthn (passkey) registration/authentication ceremony interpreter + +description: + Interprets Shōmei's passkey ceremony port with the webauthn library. Handles + the WebAuthn registration and authentication ceremonies that back passkey + enrollment, passwordless login, and password-then-passkey step-up: + challenge generation, attestation and assertion verification, origin and + relying-party checks, and signature-counter handling. Depends only on + shomei-core. + +homepage: https://github.com/shinzui/shomei +bug-reports: https://github.com/shinzui/shomei/issues +license: MIT +license-file: LICENSE +author: Nadeem Bitar +maintainer: nadeem@gmail.com +copyright: 2026 Nadeem Bitar +category: Web, Security +tested-with: ghc ==9.12.4 +extra-doc-files: CHANGELOG.md + +source-repository head + type: git + location: https://github.com/shinzui/shomei.git + +common warnings + ghc-options: + -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wpartial-fields + -Wredundant-constraints + +common shared + default-language: GHC2024 + default-extensions: + BlockArguments + DataKinds + DeriveAnyClass + DuplicateRecordFields + LambdaCase + OverloadedLabels + OverloadedRecordDot + OverloadedStrings + +library + import: warnings, shared + hs-source-dirs: src + exposed-modules: Shomei.WebAuthn.Ceremony + build-depends: + aeson >=2.1 && <2.3, + base >=4.18 && <5, + bytestring >=0.11 && <0.13, + crypton >=1.1.0 && <1.2, + effectful >=2.5 && <2.8, + effectful-core >=2.5 && <2.8, + mtl >=2.3 && <2.4, + shomei-core ^>=0.3.0.0, + text >=2.0 && <2.2, + time >=1.12 && <1.15, + time-hourglass >=0.3 && <0.4, + validation >=1.1 && <1.3, + webauthn >=0.12 && <0.13, + +test-suite shomei-webauthn-test + import: warnings, shared + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + other-modules: + Shomei.WebAuthn.CeremonySpec + Shomei.WebAuthn.SoftwareAuthenticator + Shomei.WebAuthn.WorkflowSpec + + build-depends: + aeson >=2.1 && <2.3, + base >=4.18 && <5, + bytestring >=0.11 && <0.13, + containers >=0.6 && <0.9, + crypton >=1.1.0 && <1.2, + effectful >=2.5 && <2.8, + effectful-core >=2.5 && <2.8, + ram >=0.22 && <0.23, + shomei-core ^>=0.3.0.0, + shomei-webauthn ^>=0.3.0.0, + tasty >=1.4 && <1.6, + tasty-hunit >=0.10 && <0.11, + text >=2.0 && <2.2, + time >=1.12 && <1.15, + webauthn >=0.12 && <0.13, diff --git a/src/Shomei/WebAuthn/Ceremony.hs b/src/Shomei/WebAuthn/Ceremony.hs new file mode 100644 --- /dev/null +++ b/src/Shomei/WebAuthn/Ceremony.hs @@ -0,0 +1,277 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} + +-- | The real 'WebAuthnCeremony' interpreter, backed by the @tweag/webauthn@ library +-- (MasterPlan 3, EP-1 M2). +-- +-- This is the infrastructure side of the IP-1 port: it owns every @webauthn@ library type +-- (@shomei-core@ never names one). 'runWebAuthnCeremonyLibrary' closes over the +-- 'WebAuthnConfig' Relying Party identity and: +-- +-- * /begin/ steps build the library's 'WA.CredentialOptions', encode them with +-- @webauthn-json@ to the browser-facing JSON ('optionsJson') and to an opaque +-- persisted blob ('optionsBlob', the same JSON as bytes — EP-2 stores it); +-- * /complete/ steps decode the persisted options blob (via the exposed-internal +-- 'WJI.decode'), decode the browser's credential JSON, run the library's +-- 'WA.verifyRegistrationResponse' / 'WA.verifyAuthenticationResponse', and map the +-- result (or the library's error families) to the small closed 'WebAuthnError' set. +-- +-- A potentially-cloned signature counter fails closed ('WebAuthnCounterCloned'), per the +-- ADR-25. The Metadata Service registry is empty ('mempty') and the registration trust +-- verdict is not used. @direct@ requests attestation conveyance; it does not require +-- trusted hardware or apply a device allow-list. @none@ remains the default. +-- +-- Note: 'WebAuthnConfig' fields are read via their plain selectors (@rpId cfg@, …) rather +-- than @cfg.rpId@ record-dot, because GHC does not derive @HasField@ for these records +-- under @DuplicateRecordFields@. +module Shomei.WebAuthn.Ceremony (runWebAuthnCeremonyLibrary) where + +import Control.Monad.Except (runExcept) +import Crypto.Hash (hash) +import Crypto.WebAuthn qualified as WA +import Crypto.WebAuthn.Encoding.Internal.WebAuthnJson qualified as WJI +import Crypto.WebAuthn.Encoding.Strings qualified as WStr +import Crypto.WebAuthn.Encoding.WebAuthnJson qualified as WJ +import Data.Aeson (Value, eitherDecodeStrict', encode, fromJSON, toJSON) +import Data.Aeson qualified as Aeson +import Data.Bifunctor (first) +import Data.ByteString (ByteString) +import Data.ByteString.Lazy qualified as LBS +import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty qualified as NE +import Data.Text qualified as Text +import Data.Text.Encoding (encodeUtf8) +import Data.Time (NominalDiffTime) +import Data.Validation (Validation (Failure, Success)) +import Effectful (Eff, IOE, liftIO, (:>)) +import Effectful.Dispatch.Dynamic (interpret_) +import Shomei.Config + ( AttestationPolicy (..), + UserVerificationPolicy (..), + WebAuthnConfig, + attestation, + ceremonyTimeout, + origins, + rpId, + rpName, + userVerification, + ) +import Shomei.Passkey.Ceremony.Port + ( BeginCeremony (..), + CredentialUserInfo (..), + StoredCredentialForVerify (..), + VerifiedAuthentication (..), + VerifiedRegistration (..), + WebAuthnCeremony (..), + WebAuthnError (..), + ) +import Shomei.Passkey.Domain + ( PublicKeyBytes (..), + SignatureCounter (..), + UserHandle (..), + WebAuthnCredentialId (..), + ) +import Time.System (dateCurrent) + +runWebAuthnCeremonyLibrary :: (IOE :> es) => WebAuthnConfig -> Eff (WebAuthnCeremony : es) a -> Eff es a +runWebAuthnCeremonyLibrary cfg = interpret_ \case + BeginRegistrationCeremony userInfo excludeIds -> liftIO (beginRegistration cfg userInfo excludeIds) + CompleteRegistrationCeremony blob credJson -> liftIO (completeRegistration cfg blob credJson) + BeginAuthenticationCeremony uv allowIds -> liftIO (beginAuthentication cfg uv allowIds) + CompleteAuthenticationCeremony blob stored credJson -> + pure (completeAuthentication cfg blob stored credJson) + +-- Begin steps ----------------------------------------------------------------- + +beginRegistration :: WebAuthnConfig -> CredentialUserInfo -> [WebAuthnCredentialId] -> IO BeginCeremony +beginRegistration cfg (CredentialUserInfo uh accountName displayName) excludeIds = do + challenge <- WA.generateChallenge + let opts = + WA.CredentialOptionsRegistration + { WA.corRp = + WA.CredentialRpEntity + { WA.creId = Just (WA.RpId (rpId cfg)), + WA.creName = WA.RelyingPartyName (rpName cfg) + }, + WA.corUser = + WA.CredentialUserEntity + { WA.cueId = toWAUserHandle uh, + WA.cueDisplayName = WA.UserAccountDisplayName displayName, + WA.cueName = WA.UserAccountName accountName + }, + WA.corChallenge = challenge, + WA.corPubKeyCredParams = + [ WA.CredentialParameters {WA.cpTyp = WA.CredentialTypePublicKey, WA.cpAlg = WA.CoseAlgorithmES256}, + WA.CredentialParameters {WA.cpTyp = WA.CredentialTypePublicKey, WA.cpAlg = WA.CoseAlgorithmRS256} + ], + WA.corTimeout = Just (mkTimeout (ceremonyTimeout cfg)), + WA.corExcludeCredentials = map mkDescriptor excludeIds, + WA.corAuthenticatorSelection = + Just + WA.AuthenticatorSelectionCriteria + { WA.ascAuthenticatorAttachment = Nothing, + WA.ascResidentKey = WA.ResidentKeyRequirementDiscouraged, + WA.ascUserVerification = mapUV (userVerification cfg) + }, + WA.corHints = [], + WA.corAttestation = mapAttestation (attestation cfg), + WA.corExtensions = Nothing + } + wjOpts = WJ.wjEncodeCredentialOptionsRegistration opts + pure BeginCeremony {optionsJson = toJSON wjOpts, optionsBlob = LBS.toStrict (encode wjOpts)} + +beginAuthentication :: WebAuthnConfig -> UserVerificationPolicy -> [WebAuthnCredentialId] -> IO BeginCeremony +beginAuthentication cfg uv allowIds = do + challenge <- WA.generateChallenge + let opts = + WA.CredentialOptionsAuthentication + { WA.coaRpId = Just (WA.RpId (rpId cfg)), + WA.coaTimeout = Just (mkTimeout (ceremonyTimeout cfg)), + WA.coaChallenge = challenge, + WA.coaAllowCredentials = map mkDescriptor allowIds, + WA.coaUserVerification = mapUV uv, + WA.coaHints = [], + WA.coaExtensions = Nothing + } + wjOpts = WJ.wjEncodeCredentialOptionsAuthentication opts + pure BeginCeremony {optionsJson = toJSON wjOpts, optionsBlob = LBS.toStrict (encode wjOpts)} + +-- Complete steps -------------------------------------------------------------- + +completeRegistration :: WebAuthnConfig -> ByteString -> Value -> IO (Either WebAuthnError VerifiedRegistration) +completeRegistration cfg blob credJson = do + now <- dateCurrent + pure do + allowed <- maybe (Left (WebAuthnOtherError "no allowed WebAuthn origins are configured")) Right (originsOf cfg) + opts <- recoverRegistrationOptions blob + cred <- decodeRegistrationCredential credJson + case WA.verifyRegistrationResponse allowed (rpIdHashOf cfg) mempty now opts cred of + Failure errs -> Left (mapRegError (NE.head errs)) + Success result -> Right (entryToRegistration (WA.rrEntry result)) + +completeAuthentication :: + WebAuthnConfig -> + ByteString -> + StoredCredentialForVerify -> + Value -> + Either WebAuthnError VerifiedAuthentication +completeAuthentication cfg blob (StoredCredentialForVerify scid suh spk scnt strans) credJson = do + allowed <- maybe (Left (WebAuthnOtherError "no allowed WebAuthn origins are configured")) Right (originsOf cfg) + opts <- recoverAuthenticationOptions blob + cred <- decodeAuthenticationCredential credJson + let entry = + WA.CredentialEntry + { WA.ceCredentialId = toWACredId scid, + WA.ceUserHandle = toWAUserHandle suh, + WA.cePublicKeyBytes = toWAPubKey spk, + WA.ceSignCounter = toWACounter scnt, + WA.ceTransports = map WStr.decodeAuthenticatorTransport strans + } + case WA.verifyAuthenticationResponse allowed (rpIdHashOf cfg) (Just (toWAUserHandle suh)) entry opts cred of + Failure errs -> Left (mapAuthError (NE.head errs)) + Success (WA.AuthenticationResult counterResult) -> case counterResult of + WA.SignatureCounterZero -> Right (verifiedAuth scid scnt) + WA.SignatureCounterUpdated c -> Right (verifiedAuth scid (SignatureCounter (WA.unSignatureCounter c))) + WA.SignatureCounterPotentiallyCloned -> Left WebAuthnCounterCloned + where + verifiedAuth cid newCounter = + VerifiedAuthentication {credentialId = cid, newSignCounter = newCounter} + +-- Options / credential (de)serialization -------------------------------------- + +recoverRegistrationOptions :: ByteString -> Either WebAuthnError (WA.CredentialOptions 'WA.Registration) +recoverRegistrationOptions blob = do + wjOpts <- first (WebAuthnDecodeError . Text.pack) (eitherDecodeStrict' blob) + first WebAuthnDecodeError (runExcept (WJI.decode (WJ._unWJCredentialOptionsRegistration wjOpts))) + +recoverAuthenticationOptions :: ByteString -> Either WebAuthnError (WA.CredentialOptions 'WA.Authentication) +recoverAuthenticationOptions blob = do + wjOpts <- first (WebAuthnDecodeError . Text.pack) (eitherDecodeStrict' blob) + first WebAuthnDecodeError (runExcept (WJI.decode (WJ._unWJCredentialOptionsAuthentication wjOpts))) + +decodeRegistrationCredential :: Value -> Either WebAuthnError (WA.Credential 'WA.Registration 'True) +decodeRegistrationCredential v = do + wjCred <- case fromJSON v of + Aeson.Success c -> Right c + Aeson.Error e -> Left (WebAuthnDecodeError (Text.pack e)) + first (WebAuthnDecodeError . Text.pack . show) (WJ.wjDecodeCredentialRegistration wjCred) + +decodeAuthenticationCredential :: Value -> Either WebAuthnError (WA.Credential 'WA.Authentication 'True) +decodeAuthenticationCredential v = do + wjCred <- case fromJSON v of + Aeson.Success c -> Right c + Aeson.Error e -> Left (WebAuthnDecodeError (Text.pack e)) + first (WebAuthnDecodeError . Text.pack . show) (WJ.wjDecodeCredentialAuthentication wjCred) + +entryToRegistration :: WA.CredentialEntry -> VerifiedRegistration +entryToRegistration e = + VerifiedRegistration + { credentialId = WebAuthnCredentialId (WA.unCredentialId (WA.ceCredentialId e)), + userHandle = UserHandle (WA.unUserHandle (WA.ceUserHandle e)), + publicKey = PublicKeyBytes (WA.unPublicKeyBytes (WA.cePublicKeyBytes e)), + signCounter = SignatureCounter (WA.unSignatureCounter (WA.ceSignCounter e)), + transports = map WStr.encodeAuthenticatorTransport (WA.ceTransports e) + } + +-- RP identity / policy mapping ------------------------------------------------ + +originsOf :: WebAuthnConfig -> Maybe (NonEmpty WA.Origin) +originsOf cfg = NE.nonEmpty (map WA.Origin (origins cfg)) + +rpIdHashOf :: WebAuthnConfig -> WA.RpIdHash +rpIdHashOf cfg = WA.RpIdHash (hash (encodeUtf8 (rpId cfg))) + +mkTimeout :: NominalDiffTime -> WA.Timeout +mkTimeout dt = WA.Timeout (round (realToFrac dt * 1000 :: Double)) + +mkDescriptor :: WebAuthnCredentialId -> WA.CredentialDescriptor +mkDescriptor cid = + WA.CredentialDescriptor + { WA.cdTyp = WA.CredentialTypePublicKey, + WA.cdId = toWACredId cid, + WA.cdTransports = Nothing + } + +mapUV :: UserVerificationPolicy -> WA.UserVerificationRequirement +mapUV UVRequired = WA.UserVerificationRequirementRequired +mapUV UVPreferred = WA.UserVerificationRequirementPreferred +mapUV UVDiscouraged = WA.UserVerificationRequirementDiscouraged + +mapAttestation :: AttestationPolicy -> WA.AttestationConveyancePreference +mapAttestation AttestationNone = WA.AttestationConveyancePreferenceNone +mapAttestation AttestationDirect = WA.AttestationConveyancePreferenceDirect + +-- Type bridges (Shōmei domain <-> webauthn newtypes) -------------------------- + +toWAUserHandle :: UserHandle -> WA.UserHandle +toWAUserHandle (UserHandle bs) = WA.UserHandle bs + +toWACredId :: WebAuthnCredentialId -> WA.CredentialId +toWACredId (WebAuthnCredentialId bs) = WA.CredentialId bs + +toWAPubKey :: PublicKeyBytes -> WA.PublicKeyBytes +toWAPubKey (PublicKeyBytes bs) = WA.PublicKeyBytes bs + +toWACounter :: SignatureCounter -> WA.SignatureCounter +toWACounter (SignatureCounter w) = WA.SignatureCounter w + +-- Error mapping --------------------------------------------------------------- + +mapRegError :: WA.RegistrationError -> WebAuthnError +mapRegError = \case + WA.RegistrationChallengeMismatch {} -> WebAuthnChallengeMismatch + WA.RegistrationOriginMismatch {} -> WebAuthnOriginMismatch + WA.RegistrationRpIdHashMismatch {} -> WebAuthnRpIdMismatch + WA.RegistrationUserNotPresent {} -> WebAuthnUserNotPresent + WA.RegistrationUserNotVerified {} -> WebAuthnUserNotVerified + err -> WebAuthnOtherError (Text.pack (show err)) + +mapAuthError :: WA.AuthenticationError -> WebAuthnError +mapAuthError = \case + WA.AuthenticationChallengeMismatch {} -> WebAuthnChallengeMismatch + WA.AuthenticationOriginMismatch {} -> WebAuthnOriginMismatch + WA.AuthenticationRpIdHashMismatch {} -> WebAuthnRpIdMismatch + WA.AuthenticationUserNotPresent {} -> WebAuthnUserNotPresent + WA.AuthenticationUserNotVerified {} -> WebAuthnUserNotVerified + WA.AuthenticationSignatureInvalid {} -> WebAuthnSignatureInvalid + err -> WebAuthnOtherError (Text.pack (show err)) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,8 @@ +module Main (main) where + +import Shomei.WebAuthn.CeremonySpec qualified +import Shomei.WebAuthn.WorkflowSpec qualified +import Test.Tasty (defaultMain, testGroup) + +main :: IO () +main = defaultMain (testGroup "shomei-webauthn-test" [Shomei.WebAuthn.CeremonySpec.tests, Shomei.WebAuthn.WorkflowSpec.tests]) diff --git a/test/Shomei/WebAuthn/CeremonySpec.hs b/test/Shomei/WebAuthn/CeremonySpec.hs new file mode 100644 --- /dev/null +++ b/test/Shomei/WebAuthn/CeremonySpec.hs @@ -0,0 +1,210 @@ +{-# LANGUAGE DataKinds #-} + +-- | Tests for the real @tweag/webauthn@ ceremony interpreter +-- ('Shomei.WebAuthn.Ceremony.runWebAuthnCeremonyLibrary'). +-- +-- Signed wire fixtures exercise the production decoder and verifier without a browser. +module Shomei.WebAuthn.CeremonySpec (tests) where + +import Crypto.WebAuthn.Encoding.WebAuthnJson qualified as WJ +import Data.Aeson (Value, eitherDecodeStrict', encode, object) +import Data.Aeson.Types (parseEither, withObject, (.:)) +import Data.ByteString (ByteString) +import Data.ByteString.Char8 qualified as BC +import Data.ByteString.Lazy qualified as LBS +import Data.Either (isLeft) +import Data.Text (Text) +import Effectful (runEff) +import Shomei.Config + ( AttestationPolicy (..), + UserVerificationPolicy (UVDiscouraged, UVRequired), + WebAuthnConfig (attestation, origins, userVerification), + defaultWebAuthnConfig, + ) +import Shomei.Passkey.Ceremony.Port + ( BeginCeremony (..), + CredentialUserInfo (..), + StoredCredentialForVerify (..), + VerifiedAuthentication (..), + VerifiedRegistration (..), + WebAuthnError (..), + beginAuthenticationCeremony, + beginRegistrationCeremony, + completeAuthenticationCeremony, + completeRegistrationCeremony, + ) +import Shomei.Passkey.Domain (SignatureCounter (..), UserHandle (..), b64urlEncode) +import Shomei.WebAuthn.Ceremony (runWebAuthnCeremonyLibrary) +import Shomei.WebAuthn.SoftwareAuthenticator +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (assertBool, testCase, (@?=)) + +tests :: TestTree +tests = + testGroup + "WebAuthn.Ceremony (real interpreter)" + [ testCase "direct requests evidence without enforcing authenticator trust" directAttestationBoundary, + testCase "signed ES256 registration then assertion succeeds through the real interpreter" signedRoundTrip, + testCase "signed policy mutations fail at their intended verifier boundary" signedPolicyNegatives, + testCase "counterless, advancing, repeated and regressed counters follow policy" signedCounterPolicy, + testCase "begin registration produces a round-tripping options blob" beginRegistrationRoundTrips, + testCase "begin authentication produces a round-tripping options blob" beginAuthenticationRoundTrips, + testCase "passwordless authentication requires UV even when step-up discourages it" passwordlessRequiresUv, + testCase "complete registration on malformed credential JSON fails closed" completeRejectsGarbage, + testCase "empty origins fail closed before credential decoding" emptyOriginsFailClosed + ] + +sampleUser :: CredentialUserInfo +sampleUser = + CredentialUserInfo + { userHandle = UserHandle (BC.pack "sample-user-handle"), + accountName = "ada@example.com", + displayName = "Ada Lovelace" + } + +beginRegistrationRoundTrips :: IO () +beginRegistrationRoundTrips = do + BeginCeremony {optionsBlob = blob} <- + runEff . runWebAuthnCeremonyLibrary defaultWebAuthnConfig $ beginRegistrationCeremony sampleUser [] + assertBool "registration optionsBlob is non-empty" (not (BC.null blob)) + assertBool "registration optionsBlob round-trips through webauthn-json" (registrationBlobRoundTrips blob) + +beginAuthenticationRoundTrips :: IO () +beginAuthenticationRoundTrips = do + BeginCeremony {optionsBlob = blob} <- + runEff . runWebAuthnCeremonyLibrary defaultWebAuthnConfig $ + beginAuthenticationCeremony (userVerification defaultWebAuthnConfig) [] + assertBool "authentication optionsBlob is non-empty" (not (BC.null blob)) + assertBool "authentication optionsBlob round-trips through webauthn-json" (authenticationBlobRoundTrips blob) + decodeUserVerification blob @?= Right "preferred" + +passwordlessRequiresUv :: IO () +passwordlessRequiresUv = do + let cfg = defaultWebAuthnConfig {userVerification = UVDiscouraged} + BeginCeremony {optionsBlob = blob} <- + runEff . runWebAuthnCeremonyLibrary cfg $ beginAuthenticationCeremony UVRequired [] + decodeUserVerification blob @?= Right "required" + +completeRejectsGarbage :: IO () +completeRejectsGarbage = do + result <- runEff . runWebAuthnCeremonyLibrary defaultWebAuthnConfig $ do + BeginCeremony {optionsBlob = blob} <- beginRegistrationCeremony sampleUser [] + completeRegistrationCeremony blob (object []) + assertBool "malformed credential JSON yields a WebAuthnError, not a success" (isLeft result) + +emptyOriginsFailClosed :: IO () +emptyOriginsFailClosed = do + let cfg = defaultWebAuthnConfig {origins = []} + result <- runEff . runWebAuthnCeremonyLibrary cfg $ completeRegistrationCeremony "garbage" (object []) + result @?= Left (WebAuthnOtherError "no allowed WebAuthn origins are configured") + +-- | Decode the persisted blob back to the WJ intermediate registration options type +-- and re-encode it; the bytes must be identical (this is the recovery path the +-- interpreter's @completeRegistration@ uses). +registrationBlobRoundTrips :: ByteString -> Bool +registrationBlobRoundTrips blob = case eitherDecodeStrict' blob of + Right opts -> LBS.toStrict (encode (opts :: WJ.WJCredentialOptionsRegistration)) == blob + Left _ -> False + +authenticationBlobRoundTrips :: ByteString -> Bool +authenticationBlobRoundTrips blob = case eitherDecodeStrict' blob of + Right opts -> LBS.toStrict (encode (opts :: WJ.WJCredentialOptionsAuthentication)) == blob + Left _ -> False + +decodeUserVerification :: ByteString -> Either String Text +decodeUserVerification blob = do + value <- eitherDecodeStrict' blob :: Either String Value + parseEither (withObject "authentication options" (.: "userVerification")) value + +signedConfig :: WebAuthnConfig +signedConfig = defaultWebAuthnConfig {origins = ["https://localhost"], userVerification = UVRequired} + +fixedRegistration :: IO (Value, VerifiedRegistration) +fixedRegistration = do + BeginCeremony {optionsJson} <- runEff . runWebAuthnCeremonyLibrary signedConfig $ beginRegistrationCeremony sampleUser [] + let options = freezeChallenge optionsJson + result <- runEff . runWebAuthnCeremonyLibrary signedConfig $ completeRegistrationCeremony (LBS.toStrict (encode options)) (registrationResponse options goodPolicy {responseCounter = 0}) + case result of + Left err -> error ("valid registration rejected: " <> show err) + Right credential -> pure (options, credential) + +storedFrom :: VerifiedRegistration -> SignatureCounter -> StoredCredentialForVerify +storedFrom VerifiedRegistration {credentialId, userHandle, publicKey, transports} counter = StoredCredentialForVerify credentialId userHandle publicKey counter transports + +assertWith :: VerifiedRegistration -> SignatureCounter -> ResponsePolicy -> IO (Either WebAuthnError VerifiedAuthentication) +assertWith credential counter policy = do + BeginCeremony {optionsJson} <- runEff . runWebAuthnCeremonyLibrary signedConfig $ beginAuthenticationCeremony UVRequired [] + let options = freezeChallenge optionsJson + runEff . runWebAuthnCeremonyLibrary signedConfig $ completeAuthenticationCeremony (LBS.toStrict (encode options)) (storedFrom credential counter) (assertionResponse options policy) + +signedRoundTrip :: IO () +signedRoundTrip = do + (_, credential) <- fixedRegistration + let VerifiedRegistration {userHandle} = credential + userHandle @?= UserHandle (BC.pack "sample-user-handle") + result <- assertWith credential (SignatureCounter 0) goodPolicy {responseHandle = "sample-user-handle"} + case result of + Right VerifiedAuthentication {newSignCounter} -> newSignCounter @?= SignatureCounter 1 + Left err -> error (show err) + +signedPolicyNegatives :: IO () +signedPolicyNegatives = do + (_, credential) <- fixedRegistration + let valid = goodPolicy {responseHandle = "sample-user-handle"} + sequence_ + [ assertWith credential (SignatureCounter 0) policy >>= (@?= Left expected) + | (policy, expected) <- + [ (valid {responseOrigin = "https://evil.example"}, WebAuthnOriginMismatch), + (valid {responseRp = "evil.example"}, WebAuthnRpIdMismatch), + (valid {responseChallenge = Just (b64urlEncode "wrong-challenge")}, WebAuthnChallengeMismatch), + (valid {responseFlags = 1}, WebAuthnUserNotVerified), + (valid {responseFlags = 4}, WebAuthnUserNotPresent), + (valid {corruptSignature = True}, WebAuthnSignatureInvalid) + ] + ] + BeginCeremony {optionsBlob = authBlob} <- runEff . runWebAuthnCeremonyLibrary signedConfig $ beginAuthenticationCeremony UVRequired [] + malformed <- runEff . runWebAuthnCeremonyLibrary signedConfig $ completeAuthenticationCeremony authBlob (storedFrom credential (SignatureCounter 0)) (object []) + assertBool "malformed assertion fails closed" (isLeft malformed) + emptyOrigin <- runEff . runWebAuthnCeremonyLibrary signedConfig {origins = []} $ completeAuthenticationCeremony authBlob (storedFrom credential (SignatureCounter 0)) (object []) + emptyOrigin @?= Left (WebAuthnOtherError "no allowed WebAuthn origins are configured") + crossUser <- assertWith credential (SignatureCounter 0) valid {responseHandle = "another-user"} + assertBool "a correctly signed assertion from a different user fails" (isLeft crossUser) + wrongType <- assertWith credential (SignatureCounter 0) valid {responseType = Just "webauthn.create"} + assertBool "create client data cannot satisfy get" (isLeft wrongType) + (options, _) <- fixedRegistration + let register policy = runEff . runWebAuthnCeremonyLibrary signedConfig $ completeRegistrationCeremony (LBS.toStrict (encode options)) (registrationResponse options policy) + sequence_ + [ register policy >>= (@?= Left expected) + | (policy, expected) <- + [ (valid {responseOrigin = "https://evil.example"}, WebAuthnOriginMismatch), + (valid {responseRp = "evil.example"}, WebAuthnRpIdMismatch), + (valid {responseChallenge = Just (b64urlEncode "wrong-challenge")}, WebAuthnChallengeMismatch), + (valid {responseFlags = 4}, WebAuthnUserNotPresent), + (valid {responseFlags = 1}, WebAuthnUserNotVerified) + ] + ] + badRegistrationType <- register valid {responseType = Just "webauthn.get"} + assertBool "get client data cannot satisfy create" (isLeft badRegistrationType) + +signedCounterPolicy :: IO () +signedCounterPolicy = do + (_, credential) <- fixedRegistration + let valid = goodPolicy {responseHandle = "sample-user-handle"} + zero <- assertWith credential (SignatureCounter 0) valid {responseCounter = 0} + case zero of + Right VerifiedAuthentication {newSignCounter} -> newSignCounter @?= SignatureCounter 0 + Left err -> error (show err) + advancing <- assertWith credential (SignatureCounter 3) valid {responseCounter = 4} + case advancing of + Right VerifiedAuthentication {newSignCounter} -> newSignCounter @?= SignatureCounter 4 + Left err -> error (show err) + sequence_ [assertWith credential (SignatureCounter 3) valid {responseCounter = n} >>= (@?= Left WebAuthnCounterCloned) | n <- [3, 2, 0]] + +directAttestationBoundary :: IO () +directAttestationBoundary = do + (options, _) <- fixedRegistration + let direct = signedConfig {attestation = AttestationDirect} + BeginCeremony {optionsJson} <- runEff . runWebAuthnCeremonyLibrary direct $ beginRegistrationCeremony sampleUser [] + parseEither (withObject "options" (.: "attestation")) optionsJson @?= Right ("direct" :: Text) + result <- runEff . runWebAuthnCeremonyLibrary direct $ completeRegistrationCeremony (LBS.toStrict (encode options)) (registrationResponse options goodPolicy) + assertBool "direct is a conveyance request, not a device allow-list" (not (isLeft result)) diff --git a/test/Shomei/WebAuthn/SoftwareAuthenticator.hs b/test/Shomei/WebAuthn/SoftwareAuthenticator.hs new file mode 100644 --- /dev/null +++ b/test/Shomei/WebAuthn/SoftwareAuthenticator.hs @@ -0,0 +1,141 @@ +-- | A deliberately tiny test-only ES256 authenticator. The public private scalar (1) +-- and fixed signing nonce (2) MUST NEVER be used for real credentials. Building browser +-- wire data independently exercises production JSON/CBOR decoding as well as verification. +module Shomei.WebAuthn.SoftwareAuthenticator + ( ResponsePolicy (..), + goodPolicy, + credentialBytes, + fixtureHandle, + registrationResponse, + assertionResponse, + challengeOf, + freezeChallenge, + ) +where + +import Crypto.Hash (Digest, SHA256 (..), hash) +import Crypto.Number.Serialize (i2osp, i2ospOf_) +import Crypto.PubKey.ECC.ECDSA qualified as ECDSA +import Crypto.PubKey.ECC.Prim (pointBaseMul) +import Crypto.PubKey.ECC.Types (CurveName (SEC_p256r1), Point (..), getCurveByName) +import Data.Aeson (Value (..), encode, object, (.=)) +import Data.Aeson.KeyMap qualified as KM +import Data.Aeson.Types (parseMaybe, withObject, (.:)) +import Data.Bits (shiftR) +import Data.ByteArray (convert) +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as LBS +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Data.Word (Word32, Word8) +import Shomei.Passkey.Domain (b64urlEncode) + +data ResponsePolicy = ResponsePolicy + { responseOrigin :: Text, + responseRp :: Text, + responseChallenge :: Maybe Text, + responseType :: Maybe Text, + responseFlags :: Word8, + responseCounter :: Word32, + responseHandle :: ByteString, + corruptSignature :: Bool + } + +goodPolicy :: ResponsePolicy +goodPolicy = ResponsePolicy "https://localhost" "localhost" Nothing Nothing 5 1 fixtureHandle False + +credentialBytes, fixtureHandle :: ByteString +credentialBytes = "test-only-es256-credential" +fixtureHandle = "test-only-user-handle" + +challengeOf :: Value -> Text +challengeOf v = maybe (error "fixture options lack challenge") id (parseMaybe (withObject "options" (.: "challenge")) v) + +freezeChallenge :: Value -> Value +freezeChallenge (Object o) = Object (KM.insert "challenge" (String (b64urlEncode "fixed-test-challenge-with-32-bytes")) o) +freezeChallenge _ = error "fixture options are not an object" + +sha256 :: ByteString -> ByteString +sha256 bytes = convert (hash bytes :: Digest SHA256) + +-- Minimal definite-length CBOR for this fixture's byte and text strings. +cbor :: Word8 -> ByteString -> ByteString +cbor major bytes = prefix <> bytes + where + n = BS.length bytes + prefix + | n < 24 = BS.singleton (major + fromIntegral n) + | n < 256 = BS.pack [major + 24, fromIntegral n] + | otherwise = BS.pack [major + 25, fromIntegral (n `shiftR` 8), fromIntegral n] + +publicKey :: ByteString +publicKey = case pointBaseMul (getCurveByName SEC_p256r1) 1 of + Point x y -> BS.pack [0xa5, 1, 2, 3, 0x26, 0x20, 1, 0x21] <> cbor 0x40 (i2ospOf_ 32 x) <> BS.singleton 0x22 <> cbor 0x40 (i2ospOf_ 32 y) + PointO -> error "invalid fixture point" + +authData :: Bool -> ResponsePolicy -> ByteString +authData registration p = sha256 (encodeUtf8 p.responseRp) <> BS.singleton flags <> counter <> attested + where + flags = p.responseFlags + if registration then 0x40 else 0 + n = p.responseCounter + counter = BS.pack [fromIntegral (n `shiftR` bits) | bits <- [24, 16, 8, 0]] + attested + | registration = BS.replicate 16 0 <> BS.pack [0, fromIntegral (BS.length credentialBytes)] <> credentialBytes <> publicKey + | otherwise = BS.empty + +clientData :: Text -> Value -> ResponsePolicy -> ByteString +clientData kind options p = + LBS.toStrict + ( encode + ( object + [ "type" .= maybe kind id p.responseType, + "challenge" .= maybe (challengeOf options) id p.responseChallenge, + "origin" .= p.responseOrigin, + "crossOrigin" .= False + ] + ) + ) + +registrationResponse :: Value -> ResponsePolicy -> Value +registrationResponse options p = + object + [ "id" .= b64urlEncode credentialBytes, + "rawId" .= b64urlEncode credentialBytes, + "type" .= ("public-key" :: Text), + "response" + .= object + [ "clientDataJSON" .= b64urlEncode (clientData "webauthn.create" options p), + "attestationObject" .= b64urlEncode attestation, + "transports" .= ([] :: [Text]) + ], + "clientExtensionResults" .= object [] + ] + where + attestation = BS.singleton 0xa3 <> cbor 0x60 "fmt" <> cbor 0x60 "none" <> cbor 0x60 "attStmt" <> BS.singleton 0xa0 <> cbor 0x60 "authData" <> cbor 0x40 (authData True p) + +assertionResponse :: Value -> ResponsePolicy -> Value +assertionResponse options p = + object + [ "id" .= b64urlEncode credentialBytes, + "rawId" .= b64urlEncode credentialBytes, + "type" .= ("public-key" :: Text), + "response" + .= object + [ "clientDataJSON" .= b64urlEncode client, + "authenticatorData" .= b64urlEncode authenticator, + "signature" .= b64urlEncode signature, + "userHandle" .= b64urlEncode p.responseHandle + ], + "clientExtensionResults" .= object [] + ] + where + client = clientData "webauthn.get" options p + authenticator = authData False p + signature + | p.corruptSignature = "invalid-signature" + | otherwise = case ECDSA.signWith 2 (ECDSA.PrivateKey (getCurveByName SEC_p256r1) 1) SHA256 (authenticator <> sha256 client) of + Just (ECDSA.Signature r s) -> der 0x30 (integer r <> integer s) + Nothing -> error "fixture signature failed" + integer n = let bytes = i2osp n; positive = if BS.head bytes >= 128 then BS.cons 0 bytes else bytes in der 2 positive + der tag bytes = BS.pack [tag, fromIntegral (BS.length bytes)] <> bytes diff --git a/test/Shomei/WebAuthn/WorkflowSpec.hs b/test/Shomei/WebAuthn/WorkflowSpec.hs new file mode 100644 --- /dev/null +++ b/test/Shomei/WebAuthn/WorkflowSpec.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} + +module Shomei.WebAuthn.WorkflowSpec (tests) where + +import Control.Monad (forM_) +import Data.Aeson (Value, encode) +import Data.Aeson.Types (parseMaybe, withObject, (.:)) +import Data.ByteString.Lazy qualified as LBS +import Data.IORef (IORef, modifyIORef', newIORef, readIORef) +import Data.Map.Strict qualified as Map +import Data.Time (UTCTime (..), addUTCTime, fromGregorian) +import Effectful (Eff, IOE, liftIO, runEff, (:>)) +import Effectful.Dispatch.Dynamic (interpose) +import Shomei.Account.LoginId.Domain (LoginId, mkLoginId) +import Shomei.Account.Password.Domain (PlainPassword (..)) +import Shomei.Account.User.Domain (NewUser (..), User (..)) +import Shomei.Account.User.Store (createUser) +import Shomei.Audit.Event.Domain qualified as Event +import Shomei.Authorization.Claims.Domain (Audience (..), Issuer (..)) +import Shomei.Config (ShomeiConfig (..), UserVerificationPolicy (..), WebAuthnConfig (..), defaultShomeiConfig, defaultWebAuthnConfig) +import Shomei.Error (AuthError (..)) +import Shomei.Id (genCeremonyId) +import Shomei.Mfa.Workflow (MfaCompletion (..), beginPasswordlessLogin, completeMfa, completePasswordlessLogin) +import Shomei.Passkey.Ceremony.Port +import Shomei.Passkey.Ceremony.Store (putPendingCeremony) +import Shomei.Passkey.Domain (CeremonyKind (..), PasskeyCredential (..), PendingCeremony (..), SignatureCounter (..), b64urlDecode) +import Shomei.Passkey.Workflow (beginPasskeyRegistration, completePasskeyRegistration) +import Shomei.Session.Authentication.Workflow (LoginResult (..), MfaChallenge (..), login, signup) +import Shomei.Session.Command (ClientContext (..), LoginCommand (..), ProofContext (..), SignupCommand (..)) +import Shomei.Session.LoginAttempt.Domain (AccountKey (..), ClientIp (..)) +import Shomei.Test.InMemory (InMemoryPorts, World (..), emptyWorld, runInMemory) +import Shomei.WebAuthn.Ceremony (runWebAuthnCeremonyLibrary) +import Shomei.WebAuthn.SoftwareAuthenticator +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) + +-- Storage, Clock, signing and password hashes use the normal fake stack. Only the +-- ceremony effect is interposed, and every completion runs the production verifier. +-- Freeze each challenge after the real begin step so fixture payloads are reproducible. +realCeremonies :: (WebAuthnCeremony :> es, IOE :> es) => WebAuthnConfig -> Eff es a -> Eff es a +realCeremonies cfg = interpose \_ -> \case + BeginRegistrationCeremony u ids -> liftIO (freeze =<< runEff (runWebAuthnCeremonyLibrary cfg (beginRegistrationCeremony u ids))) + BeginAuthenticationCeremony uv ids -> liftIO (freeze =<< runEff (runWebAuthnCeremonyLibrary cfg (beginAuthenticationCeremony uv ids))) + CompleteRegistrationCeremony b v -> liftIO (runEff (runWebAuthnCeremonyLibrary cfg (completeRegistrationCeremony b v))) + CompleteAuthenticationCeremony b c v -> liftIO (runEff (runWebAuthnCeremonyLibrary cfg (completeAuthenticationCeremony b c v))) + where + freeze BeginCeremony {optionsJson} = let v = freezeChallenge optionsJson in pure (BeginCeremony v (LBS.toStrict (encode v))) + +cfg :: ShomeiConfig +cfg = (defaultShomeiConfig (Issuer "test") (Audience "test")) {webauthnConfig = defaultWebAuthnConfig {origins = ["https://localhost"], userVerification = UVDiscouraged}} + +runHybrid :: IORef World -> Eff InMemoryPorts a -> IO a +runHybrid ref = runInMemory ref . realCeremonies cfg.webauthnConfig + +fixedTime :: UTCTime +fixedTime = UTCTime (fromGregorian 2026 1 1) 0 + +right :: (Show e) => Either e a -> IO a +right = either (assertFailure . show) pure + +proof :: ProofContext +proof = ProofContext (ClientIp "fixture") AccountKey + +fixtureLoginId :: LoginId +fixtureLoginId = either (error . show) id (mkLoginId "fixture-user") + +fixturePassword :: PlainPassword +fixturePassword = PlainPassword "correct horse battery staple" + +seed :: IO (IORef World, User, ResponsePolicy) +seed = do + ref <- newIORef (emptyWorld fixedTime) + (user, _) <- right =<< runHybrid ref (signup cfg (SignupCommand fixtureLoginId Nothing fixturePassword Nothing)) + (cid, options) <- right =<< runHybrid ref (beginPasskeyRegistration cfg user.userId) + handle <- case parseMaybe (withObject "options" (\o -> o .: "user" >>= withObject "user" (.: "id"))) options of + Just value -> right (b64urlDecode value) + Nothing -> assertFailure "fixture options lack user handle" + let policy = goodPolicy {responseHandle = handle, responseCounter = 0} + _ <- right =<< runHybrid ref (completePasskeyRegistration cfg user.userId cid (registrationResponse options policy) Nothing) + replay <- runHybrid ref (completePasskeyRegistration cfg user.userId cid (registrationResponse options policy) Nothing) + replay @?= Left PendingCeremonyNotFound + pure (ref, user, policy) + +tests :: TestTree +tests = + testGroup + "signed WebAuthn workflows" + [ testCase "signed enrollment, password step-up and passwordless login persist counters and audit winners" do + (ref, user, policy) <- seed + challenge <- right =<< runHybrid ref (login cfg (ClientContext (ClientIp "fixture") (AccountKey "fixture-user")) (LoginCommand fixtureLoginId fixturePassword False)) + case challenge of + MfaRequired MfaChallenge {ceremonyId, options} -> do + _ <- right =<< runHybrid ref (completeMfa cfg proof ceremonyId (MfaPasskey (assertionResponse options policy {responseCounter = 1, responseFlags = 1}))) + replay <- runHybrid ref (completeMfa cfg proof ceremonyId (MfaPasskey (assertionResponse options policy {responseCounter = 1}))) + replay @?= Left PendingCeremonyNotFound + _ -> assertFailure "expected password step-up" + (cid, options) <- right =<< runHybrid ref (beginPasswordlessLogin cfg) + (resolved, _) <- right =<< runHybrid ref (completePasswordlessLogin cfg proof cid (assertionResponse options policy {responseCounter = 2})) + resolved.userId @?= user.userId + world <- readIORef ref + map (\PasskeyCredential {signCounter} -> signCounter) (Map.elems world.passkeys) @?= [SignatureCounter 2] + length [() | Event.MfaSucceeded _ <- world.publishedEvents] @?= 2 + (replayCid, replayOptions) <- right =<< runHybrid ref (beginPasswordlessLogin cfg) + cloned <- runHybrid ref (completePasswordlessLogin cfg proof replayCid (assertionResponse replayOptions policy {responseCounter = 2})) + cloned @?= Left MfaAssertionInvalid + afterClone <- readIORef ref + length [() | Event.MfaFailed _ <- afterClone.publishedEvents] @?= 1, + testCase "passwordless always requires UV; signed bad proofs consume once and audit failures" do + forM_ [UVPreferred, UVDiscouraged] \uv -> do + (ref, _, policy) <- seed + let run :: Eff InMemoryPorts a -> IO a + run = runInMemory ref . realCeremonies cfg.webauthnConfig {userVerification = uv} + (cid, options) <- right =<< run (beginPasswordlessLogin cfg) + failed <- run (completePasswordlessLogin cfg proof cid (assertionResponse options policy {responseCounter = 1, responseFlags = 1})) + failed @?= Left MfaAssertionInvalid + replay <- run (completePasswordlessLogin cfg proof cid (assertionResponse options policy {responseCounter = 1})) + replay @?= Left PendingCeremonyNotFound + world <- readIORef ref + length [() | Event.MfaFailed _ <- world.publishedEvents] @?= 1 + assertBool "failed proof recorded in shared abuse budget" (not (null world.loginAttempts)), + testCase "a correctly signed credential owned by another user fails the step-up owner check" do + (ref, _, policy) <- seed + let bobLogin = either (error . show) id (mkLoginId "bob-fixture") + bob <- runHybrid ref (createUser (NewUser bobLogin Nothing Nothing)) + (cid, options) <- runHybrid ref do + BeginCeremony {optionsJson, optionsBlob} <- beginAuthenticationCeremony UVRequired [] + cid <- genCeremonyId + putPendingCeremony (PendingCeremony cid (Just bob.userId) AuthenticationCeremony optionsBlob fixedTime (addUTCTime 300 fixedTime)) + pure (cid, optionsJson) + wrongOwner <- runHybrid ref (completeMfa cfg proof cid (MfaPasskey (assertionResponse options policy {responseCounter = 1}))) + wrongOwner @?= Left MfaAssertionInvalid + world <- readIORef ref + length [() | Event.MfaFailed _ <- world.publishedEvents] @?= 1 + length [() | Event.MfaSucceeded _ <- world.publishedEvents] @?= 0, + testCase "expired signed ceremony fails before minting or counter advancement" do + (ref, _, policy) <- seed + (cid, options) <- right =<< runHybrid ref (beginPasswordlessLogin cfg) + modifyIORef' ref (\w -> w {clock = addUTCTime 301 fixedTime}) + expired <- runHybrid ref (completePasswordlessLogin cfg proof cid (assertionResponse options policy {responseCounter = 1})) + expired @?= Left PendingCeremonyNotFound + world <- readIORef ref + map (\PasskeyCredential {signCounter} -> signCounter) (Map.elems world.passkeys) @?= [SignatureCounter 0] + ]