{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Crypto.WebAuthn.AttestationStatementFormat.Apple
( format,
Format (..),
VerificationError (..),
)
where
import qualified Codec.CBOR.Term as CBOR
import Control.Exception (Exception)
import Control.Monad (forM, unless)
import Crypto.Hash (Digest, SHA256, digestFromByteString, hash)
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 Crypto.WebAuthn.Internal.Utils (failure)
import qualified Crypto.WebAuthn.Model.Types as M
import qualified Data.ASN1.Parse as ASN1
import qualified Data.ASN1.Types as ASN1
import Data.Aeson (ToJSON, object, toJSON, (.=))
import Data.Bifunctor (first)
import qualified Data.ByteArray as BA
import Data.FileEmbed (embedFile)
import Data.HashMap.Strict ((!?))
import Data.List.NonEmpty (NonEmpty ((:|)), toList)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as Text
import qualified Data.X509 as X509
import qualified Data.X509.CertificateStore as X509
data Format = Format
instance Show Format where
show :: Format -> [Char]
show = Text -> [Char]
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AttestationStatementFormat a => a -> Text
M.asfIdentifier
data VerificationError
=
NonceMismatch
{
VerificationError -> Digest SHA256
calculatedNonce :: Digest SHA256,
VerificationError -> Digest SHA256
receivedNonce :: Digest SHA256
}
|
PublicKeyMismatch
{
VerificationError -> PublicKey
credentialDataPublicKey :: Cose.PublicKey,
VerificationError -> PublicKey
certificatePublicKey :: Cose.PublicKey
}
deriving (Int -> VerificationError -> ShowS
[VerificationError] -> ShowS
VerificationError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [VerificationError] -> ShowS
$cshowList :: [VerificationError] -> ShowS
show :: VerificationError -> [Char]
$cshow :: VerificationError -> [Char]
showsPrec :: Int -> VerificationError -> ShowS
$cshowsPrec :: Int -> VerificationError -> ShowS
Show, Show VerificationError
Typeable VerificationError
SomeException -> Maybe VerificationError
VerificationError -> [Char]
VerificationError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> [Char])
-> Exception e
displayException :: VerificationError -> [Char]
$cdisplayException :: VerificationError -> [Char]
fromException :: SomeException -> Maybe VerificationError
$cfromException :: SomeException -> Maybe VerificationError
toException :: VerificationError -> SomeException
$ctoException :: VerificationError -> SomeException
Exception)
data Statement = Statement
{ Statement -> NonEmpty SignedCertificate
x5c :: NE.NonEmpty X509.SignedCertificate,
Statement -> Digest SHA256
sNonce :: Digest SHA256,
Statement -> PublicKey
pubKey :: Cose.PublicKey
}
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> [Char]
$cshow :: Statement -> [Char]
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show)
instance ToJSON Statement where
toJSON :: Statement -> Value
toJSON Statement {NonEmpty SignedCertificate
Digest SHA256
PublicKey
pubKey :: PublicKey
sNonce :: Digest SHA256
x5c :: NonEmpty SignedCertificate
pubKey :: Statement -> PublicKey
sNonce :: Statement -> Digest SHA256
x5c :: Statement -> NonEmpty SignedCertificate
..} =
[Pair] -> Value
object
[ Key
"x5c" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty SignedCertificate
x5c
]
newtype AppleNonceExtension = AppleNonceExtension
{ AppleNonceExtension -> Digest SHA256
nonce :: Digest SHA256
}
deriving (AppleNonceExtension -> AppleNonceExtension -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppleNonceExtension -> AppleNonceExtension -> Bool
$c/= :: AppleNonceExtension -> AppleNonceExtension -> Bool
== :: AppleNonceExtension -> AppleNonceExtension -> Bool
$c== :: AppleNonceExtension -> AppleNonceExtension -> Bool
Eq, Int -> AppleNonceExtension -> ShowS
[AppleNonceExtension] -> ShowS
AppleNonceExtension -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AppleNonceExtension] -> ShowS
$cshowList :: [AppleNonceExtension] -> ShowS
show :: AppleNonceExtension -> [Char]
$cshow :: AppleNonceExtension -> [Char]
showsPrec :: Int -> AppleNonceExtension -> ShowS
$cshowsPrec :: Int -> AppleNonceExtension -> ShowS
Show)
instance X509.Extension AppleNonceExtension where
extOID :: AppleNonceExtension -> OID
extOID = forall a b. a -> b -> a
const [Integer
1, Integer
2, Integer
840, Integer
113635, Integer
100, Integer
8, Integer
2]
extHasNestedASN1 :: Proxy AppleNonceExtension -> Bool
extHasNestedASN1 = forall a b. a -> b -> a
const Bool
False
extEncode :: AppleNonceExtension -> [ASN1]
extEncode = forall a. HasCallStack => [Char] -> a
error [Char]
"extEncode for AppleNonceExtension is unimplemented"
extDecode :: [ASN1] -> Either [Char] AppleNonceExtension
extDecode = forall a. ParseASN1 a -> [ASN1] -> Either [Char] a
ASN1.runParseASN1 ParseASN1 AppleNonceExtension
decode
where
decode :: ASN1.ParseASN1 AppleNonceExtension
decode :: ParseASN1 AppleNonceExtension
decode = do
ASN1.OctetString ByteString
nonce <-
forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
ASN1.onNextContainer ASN1ConstructionType
ASN1.Sequence forall a b. (a -> b) -> a -> b
$
forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
ASN1.onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
ASN1.Container ASN1Class
ASN1.Context Int
1) ParseASN1 ASN1
ASN1.getNext
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"The nonce in the Extention was not a valid SHA256 hash")
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> AppleNonceExtension
AppleNonceExtension)
(forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString ByteString
nonce)
instance M.AttestationStatementFormat Format where
type AttStmt Format = Statement
asfIdentifier :: Format -> Text
asfIdentifier Format
_ = Text
"apple"
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
"x5c" of
Just (CBOR.TList (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty -> Just NonEmpty Term
x5cRaw)) -> do
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
. [Char] -> Text
Text.pack) (ByteString -> Either [Char] 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
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show Term
cert)
let cert :: Certificate
cert = SignedCertificate -> Certificate
X509.getCertificate SignedCertificate
credCert
PublicKey
pubKey <- PubKey -> Either Text PublicKey
Cose.fromX509 forall a b. (a -> b) -> a -> b
$ Certificate -> PubKey
X509.certPubKey Certificate
cert
AppleNonceExtension {Digest SHA256
nonce :: Digest SHA256
nonce :: AppleNonceExtension -> Digest SHA256
..} <- case forall a. Extension a => Extensions -> Maybe (Either [Char] a)
X509.extensionGetE forall a b. (a -> b) -> a -> b
$ Certificate -> Extensions
X509.certExtensions Certificate
cert of
Just (Right AppleNonceExtension
ext) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AppleNonceExtension
ext
Just (Left [Char]
err) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode certificate apple nonce extension: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
err
Maybe (Either [Char] AppleNonceExtension)
Nothing -> forall a b. a -> Either a b
Left Text
"Certificate apple nonce extension is missing"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NonEmpty SignedCertificate
-> Digest SHA256 -> PublicKey -> Statement
Statement NonEmpty SignedCertificate
x5c Digest SHA256
nonce PublicKey
pubKey
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 (x5c: nonempty list): " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show HashMap Text Term
xs)
asfEncode :: Format -> AttStmt Format -> Term
asfEncode Format
_ Statement {NonEmpty SignedCertificate
Digest SHA256
PublicKey
pubKey :: PublicKey
sNonce :: Digest SHA256
x5c :: NonEmpty SignedCertificate
pubKey :: Statement -> PublicKey
sNonce :: Statement -> Digest SHA256
x5c :: Statement -> NonEmpty SignedCertificate
..} =
let encodedx5c :: [Term]
encodedx5c = 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
in [(Term, Term)] -> Term
CBOR.TMap
[ (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 {NonEmpty SignedCertificate
Digest SHA256
PublicKey
pubKey :: PublicKey
sNonce :: Digest SHA256
x5c :: NonEmpty SignedCertificate
pubKey :: Statement -> PublicKey
sNonce :: Statement -> Digest SHA256
x5c :: Statement -> NonEmpty SignedCertificate
..}
M.AuthenticatorData {adAttestedCredentialData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AttestedCredentialData c raw
adAttestedCredentialData = AttestedCredentialData 'Registration 'True
credData, Maybe AuthenticatorExtensionOutputs
AuthenticatorDataFlags
SignatureCounter
RpIdHash
RawField 'True
adRawData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
adExtensions :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> Maybe AuthenticatorExtensionOutputs
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
adRawData :: RawField 'True
adExtensions :: Maybe AuthenticatorExtensionOutputs
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
..}
ClientDataHash
clientDataHash = do
let nonceToHash :: ByteString
nonceToHash = RawField 'True -> ByteString
M.unRaw RawField 'True
adRawData forall a. Semigroup a => a -> a -> a
<> forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ClientDataHash -> Digest SHA256
M.unClientDataHash ClientDataHash
clientDataHash)
let nonce :: Digest SHA256
nonce = forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ByteString
nonceToHash
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Digest SHA256
nonce forall a. Eq a => a -> a -> Bool
== Digest SHA256
sNonce) 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
NonceMismatch Digest SHA256
nonce Digest SHA256
sNonce
let credentialPublicKey :: PublicKey
credentialPublicKey = PublicKeyWithSignAlg -> PublicKey
Cose.publicKey forall a b. (a -> b) -> a -> b
$ forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> PublicKeyWithSignAlg
M.acdCredentialPublicKey AttestedCredentialData 'Registration 'True
credData
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
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.VerifiableAttestationTypeAnonCA (NonEmpty SignedCertificate -> AttestationChain 'Fido2
M.Fido2Chain NonEmpty SignedCertificate
x5c)
asfTrustAnchors :: Format -> VerifiableAttestationType -> CertificateStore
asfTrustAnchors Format
_ VerifiableAttestationType
_ = CertificateStore
rootCertificateStore
rootCertificateStore :: X509.CertificateStore
rootCertificateStore :: CertificateStore
rootCertificateStore = [SignedCertificate] -> CertificateStore
X509.makeCertificateStore [SignedCertificate
rootCertificate]
rootCertificate :: X509.SignedCertificate
rootCertificate :: SignedCertificate
rootCertificate = case ByteString -> Either [Char] SignedCertificate
X509.decodeSignedCertificate $(embedFile "root-certs/apple/Apple_WebAuthn_Root_CA.crt") of
Left [Char]
err -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Error while decoding Apple root certificate: " forall a. Semigroup a => a -> a -> a
<> [Char]
err
Right SignedCertificate
cert -> SignedCertificate
cert
format :: M.SomeAttestationStatementFormat
format :: SomeAttestationStatementFormat
format = forall a.
AttestationStatementFormat a =>
a -> SomeAttestationStatementFormat
M.SomeAttestationStatementFormat Format
Format