{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

-- | Stability: experimental
-- This module implements the
-- [Android SafetyNet Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-android-safetynet-attestation).
module Crypto.WebAuthn.AttestationStatementFormat.AndroidSafetyNet
  ( format,
    Format (..),
    Integrity (..),
    VerificationError (..),
  )
where

import Codec.CBOR.Term (Term (TBytes, TString))
import qualified Codec.CBOR.Term as CBOR
import Control.Lens ((^.), (^?))
import Control.Lens.Combinators (_Just)
import Control.Monad (unless, when)
import Control.Monad.Except (MonadError, runExcept, throwError)
import qualified Crypto.Hash as Hash
import qualified Crypto.JOSE as JOSE
import qualified Crypto.JWT as JOSE
import Crypto.WebAuthn.Internal.DateOrphans ()
import Crypto.WebAuthn.Internal.Utils (failure)
import qualified Crypto.WebAuthn.Model.Types as M
import qualified Data.ASN1.Types.String as X509
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import Data.Bifunctor (Bifunctor (first))
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Lazy as LBS
import Data.Fixed (Fixed (MkFixed), Milli)
import Data.HashMap.Lazy ((!?))
import qualified Data.Hourglass as HG
import qualified Data.List.NonEmpty as NE
import Data.String (IsString)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8)
import qualified Data.X509 as X509
import qualified Data.X509.Validation as X509
import GHC.Exception (Exception)
import GHC.Generics (Generic)

