{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Crypto.WebAuthn.AttestationStatementFormat.AndroidKey
( format,
Format (..),
TrustLevel (..),
VerificationError (..),
)
where
import qualified Codec.CBOR.Term as CBOR
import Control.Exception (Exception)
import Control.Monad (forM, unless, void, when)
import Crypto.Hash (Digest, SHA256, digestFromByteString)
import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose
import qualified Crypto.WebAuthn.Cose.PublicKey as Cose
import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose
import qualified Crypto.WebAuthn.Cose.SignAlg as Cose
import Crypto.WebAuthn.Internal.Utils (failure)
import qualified Crypto.WebAuthn.Model.Types as M
import Data.ASN1.Parse (ParseASN1, getNext, getNextContainerMaybe, hasNext, onNextContainer, onNextContainerMaybe, runParseASN1)
import Data.ASN1.Types (ASN1 (IntVal, OctetString), ASN1Class (Context), ASN1ConstructionType (Container, Sequence, Set))
import Data.Aeson (ToJSON, object, toJSON, (.=))
import Data.Bifunctor (first)
import Data.ByteArray (convert)
import Data.ByteString (ByteString)
import Data.HashMap.Strict ((!?))
import Data.List.NonEmpty (NonEmpty ((:|)), toList)
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isJust)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as Text
import Data.X509 (Extension (extDecode, extEncode, extHasNestedASN1, extOID))
import qualified Data.X509 as X509
data ExtAttestation = ExtAttestation
{ ExtAttestation -> Digest SHA256
attestationChallenge :: Digest SHA256,
ExtAttestation -> AuthorizationList
softwareEnforced :: AuthorizationList,
ExtAttestation -> AuthorizationList
teeEnforced :: AuthorizationList
}
deriving (ExtAttestation -> ExtAttestation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtAttestation -> ExtAttestation -> Bool
$c/= :: ExtAttestation -> ExtAttestation -> Bool
== :: ExtAttestation -> ExtAttestation -> Bool
$c== :: ExtAttestation -> ExtAttestation -> Bool
Eq, Int -> ExtAttestation -> ShowS
[ExtAttestation] -> ShowS
ExtAttestation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtAttestation] -> ShowS
$cshowList :: [ExtAttestation] -> ShowS
show :: ExtAttestation -> String
$cshow :: ExtAttestation -> String
showsPrec :: Int -> ExtAttestation -> ShowS
$cshowsPrec :: Int -> ExtAttestation -> ShowS
Show)
data AuthorizationList = AuthorizationList
{ AuthorizationList -> Maybe (Set Integer)
purpose :: Maybe (Set Integer),
AuthorizationList -> Maybe ()
allApplications :: Maybe (),
AuthorizationList -> Maybe Integer
origin :: Maybe Integer
}
deriving (AuthorizationList -> AuthorizationList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizationList -> AuthorizationList -> Bool
$c/= :: AuthorizationList -> AuthorizationList -> Bool
== :: AuthorizationList -> AuthorizationList -> Bool
$c== :: AuthorizationList -> AuthorizationList -> Bool
Eq, Int -> AuthorizationList -> ShowS
[AuthorizationList] -> ShowS
AuthorizationList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizationList] -> ShowS
$cshowList :: [AuthorizationList] -> ShowS
show :: AuthorizationList -> String
$cshow :: AuthorizationList -> String
showsPrec :: Int -> AuthorizationList -> ShowS
$cshowsPrec :: Int -> AuthorizationList -> ShowS
Show)
instance Extension ExtAttestation where
extOID :: ExtAttestation -> OID
extOID = forall a b. a -> b -> a
const [Integer
1, Integer
3, Integer
6, Integer
1, Integer
4, Integer
1, Integer
11129, Integer
2, Integer
1, Integer
17]
extHasNestedASN1 :: Proxy ExtAttestation -> Bool
extHasNestedASN1 = forall a b. a -> b -> a
const Bool
True
extEncode :: ExtAttestation -> [ASN1]
extEncode = forall a. HasCallStack => String -> a
error String
"Can not encode the parsed ExtAttestation to a valid [ASN1] because most fields are dropped during parsing."
extDecode :: [ASN1] -> Either String ExtAttestation
extDecode [ASN1]
asn1 =
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String
"Could not decode ASN1 attestation extension: " forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$
forall a. ParseASN1 a -> [ASN1] -> Either String a
runParseASN1 ParseASN1 ExtAttestation
decodeExtAttestation [ASN1]
asn1
where
decodeExtAttestation :: ParseASN1 ExtAttestation
decodeExtAttestation :: ParseASN1 ExtAttestation
decodeExtAttestation = forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
ASN1
_attestationVersion <- ParseASN1 ASN1
getNext
ASN1
_attestationSecurityLevel <- ParseASN1 ASN1
getNext
ASN1
_keyMasterVersion <- ParseASN1 ASN1
getNext
ASN1
_keymmasterSecurityLevel <- ParseASN1 ASN1
getNext
(OctetString ByteString
attestationChallenge) <- ParseASN1 ASN1
getNext
ASN1
_uniqueId <- ParseASN1 ASN1
getNext
AuthorizationList
softwareEnforced <- forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ASN1ConstructionType
Sequence ParseASN1 AuthorizationList
decodeAttestationList
AuthorizationList
teeEnforced <- forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ASN1ConstructionType
Sequence ParseASN1 AuthorizationList
decodeAttestationList
Digest SHA256
attestationChallengeHash <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not create hash from AttestationChallenge: ") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString ByteString
attestationChallenge
pure $ Digest SHA256
-> AuthorizationList -> AuthorizationList -> ExtAttestation
ExtAttestation Digest SHA256
attestationChallengeHash AuthorizationList
softwareEnforced AuthorizationList
teeEnforced
decodeAttestationList :: ParseASN1 AuthorizationList
decodeAttestationList :: ParseASN1 AuthorizationList
decodeAttestationList = do
Maybe (Set Integer)
purpose <- forall a.
ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) (forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ASN1ConstructionType
Set forall a b. (a -> b) -> a -> b
$ Set Integer -> ParseASN1 (Set Integer)
decodeIntSet forall a. Set a
Set.empty)
Maybe [ASN1]
_algorithm <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2)
Maybe [ASN1]
_keySize <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
3)
Maybe [ASN1]
_digest <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
5)
Maybe [ASN1]
_padding <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
6)
Maybe [ASN1]
_ecCurve <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
10)
Maybe [ASN1]
_rsaPublicExponent <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
200)
Maybe [ASN1]
_rollbackResistance <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
303)
Maybe [ASN1]
_activeDateTime <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
400)
Maybe [ASN1]
_originationExpireDateTime <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
401)
Maybe [ASN1]
_usageExpireDateTime <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
402)
Maybe [ASN1]
_noAuthRequired <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
503)
Maybe [ASN1]
_userAuthType <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
504)
Maybe [ASN1]
_authTimeout <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
505)
Maybe [ASN1]
_allowWhileOnBody <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
506)
Maybe [ASN1]
_trustedUserPresenceRequired <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
507)
Maybe [ASN1]
_trustedConfirmationRequired <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
508)
Maybe [ASN1]
_unlockedDeviceRequired <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
509)
Maybe ()
allApplications <- forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
600)
Maybe [ASN1]
_applicationId <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
601)
Maybe [ASN1]
_creationDateTime <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
701)
Maybe Integer
origin <-
forall a.
ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
702) forall a b. (a -> b) -> a -> b
$
ParseASN1 ASN1
getNext forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
IntVal Integer
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
ASN1
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected non-IntVal"
Maybe [ASN1]
_rollbackResistant <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
703)
Maybe [ASN1]
_rootOfTrust <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
704)
Maybe [ASN1]
_osVersion <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
705)
Maybe [ASN1]
_osPatchLevel <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
706)
Maybe [ASN1]
_attestationApplicationId <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
709)
Maybe [ASN1]
_attestationIdBrand <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
710)
Maybe [ASN1]
_attestationIdDevice <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
711)
Maybe [ASN1]
_attestationIdProduct <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
712)
Maybe [ASN1]
_attestationIdSerial <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
713)
Maybe [ASN1]
_attestationIdImei <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
714)
Maybe [ASN1]
_attestationIdMeid <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
715)
Maybe [ASN1]
_attestationIdManufacturer <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
716)
Maybe [ASN1]
_attestationIdModel <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
717)
Maybe [ASN1]
_vendorPatchLevel <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
718)
Maybe [ASN1]
_bootPatchLevel <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
719)
pure $ Maybe (Set Integer)
-> Maybe () -> Maybe Integer -> AuthorizationList
AuthorizationList Maybe (Set Integer)
purpose Maybe ()
allApplications Maybe Integer
origin
decodeIntSet :: Set Integer -> ParseASN1 (Set Integer)
decodeIntSet :: Set Integer -> ParseASN1 (Set Integer)
decodeIntSet Set Integer
set = do
Bool
next <- ParseASN1 Bool
hasNext
if Bool
next
then do
IntVal Integer
elem <- ParseASN1 ASN1
getNext
Set Integer -> ParseASN1 (Set Integer)
decodeIntSet (forall a. Ord a => a -> Set a -> Set a
Set.insert Integer
elem Set Integer
set)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Integer
set
data TrustLevel
=
SoftwareEnforced
|
TeeEnforced
newtype Format = Format
{ Format -> TrustLevel
requiredTrustLevel :: TrustLevel
}
instance Show Format where
show :: Format -> String
show = Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AttestationStatementFormat a => a -> Text
M.asfIdentifier
data Statement = Statement
{ Statement -> ByteString
sig :: ByteString,
Statement -> NonEmpty SignedCertificate
x5c :: NonEmpty X509.SignedCertificate,
Statement -> PublicKeyWithSignAlg
pubKeyAndAlg :: Cose.PublicKeyWithSignAlg,
Statement -> ExtAttestation
attExt :: ExtAttestation
}
deriving (Statement -> Statement -> Bool
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
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 {NonEmpty SignedCertificate
ByteString
PublicKeyWithSignAlg
ExtAttestation
attExt :: ExtAttestation
pubKeyAndAlg :: PublicKeyWithSignAlg
x5c :: NonEmpty SignedCertificate
sig :: ByteString
attExt :: Statement -> ExtAttestation
pubKeyAndAlg :: Statement -> PublicKeyWithSignAlg
x5c :: Statement -> NonEmpty SignedCertificate
sig :: Statement -> ByteString
..} =
[Pair] -> Value
object
[ Key
"alg" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PublicKeyWithSignAlg -> CoseSignAlg
Cose.signAlg PublicKeyWithSignAlg
pubKeyAndAlg,
Key
"sig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString
sig,
Key
"x5c" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty SignedCertificate
x5c
]
data VerificationError
=
PublicKeyMismatch
{
VerificationError -> PublicKey
credentialDataPublicKey :: Cose.PublicKey,
VerificationError -> PublicKey
certificatePublicKey :: Cose.PublicKey
}
|
HashMismatch
{
VerificationError -> Digest SHA256
certificateChallenge :: Digest SHA256,
VerificationError -> Digest SHA256
clientDataHash :: Digest SHA256
}
|
AndroidKeyAllApplicationsFieldFound
|
AndroidKeyOriginFieldInvalid
{
VerificationError -> Maybe Integer
teeEnforcedOrigin :: Maybe Integer,
VerificationError -> Maybe Integer
softwareEnforcedOrigin :: Maybe Integer
}
|
AndroidKeyPurposeFieldInvalid
{
VerificationError -> Maybe (Set Integer)
teeEnforcedPurpose :: Maybe (Set Integer),
VerificationError -> Maybe (Set Integer)
softwareEnforcedPurpose :: Maybe (Set Integer)
}
|
VerificationFailure Text
deriving (Int -> VerificationError -> ShowS
[VerificationError] -> ShowS
VerificationError -> String
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
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)
kmOriginGenerated :: Integer
kmOriginGenerated :: Integer
kmOriginGenerated = Integer
0
kmPurposeSign :: Integer
kmPurposeSign :: Integer
kmPurposeSign = Integer
2
instance M.AttestationStatementFormat Format where
type AttStmt Format = Statement
asfIdentifier :: Format -> Text
asfIdentifier Format
_ = Text
"android-key"
asfDecode :: Format -> HashMap Text Term -> Either Text (AttStmt Format)
asfDecode Format
_ HashMap Text Term
xs =
case (HashMap Text Term
xs forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"alg", HashMap Text Term
xs forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"sig", HashMap Text Term
xs 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), Just (CBOR.TList (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty -> Just NonEmpty Term
x5cRaw))) -> do
CoseSignAlg
alg <- forall a. (Eq a, Num a, Show a) => a -> Either Text CoseSignAlg
Cose.toCoseSignAlg Int
algId
x5c :: NonEmpty SignedCertificate
x5c@(SignedCertificate
credCert :| [SignedCertificate]
_) <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty Term
x5cRaw forall a b. (a -> b) -> a -> b
$ \case
CBOR.TBytes ByteString
certBytes ->
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Text
"Failed to decode signed certificate: " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) (ByteString -> Either String SignedCertificate
X509.decodeSignedCertificate ByteString
certBytes)
Term
cert ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Certificate CBOR value is not bytes: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Term
cert)
let cert :: Certificate
cert = SignedCertificate -> Certificate
X509.getCertificate SignedCertificate
credCert
ExtAttestation
attExt <- case forall a. Extension a => Extensions -> Maybe (Either String a)
X509.extensionGetE (Certificate -> Extensions
X509.certExtensions Certificate
cert) of
Just (Right ExtAttestation
ext) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtAttestation
ext
Just (Left String
err) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode certificate attestation extension: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
err
Maybe (Either String ExtAttestation)
Nothing -> forall a b. a -> Either a b
Left Text
"Certificate attestation extension is missing"
PublicKey
pubKey <- PubKey -> Either Text PublicKey
Cose.fromX509 forall a b. (a -> b) -> a -> b
$ Certificate -> PubKey
X509.certPubKey Certificate
cert
PublicKeyWithSignAlg
pubKeyAndAlg <- PublicKey -> CoseSignAlg -> Either Text PublicKeyWithSignAlg
Cose.makePublicKeyWithSignAlg PublicKey
pubKey CoseSignAlg
alg
pure Statement {NonEmpty SignedCertificate
ByteString
PublicKeyWithSignAlg
ExtAttestation
pubKeyAndAlg :: PublicKeyWithSignAlg
attExt :: ExtAttestation
x5c :: NonEmpty SignedCertificate
sig :: ByteString
attExt :: ExtAttestation
pubKeyAndAlg :: PublicKeyWithSignAlg
x5c :: NonEmpty SignedCertificate
sig :: ByteString
..}
(Maybe Term, Maybe Term, Maybe Term)
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"CBOR map didn't have expected value types (alg: int, sig: bytes, x5c: nonempty list): " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show HashMap Text Term
xs)
asfEncode :: Format -> AttStmt Format -> Term
asfEncode Format
_ Statement {NonEmpty SignedCertificate
ByteString
PublicKeyWithSignAlg
ExtAttestation
attExt :: ExtAttestation
pubKeyAndAlg :: PublicKeyWithSignAlg
x5c :: NonEmpty SignedCertificate
sig :: ByteString
attExt :: Statement -> ExtAttestation
pubKeyAndAlg :: Statement -> PublicKeyWithSignAlg
x5c :: Statement -> NonEmpty SignedCertificate
sig :: Statement -> ByteString
..} =
[(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 forall a b. (a -> b) -> a -> b
$ forall p. Num p => CoseSignAlg -> p
Cose.fromCoseSignAlg forall a b. (a -> b) -> a -> b
$ PublicKeyWithSignAlg -> CoseSignAlg
Cose.signAlg PublicKeyWithSignAlg
pubKeyAndAlg),
( Text -> Term
CBOR.TString Text
"x5c",
[Term] -> Term
CBOR.TList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Term
CBOR.TBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
X509.encodeSignedObject) forall a b. (a -> b) -> a -> b
$
forall a. NonEmpty a -> [a]
toList NonEmpty SignedCertificate
x5c
)
]
type AttStmtVerificationError Format = VerificationError
asfVerify :: Format
-> DateTime
-> AttStmt Format
-> AuthenticatorData 'Registration 'True
-> ClientDataHash
-> Validation
(NonEmpty (AttStmtVerificationError Format)) SomeAttestationType
asfVerify Format {TrustLevel
requiredTrustLevel :: TrustLevel
requiredTrustLevel :: Format -> TrustLevel
..} DateTime
_ Statement {NonEmpty SignedCertificate
ByteString
PublicKeyWithSignAlg
ExtAttestation
attExt :: ExtAttestation
pubKeyAndAlg :: PublicKeyWithSignAlg
x5c :: NonEmpty SignedCertificate
sig :: ByteString
attExt :: Statement -> ExtAttestation
pubKeyAndAlg :: Statement -> PublicKeyWithSignAlg
x5c :: Statement -> NonEmpty SignedCertificate
sig :: Statement -> ByteString
..} M.AuthenticatorData {adRawData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
adRawData = M.WithRaw ByteString
rawData, Maybe AuthenticatorExtensionOutputs
AttestedCredentialData 'Registration 'True
AuthenticatorDataFlags
SignatureCounter
RpIdHash
adExtensions :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> Maybe AuthenticatorExtensionOutputs
adAttestedCredentialData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AttestedCredentialData c raw
adSignCount :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> SignatureCounter
adFlags :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorDataFlags
adRpIdHash :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RpIdHash
adExtensions :: Maybe AuthenticatorExtensionOutputs
adAttestedCredentialData :: AttestedCredentialData 'Registration 'True
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
..} ClientDataHash
clientDataHash = do
let signedData :: ByteString
signedData = ByteString
rawData forall a. Semigroup a => a -> a -> a
<> forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ClientDataHash -> Digest SHA256
M.unClientDataHash ClientDataHash
clientDataHash)
case PublicKeyWithSignAlg -> ByteString -> ByteString -> Either Text ()
Cose.verify PublicKeyWithSignAlg
pubKeyAndAlg ByteString
signedData ByteString
sig of
Right () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Left Text
err -> forall e a. e -> Validation (NonEmpty e) a
failure forall a b. (a -> b) -> a -> b
$ Text -> VerificationError
VerificationFailure Text
err
let credentialPublicKey :: PublicKey
credentialPublicKey = PublicKeyWithSignAlg -> PublicKey
Cose.publicKey (forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> PublicKeyWithSignAlg
M.acdCredentialPublicKey AttestedCredentialData 'Registration 'True
adAttestedCredentialData)
pubKey :: PublicKey
pubKey = PublicKeyWithSignAlg -> PublicKey
Cose.publicKey PublicKeyWithSignAlg
pubKeyAndAlg
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PublicKey
credentialPublicKey forall a. Eq a => a -> a -> Bool
== PublicKey
pubKey) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. e -> Validation (NonEmpty e) a
failure forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey -> VerificationError
PublicKeyMismatch PublicKey
credentialPublicKey PublicKey
pubKey
let attChallenge :: Digest SHA256
attChallenge = ExtAttestation -> Digest SHA256
attestationChallenge ExtAttestation
attExt
let clientDataHashDigest :: Digest SHA256
clientDataHashDigest = ClientDataHash -> Digest SHA256
M.unClientDataHash ClientDataHash
clientDataHash
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Digest SHA256
attChallenge forall a. Eq a => a -> a -> Bool
== Digest SHA256
clientDataHashDigest) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. e -> Validation (NonEmpty e) a
failure forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> Digest SHA256 -> VerificationError
HashMismatch Digest SHA256
attChallenge Digest SHA256
clientDataHashDigest
let software :: AuthorizationList
software = ExtAttestation -> AuthorizationList
softwareEnforced ExtAttestation
attExt
let tee :: AuthorizationList
tee = ExtAttestation -> AuthorizationList
teeEnforced ExtAttestation
attExt
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust (AuthorizationList -> Maybe ()
allApplications AuthorizationList
software) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (AuthorizationList -> Maybe ()
allApplications AuthorizationList
tee)) forall a b. (a -> b) -> a -> b
$ forall e a. e -> Validation (NonEmpty e) a
failure VerificationError
AndroidKeyAllApplicationsFieldFound
let targetSet :: Set Integer
targetSet = forall a. a -> Set a
Set.singleton Integer
kmPurposeSign
case TrustLevel
requiredTrustLevel of
TrustLevel
SoftwareEnforced -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AuthorizationList -> Maybe Integer
origin AuthorizationList
software forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Integer
kmOriginGenerated Bool -> Bool -> Bool
|| AuthorizationList -> Maybe Integer
origin AuthorizationList
tee forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Integer
kmOriginGenerated) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. e -> Validation (NonEmpty e) a
failure forall a b. (a -> b) -> a -> b
$ Maybe Integer -> Maybe Integer -> VerificationError
AndroidKeyOriginFieldInvalid (AuthorizationList -> Maybe Integer
origin AuthorizationList
tee) (AuthorizationList -> Maybe Integer
origin AuthorizationList
software)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. a -> Maybe a
Just Set Integer
targetSet forall a. Eq a => a -> a -> Bool
== AuthorizationList -> Maybe (Set Integer)
purpose AuthorizationList
software Bool -> Bool -> Bool
|| forall a. a -> Maybe a
Just Set Integer
targetSet forall a. Eq a => a -> a -> Bool
== AuthorizationList -> Maybe (Set Integer)
purpose AuthorizationList
tee) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. e -> Validation (NonEmpty e) a
failure forall a b. (a -> b) -> a -> b
$ Maybe (Set Integer) -> Maybe (Set Integer) -> VerificationError
AndroidKeyPurposeFieldInvalid (AuthorizationList -> Maybe (Set Integer)
purpose AuthorizationList
tee) (AuthorizationList -> Maybe (Set Integer)
purpose AuthorizationList
software)
pure ()
TrustLevel
TeeEnforced -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AuthorizationList -> Maybe Integer
origin AuthorizationList
tee forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Integer
kmOriginGenerated) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. e -> Validation (NonEmpty e) a
failure forall a b. (a -> b) -> a -> b
$ Maybe Integer -> Maybe Integer -> VerificationError
AndroidKeyOriginFieldInvalid (AuthorizationList -> Maybe Integer
origin AuthorizationList
tee) forall a. Maybe a
Nothing
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. a -> Maybe a
Just Set Integer
targetSet forall a. Eq a => a -> a -> Bool
== AuthorizationList -> Maybe (Set Integer)
purpose AuthorizationList
tee) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. e -> Validation (NonEmpty e) a
failure forall a b. (a -> b) -> a -> b
$ Maybe (Set Integer) -> Maybe (Set Integer) -> VerificationError
AndroidKeyPurposeFieldInvalid (AuthorizationList -> Maybe (Set Integer)
purpose AuthorizationList
tee) forall a. Maybe a
Nothing
pure ()
pure $
forall (k :: AttestationKind).
AttestationType k -> SomeAttestationType
M.SomeAttestationType forall a b. (a -> b) -> a -> b
$
forall (p :: ProtocolKind).
VerifiableAttestationType
-> AttestationChain p -> AttestationType ('Verifiable p)
M.AttestationTypeVerifiable VerifiableAttestationType
M.VerifiableAttestationTypeBasic (NonEmpty SignedCertificate -> AttestationChain 'Fido2
M.Fido2Chain NonEmpty SignedCertificate
x5c)
asfTrustAnchors :: Format -> VerifiableAttestationType -> CertificateStore
asfTrustAnchors Format
_ VerifiableAttestationType
_ = forall a. Monoid a => a
mempty
format :: M.SomeAttestationStatementFormat
format :: SomeAttestationStatementFormat
format = forall a.
AttestationStatementFormat a =>
a -> SomeAttestationStatementFormat
M.SomeAttestationStatementFormat forall a b. (a -> b) -> a -> b
$ TrustLevel -> Format
Format TrustLevel
TeeEnforced