{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module Crypto.WebAuthn.Operation.Authentication
( verifyAuthenticationResponse,
AuthenticationError (..),
AuthenticationResult (..),
SignatureCounterResult (..),
)
where
import qualified Codec.CBOR.Read as CBOR
import Codec.Serialise (decode)
import Control.Exception (Exception)
import Control.Monad (unless)
import qualified Crypto.Hash as Hash
import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose
import Crypto.WebAuthn.Internal.Utils (failure)
import qualified Crypto.WebAuthn.Model as M
import Crypto.WebAuthn.Operation.CredentialEntry (CredentialEntry (cePublicKeyBytes, ceSignCounter, ceUserHandle))
import Data.ByteArray (convert)
import qualified Data.ByteString.Lazy as LBS
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Data.Validation (Validation)
data AuthenticationError
=
AuthenticationCredentialDisallowed
{
AuthenticationError -> [CredentialDescriptor]
aeAllowedCredentials :: [M.CredentialDescriptor],
AuthenticationError -> Credential 'Authentication 'True
aeReceivedCredential :: M.Credential 'M.Authentication 'True
}
|
AuthenticationIdentifiedUserHandleMismatch
{
AuthenticationError -> UserHandle
aeIdentifiedUser :: M.UserHandle,
AuthenticationError -> UserHandle
aeRegisteredUser :: M.UserHandle
}
|
AuthenticationCredentialUserHandleMismatch
{
aeIdentifiedUser :: M.UserHandle,
AuthenticationError -> UserHandle
aeAuthenticatorUser :: M.UserHandle
}
|
AuthenticationCannotVerifyUserHandle
|
AuthenticationChallengeMismatch
{
AuthenticationError -> Challenge
aeCreatedChallenge :: M.Challenge,
AuthenticationError -> Challenge
aeReceivedChallenge :: M.Challenge
}
|
AuthenticationOriginMismatch
{
AuthenticationError -> Origin
aeExpectedOrigin :: M.Origin,
AuthenticationError -> Origin
aeReceivedOrigin :: M.Origin
}
|
AuthenticationRpIdHashMismatch
{
AuthenticationError -> RpIdHash
aeExpectedRpIdHash :: M.RpIdHash,
AuthenticationError -> RpIdHash
aeReceivedRpIdHash :: M.RpIdHash
}
|
AuthenticationUserNotPresent
|
AuthenticationUserNotVerified
|
AuthenticationSignatureDecodingError CBOR.DeserialiseFailure
|
AuthenticationSignatureInvalid Text
deriving (Int -> AuthenticationError -> ShowS
[AuthenticationError] -> ShowS
AuthenticationError -> String
(Int -> AuthenticationError -> ShowS)
-> (AuthenticationError -> String)
-> ([AuthenticationError] -> ShowS)
-> Show AuthenticationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationError] -> ShowS
$cshowList :: [AuthenticationError] -> ShowS
show :: AuthenticationError -> String
$cshow :: AuthenticationError -> String
showsPrec :: Int -> AuthenticationError -> ShowS
$cshowsPrec :: Int -> AuthenticationError -> ShowS
Show, Show AuthenticationError
Typeable AuthenticationError
Typeable AuthenticationError
-> Show AuthenticationError
-> (AuthenticationError -> SomeException)
-> (SomeException -> Maybe AuthenticationError)
-> (AuthenticationError -> String)
-> Exception AuthenticationError
SomeException -> Maybe AuthenticationError
AuthenticationError -> String
AuthenticationError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: AuthenticationError -> String
$cdisplayException :: AuthenticationError -> String
fromException :: SomeException -> Maybe AuthenticationError
$cfromException :: SomeException -> Maybe AuthenticationError
toException :: AuthenticationError -> SomeException
$ctoException :: AuthenticationError -> SomeException
Exception)
data SignatureCounterResult
=
SignatureCounterZero
|
SignatureCounterUpdated M.SignatureCounter
|
SignatureCounterPotentiallyCloned
deriving (SignatureCounterResult -> SignatureCounterResult -> Bool
(SignatureCounterResult -> SignatureCounterResult -> Bool)
-> (SignatureCounterResult -> SignatureCounterResult -> Bool)
-> Eq SignatureCounterResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureCounterResult -> SignatureCounterResult -> Bool
$c/= :: SignatureCounterResult -> SignatureCounterResult -> Bool
== :: SignatureCounterResult -> SignatureCounterResult -> Bool
$c== :: SignatureCounterResult -> SignatureCounterResult -> Bool
Eq, Int -> SignatureCounterResult -> ShowS
[SignatureCounterResult] -> ShowS
SignatureCounterResult -> String
(Int -> SignatureCounterResult -> ShowS)
-> (SignatureCounterResult -> String)
-> ([SignatureCounterResult] -> ShowS)
-> Show SignatureCounterResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureCounterResult] -> ShowS
$cshowList :: [SignatureCounterResult] -> ShowS
show :: SignatureCounterResult -> String
$cshow :: SignatureCounterResult -> String
showsPrec :: Int -> SignatureCounterResult -> ShowS
$cshowsPrec :: Int -> SignatureCounterResult -> ShowS
Show)
newtype AuthenticationResult = AuthenticationResult
{
AuthenticationResult -> SignatureCounterResult
arSignatureCounterResult :: SignatureCounterResult
}
deriving (AuthenticationResult -> AuthenticationResult -> Bool
(AuthenticationResult -> AuthenticationResult -> Bool)
-> (AuthenticationResult -> AuthenticationResult -> Bool)
-> Eq AuthenticationResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticationResult -> AuthenticationResult -> Bool
$c/= :: AuthenticationResult -> AuthenticationResult -> Bool
== :: AuthenticationResult -> AuthenticationResult -> Bool
$c== :: AuthenticationResult -> AuthenticationResult -> Bool
Eq, Int -> AuthenticationResult -> ShowS
[AuthenticationResult] -> ShowS
AuthenticationResult -> String
(Int -> AuthenticationResult -> ShowS)
-> (AuthenticationResult -> String)
-> ([AuthenticationResult] -> ShowS)
-> Show AuthenticationResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationResult] -> ShowS
$cshowList :: [AuthenticationResult] -> ShowS
show :: AuthenticationResult -> String
$cshow :: AuthenticationResult -> String
showsPrec :: Int -> AuthenticationResult -> ShowS
$cshowsPrec :: Int -> AuthenticationResult -> ShowS
Show)
verifyAuthenticationResponse ::
M.Origin ->
M.RpIdHash ->
Maybe M.UserHandle ->
CredentialEntry ->
M.CredentialOptions 'M.Authentication ->
M.Credential 'M.Authentication 'True ->
Validation (NonEmpty AuthenticationError) AuthenticationResult
verifyAuthenticationResponse :: Origin
-> RpIdHash
-> Maybe UserHandle
-> CredentialEntry
-> CredentialOptions 'Authentication
-> Credential 'Authentication 'True
-> Validation (NonEmpty AuthenticationError) AuthenticationResult
verifyAuthenticationResponse Origin
origin RpIdHash
rpIdHash Maybe UserHandle
midentifiedUser CredentialEntry
entry CredentialOptions 'Authentication
options Credential 'Authentication 'True
credential = do
let response :: AuthenticatorResponse 'Authentication 'True
response = Credential 'Authentication 'True
-> AuthenticatorResponse 'Authentication 'True
forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> AuthenticatorResponse c raw
M.cResponse Credential 'Authentication 'True
credential
let allowCredentials :: [CredentialDescriptor]
allowCredentials = CredentialOptions 'Authentication -> [CredentialDescriptor]
M.coaAllowCredentials CredentialOptions 'Authentication
options
Bool
-> Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
([CredentialDescriptor] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CredentialDescriptor]
allowCredentials Bool -> Bool -> Bool
|| Credential 'Authentication 'True -> CredentialId
forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> CredentialId
M.cIdentifier Credential 'Authentication 'True
credential CredentialId -> [CredentialId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (CredentialDescriptor -> CredentialId)
-> [CredentialDescriptor] -> [CredentialId]
forall a b. (a -> b) -> [a] -> [b]
map CredentialDescriptor -> CredentialId
M.cdId [CredentialDescriptor]
allowCredentials)
(Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ())
-> (AuthenticationError
-> Validation (NonEmpty AuthenticationError) ())
-> AuthenticationError
-> Validation (NonEmpty AuthenticationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure
(AuthenticationError
-> Validation (NonEmpty AuthenticationError) ())
-> AuthenticationError
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$ [CredentialDescriptor]
-> Credential 'Authentication 'True -> AuthenticationError
AuthenticationCredentialDisallowed [CredentialDescriptor]
allowCredentials Credential 'Authentication 'True
credential
let owner :: UserHandle
owner = CredentialEntry -> UserHandle
ceUserHandle CredentialEntry
entry
let mUserHandler :: Maybe UserHandle
mUserHandler = case AuthenticatorResponse 'Authentication 'True -> Maybe UserHandle
forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw -> Maybe UserHandle
M.araUserHandle AuthenticatorResponse 'Authentication 'True
response of
Just (M.UserHandle ByteString
"") -> Maybe UserHandle
forall a. Maybe a
Nothing
Maybe UserHandle
userHandle -> Maybe UserHandle
userHandle
case (Maybe UserHandle
midentifiedUser, Maybe UserHandle
mUserHandler) of
(Just UserHandle
identifiedUser, Just UserHandle
userHandle)
| UserHandle
identifiedUser UserHandle -> UserHandle -> Bool
forall a. Eq a => a -> a -> Bool
/= UserHandle
owner ->
AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (AuthenticationError
-> Validation (NonEmpty AuthenticationError) ())
-> AuthenticationError
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$ UserHandle -> UserHandle -> AuthenticationError
AuthenticationIdentifiedUserHandleMismatch UserHandle
identifiedUser UserHandle
owner
| UserHandle
userHandle UserHandle -> UserHandle -> Bool
forall a. Eq a => a -> a -> Bool
/= UserHandle
owner ->
AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (AuthenticationError
-> Validation (NonEmpty AuthenticationError) ())
-> AuthenticationError
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$ UserHandle -> UserHandle -> AuthenticationError
AuthenticationCredentialUserHandleMismatch UserHandle
userHandle UserHandle
owner
| Bool
otherwise -> () -> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(Just UserHandle
identifiedUser, Maybe UserHandle
Nothing)
| UserHandle
identifiedUser UserHandle -> UserHandle -> Bool
forall a. Eq a => a -> a -> Bool
/= UserHandle
owner ->
AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (AuthenticationError
-> Validation (NonEmpty AuthenticationError) ())
-> AuthenticationError
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$ UserHandle -> UserHandle -> AuthenticationError
AuthenticationIdentifiedUserHandleMismatch UserHandle
identifiedUser UserHandle
owner
| Bool
otherwise -> () -> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(Maybe UserHandle
Nothing, Just UserHandle
userHandle)
| UserHandle
userHandle UserHandle -> UserHandle -> Bool
forall a. Eq a => a -> a -> Bool
/= UserHandle
owner ->
AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (AuthenticationError
-> Validation (NonEmpty AuthenticationError) ())
-> AuthenticationError
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$ UserHandle -> UserHandle -> AuthenticationError
AuthenticationCredentialUserHandleMismatch UserHandle
userHandle UserHandle
owner
| Bool
otherwise -> () -> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(Maybe UserHandle
Nothing, Maybe UserHandle
Nothing) ->
AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure AuthenticationError
AuthenticationCannotVerifyUserHandle
let M.AuthenticatorResponseAuthentication
{ araClientData :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw
-> CollectedClientData 'Authentication raw
M.araClientData = CollectedClientData 'Authentication 'True
c,
araAuthenticatorData :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw
-> AuthenticatorData 'Authentication raw
M.araAuthenticatorData = authData :: AuthenticatorData 'Authentication 'True
authData@M.AuthenticatorData {adRawData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
M.adRawData = M.WithRaw ByteString
rawData},
araSignature :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw -> AssertionSignature
M.araSignature = AssertionSignature
sig
} = AuthenticatorResponse 'Authentication 'True
response
Bool
-> Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CollectedClientData 'Authentication 'True -> Challenge
forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Challenge
M.ccdChallenge CollectedClientData 'Authentication 'True
c Challenge -> Challenge -> Bool
forall a. Eq a => a -> a -> Bool
== CredentialOptions 'Authentication -> Challenge
M.coaChallenge CredentialOptions 'Authentication
options) (Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ())
-> Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$
AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (AuthenticationError
-> Validation (NonEmpty AuthenticationError) ())
-> AuthenticationError
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$ Challenge -> Challenge -> AuthenticationError
AuthenticationChallengeMismatch (CredentialOptions 'Authentication -> Challenge
M.coaChallenge CredentialOptions 'Authentication
options) (CollectedClientData 'Authentication 'True -> Challenge
forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Challenge
M.ccdChallenge CollectedClientData 'Authentication 'True
c)
Bool
-> Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CollectedClientData 'Authentication 'True -> Origin
forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Origin
M.ccdOrigin CollectedClientData 'Authentication 'True
c Origin -> Origin -> Bool
forall a. Eq a => a -> a -> Bool
== Origin
origin) (Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ())
-> Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$
AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (AuthenticationError
-> Validation (NonEmpty AuthenticationError) ())
-> AuthenticationError
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$ Origin -> Origin -> AuthenticationError
AuthenticationOriginMismatch Origin
origin (CollectedClientData 'Authentication 'True -> Origin
forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Origin
M.ccdOrigin CollectedClientData 'Authentication 'True
c)
Bool
-> Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AuthenticatorData 'Authentication 'True -> RpIdHash
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RpIdHash
M.adRpIdHash AuthenticatorData 'Authentication 'True
authData RpIdHash -> RpIdHash -> Bool
forall a. Eq a => a -> a -> Bool
== RpIdHash
rpIdHash) (Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ())
-> Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$
AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (AuthenticationError
-> Validation (NonEmpty AuthenticationError) ())
-> AuthenticationError
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$ RpIdHash -> RpIdHash -> AuthenticationError
AuthenticationRpIdHashMismatch RpIdHash
rpIdHash (AuthenticatorData 'Authentication 'True -> RpIdHash
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RpIdHash
M.adRpIdHash AuthenticatorData 'Authentication 'True
authData)
Bool
-> Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AuthenticatorDataFlags -> Bool
M.adfUserPresent (AuthenticatorData 'Authentication 'True -> AuthenticatorDataFlags
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorDataFlags
M.adFlags AuthenticatorData 'Authentication 'True
authData)) (Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ())
-> Validation (NonEmpty AuthenticationError) ()
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$
AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure AuthenticationError
AuthenticationUserNotPresent
case ( CredentialOptions 'Authentication -> UserVerificationRequirement
M.coaUserVerification CredentialOptions 'Authentication
options,
AuthenticatorDataFlags -> Bool
M.adfUserVerified (AuthenticatorData 'Authentication 'True -> AuthenticatorDataFlags
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorDataFlags
M.adFlags AuthenticatorData 'Authentication 'True
authData)
) of
(UserVerificationRequirement
M.UserVerificationRequirementRequired, Bool
True) -> () -> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(UserVerificationRequirement
M.UserVerificationRequirementRequired, Bool
False) -> AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure AuthenticationError
AuthenticationUserNotVerified
(UserVerificationRequirement
M.UserVerificationRequirementPreferred, Bool
True) -> () -> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(UserVerificationRequirement
M.UserVerificationRequirementPreferred, Bool
False) -> () -> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(UserVerificationRequirement
M.UserVerificationRequirementDiscouraged, Bool
True) -> () -> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(UserVerificationRequirement
M.UserVerificationRequirementDiscouraged, Bool
False) -> () -> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
let hash :: ClientDataHash
hash = Digest SHA256 -> ClientDataHash
M.ClientDataHash (Digest SHA256 -> ClientDataHash)
-> Digest SHA256 -> ClientDataHash
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash (ByteString -> Digest SHA256) -> ByteString -> Digest SHA256
forall a b. (a -> b) -> a -> b
$ RawField 'True -> ByteString
M.unRaw (RawField 'True -> ByteString) -> RawField 'True -> ByteString
forall a b. (a -> b) -> a -> b
$ CollectedClientData 'Authentication 'True -> RawField 'True
forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> RawField raw
M.ccdRawData CollectedClientData 'Authentication 'True
c
let pubKeyBytes :: ByteString
pubKeyBytes = ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ PublicKeyBytes -> ByteString
M.unPublicKeyBytes (PublicKeyBytes -> ByteString) -> PublicKeyBytes -> ByteString
forall a b. (a -> b) -> a -> b
$ CredentialEntry -> PublicKeyBytes
cePublicKeyBytes CredentialEntry
entry
message :: ByteString
message = ByteString
rawData ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ClientDataHash -> Digest SHA256
M.unClientDataHash ClientDataHash
hash)
case (forall s. Decoder s PublicKeyWithSignAlg)
-> ByteString
-> Either DeserialiseFailure (ByteString, PublicKeyWithSignAlg)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes forall s. Decoder s PublicKeyWithSignAlg
forall a s. Serialise a => Decoder s a
decode ByteString
pubKeyBytes of
Left DeserialiseFailure
err -> AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (AuthenticationError
-> Validation (NonEmpty AuthenticationError) ())
-> AuthenticationError
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$ DeserialiseFailure -> AuthenticationError
AuthenticationSignatureDecodingError DeserialiseFailure
err
Right (ByteString
_, PublicKeyWithSignAlg
coseKey) ->
case PublicKeyWithSignAlg -> ByteString -> ByteString -> Either Text ()
Cose.verify PublicKeyWithSignAlg
coseKey ByteString
message (AssertionSignature -> ByteString
M.unAssertionSignature AssertionSignature
sig) of
Right () -> () -> Validation (NonEmpty AuthenticationError) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Left Text
err -> AuthenticationError -> Validation (NonEmpty AuthenticationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (AuthenticationError
-> Validation (NonEmpty AuthenticationError) ())
-> AuthenticationError
-> Validation (NonEmpty AuthenticationError) ()
forall a b. (a -> b) -> a -> b
$ Text -> AuthenticationError
AuthenticationSignatureInvalid Text
err
SignatureCounterResult
signCountResult <- case (AuthenticatorData 'Authentication 'True -> SignatureCounter
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> SignatureCounter
M.adSignCount AuthenticatorData 'Authentication 'True
authData, CredentialEntry -> SignatureCounter
ceSignCounter CredentialEntry
entry) of
(SignatureCounter
0, SignatureCounter
0) -> SignatureCounterResult
-> Validation (NonEmpty AuthenticationError) SignatureCounterResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignatureCounterResult
SignatureCounterZero
(SignatureCounter
returned, SignatureCounter
stored)
| SignatureCounter
returned SignatureCounter -> SignatureCounter -> Bool
forall a. Ord a => a -> a -> Bool
> SignatureCounter
stored -> SignatureCounterResult
-> Validation (NonEmpty AuthenticationError) SignatureCounterResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignatureCounterResult
-> Validation
(NonEmpty AuthenticationError) SignatureCounterResult)
-> SignatureCounterResult
-> Validation (NonEmpty AuthenticationError) SignatureCounterResult
forall a b. (a -> b) -> a -> b
$ SignatureCounter -> SignatureCounterResult
SignatureCounterUpdated SignatureCounter
returned
| Bool
otherwise -> SignatureCounterResult
-> Validation (NonEmpty AuthenticationError) SignatureCounterResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignatureCounterResult
SignatureCounterPotentiallyCloned
pure $
AuthenticationResult :: SignatureCounterResult -> AuthenticationResult
AuthenticationResult
{ arSignatureCounterResult :: SignatureCounterResult
arSignatureCounterResult = SignatureCounterResult
signCountResult
}