-- | [(spec)](https://developer.android.com/training/safetynet/attestation#potential-integrity-verdicts)
-- The integrity of an android device from which a SafetyNet message
-- originated.
data Integrity
  = -- | The device has no integrity, which is the case for an emulator, or it
    -- could be the case for a compromised device
    NoIntegrity
  | -- | The device must have passed the basic integrity check, which is e.g.
    -- the case for a device with a custom ROM but not rooted, or a certified
    -- device with an unlocked bootloader
    BasicIntegrity
  | -- | The device passed the [CTS](https://source.android.com/compatibility/cts/),
    -- it is genuine and verified
    CTSProfileIntegrity
  deriving (Int -> Integrity
Integrity -> Int
Integrity -> [Integrity]
Integrity -> Integrity
Integrity -> Integrity -> [Integrity]
Integrity -> Integrity -> Integrity -> [Integrity]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Integrity -> Integrity -> Integrity -> [Integrity]
$cenumFromThenTo :: Integrity -> Integrity -> Integrity -> [Integrity]
enumFromTo :: Integrity -> Integrity -> [Integrity]
$cenumFromTo :: Integrity -> Integrity -> [Integrity]
enumFromThen :: Integrity -> Integrity -> [Integrity]
$cenumFromThen :: Integrity -> Integrity -> [Integrity]
enumFrom :: Integrity -> [Integrity]
$cenumFrom :: Integrity -> [Integrity]
fromEnum :: Integrity -> Int
$cfromEnum :: Integrity -> Int
toEnum :: Int -> Integrity
$ctoEnum :: Int -> Integrity
pred :: Integrity -> Integrity
$cpred :: Integrity -> Integrity
succ :: Integrity -> Integrity
$csucc :: Integrity -> Integrity
Enum, Integrity
forall a. a -> a -> Bounded a
maxBound :: Integrity
$cmaxBound :: Integrity
minBound :: Integrity
$cminBound :: Integrity
Bounded, Integrity -> Integrity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Integrity -> Integrity -> Bool
$c/= :: Integrity -> Integrity -> Bool
== :: Integrity -> Integrity -> Bool
$c== :: Integrity -> Integrity -> Bool
Eq, Eq Integrity
Integrity -> Integrity -> Bool
Integrity -> Integrity -> Ordering
Integrity -> Integrity -> Integrity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Integrity -> Integrity -> Integrity
$cmin :: Integrity -> Integrity -> Integrity
max :: Integrity -> Integrity -> Integrity
$cmax :: Integrity -> Integrity -> Integrity
>= :: Integrity -> Integrity -> Bool
$c>= :: Integrity -> Integrity -> Bool
> :: Integrity -> Integrity -> Bool
$c> :: Integrity -> Integrity -> Bool
<= :: Integrity -> Integrity -> Bool
$c<= :: Integrity -> Integrity -> Bool
< :: Integrity -> Integrity -> Bool
$c< :: Integrity -> Integrity -> Bool
compare :: Integrity -> Integrity -> Ordering
$ccompare :: Integrity -> Integrity -> Ordering
Ord, Int -> Integrity -> ShowS
[Integrity] -> ShowS
Integrity -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Integrity] -> ShowS
$cshowList :: [Integrity] -> ShowS
show :: Integrity -> [Char]
$cshow :: Integrity -> [Char]
showsPrec :: Int -> Integrity -> ShowS
$cshowsPrec :: Int -> Integrity -> ShowS
Show)

-- | The Android SafetyKey Format. Allows configuration of the required level of
-- trust.
data Format = Format
  { -- | What level the integrity check of the originating Android device must
    -- have passed.
    Format -> Integrity
requiredIntegrity :: Integrity,
    -- | The maximum time the received message may be old for it to still be
    -- considered valid.
    Format -> Duration
driftBackwardsTolerance :: HG.Duration,
    -- | The maximum time difference the received message may report being from
    -- the future for it to still be considered valid.
    Format -> Duration
driftForwardsTolerance :: HG.Duration
  }

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

-- | [(spec)](https://developer.android.com/training/safetynet/attestation.html#compat-check-response)
data Response = Response
  { Response -> Milliseconds
timestampMs :: Milliseconds,
    Response -> Text
nonce :: Text,
    Response -> Text
apkPackageName :: Text,
    Response -> [Text]
apkCertificateDigestSha256 :: [Text], -- [Base 64 encoded SHA256 hash]
    Response -> Bool
ctsProfileMatch :: Bool,
    Response -> Bool
basicIntegrity :: Bool,
    Response -> Text
evaluationType :: Text
  }
  deriving (Response -> Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c== :: Response -> Response -> Bool
Eq, Int -> Response -> ShowS
[Response] -> ShowS
Response -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> [Char]
$cshow :: Response -> [Char]
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show, forall x. Rep Response x -> Response
forall x. Response -> Rep Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Response x -> Response
$cfrom :: forall x. Response -> Rep Response x
Generic, Value -> Parser [Response]
Value -> Parser Response
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Response]
$cparseJSONList :: Value -> Parser [Response]
parseJSON :: Value -> Parser Response
$cparseJSON :: Value -> Parser Response
Aeson.FromJSON, [Response] -> Encoding
[Response] -> Value
Response -> Encoding
Response -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Response] -> Encoding
$ctoEncodingList :: [Response] -> Encoding
toJSONList :: [Response] -> Value
$ctoJSONList :: [Response] -> Value
toEncoding :: Response -> Encoding
$ctoEncoding :: Response -> Encoding
toJSON :: Response -> Value
$ctoJSON :: Response -> Value
Aeson.ToJSON)

