{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Crypto.WebAuthn.AttestationStatementFormat.FidoU2F
( format,
Format (..),
VerificationError (..),
)
where
import qualified Codec.CBOR.Term as CBOR
import Control.Exception (Exception)
import Control.Monad (unless)
import Crypto.PubKey.ECC.Types (CurveName (SEC_p256r1))
import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose
import Crypto.WebAuthn.Internal.Utils (failure)
import qualified Crypto.WebAuthn.Model.Types as M
import Data.Aeson (ToJSON, object, toJSON, (.=))
import Data.Bifunctor (first)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import Data.HashMap.Strict ((!?))
import qualified Data.Text as Text
import qualified Data.X509 as X509
import qualified Data.X509.EC 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 DecodingError
=
NoSig
|
NoX5C
|
MultipleX5C
|
DecodingErrorX5C String
deriving (Int -> DecodingError -> ShowS
[DecodingError] -> ShowS
DecodingError -> String
(Int -> DecodingError -> ShowS)
-> (DecodingError -> String)
-> ([DecodingError] -> ShowS)
-> Show DecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodingError] -> ShowS
$cshowList :: [DecodingError] -> ShowS
show :: DecodingError -> String
$cshow :: DecodingError -> String
showsPrec :: Int -> DecodingError -> ShowS
$cshowsPrec :: Int -> DecodingError -> ShowS
Show, Show DecodingError
Typeable DecodingError
Typeable DecodingError
-> Show DecodingError
-> (DecodingError -> SomeException)
-> (SomeException -> Maybe DecodingError)
-> (DecodingError -> String)
-> Exception DecodingError
SomeException -> Maybe DecodingError
DecodingError -> String
DecodingError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: DecodingError -> String
$cdisplayException :: DecodingError -> String
fromException :: SomeException -> Maybe DecodingError
$cfromException :: SomeException -> Maybe DecodingError
toException :: DecodingError -> SomeException
$ctoException :: DecodingError -> SomeException
$cp2Exception :: Show DecodingError
$cp1Exception :: Typeable DecodingError
Exception)
data VerificationError
=
InvalidCertificatePublicKey X509.PubKey
|
NonECDSACredentialPublicKey Cose.PublicKey
|
WrongCoordinateSize Int Int
|
InvalidSignature X509.SignatureFailure
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 -> ByteString
sig :: BS.ByteString,
Statement -> SignedCertificate
attCert :: X509.SignedCertificate
}
deriving (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, 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)
instance ToJSON Statement where
toJSON :: Statement -> Value
toJSON Statement {ByteString
SignedCertificate
attCert :: SignedCertificate
sig :: ByteString
attCert :: Statement -> SignedCertificate
sig :: Statement -> ByteString
..} =
[Pair] -> Value
object
[ Text
"attestnCert" Text -> SignedCertificate -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SignedCertificate
attCert,
Text
"sig" Text -> ByteString -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString
sig
]
instance M.AttestationStatementFormat Format where
type AttStmt Format = Statement
asfIdentifier :: Format -> Text
asfIdentifier Format
_ = Text
"fido-u2f"
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
"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.TBytes ByteString
sig), Just (CBOR.TList [CBOR.TBytes ByteString
certBytes])) -> do
SignedCertificate
attCert <- (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)
pure $ ByteString -> SignedCertificate -> Statement
Statement ByteString
sig SignedCertificate
attCert
(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 (sig: bytes, x5c: one-element 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 {..} =
[(Term, Term)] -> Term
CBOR.TMap
[ (Text -> Term
CBOR.TString Text
"sig", ByteString -> Term
CBOR.TBytes ByteString
sig),
(Text -> Term
CBOR.TString Text
"x5c", [Term] -> Term
CBOR.TList [ByteString -> Term
CBOR.TBytes (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ SignedCertificate -> ByteString
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
X509.encodeSignedObject SignedCertificate
attCert])
]
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
M.adAttestedCredentialData = M.AttestedCredentialData {CosePublicKey
AAGUID
CredentialId
RawField 'True
acdCredentialPublicKeyBytes :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> RawField raw
acdCredentialPublicKey :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CosePublicKey
acdCredentialId :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CredentialId
acdAaguid :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> AAGUID
acdCredentialPublicKeyBytes :: RawField 'True
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
..},
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 certPubKey :: PubKey
certPubKey = Certificate -> PubKey
X509.certPubKey (Certificate -> PubKey) -> Certificate -> PubKey
forall a b. (a -> b) -> a -> b
$ SignedCertificate -> Certificate
X509.getCertificate SignedCertificate
attCert
case PubKey
certPubKey of
X509.PubKeyEC PubKeyEC
pk ->
case PubKeyEC -> Maybe CurveName
X509.ecPubKeyCurveName PubKeyEC
pk of
Just CurveName
SEC_p256r1 -> () -> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe CurveName
_ -> 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
$ PubKey -> VerificationError
InvalidCertificatePublicKey PubKey
certPubKey
PubKey
_ -> 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
$ PubKey -> VerificationError
InvalidCertificatePublicKey PubKey
certPubKey
case CosePublicKey -> PublicKey
Cose.fromCose CosePublicKey
acdCredentialPublicKey of
Cose.PublicKeyECDSA {ecdsaX :: PublicKey -> ByteString
ecdsaX = ByteString
xb, ecdsaY :: PublicKey -> ByteString
ecdsaY = ByteString
yb} -> do
let xlen :: Int
xlen = ByteString -> Int
BS.length ByteString
xb
ylen :: Int
ylen = ByteString -> Int
BS.length ByteString
yb
Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
xlen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 Bool -> Bool -> Bool
&& Int
ylen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32) (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 -> Validation (NonEmpty VerificationError) ())
-> VerificationError -> Validation (NonEmpty VerificationError) ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> VerificationError
WrongCoordinateSize Int
xlen Int
ylen
let publicKeyU2F :: ByteString
publicKeyU2F = Word8 -> ByteString
BS.singleton Word8
0x04 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
xb ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
yb
let credId :: ByteString
credId = CredentialId -> ByteString
M.unCredentialId CredentialId
acdCredentialId
verificationData :: ByteString
verificationData = Word8 -> ByteString
BS.singleton Word8
0x00 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (RpIdHash -> Digest SHA256
M.unRpIdHash RpIdHash
adRpIdHash) 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) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
credId ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
publicKeyU2F
case SignatureALG
-> PubKey -> ByteString -> ByteString -> SignatureVerification
X509.verifySignature (HashALG -> PubKeyALG -> SignatureALG
X509.SignatureALG HashALG
X509.HashSHA256 PubKeyALG
X509.PubKeyALG_EC) PubKey
certPubKey ByteString
verificationData ByteString
sig of
SignatureVerification
X509.SignaturePass -> () -> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
X509.SignatureFailed SignatureFailure
e -> 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
InvalidSignature SignatureFailure
e
pure ()
PublicKey
key -> 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 -> VerificationError
NonECDSACredentialPublicKey PublicKey
key
pure $
AttestationType ('Verifiable 'FidoU2F) -> SomeAttestationType
forall (k :: AttestationKind).
AttestationType k -> SomeAttestationType
M.SomeAttestationType (AttestationType ('Verifiable 'FidoU2F) -> SomeAttestationType)
-> AttestationType ('Verifiable 'FidoU2F) -> SomeAttestationType
forall a b. (a -> b) -> a -> b
$
VerifiableAttestationType
-> AttestationChain 'FidoU2F
-> AttestationType ('Verifiable 'FidoU2F)
forall (p :: ProtocolKind).
VerifiableAttestationType
-> AttestationChain p -> AttestationType ('Verifiable p)
M.AttestationTypeVerifiable VerifiableAttestationType
M.VerifiableAttestationTypeUncertain (SignedCertificate -> AttestationChain 'FidoU2F
M.FidoU2FCert SignedCertificate
attCert)
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