{-# 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)
import Control.Monad.Cont (unless)
import Crypto.Hash (Digest, SHA256, digestFromByteString, hash)
import qualified Crypto.WebAuthn.Cose.Internal.Verify 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 -> 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 VerificationError
=
NonceMismatch (Digest SHA256) (Digest SHA256)
|
PublickeyMismatch Cose.PublicKey Cose.PublicKey
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
$cp2Exception :: Show VerificationError
$cp1Exception :: Typeable VerificationError
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
(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 {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
[ Text
"x5c" Text -> NonEmpty SignedCertificate -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= NonEmpty SignedCertificate
x5c
]
newtype AppleNonceExtension = AppleNonceExtension
{ AppleNonceExtension -> Digest SHA256
nonce :: Digest SHA256
}
deriving (AppleNonceExtension -> AppleNonceExtension -> Bool
(AppleNonceExtension -> AppleNonceExtension -> Bool)
-> (AppleNonceExtension -> AppleNonceExtension -> Bool)
-> Eq AppleNonceExtension
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 -> String
(Int -> AppleNonceExtension -> ShowS)
-> (AppleNonceExtension -> String)
-> ([AppleNonceExtension] -> ShowS)
-> Show AppleNonceExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppleNonceExtension] -> ShowS
$cshowList :: [AppleNonceExtension] -> ShowS
show :: AppleNonceExtension -> String
$cshow :: AppleNonceExtension -> String
showsPrec :: Int -> AppleNonceExtension -> ShowS
$cshowsPrec :: Int -> AppleNonceExtension -> ShowS
Show)
instance X509.Extension AppleNonceExtension where
extOID :: AppleNonceExtension -> OID
extOID = OID -> AppleNonceExtension -> OID
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 = Bool -> Proxy AppleNonceExtension -> Bool
forall a b. a -> b -> a
const Bool
False
extEncode :: AppleNonceExtension -> [ASN1]
extEncode = String -> AppleNonceExtension -> [ASN1]
forall a. HasCallStack => String -> a
error String
"extEncode for AppleNonceExtension is unimplemented"
extDecode :: [ASN1] -> Either String AppleNonceExtension
extDecode = ParseASN1 AppleNonceExtension
-> [ASN1] -> Either String AppleNonceExtension
forall a. ParseASN1 a -> [ASN1] -> Either String a
ASN1.runParseASN1 ParseASN1 AppleNonceExtension
decode
where
decode :: ASN1.ParseASN1 AppleNonceExtension
decode :: ParseASN1 AppleNonceExtension
decode = do
ASN1.OctetString ByteString
nonce <-
ASN1ConstructionType -> ParseASN1 ASN1 -> ParseASN1 ASN1
forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
ASN1.onNextContainer ASN1ConstructionType
ASN1.Sequence (ParseASN1 ASN1 -> ParseASN1 ASN1)
-> ParseASN1 ASN1 -> ParseASN1 ASN1
forall a b. (a -> b) -> a -> b
$
ASN1ConstructionType -> ParseASN1 ASN1 -> ParseASN1 ASN1
forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
ASN1.onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
ASN1.Container ASN1Class
ASN1.Context Int
1) ParseASN1 ASN1
ASN1.getNext
ParseASN1 AppleNonceExtension
-> (Digest SHA256 -> ParseASN1 AppleNonceExtension)
-> Maybe (Digest SHA256)
-> ParseASN1 AppleNonceExtension
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(String -> ParseASN1 AppleNonceExtension
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"The nonce in the Extention was not a valid SHA256 hash")
(AppleNonceExtension -> ParseASN1 AppleNonceExtension
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppleNonceExtension -> ParseASN1 AppleNonceExtension)
-> (Digest SHA256 -> AppleNonceExtension)
-> Digest SHA256
-> ParseASN1 AppleNonceExtension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> AppleNonceExtension
AppleNonceExtension)
(ByteString -> Maybe (Digest SHA256)
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 HashMap Text Term -> Text -> Maybe Term
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"x5c" of
Just (CBOR.TList ([Term] -> Maybe (NonEmpty Term)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty -> Just NonEmpty Term
x5cRaw)) -> do
x5c :: NonEmpty SignedCertificate
x5c@(SignedCertificate
credCert :| [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
x5cRaw ((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
credCert
PublicKey
pubKey <- PubKey -> Either Text PublicKey
Cose.fromX509 (PubKey -> Either Text PublicKey)
-> PubKey -> Either Text PublicKey
forall a b. (a -> b) -> a -> b
$ Certificate -> PubKey
X509.certPubKey Certificate
cert
AppleNonceExtension {Digest SHA256
nonce :: Digest SHA256
nonce :: AppleNonceExtension -> Digest SHA256
..} <- case Extensions -> Maybe (Either String AppleNonceExtension)
forall a. Extension a => Extensions -> Maybe (Either String a)
X509.extensionGetE (Extensions -> Maybe (Either String AppleNonceExtension))
-> Extensions -> Maybe (Either String AppleNonceExtension)
forall a b. (a -> b) -> a -> b
$ Certificate -> Extensions
X509.certExtensions Certificate
cert of
Just (Right AppleNonceExtension
ext) -> AppleNonceExtension -> Either Text AppleNonceExtension
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppleNonceExtension
ext
Just (Left String
err) -> Text -> Either Text AppleNonceExtension
forall a b. a -> Either a b
Left (Text -> Either Text AppleNonceExtension)
-> Text -> Either Text AppleNonceExtension
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode certificate apple nonce extension: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
err
Maybe (Either String AppleNonceExtension)
Nothing -> Text -> Either Text AppleNonceExtension
forall a b. a -> Either a b
Left Text
"Certificate apple nonce extension is missing"
Statement -> Either Text Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Statement -> Either Text Statement)
-> Statement -> Either Text Statement
forall a b. (a -> b) -> a -> b
$ NonEmpty SignedCertificate
-> Digest SHA256 -> PublicKey -> Statement
Statement NonEmpty SignedCertificate
x5c Digest SHA256
nonce PublicKey
pubKey
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 (x5c: nonempty 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 {..} =
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
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 {..}
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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ClientDataHash -> Digest SHA256
M.unClientDataHash ClientDataHash
clientDataHash)
let nonce :: Digest SHA256
nonce = ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ByteString
nonceToHash
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Digest SHA256
nonce Digest SHA256 -> Digest SHA256 -> Bool
forall a. Eq a => a -> a -> Bool
== Digest SHA256
sNonce) (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
$ Digest SHA256 -> Digest SHA256 -> VerificationError
NonceMismatch Digest SHA256
nonce Digest SHA256
sNonce
let credentialPublicKey :: PublicKey
credentialPublicKey = CosePublicKey -> PublicKey
Cose.fromCose (CosePublicKey -> PublicKey) -> CosePublicKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ AttestedCredentialData 'Registration 'True -> CosePublicKey
forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CosePublicKey
M.acdCredentialPublicKey AttestedCredentialData 'Registration 'True
credData
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PublicKey
credentialPublicKey PublicKey -> PublicKey -> Bool
forall a. Eq a => a -> a -> Bool
== PublicKey
pubKey) (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
$ PublicKey -> PublicKey -> VerificationError
PublickeyMismatch PublicKey
credentialPublicKey PublicKey
pubKey
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.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 String SignedCertificate
X509.decodeSignedCertificate $(embedFile "root-certs/apple/Apple_WebAuthn_Root_CA.crt") of
Left String
err -> String -> SignedCertificate
forall a. HasCallStack => String -> a
error (String -> SignedCertificate) -> String -> SignedCertificate
forall a b. (a -> b) -> a -> b
$ String
"Error while decoding Apple root certificate: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err
Right SignedCertificate
cert -> SignedCertificate
cert
format :: M.SomeAttestationStatementFormat
format :: SomeAttestationStatementFormat
format = Format -> SomeAttestationStatementFormat
forall a.
AttestationStatementFormat a =>
a -> SomeAttestationStatementFormat
M.SomeAttestationStatementFormat Format
Format