-- | Milliseconds represented as an 'Integer', used for @timestampMs@
newtype Milliseconds = Milliseconds Integer
  deriving (Milliseconds -> Milliseconds -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Milliseconds -> Milliseconds -> Bool
$c/= :: Milliseconds -> Milliseconds -> Bool
== :: Milliseconds -> Milliseconds -> Bool
$c== :: Milliseconds -> Milliseconds -> Bool
Eq, Int -> Milliseconds -> ShowS
[Milliseconds] -> ShowS
Milliseconds -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Milliseconds] -> ShowS
$cshowList :: [Milliseconds] -> ShowS
show :: Milliseconds -> [Char]
$cshow :: Milliseconds -> [Char]
showsPrec :: Int -> Milliseconds -> ShowS
$cshowsPrec :: Int -> Milliseconds -> ShowS
Show)
  deriving newtype (Value -> Parser [Milliseconds]
Value -> Parser Milliseconds
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Milliseconds]
$cparseJSONList :: Value -> Parser [Milliseconds]
parseJSON :: Value -> Parser Milliseconds
$cparseJSON :: Value -> Parser Milliseconds
Aeson.FromJSON, [Milliseconds] -> Encoding
[Milliseconds] -> Value
Milliseconds -> Encoding
Milliseconds -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Milliseconds] -> Encoding
$ctoEncodingList :: [Milliseconds] -> Encoding
toJSONList :: [Milliseconds] -> Value
$ctoJSONList :: [Milliseconds] -> Value
toEncoding :: Milliseconds -> Encoding
$ctoEncoding :: Milliseconds -> Encoding
toJSON :: Milliseconds -> Value
$ctoJSON :: Milliseconds -> Value
Aeson.ToJSON)
  deriving (Milliseconds -> NanoSeconds
Milliseconds -> Elapsed
Milliseconds -> ElapsedP
forall t.
(t -> ElapsedP)
-> (t -> Elapsed) -> (t -> NanoSeconds) -> Timeable t
timeGetNanoSeconds :: Milliseconds -> NanoSeconds
$ctimeGetNanoSeconds :: Milliseconds -> NanoSeconds
timeGetElapsed :: Milliseconds -> Elapsed
$ctimeGetElapsed :: Milliseconds -> Elapsed
timeGetElapsedP :: Milliseconds -> ElapsedP
$ctimeGetElapsedP :: Milliseconds -> ElapsedP
HG.Timeable) via Milli

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-android-safetynet-attestation)
data Statement = Statement
  { Statement -> Text
ver :: Text.Text,
    Statement -> NonEmpty SignedCertificate
x5c :: NE.NonEmpty X509.SignedCertificate,
    Statement -> Response
response :: Response,
    Statement -> ByteString
responseRaw :: BS.ByteString
  }
  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 Aeson.ToJSON Statement where
  toJSON :: Statement -> Value
toJSON Statement {NonEmpty SignedCertificate
ByteString
Text
Response
responseRaw :: ByteString
response :: Response
x5c :: NonEmpty SignedCertificate
ver :: Text
responseRaw :: Statement -> ByteString
response :: Statement -> Response
x5c :: Statement -> NonEmpty SignedCertificate
ver :: Statement -> Text
..} =
    [Pair] -> Value
Aeson.object
      [ Key
"ver" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
ver,
        Key
"x5c" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty SignedCertificate
x5c,
        Key
"response" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Response
response
      ]

-- | Verification errors specific to Android SafetyNet
data VerificationError
  = -- | The receiced nonce was not set to the concatenation of the
    -- authenticator data and client data hash
    NonceMismatch
      { -- | Nonce from the AndroidSafetyNet response
        VerificationError -> Text
responseNonce :: Text,
        -- | Base64 encoding of the SHA-256 hash of the concatenation of
        -- authenticatorData and clientDataHash
        VerificationError -> Text
calculatedNonce :: Text
      }
  | -- | The response was created to far in the past or future
    ResponseTimeInvalid
      { -- | The UTC time minus the allowed drift specified in the `Format`.
        VerificationError -> DateTime
lowerBound :: HG.DateTime,
        -- | The UTC time plus the allowed drift specified in the `Format`.
        VerificationError -> DateTime
upperBound :: HG.DateTime,
        -- | The UTC time when the Android SafetyNet response was generated
        VerificationError -> DateTime
generatedtime :: HG.DateTime
      }
  | -- | The integrity check failed based on the required integrity from the
    -- format
    IntegrityCheckFailed Integrity
  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)

androidHostName :: VerificationHostName
androidHostName :: VerificationHostName
androidHostName = VerificationHostName
"attest.android.com"

newtype VerificationHostName = VerificationHostName {VerificationHostName -> [Char]
unVerificationHostName :: X509.HostName}
  deriving newtype ([Char] -> VerificationHostName
forall a. ([Char] -> a) -> IsString a
fromString :: [Char] -> VerificationHostName
$cfromString :: [Char] -> VerificationHostName
IsString)

-- | This instance doesn't actually perform any validation
instance MonadError JOSE.Error m => JOSE.VerificationKeyStore m (JOSE.JWSHeader ()) p VerificationHostName where
  getVerificationKeys :: JWSHeader () -> p -> VerificationHostName -> m [JWK]
getVerificationKeys JWSHeader ()
header p
_ VerificationHostName
hostName = do
    NonEmpty SignedCertificate
