{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
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)
data Integrity
=
NoIntegrity
|
BasicIntegrity
|
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)
data Format = Format
{
Format -> Integrity
requiredIntegrity :: Integrity,
Format -> Duration
driftBackwardsTolerance :: HG.Duration,
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
data Response = Response
{ Response -> Milliseconds
timestampMs :: Milliseconds,
Response -> Text
nonce :: Text,
Response -> Text
apkPackageName :: Text,
Response -> [Text]
apkCertificateDigestSha256 :: [Text],
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)
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
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
]
data VerificationError
=
NonceMismatch
{
VerificationError -> Text
responseNonce :: Text,
VerificationError -> Text
calculatedNonce :: Text
}
|
ResponseTimeInvalid
{
VerificationError -> DateTime
lowerBound :: HG.DateTime,
VerificationError -> DateTime
upperBound :: HG.DateTime,
VerificationError -> DateTime
generatedtime :: HG.DateTime
}
|
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)
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
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
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
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
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
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
}