{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

-- | Stability: experimental
-- This module implements the
-- [Packed Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-packed-attestation).
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 qualified Data.ByteString as BS
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

-- | The Packed format. The sole purpose of this type is to instantiate the
-- AttestationStatementFormat typeclass below.
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

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-packed-attestation)
data Statement = Statement
  { Statement -> CoseSignAlg
alg :: Cose.CoseSignAlg,
    Statement -> ByteString
sig :: BS.ByteString,
    Statement -> Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
x5c :: Maybe (NE.NonEmpty X509.SignedCertificate, IdFidoGenCeAAGUID)
  }
  deriving (Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c== :: 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
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> String
$cshow :: Statement -> String
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show)

instance ToJSON Statement where
  toJSON :: Statement -> Value
toJSON Statement {Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
ByteString
CoseSignAlg
x5c :: Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
sig :: ByteString
alg :: CoseSignAlg
x5c :: Statement -> Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
sig :: Statement -> ByteString
alg :: Statement -> CoseSignAlg
..} =
    [Pair] -> Value
object
      ( [ Key
"alg" Key -> CoseSignAlg -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CoseSignAlg
alg,
          Key
"sig" Key -> ByteString -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString
sig
        ]
          [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair]
-> ((NonEmpty SignedCertificate, IdFidoGenCeAAGUID) -> [Pair])
-> Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(NonEmpty SignedCertificate
x5c', IdFidoGenCeAAGUID
_) -> [Key
"x5c" Key -> NonEmpty SignedCertificate -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty SignedCertificate
x5c']) Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
x5c
      )

-- | Verification errors specific to Packed attestation
data VerificationError
  = -- | The Algorithm from the attestation format does not match the algorithm
    -- of the key in the credential data
    AlgorithmMismatch
      { -- | The algorithm received in the attestation statement
        VerificationError -> CoseSignAlg
statementAlg :: Cose.CoseSignAlg,
        -- | The algorithm of the credentialPublicKey in authenticatorData
        VerificationError -> CoseSignAlg
credentialAlg :: Cose.CoseSignAlg
      }
  | -- | The statement key cannot verify the signature over the attested
    -- credential data and client data for self attestation
    InvalidSignature Text
  | -- | The statement certificate cannot verify the signature over the attested
    -- credential data and client data for nonself attestation
    VerificationFailure X509.SignatureFailure
  | -- | The certificate does not meet the requirements layed out in the
    -- webauthn specification
    -- https://www.w3.org/TR/webauthn-2/#sctn-packed-attestation-cert-requirements
    CertificateRequirementsUnmet
  | -- | The AAGUID in the certificate extension does not match the AAGUID in
    -- the authenticator data
    CertificateAAGUIDMismatch
      { -- | AAGUID from the id-fido-gen-ce-aaguid certificate extension
        VerificationError -> AAGUID
certificateExtensionAAGUID :: AAGUID,
        -- | A AGUID from the attested credential data in the authenticator
        -- data
        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
showList :: [VerificationError] -> ShowS
$cshowList :: [VerificationError] -> ShowS
show :: VerificationError -> String
$cshow :: VerificationError -> String
showsPrec :: Int -> VerificationError -> ShowS
$cshowsPrec :: Int -> 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
displayException :: VerificationError -> String
$cdisplayException :: VerificationError -> String
fromException :: SomeException -> Maybe VerificationError
$cfromException :: SomeException -> Maybe VerificationError
toException :: VerificationError -> SomeException
$ctoException :: VerificationError -> SomeException
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
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, IdFidoGenCeAAGUID)
x5c <- case Maybe Term
mx5c of
          Maybe Term
Nothing -> Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
-> Either
     Text (Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (NonEmpty SignedCertificate, 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, IdFidoGenCeAAGUID)
-> Either
     Text (Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (NonEmpty SignedCertificate, 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 (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
              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) -> IdFidoGenCeAAGUID -> Either Text IdFidoGenCeAAGUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdFidoGenCeAAGUID
ext
                Just (Left String
err) -> Text -> Either Text IdFidoGenCeAAGUID
forall a b. a -> Either a b
Left (Text -> Either Text IdFidoGenCeAAGUID)
-> Text -> Either Text 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 -> Text -> Either Text IdFidoGenCeAAGUID
forall a b. a -> Either a b
Left Text
"Certificate aaguid extension is missing"
              pure $ (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
-> Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
forall a. a -> Maybe a
Just (NonEmpty SignedCertificate
x5c, IdFidoGenCeAAGUID
aaguidExt)
          Just Term
_ -> Text
-> Either
     Text (Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID))
forall a b. a -> Either a b
Left (Text
 -> Either
      Text (Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)))
-> Text
-> Either
     Text (Maybe (NonEmpty SignedCertificate, 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 :: CoseSignAlg
-> ByteString
-> Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
-> Statement
Statement {Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
ByteString
CoseSignAlg
x5c :: Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
alg :: CoseSignAlg
sig :: ByteString
x5c :: Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
sig :: ByteString
alg :: CoseSignAlg
..}
      (Maybe Term, Maybe Term, Maybe Term)
_ -> Text -> Either Text Statement
forall a b. a -> Either a b
Left (Text -> Either Text Statement) -> Text -> Either Text Statement
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, IdFidoGenCeAAGUID)
ByteString
CoseSignAlg
x5c :: Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
sig :: ByteString
alg :: CoseSignAlg
x5c :: Statement -> Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
sig :: Statement -> ByteString
alg :: Statement -> CoseSignAlg
..} =
    [(Term, Term)] -> Term
CBOR.TMap
      ( [ (Text -> Term
CBOR.TString Text
"sig", ByteString -> Term
CBOR.TBytes ByteString
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, IdFidoGenCeAAGUID)
x5c of
            Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
Nothing -> []
            Just (NonEmpty SignedCertificate
certChain, 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 -> ByteString
sig = ByteString
stmtSig, x5c :: Statement -> Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
x5c = Maybe (NonEmpty SignedCertificate, 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 :: ByteString
signedData = 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, IdFidoGenCeAAGUID)
stmtx5c of
        -- Self attestation
        Maybe (NonEmpty SignedCertificate, IdFidoGenCeAAGUID)
Nothing -> do
          -- Validate that alg matches the algorithm of the credentialPublicKey in authenticatorData.
          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

          -- Verify that sig is a valid signature over the concatenation of
          -- authenticatorData and clientDataHash using the credential public key with alg.
          case CosePublicKey -> ByteString -> ByteString -> Either Text ()
Cose.verify CosePublicKey
key ByteString
signedData ByteString
stmtSig of
            Right () -> () -> Validation (NonEmpty VerificationError) ()
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

        -- Basic, AttCA
        Just (x5c :: NonEmpty SignedCertificate
x5c@(SignedCertificate
certCred :| [SignedCertificate]
_), IdFidoGenCeAAGUID AAGUID
certAAGUID) -> do
          let cert :: Certificate
cert = SignedCertificate -> Certificate
X509.getCertificate SignedCertificate
certCred
              pubKey :: PubKey
pubKey = Certificate -> PubKey
X509.certPubKey Certificate
cert
          -- Verify that sig is a valid signature over the concatenation of authenticatorData and clientDataHash using
          -- the attestation public key in attestnCert with the algorithm specified in alg.
          case SignatureALG
-> PubKey -> ByteString -> ByteString -> SignatureVerification
X509.verifySignature (HashALG -> PubKeyALG -> SignatureALG
X509.SignatureALG HashALG
X509.HashSHA256 PubKeyALG
X509.PubKeyALG_EC) PubKey
pubKey ByteString
signedData ByteString
stmtSig of
            SignatureVerification
X509.SignaturePass -> () -> Validation (NonEmpty VerificationError) ()
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

          -- Verify that attestnCert meets the requirements in § 8.2.1 Packed Attestation Statement Certificate
          -- Requirements.
          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

          -- If attestnCert contains an extension with OID 1.3.6.1.4.1.45724.1.1.4 (id-fido-gen-ce-aaguid) verify that
          -- the value of this extension matches the aaguid in authenticatorData.
          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

          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

-- | Helper function that wraps the Packed format into the general
-- SomeAttestationStatementFormat type.
format :: M.SomeAttestationStatementFormat
format :: SomeAttestationStatementFormat
format = Format -> SomeAttestationStatementFormat
forall a.
AttestationStatementFormat a =>
a -> SomeAttestationStatementFormat
M.SomeAttestationStatementFormat Format
Format