chain <- case JWSHeader ()
header forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (a :: * -> *) p.
HasX5c a =>
Lens' (a p) (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
JOSE.x5c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. Lens' (HeaderParam p a) a
JOSE.param of
      Maybe (NonEmpty SignedCertificate)
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Error
JOSE.JWSInvalidSignature
      Just NonEmpty SignedCertificate
chain -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty SignedCertificate
chain

    let leaf :: SignedCertificate
leaf = forall a. NonEmpty a -> a
NE.head NonEmpty SignedCertificate
chain
    case ASN1CharacterString -> Maybe [Char]
X509.asn1CharacterToString
      forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ( DnElement -> DistinguishedName -> Maybe ASN1CharacterString
X509.getDnElement DnElement
X509.DnCommonName
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Certificate -> DistinguishedName
X509.certSubjectDN
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedCertificate -> Certificate
X509.getCertificate
              forall a b. (a -> b) -> a -> b
$ SignedCertificate
leaf
          ) of
      Maybe [Char]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just [Char]
commonName ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char]
commonName forall a. Eq a => a -> a -> Bool
== VerificationHostName -> [Char]
unVerificationHostName VerificationHostName
hostName)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
          forall a b. (a -> b) -> a -> b
$ Error
JOSE.JWSInvalidSignature

    -- Create a JWK from the leaf certificate, which is used to sign the payload
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e (m :: * -> *).
(AsError e, MonadError e m) =>
SignedCertificate -> m JWK
JOSE.fromX509Certificate SignedCertificate
leaf

instance M.AttestationStatementFormat Format where
  type AttStmt Format = Statement
  asfIdentifier :: Format -> Text
asfIdentifier Format
_ = Text
"android-safetynet"

  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
"ver", HashMap Text Term
xs forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"response") of
      (Just (TString Text
ver), Just (TBytes ByteString
responseRaw)) -> do
        JWS Identity () JWSHeader
jws <-
          forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Text
"Failed to decode compact JWT response blob: " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a b. (a -> b) -> a -> b
$
            forall e a. Except e a -> Either e a
runExcept @JOSE.Error forall a b. (a -> b) -> a -> b
$
              forall a e (m :: * -> *).
(FromCompact a, AsError e, MonadError e m) =>
ByteString -> m a
JOSE.decodeCompact (ByteString -> ByteString
LBS.fromStrict ByteString
responseRaw)
        Response
response <-
          forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Text
"Failed to verify/decode JWT payload: " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a b. (a -> b) -> a -> b
$
            forall a e (m :: * -> *) (h :: * -> *) p payload k s (t :: * -> *).
(HasAlgorithms a, HasValidationPolicy a, AsError e, MonadError e m,
 HasJWSHeader h, HasParams h,
 VerificationKeyStore m (h p) payload k, Cons s s Word8 Word8,
 AsEmpty s, Foldable t, ProtectionIndicator p) =>
(s -> m payload) -> a -> k -> JWS t p h -> m payload
JOSE.verifyJWSWithPayload
              (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> Error
JOSE.JSONDecodeError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either [Char] a
Aeson.eitherDecode)
              ((StringOrURI -> Bool) -> JWTValidationSettings
JOSE.defaultJWTValidationSettings (forall a b. a -> b -> a
const Bool
True))
              VerificationHostName
androidHostName
              JWS Identity () JWSHeader
jws
        NonEmpty SignedCertificate
x5c <- JWS Identity () JWSHeader
-> Either Text (NonEmpty SignedCertificate)
extractX5C JWS Identity () JWSHeader
jws
        pure $ Statement {NonEmpty SignedCertificate
ByteString
Text
Response
x5c :: NonEmpty SignedCertificate
response :: Response
responseRaw :: ByteString
ver :: Text
responseRaw :: ByteString
response :: Response
x5c :: NonEmpty SignedCertificate
ver :: Text
..}
      (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 types (ver: string, response: bytes): " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show HashMap Text Term
xs)
    where
      extractX5C :: JOSE.CompactJWS JOSE.JWSHeader -> Either Text (NE.NonEmpty X509.SignedCertificate)
      extractX5C :: JWS Identity () JWSHeader
