{-# 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]
(Integrity -> Integrity)
-> (Integrity -> Integrity)
-> (Int -> Integrity)
-> (Integrity -> Int)
-> (Integrity -> [Integrity])
-> (Integrity -> Integrity -> [Integrity])
-> (Integrity -> Integrity -> [Integrity])
-> (Integrity -> Integrity -> Integrity -> [Integrity])
-> Enum 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
Integrity -> Integrity -> Bounded Integrity
forall a. a -> a -> Bounded a
maxBound :: Integrity
$cmaxBound :: Integrity
minBound :: Integrity
$cminBound :: Integrity
Bounded, Integrity -> Integrity -> Bool
(Integrity -> Integrity -> Bool)
-> (Integrity -> Integrity -> Bool) -> Eq Integrity
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
Eq Integrity
-> (Integrity -> Integrity -> Ordering)
-> (Integrity -> Integrity -> Bool)
-> (Integrity -> Integrity -> Bool)
-> (Integrity -> Integrity -> Bool)
-> (Integrity -> Integrity -> Bool)
-> (Integrity -> Integrity -> Integrity)
-> (Integrity -> Integrity -> Integrity)
-> Ord 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
$cp1Ord :: Eq Integrity
Ord, Int -> Integrity -> ShowS
[Integrity] -> ShowS
Integrity -> String
(Int -> Integrity -> ShowS)
-> (Integrity -> String)
-> ([Integrity] -> ShowS)
-> Show Integrity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Integrity] -> ShowS
$cshowList :: [Integrity] -> ShowS
show :: Integrity -> String
$cshow :: Integrity -> String
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 -> 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

