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

-- | Stability: experimental
-- This module implements the
-- [FIDO U2F Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-fido-u2f-attestation).
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

-- | The Fido U2F 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

-- | Decoding errors specific to Fido U2F attestation
data DecodingError
  = -- | No Signature field was present
    NoSig
  | -- | No x5c certificate was present
    NoX5C
  | -- | Multiple x5c certificates were found where only one was expected
    MultipleX5C
  | -- | There was an error decoding the x5c certificate, string is the error resulted by the `Data.X509.decodeSignedCertificate` function
    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)

-- | Verification errors specific to Fido U2F attestation
data VerificationError
  = -- | The public key in the certificate was not an EC Key or the curve was not the p256 curve
    InvalidCertificatePublicKey X509.PubKey
  | -- | The credential public key is not an ECDSA key
    NonECDSACredentialPublicKey Cose.PublicKey
  | -- | The x and/or y coordinates of the credential public key don't have a length of 32 bytes
    WrongCoordinateSize Int Int
  | -- | The provided public key cannot validate the signature over the verification data
    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)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-fido-u2f-attestation)
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
      -- 1. Verify that attStmt is valid CBOR conforming to the syntax defined above
      -- and perform CBOR decoding on it to extract the contained fields.
      -- NOTE: The validity of the data is already checked during decoding.

      -- 2.a Check that x5c has exactly one element and let attCert be that element.
      -- NOTE: This has already been done during decoding

      -- 2.b Let certificate public key be the public key conveyed by attCert. If
      -- certificate public key is not an Elliptic Curve (EC) public key over the
      -- P-256 curve, terminate this algorithm and return an appropriate error.
      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

      -- 3. Extract the claimed rpIdHash from authenticatorData, and the claimed
      -- credentialId and credentialPublicKey from authenticatorData.attestedCredentialData.
      -- NOTE: Done in patternmatch

      -- 4. Convert the COSE_KEY formatted credentialPublicKey (see Section 7 of
      -- [RFC8152]) to Raw ANSI X9.62 public key format (see ALG_KEY_ECC_X962_RAW in
      -- Section 3.6.2 Public Key Representation Formats of [FIDO-Registry]).

      -- 4.a Let x be the value corresponding to the "-2" key (representing x
      -- coordinate) in credentialPublicKey, and confirm its size to be of 32 bytes.
      -- If size differs or "-2" key is not found, terminate this algorithm and
      -- return an appropriate error.
      -- 4.b Let y be the value corresponding to the "-3" key (representing y
      -- coordinate) in credentialPublicKey, and confirm its size to be of 32 bytes.
      -- If size differs or "-3" key is not found, terminate this algorithm and
      -- return an appropriate error.
      -- NOTE: Already done during decoding of the COSE public key
      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

          -- 4.c Let publicKeyU2F be the concatenation 0x04 || x || y.
          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

          -- 5. Let verificationData be the concatenation of (0x00 || rpIdHash ||
          -- clientDataHash || credentialId || publicKeyU2F) (see Section 4.3 of
          -- [FIDO-U2F-Message-Formats]).
          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

          -- 6. Verify the sig using verificationData and the certificate public key per
          -- section 4.1.4 of [SEC1] with SHA-256 as the hash function used in step two.
          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

      -- 7. Optionally, inspect x5c and consult externally provided knowledge to
      -- determine whether attStmt conveys a Basic or AttCA attestation.
      -- 8. If successful, return implementation-specific values representing
      -- attestation type Basic, AttCA or uncertainty, and attestation trust path
      -- x5c.
      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

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