-> Either Text (NonEmpty SignedCertificate)
extractX5C JWS Identity () JWSHeader
jws = do
        Signature () JWSHeader
sig <- case JWS Identity () JWSHeader
jws forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (t :: * -> *) p (a :: * -> *).
Foldable t =>
Fold (JWS t p a) (Signature p a)
JOSE.signatures of
          Maybe (Signature () JWSHeader)
Nothing -> forall a b. a -> Either a b
Left Text
"Can't extract x5c because the JWT contains no signatures"
          Just Signature () JWSHeader
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Signature () JWSHeader
res
        JOSE.HeaderParam () NonEmpty SignedCertificate
x5c <- case Signature () JWSHeader
sig forall s a. s -> Getting a s a -> a
^. forall p (a :: * -> *). Getter (Signature p a) (a p)
JOSE.header forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> *) p.
HasX5c a =>
Lens' (a p) (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
JOSE.x5c of
          Maybe (HeaderParam () (NonEmpty SignedCertificate))
Nothing -> forall a b. a -> Either a b
Left Text
"No x5c in the header of the first JWT signature"
          Just HeaderParam () (NonEmpty SignedCertificate)
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HeaderParam () (NonEmpty SignedCertificate)
res
        forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty SignedCertificate
x5c

  asfEncode :: Format -> AttStmt Format -> Term
asfEncode Format
_ Statement {NonEmpty SignedCertificate
ByteString
Text
Response
responseRaw :: ByteString
response :: Response
x5c :: NonEmpty SignedCertificate
ver :: Text
responseRaw :: Statement -> ByteString
response :: Statement -> Response
x5c :: Statement -> NonEmpty SignedCertificate
ver :: Statement -> Text
..} =
    [(Term, Term)] -> Term
CBOR.TMap
      [ (Text -> Term
TString Text
"ver", Text -> Term
TString Text
ver),
        (Text -> Term
TString Text
"response", ByteString -> Term
TBytes ByteString
responseRaw)
      ]

  type AttStmtVerificationError Format = VerificationError
  asfVerify :: Format
-> DateTime
-> AttStmt Format
-> AuthenticatorData 'Registration 'True
-> ClientDataHash
-> Validation
     (NonEmpty (AttStmtVerificationError Format)) SomeAttestationType
asfVerify Format {Duration
Integrity
driftForwardsTolerance :: Duration
driftBackwardsTolerance :: Duration
requiredIntegrity :: Integrity
driftForwardsTolerance :: Format -> Duration
driftBackwardsTolerance :: Format -> Duration
requiredIntegrity :: Format -> Integrity
..} DateTime
now Statement {NonEmpty SignedCertificate
ByteString
Text
Response
responseRaw :: ByteString
response :: Response
x5c :: NonEmpty SignedCertificate
ver :: Text
responseRaw :: Statement -> ByteString
response :: Statement -> Response
x5c :: Statement -> NonEmpty SignedCertificate
ver :: Statement -> Text
..} M.AuthenticatorData {adRawData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
adRawData = M.WithRaw ByteString
rawData} 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: Done in decoding

    -- 2. Verify that response is a valid SafetyNet response of version ver by following the steps indicated by the
    -- SafetyNet online documentation. As of this writing, there is only one format of the SafetyNet response and ver
    -- is reserved for future use.
    -- NOTE: As stated above, only one version exists, which we assume during decoding

    -- 3. Verify that the nonce attribute in the payload of response is identical to the Base64 encoding of the SHA-256
    -- hash of the concatenation of authenticatorData and clientDataHash.
    let signedData :: ByteString
signedData = ByteString
rawData 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 hashedData :: Digest SHA256
hashedData = forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Hash.hashWith SHA256
Hash.SHA256 ByteString
signedData
    let encodedData :: Text
encodedData = ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Digest SHA256
hashedData
    let responseNonce :: Text