-- | [(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
(Response -> Response -> Bool)
-> (Response -> Response -> Bool) -> Eq Response
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 -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show, (forall x. Response -> Rep Response x)
-> (forall x. Rep Response x -> Response) -> Generic Response
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
(Value -> Parser Response)
-> (Value -> Parser [Response]) -> FromJSON 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
(Response -> Value)
-> (Response -> Encoding)
-> ([Response] -> Value)
-> ([Response] -> Encoding)
-> ToJSON Response
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
(Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Bool) -> Eq Milliseconds
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 -> String
(Int -> Milliseconds -> ShowS)
-> (Milliseconds -> String)
-> ([Milliseconds] -> ShowS)
-> Show Milliseconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Milliseconds] -> ShowS
$cshowList :: [Milliseconds] -> ShowS
show :: Milliseconds -> String
$cshow :: Milliseconds -> String
showsPrec :: Int -> Milliseconds -> ShowS
$cshowsPrec :: Int -> Milliseconds -> ShowS
Show)
  deriving newtype (Value -> Parser [Milliseconds]
Value -> Parser Milliseconds
(Value -> Parser Milliseconds)
-> (Value -> Parser [Milliseconds]) -> FromJSON 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
(Milliseconds -> Value)
-> (Milliseconds -> Encoding)
-> ([Milliseconds] -> Value)
-> ([Milliseconds] -> Encoding)
-> ToJSON Milliseconds
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
(Milliseconds -> ElapsedP)
-> (Milliseconds -> Elapsed)
-> (Milliseconds -> NanoSeconds)
-> Timeable Milliseconds
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
(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 Aeson.ToJSON Statement where
  toJSON :: Statement -> Value
toJSON Statement {ByteString
Text
NonEmpty SignedCertificate
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
      [ Text
"ver" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
ver,
        Text
"x5c" Text -> NonEmpty SignedCertificate -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= NonEmpty SignedCertificate
x5c,
        Text
"response" Text -> Response -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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
    VerificationErrorInvalidNonce
  | -- | The response was created to far in the past
    -- (first: now, second: generated time)
    VerificationErrorResponseTooOld HG.DateTime HG.DateTime
  | -- | The response was created to far in the future
    -- (first: now, second: generated time)
    VerificationErrorResponseInFuture HG.DateTime HG.DateTime
  | -- | The integrity check failed based on the required integrity from the
    -- format
    VerificationErrorFailedIntegrityCheck Integrity
  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)

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

newtype VerificationHostName = VerificationHostName {VerificationHostName -> String
unVerificationHostName :: X509.HostName}
  deriving newtype (String -> VerificationHostName
(String -> VerificationHostName) -> IsString VerificationHostName
forall a. (String -> a) -> IsString a
fromString :: String -> VerificationHostName
$cfromString :: String -> 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 JWSHeader ()
-> Getting
     (First (NonEmpty SignedCertificate))
     (JWSHeader ())
     (NonEmpty SignedCertificate)
-> Maybe (NonEmpty SignedCertificate)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe (HeaderParam () (NonEmpty SignedCertificate))
 -> Const
      (First (NonEmpty SignedCertificate))
      (Maybe (HeaderParam () (NonEmpty SignedCertificate))))
-> JWSHeader ()
-> Const (First (NonEmpty SignedCertificate)) (JWSHeader ())
forall (a :: * -> *) p.
HasX5c a =>
Lens' (a p) (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
JOSE.x5c ((Maybe (HeaderParam () (NonEmpty SignedCertificate))
  -> Const
       (First (NonEmpty SignedCertificate))
       (Maybe (HeaderParam () (NonEmpty SignedCertificate))))
 -> JWSHeader ()
 -> Const (First (NonEmpty SignedCertificate)) (JWSHeader ()))
-> ((NonEmpty SignedCertificate
     -> Const
          (First (NonEmpty SignedCertificate)) (NonEmpty SignedCertificate))
    -> Maybe (HeaderParam () (NonEmpty SignedCertificate))
    -> Const
         (First (NonEmpty SignedCertificate))
         (Maybe (HeaderParam () (NonEmpty SignedCertificate))))
-> Getting
     (First (NonEmpty SignedCertificate))
     (JWSHeader ())
     (NonEmpty SignedCertificate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderParam () (NonEmpty SignedCertificate)
 -> Const
      (First (NonEmpty SignedCertificate))
      (HeaderParam () (NonEmpty SignedCertificate)))
-> Maybe (HeaderParam () (NonEmpty SignedCertificate))
-> Const
     (First (NonEmpty SignedCertificate))
     (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((HeaderParam () (NonEmpty SignedCertificate)
  -> Const
       (First (NonEmpty SignedCertificate))
       (HeaderParam () (NonEmpty SignedCertificate)))
 -> Maybe (HeaderParam () (NonEmpty SignedCertificate))
 -> Const
      (First (NonEmpty SignedCertificate))
      (Maybe (HeaderParam () (NonEmpty SignedCertificate))))
-> ((NonEmpty SignedCertificate
     -> Const
          (First (NonEmpty SignedCertificate)) (NonEmpty SignedCertificate))
    -> HeaderParam () (NonEmpty SignedCertificate)
    -> Const
         (First (NonEmpty SignedCertificate))
         (HeaderParam () (NonEmpty SignedCertificate)))
-> (NonEmpty SignedCertificate
    -> Const
         (First (NonEmpty SignedCertificate)) (NonEmpty SignedCertificate))
-> Maybe (HeaderParam () (NonEmpty SignedCertificate))
-> Const
     (First (NonEmpty SignedCertificate))
     (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty SignedCertificate
 -> Const
      (First (NonEmpty SignedCertificate)) (NonEmpty SignedCertificate))
-> HeaderParam () (NonEmpty SignedCertificate)
-> Const
     (First (NonEmpty SignedCertificate))
     (HeaderParam () (NonEmpty SignedCertificate))
forall p a. Lens' (HeaderParam p a) a
JOSE.param of
      Maybe (NonEmpty SignedCertificate)
Nothing -> Error -> m (NonEmpty SignedCertificate)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Error
JOSE.JWSInvalidSignature
      Just NonEmpty SignedCertificate
chain -> NonEmpty SignedCertificate -> m (NonEmpty SignedCertificate)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty SignedCertificate
chain

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

    -- Create a JWK from the leaf certificate, which is used to sign the payload
    JWK -> [JWK]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JWK -> [JWK]) -> m JWK -> m [JWK]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SignedCertificate -> m JWK
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 HashMap Text Term -> Text -> Maybe Term
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
"ver", HashMap Text Term
xs HashMap Text Term -> Text -> Maybe Term
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 <-
          (Error -> Text)
-> Either Error (JWS Identity () JWSHeader)
-> Either Text (JWS Identity () JWSHeader)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Text
"Failed to decode compact JWT response blob: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Error -> Text) -> Error -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Error -> String) -> Error -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
forall a. Show a => a -> String
show) (Either Error (JWS Identity () JWSHeader)
 -> Either Text (JWS Identity () JWSHeader))
-> Either Error (JWS Identity () JWSHeader)
-> Either Text (JWS Identity () JWSHeader)
forall a b. (a -> b) -> a -> b
$
            forall a. Except Error a -> Either Error a
forall e a. Except e a -> Either e a
runExcept @JOSE.Error (Except Error (JWS Identity () JWSHeader)
 -> Either Error (JWS Identity () JWSHeader))
-> Except Error (JWS Identity () JWSHeader)
-> Either Error (JWS Identity () JWSHeader)
forall a b. (a -> b) -> a -> b
$ ByteString -> Except Error (JWS Identity () JWSHeader)
forall a e (m :: * -> *).
(FromCompact a, AsError e, MonadError e m) =>
ByteString -> m a
JOSE.decodeCompact (ByteString -> ByteString
LBS.fromStrict ByteString
responseRaw)
        Response
response <-
          (Error -> Text) -> Either Error Response -> Either Text Response
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Text
"Failed to verify/decode JWT payload: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Error -> Text) -> Error -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Error -> String) -> Error -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
forall a. Show a => a -> String
show) (Either Error Response -> Either Text Response)
-> Either Error Response -> Either Text Response
forall a b. (a -> b) -> a -> b
$
            (ByteString -> Either Error Response)
-> JWTValidationSettings
-> VerificationHostName
-> JWS Identity () JWSHeader
-> Either Error Response
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
              ((String -> Error)
-> Either String Response -> Either Error Response
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Error
JOSE.JSONDecodeError (Either String Response -> Either Error Response)
-> (ByteString -> Either String Response)
-> ByteString
-> Either Error Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Response
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode)
              ((StringOrURI -> Bool) -> JWTValidationSettings
JOSE.defaultJWTValidationSettings (Bool -> StringOrURI -> Bool
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 :: Text
-> NonEmpty SignedCertificate
-> Response
-> ByteString
-> Statement
Statement {ByteString
Text
NonEmpty SignedCertificate
Response
x5c :: NonEmpty SignedCertificate
response :: Response
responseRaw :: ByteString
ver :: Text
responseRaw :: ByteString
response :: Response
x5c :: NonEmpty SignedCertificate
ver :: Text
..}
      (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 types (ver: string, response: bytes): " 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)
    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 JWS Identity () JWSHeader
-> Getting
     (First (Signature () JWSHeader))
     (JWS Identity () JWSHeader)
     (Signature () JWSHeader)
-> Maybe (Signature () JWSHeader)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (Signature () JWSHeader))
  (JWS Identity () JWSHeader)
  (Signature () JWSHeader)
forall (t :: * -> *) p (a :: * -> *).
Foldable t =>
Fold (JWS t p a) (Signature p a)
JOSE.signatures of
          Maybe (Signature () JWSHeader)
Nothing -> Text -> Either Text (Signature () JWSHeader)
forall a b. a -> Either a b
Left Text
"Can't extract x5c because the JWT contains no signatures"
          Just Signature () JWSHeader
res -> Signature () JWSHeader -> Either Text (Signature () JWSHeader)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Signature () JWSHeader
res
        JOSE.HeaderParam () NonEmpty SignedCertificate
x5c <- case Signature () JWSHeader
sig Signature () JWSHeader
-> Getting
     (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
     (Signature () JWSHeader)
     (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
-> Maybe (HeaderParam () (NonEmpty SignedCertificate))
forall s a. s -> Getting a s a -> a
^. (JWSHeader ()
 -> Const
      (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
      (JWSHeader ()))
-> Signature () JWSHeader
-> Const
     (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
     (Signature () JWSHeader)
forall p (a :: * -> *). Getter (Signature p a) (a p)
JOSE.header ((JWSHeader ()
  -> Const
       (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
       (JWSHeader ()))
 -> Signature () JWSHeader
 -> Const
      (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
      (Signature () JWSHeader))
-> ((Maybe (HeaderParam () (NonEmpty SignedCertificate))
     -> Const
          (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
          (Maybe (HeaderParam () (NonEmpty SignedCertificate))))
    -> JWSHeader ()
    -> Const
         (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
         (JWSHeader ()))
-> Getting
     (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
     (Signature () JWSHeader)
     (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (HeaderParam () (NonEmpty SignedCertificate))
 -> Const
      (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
      (Maybe (HeaderParam () (NonEmpty SignedCertificate))))
-> JWSHeader ()
-> Const
     (Maybe (HeaderParam () (NonEmpty SignedCertificate)))
     (JWSHeader ())
forall (a :: * -> *) p.
HasX5c a =>
Lens' (a p) (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
JOSE.x5c of
          Maybe (HeaderParam () (NonEmpty SignedCertificate))
Nothing -> Text -> Either Text (HeaderParam () (NonEmpty SignedCertificate))
forall a b. a -> Either a b
Left Text
"No x5c in the header of the first JWT signature"
          Just HeaderParam () (NonEmpty SignedCertificate)
res -> HeaderParam () (NonEmpty SignedCertificate)
-> Either Text (HeaderParam () (NonEmpty SignedCertificate))
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeaderParam () (NonEmpty SignedCertificate)
res
        NonEmpty SignedCertificate
-> Either Text (NonEmpty SignedCertificate)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty SignedCertificate
x5c

  asfEncode :: Format -> AttStmt Format -> Term
asfEncode Format
_ Statement {..} =
    [(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 {..} 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 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 hashedData :: Digest SHA256
hashedData = SHA256 -> ByteString -> Digest SHA256
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 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Digest SHA256
hashedData
    Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Response -> Text
nonce Response
response Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
encodedData) (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
$ VerificationError
VerificationErrorInvalidNonce

    -- 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 = Milliseconds -> DateTime
forall t1 t2. (Timeable t1, Time t2) => t1 -> t2
HG.timeConvert (Milliseconds -> DateTime) -> Milliseconds -> DateTime
forall a b. (a -> b) -> a -> b
$ Response -> Milliseconds
timestampMs Response
response
    Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((DateTime
generatedTime DateTime -> Duration -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
`HG.timeAdd` Duration
driftBackwardsTolerance) DateTime -> DateTime -> Bool
forall a. Ord a => a -> a -> Bool
< DateTime
now) (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
$ DateTime -> DateTime -> VerificationError
VerificationErrorResponseTooOld DateTime
now DateTime
generatedTime
    Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DateTime
generatedTime DateTime -> DateTime -> Bool
forall a. Ord a => a -> a -> Bool
> (DateTime
now DateTime -> Duration -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
`HG.timeAdd` Duration
driftForwardsTolerance)) (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
$ DateTime -> DateTime -> VerificationError
VerificationErrorResponseInFuture DateTime
now 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
    Bool
-> Validation (NonEmpty VerificationError) ()
-> Validation (NonEmpty VerificationError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Integrity
integrity Integrity -> Integrity -> Bool
forall a. Ord a => a -> a -> Bool
>= Integrity
requiredIntegrity) (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
$ Integrity -> VerificationError
VerificationErrorFailedIntegrityCheck Integrity
integrity

    -- 5. If successful, return implementation-specific values representing attestation type Basic and attestation trust
    -- path x5c.
    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.VerifiableAttestationTypeBasic (NonEmpty SignedCertificate -> AttestationChain 'Fido2
M.Fido2Chain NonEmpty SignedCertificate
x5c)

  asfTrustAnchors :: Format -> VerifiableAttestationType -> CertificateStore
asfTrustAnchors Format
_ VerifiableAttestationType
_ = CertificateStore
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 =
  Format -> SomeAttestationStatementFormat
forall a.
AttestationStatementFormat a =>
a -> SomeAttestationStatementFormat
M.SomeAttestationStatementFormat (Format -> SomeAttestationStatementFormat)
-> Format -> SomeAttestationStatementFormat
forall a b. (a -> b) -> a -> b
$
    Format :: Integrity -> Duration -> Duration -> Format
Format
      { requiredIntegrity :: Integrity
requiredIntegrity = Integrity
CTSProfileIntegrity,
        driftBackwardsTolerance :: Duration
driftBackwardsTolerance = Duration
forall a. Monoid a => a
mempty {durationSeconds :: Seconds
HG.durationSeconds = Seconds
60},
        driftForwardsTolerance :: Duration
driftForwardsTolerance = Duration
forall a. Monoid a => a
mempty
      }