{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Crypto.WebAuthn.AttestationStatementFormat.Packed
( format,
Format (..),
VerificationError (..),
)
where
import qualified Codec.CBOR.Term as CBOR
import Control.Exception (Exception)
import Control.Monad (forM, unless, when)
import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose
import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose
import qualified Crypto.WebAuthn.Cose.SignAlg as Cose
import Crypto.WebAuthn.Internal.Utils (IdFidoGenCeAAGUID (IdFidoGenCeAAGUID), failure)
import Crypto.WebAuthn.Model (AAGUID)
import qualified Crypto.WebAuthn.Model.Types as M
import qualified Data.ASN1.OID as OID
import Data.Aeson (ToJSON, object, toJSON, (.=))
import Data.Bifunctor (first)
import Data.ByteArray (convert)
import Data.HashMap.Strict ((!?))
import Data.List.NonEmpty (NonEmpty ((:|)), toList)
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.X509 as X509
import qualified Data.X509.Validation as X509
data Format = Format
instance Show Format where
show :: Format -> String
show = Text -> String
Text.unpack (Text -> String) -> (Format -> Text) -> Format -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text
forall a. AttestationStatementFormat a => a -> Text
M.asfIdentifier
data Statement = Statement
{ Statement -> CoseSignAlg
alg :: Cose.CoseSignAlg,
Statement -> Signature
sig :: Cose.Signature,
Statement
-> Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
x5c :: Maybe (NE.NonEmpty X509.SignedCertificate, Maybe IdFidoGenCeAAGUID)
}
deriving (Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
/= :: Statement -> Statement -> Bool
Eq, Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
(Int -> Statement -> ShowS)
-> (Statement -> String)
-> ([Statement] -> ShowS)
-> Show Statement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Statement -> ShowS
showsPrec :: Int -> Statement -> ShowS
$cshow :: Statement -> String
show :: Statement -> String
$cshowList :: [Statement] -> ShowS
showList :: [Statement] -> ShowS
Show)
instance ToJSON Statement where
toJSON :: Statement -> Value
toJSON Statement {Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
CoseSignAlg
Signature
alg :: Statement -> CoseSignAlg
sig :: Statement -> Signature
x5c :: Statement
-> Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
alg :: CoseSignAlg
sig :: Signature
x5c :: Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
..} =
[Pair] -> Value
object
( [ Key
"alg" Key -> CoseSignAlg -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CoseSignAlg
alg,
Key
"sig" Key -> Signature -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Signature
sig
]
[Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair]
-> ((NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
-> [Pair])
-> Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(NonEmpty SignedCertificate
x5c', Maybe IdFidoGenCeAAGUID
_) -> [Key
"x5c" Key -> NonEmpty SignedCertificate -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NonEmpty SignedCertificate
x5c']) Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
x5c
)
data VerificationError
=
AlgorithmMismatch
{
VerificationError -> CoseSignAlg
statementAlg :: Cose.CoseSignAlg,
VerificationError -> CoseSignAlg
credentialAlg :: Cose.CoseSignAlg
}
|
InvalidSignature Text
|
VerificationFailure X509.SignatureFailure
|
CertificateRequirementsUnmet
|
CertificateAAGUIDMismatch
{
VerificationError -> AAGUID
certificateExtensionAAGUID :: AAGUID,
VerificationError -> AAGUID
attestedCredentialDataAAGUID :: AAGUID
}
deriving (Int -> VerificationError -> ShowS
[VerificationError] -> ShowS
VerificationError -> String
(Int -> VerificationError -> ShowS)
-> (VerificationError -> String)
-> ([VerificationError] -> ShowS)
-> Show VerificationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationError -> ShowS
showsPrec :: Int -> VerificationError -> ShowS
$cshow :: VerificationError -> String
show :: VerificationError -> String
$cshowList :: [VerificationError] -> ShowS
showList :: [VerificationError] -> ShowS
Show, Show VerificationError
Typeable VerificationError
Typeable VerificationError
-> Show VerificationError
-> (VerificationError -> SomeException)
-> (SomeException -> Maybe VerificationError)
-> (VerificationError -> String)
-> Exception VerificationError
SomeException -> Maybe VerificationError
VerificationError -> String
VerificationError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
$ctoException :: VerificationError -> SomeException
toException :: VerificationError -> SomeException
$cfromException :: SomeException -> Maybe VerificationError
fromException :: SomeException -> Maybe VerificationError
$cdisplayException :: VerificationError -> String
displayException :: VerificationError -> String
Exception)
instance M.AttestationStatementFormat Format where
type AttStmt Format = Statement
asfIdentifier :: Format -> Text
asfIdentifier Format
_ = Text
"packed"
asfDecode :: Format -> HashMap Text Term -> Either Text (AttStmt Format)
asfDecode Format
_ HashMap Text Term
xs =
case (HashMap Text Term
xs HashMap Text Term -> Text -> Maybe Term
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"alg", HashMap Text Term
xs HashMap Text Term -> Text -> Maybe Term
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"sig", HashMap Text Term
xs HashMap Text Term -> Text -> Maybe Term
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"x5c") of
(Just (CBOR.TInt Int
algId), Just (CBOR.TBytes (ByteString -> Signature
Cose.Signature -> Signature
sig)), Maybe Term
mx5c) -> do
CoseSignAlg
alg <- Int -> Either Text CoseSignAlg
forall a. (Eq a, Num a, Show a) => a -> Either Text CoseSignAlg
Cose.toCoseSignAlg Int
algId
Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
x5c <- case Maybe Term
mx5c of
Maybe Term
Nothing -> Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
-> Either
Text (Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID))
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
forall a. Maybe a
Nothing
Just (CBOR.TList [Term]
x5cRaw) -> case [Term] -> Maybe (NonEmpty Term)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Term]
x5cRaw of
Maybe (NonEmpty Term)
Nothing -> Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
-> Either
Text (Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID))
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
forall a. Maybe a
Nothing
Just NonEmpty Term
x5cBytes -> do
x5c :: NonEmpty SignedCertificate
x5c@(SignedCertificate
signedCert :| [SignedCertificate]
_) <- NonEmpty Term
-> (Term -> Either Text SignedCertificate)
-> Either Text (NonEmpty SignedCertificate)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty Term
x5cBytes ((Term -> Either Text SignedCertificate)
-> Either Text (NonEmpty SignedCertificate))
-> (Term -> Either Text SignedCertificate)
-> Either Text (NonEmpty SignedCertificate)
forall a b. (a -> b) -> a -> b
$ \case
CBOR.TBytes ByteString
certBytes ->
(String -> Text)
-> Either String SignedCertificate -> Either Text SignedCertificate
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Text
"Failed to decode signed certificate: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) (ByteString -> Either String SignedCertificate
X509.decodeSignedCertificate ByteString
certBytes)
Term
cert ->
Text -> Either Text SignedCertificate
forall a b. a -> Either a b
Left (Text -> Either Text SignedCertificate)
-> Text -> Either Text SignedCertificate
forall a b. (a -> b) -> a -> b
$ Text
"Certificate CBOR value is not bytes: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Term -> String
forall a. Show a => a -> String
show Term
cert)
let cert :: Certificate
cert = SignedCertificate -> Certificate
X509.getCertificate SignedCertificate
signedCert
Maybe IdFidoGenCeAAGUID
aaguidExt <- case Extensions -> Maybe (Either String IdFidoGenCeAAGUID)
forall a. Extension a => Extensions -> Maybe (Either String a)
X509.extensionGetE (Certificate -> Extensions
X509.certExtensions Certificate
cert) of
Just (Right IdFidoGenCeAAGUID
ext) -> Maybe IdFidoGenCeAAGUID -> Either Text (Maybe IdFidoGenCeAAGUID)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe IdFidoGenCeAAGUID -> Either Text (Maybe IdFidoGenCeAAGUID))
-> Maybe IdFidoGenCeAAGUID -> Either Text (Maybe IdFidoGenCeAAGUID)
forall a b. (a -> b) -> a -> b
$ IdFidoGenCeAAGUID -> Maybe IdFidoGenCeAAGUID
forall a. a -> Maybe a
Just IdFidoGenCeAAGUID
ext
Just (Left String
err) -> Text -> Either Text (Maybe IdFidoGenCeAAGUID)
forall a b. a -> Either a b
Left (Text -> Either Text (Maybe IdFidoGenCeAAGUID))
-> Text -> Either Text (Maybe IdFidoGenCeAAGUID)
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode certificate aaguid extension: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
err
Maybe (Either String IdFidoGenCeAAGUID)
Nothing -> Maybe IdFidoGenCeAAGUID -> Either Text (Maybe IdFidoGenCeAAGUID)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe IdFidoGenCeAAGUID
forall a. Maybe a
Nothing
pure $ (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
-> Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
forall a. a -> Maybe a
Just (NonEmpty SignedCertificate
x5c, Maybe IdFidoGenCeAAGUID
aaguidExt)
Just Term
_ -> Text
-> Either
Text (Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID))
forall a b. a -> Either a b
Left (Text
-> Either
Text (Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)))
-> Text
-> Either
Text (Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID))
forall a b. (a -> b) -> a -> b
$ Text
"CBOR map didn't have expected value types (alg: int, sig: bytes, [optional] x5c: non-empty list): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (HashMap Text Term -> String
forall a. Show a => a -> String
show HashMap Text Term
xs)
pure $ Statement {Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
CoseSignAlg
Signature
alg :: CoseSignAlg
sig :: Signature
x5c :: Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
sig :: Signature
alg :: CoseSignAlg
x5c :: Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
..}
(Maybe Term, Maybe Term, Maybe Term)
_ -> Text -> Either Text (AttStmt Format)
forall a b. a -> Either a b
Left (Text -> Either Text (AttStmt Format))
-> Text -> Either Text (AttStmt Format)
forall a b. (a -> b) -> a -> b
$ Text
"CBOR map didn't have expected value types (alg: int, sig: bytes, [optional] x5c: non-empty list): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (HashMap Text Term -> String
forall a. Show a => a -> String
show HashMap Text Term
xs)
asfEncode :: Format -> AttStmt Format -> Term
asfEncode Format
_ Statement {Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
CoseSignAlg
Signature
alg :: Statement -> CoseSignAlg
sig :: Statement -> Signature
x5c :: Statement
-> Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
alg :: CoseSignAlg
sig :: Signature
x5c :: Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
..} =
[(Term, Term)] -> Term
CBOR.TMap
( [ (Text -> Term
CBOR.TString Text
"sig", ByteString -> Term
CBOR.TBytes (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ Signature -> ByteString
Cose.unSignature Signature
sig),
(Text -> Term
CBOR.TString Text
"alg", Int -> Term
CBOR.TInt (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ CoseSignAlg -> Int
forall p. Num p => CoseSignAlg -> p
Cose.fromCoseSignAlg CoseSignAlg
alg)
]
[(Term, Term)] -> [(Term, Term)] -> [(Term, Term)]
forall a. [a] -> [a] -> [a]
++ case Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
x5c of
Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
Nothing -> []
Just (NonEmpty SignedCertificate
certChain, Maybe IdFidoGenCeAAGUID
_) ->
let encodedx5c :: [Term]
encodedx5c = (SignedCertificate -> Term) -> [SignedCertificate] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Term
CBOR.TBytes (ByteString -> Term)
-> (SignedCertificate -> ByteString) -> SignedCertificate -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedCertificate -> ByteString
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
X509.encodeSignedObject) ([SignedCertificate] -> [Term]) -> [SignedCertificate] -> [Term]
forall a b. (a -> b) -> a -> b
$ NonEmpty SignedCertificate -> [SignedCertificate]
forall a. NonEmpty a -> [a]
toList NonEmpty SignedCertificate
certChain
in [ (Text -> Term
CBOR.TString Text
"x5c", [Term] -> Term
CBOR.TList [Term]
encodedx5c)
]
)
type AttStmtVerificationError Format = VerificationError
asfVerify :: Format
-> DateTime
-> AttStmt Format
-> AuthenticatorData 'Registration 'True
-> ClientDataHash
-> Validation
(NonEmpty (AttStmtVerificationError Format)) SomeAttestationType
asfVerify
Format
_
DateTime
_
Statement {alg :: Statement -> CoseSignAlg
alg = CoseSignAlg
stmtAlg, sig :: Statement -> Signature
sig = Signature
stmtSig, x5c :: Statement
-> Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
x5c = Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
stmtx5c}
M.AuthenticatorData {adRawData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
M.adRawData = M.WithRaw ByteString
rawData, adAttestedCredentialData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AttestedCredentialData c raw
M.adAttestedCredentialData = AttestedCredentialData 'Registration 'True
credData}
ClientDataHash
clientDataHash = do
let signedData :: Message
signedData = ByteString -> Message
Cose.Message (ByteString -> Message) -> ByteString -> Message
forall a b. (a -> b) -> a -> b
$ 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
clientDataHash)
case Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
stmtx5c of
Maybe (NonEmpty SignedCertificate, Maybe IdFidoGenCeAAGUID)
Nothing -> do
let key :: CosePublicKey
key = AttestedCredentialData 'Registration 'True -> CosePublicKey
forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CosePublicKey
M.acdCredentialPublicKey AttestedCredentialData 'Registration 'True
credData
signAlg :: CoseSignAlg
signAlg = CosePublicKey -> CoseSignAlg
Cose.signAlg CosePublicKey
key
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CoseSignAlg
stmtAlg CoseSignAlg -> CoseSignAlg -> Bool
forall a. Eq a => a -> a -> Bool
/= CoseSignAlg
signAlg) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> (VerificationError
-> Validation (NonEmpty VerificationError) ())
-> VerificationError
-> Validation (NonEmpty VerificationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ CoseSignAlg -> CoseSignAlg -> VerificationError
AlgorithmMismatch CoseSignAlg
stmtAlg CoseSignAlg
signAlg
case CosePublicKey -> Message -> Signature -> Either Text ()
Cose.verify CosePublicKey
key Message
signedData Signature
stmtSig of
Right () -> () -> Validation (NonEmpty VerificationError) ()
forall a. a -> Validation (NonEmpty VerificationError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Left Text
err -> VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ Text -> VerificationError
InvalidSignature Text
err
pure $ AttestationType 'Unverifiable -> SomeAttestationType
forall (k :: AttestationKind).
AttestationType k -> SomeAttestationType
M.SomeAttestationType AttestationType 'Unverifiable
M.AttestationTypeSelf
Just (x5c :: NonEmpty SignedCertificate
x5c@(SignedCertificate
certCred :| [SignedCertificate]
_), Maybe IdFidoGenCeAAGUID
mbAAGUID) -> do
let cert :: Certificate
cert = SignedCertificate -> Certificate
X509.getCertificate SignedCertificate
certCred
pubKey :: PubKey
pubKey = Certificate -> PubKey
X509.certPubKey Certificate
cert
case SignatureALG
-> PubKey -> ByteString -> ByteString -> SignatureVerification
X509.verifySignature (HashALG -> PubKeyALG -> SignatureALG
X509.SignatureALG HashALG
X509.HashSHA256 PubKeyALG
X509.PubKeyALG_EC) PubKey
pubKey (Message -> ByteString
Cose.unMessage Message
signedData) (Signature -> ByteString
Cose.unSignature Signature
stmtSig) of
SignatureVerification
X509.SignaturePass -> () -> Validation (NonEmpty VerificationError) ()
forall a. a -> Validation (NonEmpty VerificationError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
X509.SignatureFailed SignatureFailure
err -> VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ SignatureFailure -> VerificationError
VerificationFailure SignatureFailure
err
let dnElements :: [(OID, ASN1CharacterString)]
dnElements = DistinguishedName -> [(OID, ASN1CharacterString)]
X509.getDistinguishedElements (DistinguishedName -> [(OID, ASN1CharacterString)])
-> DistinguishedName -> [(OID, ASN1CharacterString)]
forall a b. (a -> b) -> a -> b
$ Certificate -> DistinguishedName
X509.certSubjectDN Certificate
cert
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
( DnElement -> [(OID, ASN1CharacterString)] -> Bool
hasDnElement DnElement
X509.DnCountry [(OID, ASN1CharacterString)]
dnElements
Bool -> Bool -> Bool
&& DnElement -> [(OID, ASN1CharacterString)] -> Bool
hasDnElement DnElement
X509.DnOrganization [(OID, ASN1CharacterString)]
dnElements
Bool -> Bool -> Bool
&& DnElement -> [(OID, ASN1CharacterString)] -> Bool
hasDnElement DnElement
X509.DnCommonName [(OID, ASN1CharacterString)]
dnElements
Bool -> Bool -> Bool
&& DnElement
-> [(OID, ASN1CharacterString)] -> Maybe ASN1CharacterString
findDnElement DnElement
X509.DnOrganizationUnit [(OID, ASN1CharacterString)]
dnElements Maybe ASN1CharacterString -> Maybe ASN1CharacterString -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1CharacterString -> Maybe ASN1CharacterString
forall a. a -> Maybe a
Just ASN1CharacterString
"Authenticator Attestation"
)
(Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure VerificationError
CertificateRequirementsUnmet
case Maybe IdFidoGenCeAAGUID
mbAAGUID of
Just (IdFidoGenCeAAGUID AAGUID
certAAGUID) -> do
let aaguid :: AAGUID
aaguid = AttestedCredentialData 'Registration 'True -> AAGUID
forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> AAGUID
M.acdAaguid AttestedCredentialData 'Registration 'True
credData
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AAGUID
certAAGUID AAGUID -> AAGUID -> Bool
forall a. Eq a => a -> a -> Bool
== AAGUID
aaguid) (Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ())
-> (VerificationError
-> Validation (NonEmpty VerificationError) ())
-> VerificationError
-> Validation (NonEmpty VerificationError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationError -> Validation (NonEmpty VerificationError) ()
forall e a. e -> Validation (NonEmpty e) a
failure (VerificationError -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ AAGUID -> AAGUID -> VerificationError
CertificateAAGUIDMismatch AAGUID
certAAGUID AAGUID
aaguid
Maybe IdFidoGenCeAAGUID
Nothing -> () -> Validation (NonEmpty VerificationError) ()
forall a. a -> Validation (NonEmpty VerificationError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
pure $
AttestationType ('Verifiable 'Fido2) -> SomeAttestationType
forall (k :: AttestationKind).
AttestationType k -> SomeAttestationType
M.SomeAttestationType (AttestationType ('Verifiable 'Fido2) -> SomeAttestationType)
-> AttestationType ('Verifiable 'Fido2) -> SomeAttestationType
forall a b. (a -> b) -> a -> b
$
VerifiableAttestationType
-> AttestationChain 'Fido2 -> AttestationType ('Verifiable 'Fido2)
forall (p :: ProtocolKind).
VerifiableAttestationType
-> AttestationChain p -> AttestationType ('Verifiable p)
M.AttestationTypeVerifiable VerifiableAttestationType
M.VerifiableAttestationTypeUncertain (NonEmpty SignedCertificate -> AttestationChain 'Fido2
M.Fido2Chain NonEmpty SignedCertificate
x5c)
where
hasDnElement :: X509.DnElement -> [(OID.OID, X509.ASN1CharacterString)] -> Bool
hasDnElement :: DnElement -> [(OID, ASN1CharacterString)] -> Bool
hasDnElement DnElement
el = Maybe ASN1CharacterString -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ASN1CharacterString -> Bool)
-> ([(OID, ASN1CharacterString)] -> Maybe ASN1CharacterString)
-> [(OID, ASN1CharacterString)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DnElement
-> [(OID, ASN1CharacterString)] -> Maybe ASN1CharacterString
findDnElement DnElement
el
findDnElement :: X509.DnElement -> [(OID.OID, X509.ASN1CharacterString)] -> Maybe X509.ASN1CharacterString
findDnElement :: DnElement
-> [(OID, ASN1CharacterString)] -> Maybe ASN1CharacterString
findDnElement DnElement
dnElementName = OID -> [(OID, ASN1CharacterString)] -> Maybe ASN1CharacterString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (DnElement -> OID
forall a. OIDable a => a -> OID
OID.getObjectID DnElement
dnElementName)
asfTrustAnchors :: Format -> VerifiableAttestationType -> CertificateStore
asfTrustAnchors Format
_ VerifiableAttestationType
_ = CertificateStore
forall a. Monoid a => a
mempty
format :: M.SomeAttestationStatementFormat
format :: SomeAttestationStatementFormat
format = Format -> SomeAttestationStatementFormat
forall a.
AttestationStatementFormat a =>
a -> SomeAttestationStatementFormat
M.SomeAttestationStatementFormat Format
Format