responseNonce = Response -> Text
nonce Response
response
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
responseNonce forall a. Eq a => a -> a -> Bool
== Text
encodedData) 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
$ Text -> Text -> VerificationError
NonceMismatch Text
responseNonce Text
encodedData

    -- 4. Verify that the SafetyNet response actually came from the SafetyNet service by following the steps in the
    -- SafetyNet online documentation.
    -- 4.1. Extract the SSL certificate chain from the JWS message.
    -- NOTE: Done during decoding

    -- 4.2. Validate the SSL certificate chain and use SSL hostname matching to verify that the leaf certificate was
    -- issued to the hostname attest.android.com.
    -- NOTE: Done during decoding

    -- 4.3. Use the certificate to verify the signature of the JWS message.
    -- NOTE: Done during decoding. The jose library forces us to do verification before we access the payload. Since we
    -- would like to decode the payload during decoding, this step is also done during decoding.

    -- 4.4. Check the data of the JWS message to make sure it matches the data within your original request. In particular,
    -- make sure that the timestamp has been validated and that the nonce, package name, and hashes of the app's
    -- signing certificate(s) match the expected values.
    -- NOTE: For WebAuthn, we need not care about the package name or the app's signing certificate. The Nonce as
    -- has already been dealt with.
    let generatedTime :: DateTime
generatedTime = forall t1 t2. (Timeable t1, Time t2) => t1 -> t2
HG.timeConvert forall a b. (a -> b) -> a -> b
$ Response -> Milliseconds
timestampMs Response
response
    let lowerBound :: DateTime
lowerBound = DateTime
now forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
`HG.timeAdd` forall a. Num a => a -> a
negate (forall i. TimeInterval i => i -> Seconds
HG.toSeconds Duration
driftBackwardsTolerance)
    let upperBound :: DateTime
upperBound = DateTime
now forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
`HG.timeAdd` Duration
driftForwardsTolerance
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DateTime
generatedTime forall a. Ord a => a -> a -> Bool
< DateTime
lowerBound) forall a b. (a -> b) -> a -> b
$ forall e a. e -> Validation (NonEmpty e) a
failure forall a b. (a -> b) -> a -> b
$ DateTime -> DateTime -> DateTime -> VerificationError
ResponseTimeInvalid DateTime
lowerBound DateTime
upperBound DateTime
generatedTime
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DateTime
generatedTime forall a. Ord a => a -> a -> Bool
> DateTime
upperBound) forall a b. (a -> b) -> a -> b
$ forall e a. e -> Validation (NonEmpty e) a
failure forall a b. (a -> b) -> a -> b
$ DateTime -> DateTime -> DateTime -> VerificationError
ResponseTimeInvalid DateTime
lowerBound DateTime
upperBound DateTime
generatedTime

    let integrity :: Integrity
integrity = case (Response -> Bool
basicIntegrity Response
response, Response -> Bool
ctsProfileMatch Response
response) of
          (Bool
_, Bool
True) -> Integrity
CTSProfileIntegrity
          (Bool
True, Bool
False) -> Integrity
BasicIntegrity
          (Bool
False, Bool
False) -> Integrity
NoIntegrity
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Integrity
integrity forall a. Ord a => a -> a -> Bool
>= Integrity
requiredIntegrity) forall a b. (a -> b) -> a -> b
$
      forall e a. e -> Validation (NonEmpty e) a
failure forall a b. (a -> b) -> a -> b
$
        Integrity -> VerificationError
IntegrityCheckFailed Integrity
integrity

    -- 5. If successful, return implementation-specific values representing attestation type Basic and attestation trust
    -- path x5c.
    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

-- | The default SafetyNet format configuration. Requires full
-- CTSProfileIntegrity and allows for the SafetyNet message to be at most 60
-- seconds old. Does not allow any timedrift into the future.
format :: M.SomeAttestationStatementFormat
format :: SomeAttestationStatementFormat
format =
  forall a.
AttestationStatementFormat a =>
a -> SomeAttestationStatementFormat
M.SomeAttestationStatementFormat forall a b. (a -> b) -> a -> b
$
    Format
      { requiredIntegrity :: Integrity
requiredIntegrity = Integrity
CTSProfileIntegrity,
        driftBackwardsTolerance :: Duration
driftBackwardsTolerance = forall a. Monoid a => a
mempty {durationSeconds :: Seconds
HG.durationSeconds = Seconds
60},
        driftForwardsTolerance :: Duration
driftForwardsTolerance = forall a. Monoid a => a
mempty
      }