{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Crypto.WebAuthn.Encoding.Binary
(
encodeRawCollectedClientData,
stripRawCollectedClientData,
decodeCollectedClientData,
encodeRawAttestedCredentialData,
stripRawAttestedCredentialData,
encodeRawAuthenticatorData,
stripRawAuthenticatorData,
decodeAuthenticatorData,
encodeRawAttestationObject,
stripRawAttestationObject,
encodeAttestationObject,
decodeAttestationObject,
encodeRawAuthenticatorResponse,
stripRawAuthenticatorResponse,
encodeRawCredential,
stripRawCredential,
)
where
import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Read as CBOR
import qualified Codec.CBOR.Term as CBOR
import qualified Codec.CBOR.Write as CBOR
import Codec.Serialise (Serialise (decode), encode)
import Control.Monad (unless)
import Control.Monad.Except (throwError)
import Control.Monad.State (MonadState (get, put), StateT (runStateT))
import qualified Crypto.Hash as Hash
import Crypto.WebAuthn.Internal.Utils (jsonEncodingOptions)
import Crypto.WebAuthn.Model.Identifier (AAGUID (AAGUID), unAAGUID)
import qualified Crypto.WebAuthn.Model.Kinds as K
import qualified Crypto.WebAuthn.Model.Types as M
import qualified Data.Aeson as Aeson
import qualified Data.Binary.Get as Binary
import qualified Data.Binary.Put as Binary
import Data.Bits ((.|.))
import qualified Data.Bits as Bits
import Data.ByteArray (convert)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Base64.URL as Base64Url
import Data.ByteString.Builder (Builder, stringUtf8, toLazyByteString)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (fromJust, fromMaybe)
import Data.Singletons (SingI (sing))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.UUID as UUID
import Data.Word (Word16, Word8)
import GHC.Generics (Generic)
type PartialBinaryDecoder a = StateT LBS.ByteString (Either Text) a
runPartialBinaryDecoder ::
BS.ByteString ->
PartialBinaryDecoder a ->
Either Text a
runPartialBinaryDecoder :: ByteString -> PartialBinaryDecoder a -> Either Text a
runPartialBinaryDecoder ByteString
bytes PartialBinaryDecoder a
decoder =
case PartialBinaryDecoder a -> ByteString -> Either Text (a, ByteString)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT PartialBinaryDecoder a
decoder (ByteString -> Either Text (a, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> Either Text (a, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict (ByteString -> Either Text (a, ByteString))
-> ByteString -> Either Text (a, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString
bytes of
Left Text
err -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
err
Right (a
result, ByteString
rest)
| ByteString -> Bool
LBS.null ByteString
rest -> a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
| Bool
otherwise ->
Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$
Text
"Not all binary input used, rest in base64 format is: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (ByteString -> ByteString
Base64.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict ByteString
rest)
runBinary ::
Binary.Get a ->
PartialBinaryDecoder a
runBinary :: Get a -> PartialBinaryDecoder a
runBinary Get a
decoder = do
ByteString
bytes <- StateT ByteString (Either Text) ByteString
forall s (m :: * -> *). MonadState s m => m s
get
case Get a
-> ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Binary.runGetOrFail Get a
decoder ByteString
bytes of
Left (ByteString
_rest, ByteOffset
_offset, String
err) ->
Text -> PartialBinaryDecoder a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> PartialBinaryDecoder a) -> Text -> PartialBinaryDecoder a
forall a b. (a -> b) -> a -> b
$ Text
"Binary decoding error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
err
Right (ByteString
rest, ByteOffset
_offset, a
result) -> do
ByteString -> StateT ByteString (Either Text) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ByteString
rest
a -> PartialBinaryDecoder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
runCBOR ::
(forall s. CBOR.Decoder s a) ->
PartialBinaryDecoder (LBS.ByteString, a)
runCBOR :: (forall s. Decoder s a) -> PartialBinaryDecoder (ByteString, a)
runCBOR forall s. Decoder s a
decoder = do
ByteString
bytes <- StateT ByteString (Either Text) ByteString
forall s (m :: * -> *). MonadState s m => m s
get
case (forall s. Decoder s a)
-> ByteString
-> Either DeserialiseFailure (ByteString, ByteOffset, a)
forall a.
(forall s. Decoder s a)
-> ByteString
-> Either DeserialiseFailure (ByteString, ByteOffset, a)
CBOR.deserialiseFromBytesWithSize forall s. Decoder s a
decoder ByteString
bytes of
Left DeserialiseFailure
err ->
Text -> PartialBinaryDecoder (ByteString, a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> PartialBinaryDecoder (ByteString, a))
-> Text -> PartialBinaryDecoder (ByteString, a)
forall a b. (a -> b) -> a -> b
$ Text
"CBOR decoding error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (DeserialiseFailure -> String
forall a. Show a => a -> String
show DeserialiseFailure
err)
Right (ByteString
rest, ByteOffset
consumed, a
a) -> do
ByteString -> StateT ByteString (Either Text) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ByteString
rest
(ByteString, a) -> PartialBinaryDecoder (ByteString, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteOffset -> ByteString -> ByteString
LBS.take (ByteOffset -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
consumed) ByteString
bytes, a
a)
encodeExtensions ::
M.AuthenticatorExtensionOutputs ->
Builder
encodeExtensions :: AuthenticatorExtensionOutputs -> Builder
encodeExtensions M.AuthenticatorExtensionOutputs {} =
Encoding -> Builder
CBOR.toBuilder (Encoding -> Builder) -> Encoding -> Builder
forall a b. (a -> b) -> a -> b
$ Term -> Encoding
CBOR.encodeTerm ([(Term, Term)] -> Term
CBOR.TMap [])
decodeExtensions ::
PartialBinaryDecoder M.AuthenticatorExtensionOutputs
decodeExtensions :: PartialBinaryDecoder AuthenticatorExtensionOutputs
decodeExtensions = do
(ByteString
_, Term
_extensions :: CBOR.Term) <- (forall s. Decoder s Term)
-> PartialBinaryDecoder (ByteString, Term)
forall a.
(forall s. Decoder s a) -> PartialBinaryDecoder (ByteString, a)
runCBOR forall s. Decoder s Term
CBOR.decodeTerm
AuthenticatorExtensionOutputs
-> PartialBinaryDecoder AuthenticatorExtensionOutputs
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthenticatorExtensionOutputs :: AuthenticatorExtensionOutputs
M.AuthenticatorExtensionOutputs {}
data ClientDataJSON = ClientDataJSON
{ ClientDataJSON -> Text
littype :: Text,
ClientDataJSON -> Text
challenge :: Text,
ClientDataJSON -> Text
origin :: Text,
ClientDataJSON -> Maybe Bool
crossOrigin :: Maybe Bool
}
deriving ((forall x. ClientDataJSON -> Rep ClientDataJSON x)
-> (forall x. Rep ClientDataJSON x -> ClientDataJSON)
-> Generic ClientDataJSON
forall x. Rep ClientDataJSON x -> ClientDataJSON
forall x. ClientDataJSON -> Rep ClientDataJSON x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientDataJSON x -> ClientDataJSON
$cfrom :: forall x. ClientDataJSON -> Rep ClientDataJSON x
Generic)
instance Aeson.FromJSON ClientDataJSON where
parseJSON :: Value -> Parser ClientDataJSON
parseJSON = Options -> Value -> Parser ClientDataJSON
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
jsonEncodingOptions
encodeRawCollectedClientData ::
forall (c :: K.CeremonyKind) raw.
SingI c =>
M.CollectedClientData c raw ->
M.CollectedClientData c 'True
encodeRawCollectedClientData :: CollectedClientData c raw -> CollectedClientData c 'True
encodeRawCollectedClientData M.CollectedClientData {Maybe Bool
Origin
Challenge
RawField raw
ccdRawData :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> RawField raw
ccdCrossOrigin :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Maybe Bool
ccdOrigin :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Origin
ccdChallenge :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Challenge
ccdRawData :: RawField raw
ccdCrossOrigin :: Maybe Bool
ccdOrigin :: Origin
ccdChallenge :: Challenge
..} =
CollectedClientData :: forall (c :: CeremonyKind) (raw :: Bool).
Challenge
-> Origin
-> Maybe Bool
-> RawField raw
-> CollectedClientData c raw
M.CollectedClientData {ccdRawData :: RawField 'True
ccdRawData = ByteString -> RawField 'True
M.WithRaw ByteString
bytes, Maybe Bool
Origin
Challenge
ccdCrossOrigin :: Maybe Bool
ccdOrigin :: Origin
ccdChallenge :: Challenge
ccdCrossOrigin :: Maybe Bool
ccdOrigin :: Origin
ccdChallenge :: Challenge
..}
where
bytes :: ByteString
bytes = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
builder
builder :: Builder
builder :: Builder
builder =
String -> Builder
stringUtf8 String
"{\"type\":"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall a. ToJSON a => a -> Builder
jsonBuilder Text
typeValue
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 String
",\"challenge\":"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall a. ToJSON a => a -> Builder
jsonBuilder Text
challengeValue
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 String
",\"origin\":"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall a. ToJSON a => a -> Builder
jsonBuilder Text
originValue
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 String
",\"crossOrigin\":"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
forall a. ToJSON a => a -> Builder
jsonBuilder Bool
crossOriginValue
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 String
"}"
typeValue :: Text
typeValue :: Text
typeValue = case SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @c of
Sing c
K.SRegistration -> Text
"webauthn.create"
Sing c
K.SAuthentication -> Text
"webauthn.get"
challengeValue :: Text
challengeValue :: Text
challengeValue = ByteString -> Text
decodeUtf8 (ByteString -> ByteString
Base64Url.encode (Challenge -> ByteString
M.unChallenge Challenge
ccdChallenge))
originValue :: Text
originValue :: Text
originValue = Origin -> Text
M.unOrigin Origin
ccdOrigin
crossOriginValue :: Bool
crossOriginValue :: Bool
crossOriginValue = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
ccdCrossOrigin
jsonBuilder :: Aeson.ToJSON a => a -> Builder
jsonBuilder :: a -> Builder
jsonBuilder = Encoding' Value -> Builder
forall tag. Encoding' tag -> Builder
Aeson.fromEncoding (Encoding' Value -> Builder)
-> (a -> Encoding' Value) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
Aeson.toEncoding
stripRawCollectedClientData ::
M.CollectedClientData c raw ->
M.CollectedClientData c 'False
stripRawCollectedClientData :: CollectedClientData c raw -> CollectedClientData c 'False
stripRawCollectedClientData M.CollectedClientData {Maybe Bool
Origin
Challenge
RawField raw
ccdRawData :: RawField raw
ccdCrossOrigin :: Maybe Bool
ccdOrigin :: Origin
ccdChallenge :: Challenge
ccdRawData :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> RawField raw
ccdCrossOrigin :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Maybe Bool
ccdOrigin :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Origin
ccdChallenge :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Challenge
..} =
CollectedClientData :: forall (c :: CeremonyKind) (raw :: Bool).
Challenge
-> Origin
-> Maybe Bool
-> RawField raw
-> CollectedClientData c raw
M.CollectedClientData {ccdRawData :: RawField 'False
ccdRawData = RawField 'False
M.NoRaw, Maybe Bool
Origin
Challenge
ccdCrossOrigin :: Maybe Bool
ccdOrigin :: Origin
ccdChallenge :: Challenge
ccdCrossOrigin :: Maybe Bool
ccdOrigin :: Origin
ccdChallenge :: Challenge
..}
decodeCollectedClientData ::
forall (c :: K.CeremonyKind).
SingI c =>
BS.ByteString ->
Either Text (M.CollectedClientData c 'True)
decodeCollectedClientData :: ByteString -> Either Text (CollectedClientData c 'True)
decodeCollectedClientData ByteString
bytes = do
ClientDataJSON {Maybe Bool
Text
crossOrigin :: Maybe Bool
origin :: Text
challenge :: Text
littype :: Text
crossOrigin :: ClientDataJSON -> Maybe Bool
origin :: ClientDataJSON -> Text
challenge :: ClientDataJSON -> Text
littype :: ClientDataJSON -> Text
..} <- case ByteString -> Either String ClientDataJSON
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict ByteString
bytes of
Left String
err ->
Text -> Either Text ClientDataJSON
forall a b. a -> Either a b
Left (Text -> Either Text ClientDataJSON)
-> Text -> Either Text ClientDataJSON
forall a b. (a -> b) -> a -> b
$
Text
"Collected client data JSON decoding error: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
err
Right ClientDataJSON
res -> ClientDataJSON -> Either Text ClientDataJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientDataJSON
res
ByteString
challenge <- case ByteString -> Either String ByteString
Base64Url.decode (Text -> ByteString
encodeUtf8 Text
challenge) of
Left String
err ->
Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$
Text
"Failed to base64url-decode challenge "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
challenge
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
err
Right ByteString
res -> ByteString -> Either Text ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
res
let expectedType :: Text
expectedType = case SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @c of
Sing c
K.SRegistration -> Text
"webauthn.create"
Sing c
K.SAuthentication -> Text
"webauthn.get"
Bool -> Either Text () -> Either Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
littype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expectedType) (Either Text () -> Either Text ())
-> Either Text () -> Either Text ()
forall a b. (a -> b) -> a -> b
$
Text -> Either Text ()
forall a b. a -> Either a b
Left (Text -> Either Text ()) -> Text -> Either Text ()
forall a b. (a -> b) -> a -> b
$
Text
"Expected collected client data to have webauthn type "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expectedType
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but it is "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
littype
CollectedClientData c 'True
-> Either Text (CollectedClientData c 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
CollectedClientData :: forall (c :: CeremonyKind) (raw :: Bool).
Challenge
-> Origin
-> Maybe Bool
-> RawField raw
-> CollectedClientData c raw
M.CollectedClientData
{ ccdChallenge :: Challenge
ccdChallenge = ByteString -> Challenge
M.Challenge ByteString
challenge,
ccdOrigin :: Origin
ccdOrigin = Text -> Origin
M.Origin Text
origin,
ccdCrossOrigin :: Maybe Bool
ccdCrossOrigin = Maybe Bool
crossOrigin,
ccdRawData :: RawField 'True
ccdRawData = ByteString -> RawField 'True
M.WithRaw ByteString
bytes
}
encodeRawAttestedCredentialData ::
M.AttestedCredentialData c raw ->
M.AttestedCredentialData c 'True
encodeRawAttestedCredentialData :: AttestedCredentialData c raw -> AttestedCredentialData c 'True
encodeRawAttestedCredentialData M.AttestedCredentialData {CosePublicKey
AAGUID
CredentialId
RawField raw
acdCredentialPublicKeyBytes :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> RawField raw
acdCredentialPublicKey :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CosePublicKey
acdCredentialId :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CredentialId
acdAaguid :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> AAGUID
acdCredentialPublicKeyBytes :: RawField raw
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
..} =
AttestedCredentialData :: forall (raw :: Bool).
AAGUID
-> CredentialId
-> CosePublicKey
-> RawField raw
-> AttestedCredentialData 'Registration raw
M.AttestedCredentialData
{ acdCredentialPublicKeyBytes :: RawField 'True
acdCredentialPublicKeyBytes = ByteString -> RawField 'True
M.WithRaw (ByteString -> RawField 'True) -> ByteString -> RawField 'True
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict ByteString
bytes,
CosePublicKey
AAGUID
CredentialId
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
..
}
where
bytes :: ByteString
bytes = Encoding -> ByteString
CBOR.toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ CosePublicKey -> Encoding
forall a. Serialise a => a -> Encoding
encode CosePublicKey
acdCredentialPublicKey
encodeRawAttestedCredentialData AttestedCredentialData c raw
M.NoAttestedCredentialData =
AttestedCredentialData c 'True
forall (raw :: Bool). AttestedCredentialData 'Authentication raw
M.NoAttestedCredentialData
stripRawAttestedCredentialData ::
M.AttestedCredentialData c raw ->
M.AttestedCredentialData c 'False
stripRawAttestedCredentialData :: AttestedCredentialData c raw -> AttestedCredentialData c 'False
stripRawAttestedCredentialData M.AttestedCredentialData {CosePublicKey
AAGUID
CredentialId
RawField raw
acdCredentialPublicKeyBytes :: RawField raw
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
acdCredentialPublicKeyBytes :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> RawField raw
acdCredentialPublicKey :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CosePublicKey
acdCredentialId :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CredentialId
acdAaguid :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> AAGUID
..} =
AttestedCredentialData :: forall (raw :: Bool).
AAGUID
-> CredentialId
-> CosePublicKey
-> RawField raw
-> AttestedCredentialData 'Registration raw
M.AttestedCredentialData {acdCredentialPublicKeyBytes :: RawField 'False
acdCredentialPublicKeyBytes = RawField 'False
M.NoRaw, CosePublicKey
AAGUID
CredentialId
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
..}
stripRawAttestedCredentialData AttestedCredentialData c raw
M.NoAttestedCredentialData =
AttestedCredentialData c 'False
forall (raw :: Bool). AttestedCredentialData 'Authentication raw
M.NoAttestedCredentialData
encodeAttestedCredentialData ::
M.AttestedCredentialData 'K.Registration 'True ->
Builder
encodeAttestedCredentialData :: AttestedCredentialData 'Registration 'True -> Builder
encodeAttestedCredentialData M.AttestedCredentialData {CosePublicKey
AAGUID
CredentialId
RawField 'True
acdCredentialPublicKeyBytes :: RawField 'True
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
acdCredentialPublicKeyBytes :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> RawField raw
acdCredentialPublicKey :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CosePublicKey
acdCredentialId :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CredentialId
acdAaguid :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> AAGUID
..} =
PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (ByteString -> PutM ()
Binary.putLazyByteString (ByteString -> PutM ()) -> ByteString -> PutM ()
forall a b. (a -> b) -> a -> b
$ UUID -> ByteString
UUID.toByteString (UUID -> ByteString) -> UUID -> ByteString
forall a b. (a -> b) -> a -> b
$ AAGUID -> UUID
unAAGUID AAGUID
acdAaguid)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (Word16 -> PutM ()
Binary.putWord16be Word16
credentialLength)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (ByteString -> PutM ()
Binary.putByteString (ByteString -> PutM ()) -> ByteString -> PutM ()
forall a b. (a -> b) -> a -> b
$ CredentialId -> ByteString
M.unCredentialId CredentialId
acdCredentialId)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (ByteString -> PutM ()
Binary.putByteString (ByteString -> PutM ()) -> ByteString -> PutM ()
forall a b. (a -> b) -> a -> b
$ RawField 'True -> ByteString
M.unRaw RawField 'True
acdCredentialPublicKeyBytes)
where
credentialLength :: Word16
credentialLength :: Word16
credentialLength = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ CredentialId -> ByteString
M.unCredentialId CredentialId
acdCredentialId
decodeAttestedCredentialData ::
PartialBinaryDecoder (M.AttestedCredentialData 'K.Registration 'True)
decodeAttestedCredentialData :: PartialBinaryDecoder (AttestedCredentialData 'Registration 'True)
decodeAttestedCredentialData = do
AAGUID
acdAaguid <-
UUID -> AAGUID
AAGUID (UUID -> AAGUID) -> (ByteString -> UUID) -> ByteString -> AAGUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UUID -> UUID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UUID -> UUID)
-> (ByteString -> Maybe UUID) -> ByteString -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe UUID
UUID.fromByteString
(ByteString -> AAGUID)
-> StateT ByteString (Either Text) ByteString
-> StateT ByteString (Either Text) AAGUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString -> StateT ByteString (Either Text) ByteString
forall a. Get a -> PartialBinaryDecoder a
runBinary (ByteOffset -> Get ByteString
Binary.getLazyByteString ByteOffset
16)
Word16
credentialLength <-
Get Word16 -> PartialBinaryDecoder Word16
forall a. Get a -> PartialBinaryDecoder a
runBinary Get Word16
Binary.getWord16be
CredentialId
acdCredentialId <-
ByteString -> CredentialId
M.CredentialId
(ByteString -> CredentialId)
-> StateT ByteString (Either Text) ByteString
-> StateT ByteString (Either Text) CredentialId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString -> StateT ByteString (Either Text) ByteString
forall a. Get a -> PartialBinaryDecoder a
runBinary (Int -> Get ByteString
Binary.getByteString (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
credentialLength))
(ByteString
usedBytes, CosePublicKey
acdCredentialPublicKey) <- (forall s. Decoder s CosePublicKey)
-> PartialBinaryDecoder (ByteString, CosePublicKey)
forall a.
(forall s. Decoder s a) -> PartialBinaryDecoder (ByteString, a)
runCBOR forall s. Decoder s CosePublicKey
forall a s. Serialise a => Decoder s a
decode
let acdCredentialPublicKeyBytes :: RawField 'True
acdCredentialPublicKeyBytes = ByteString -> RawField 'True
M.WithRaw (ByteString -> RawField 'True) -> ByteString -> RawField 'True
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict ByteString
usedBytes
AttestedCredentialData 'Registration 'True
-> PartialBinaryDecoder
(AttestedCredentialData 'Registration 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttestedCredentialData :: forall (raw :: Bool).
AAGUID
-> CredentialId
-> CosePublicKey
-> RawField raw
-> AttestedCredentialData 'Registration raw
M.AttestedCredentialData {CosePublicKey
AAGUID
CredentialId
RawField 'True
acdCredentialPublicKeyBytes :: RawField 'True
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
acdCredentialPublicKeyBytes :: RawField 'True
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
..}
encodeRawAuthenticatorData ::
forall (c :: K.CeremonyKind) raw.
SingI c =>
M.AuthenticatorData c raw ->
M.AuthenticatorData c 'True
encodeRawAuthenticatorData :: AuthenticatorData c raw -> AuthenticatorData c 'True
encodeRawAuthenticatorData M.AuthenticatorData {Maybe AuthenticatorExtensionOutputs
AttestedCredentialData c raw
AuthenticatorDataFlags
SignatureCounter
RpIdHash
RawField raw
adRawData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
adExtensions :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> Maybe AuthenticatorExtensionOutputs
adAttestedCredentialData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AttestedCredentialData c raw
adSignCount :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> SignatureCounter
adFlags :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorDataFlags
adRpIdHash :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RpIdHash
adRawData :: RawField raw
adExtensions :: Maybe AuthenticatorExtensionOutputs
adAttestedCredentialData :: AttestedCredentialData c raw
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
..} =
AuthenticatorData :: forall (c :: CeremonyKind) (raw :: Bool).
RpIdHash
-> AuthenticatorDataFlags
-> SignatureCounter
-> AttestedCredentialData c raw
-> Maybe AuthenticatorExtensionOutputs
-> RawField raw
-> AuthenticatorData c raw
M.AuthenticatorData
{ adRawData :: RawField 'True
adRawData = ByteString -> RawField 'True
M.WithRaw ByteString
bytes,
adAttestedCredentialData :: AttestedCredentialData c 'True
adAttestedCredentialData = AttestedCredentialData c 'True
rawAttestedCredentialData,
Maybe AuthenticatorExtensionOutputs
AuthenticatorDataFlags
SignatureCounter
RpIdHash
adExtensions :: Maybe AuthenticatorExtensionOutputs
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
adExtensions :: Maybe AuthenticatorExtensionOutputs
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
..
}
where
rawAttestedCredentialData :: AttestedCredentialData c 'True
rawAttestedCredentialData =
AttestedCredentialData c raw -> AttestedCredentialData c 'True
forall (c :: CeremonyKind) (raw :: Bool).
AttestedCredentialData c raw -> AttestedCredentialData c 'True
encodeRawAttestedCredentialData AttestedCredentialData c raw
adAttestedCredentialData
bytes :: BS.ByteString
bytes :: ByteString
bytes = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
builder
flags :: Word8
flags :: Word8
flags =
Word8
userPresentFlag
Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
userVerifiedFlag
Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
attestedCredentialDataPresentFlag
Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
extensionsPresentFlag
where
userPresentFlag :: Word8
userPresentFlag = if AuthenticatorDataFlags -> Bool
M.adfUserPresent AuthenticatorDataFlags
adFlags then Int -> Word8
forall a. Bits a => Int -> a
Bits.bit Int
0 else Word8
0
userVerifiedFlag :: Word8
userVerifiedFlag = if AuthenticatorDataFlags -> Bool
M.adfUserVerified AuthenticatorDataFlags
adFlags then Int -> Word8
forall a. Bits a => Int -> a
Bits.bit Int
2 else Word8
0
attestedCredentialDataPresentFlag :: Word8
attestedCredentialDataPresentFlag = case SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @c of
Sing c
K.SRegistration -> Int -> Word8
forall a. Bits a => Int -> a
Bits.bit Int
6
Sing c
K.SAuthentication -> Word8
0
extensionsPresentFlag :: Word8
extensionsPresentFlag = case Maybe AuthenticatorExtensionOutputs
adExtensions of
Just AuthenticatorExtensionOutputs
_ -> Int -> Word8
forall a. Bits a => Int -> a
Bits.bit Int
7
Maybe AuthenticatorExtensionOutputs
Nothing -> Word8
0
builder :: Builder
builder :: Builder
builder =
PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (ByteString -> PutM ()
Binary.putByteString (ByteString -> PutM ()) -> ByteString -> PutM ()
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest SHA256 -> ByteString) -> Digest SHA256 -> ByteString
forall a b. (a -> b) -> a -> b
$ RpIdHash -> Digest SHA256
M.unRpIdHash RpIdHash
adRpIdHash)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (Word8 -> PutM ()
Binary.putWord8 Word8
flags)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (Word32 -> PutM ()
Binary.putWord32be (Word32 -> PutM ()) -> Word32 -> PutM ()
forall a b. (a -> b) -> a -> b
$ SignatureCounter -> Word32
M.unSignatureCounter SignatureCounter
adSignCount)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ( case SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @c of
Sing c
K.SRegistration ->
AttestedCredentialData 'Registration 'True -> Builder
encodeAttestedCredentialData AttestedCredentialData c 'True
AttestedCredentialData 'Registration 'True
rawAttestedCredentialData
Sing c
K.SAuthentication ->
Builder
forall a. Monoid a => a
mempty
)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
-> (AuthenticatorExtensionOutputs -> Builder)
-> Maybe AuthenticatorExtensionOutputs
-> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty AuthenticatorExtensionOutputs -> Builder
encodeExtensions Maybe AuthenticatorExtensionOutputs
adExtensions
stripRawAuthenticatorData ::
M.AuthenticatorData c raw ->
M.AuthenticatorData c 'False
stripRawAuthenticatorData :: AuthenticatorData c raw -> AuthenticatorData c 'False
stripRawAuthenticatorData M.AuthenticatorData {Maybe AuthenticatorExtensionOutputs
AttestedCredentialData c raw
AuthenticatorDataFlags
SignatureCounter
RpIdHash
RawField raw
adRawData :: RawField raw
adExtensions :: Maybe AuthenticatorExtensionOutputs
adAttestedCredentialData :: AttestedCredentialData c raw
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
adRawData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
adExtensions :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> Maybe AuthenticatorExtensionOutputs
adAttestedCredentialData :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AttestedCredentialData c raw
adSignCount :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> SignatureCounter
adFlags :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorDataFlags
adRpIdHash :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RpIdHash
..} =
AuthenticatorData :: forall (c :: CeremonyKind) (raw :: Bool).
RpIdHash
-> AuthenticatorDataFlags
-> SignatureCounter
-> AttestedCredentialData c raw
-> Maybe AuthenticatorExtensionOutputs
-> RawField raw
-> AuthenticatorData c raw
M.AuthenticatorData
{ adRawData :: RawField 'False
adRawData = RawField 'False
M.NoRaw,
adAttestedCredentialData :: AttestedCredentialData c 'False
adAttestedCredentialData =
AttestedCredentialData c raw -> AttestedCredentialData c 'False
forall (c :: CeremonyKind) (raw :: Bool).
AttestedCredentialData c raw -> AttestedCredentialData c 'False
stripRawAttestedCredentialData AttestedCredentialData c raw
adAttestedCredentialData,
Maybe AuthenticatorExtensionOutputs
AuthenticatorDataFlags
SignatureCounter
RpIdHash
adExtensions :: Maybe AuthenticatorExtensionOutputs
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
adExtensions :: Maybe AuthenticatorExtensionOutputs
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
..
}
decodeAuthenticatorData ::
forall (c :: K.CeremonyKind).
SingI c =>
BS.ByteString ->
Either Text (M.AuthenticatorData c 'True)
decodeAuthenticatorData :: ByteString -> Either Text (AuthenticatorData c 'True)
decodeAuthenticatorData ByteString
strictBytes = ByteString
-> PartialBinaryDecoder (AuthenticatorData c 'True)
-> Either Text (AuthenticatorData c 'True)
forall a. ByteString -> PartialBinaryDecoder a -> Either Text a
runPartialBinaryDecoder ByteString
strictBytes (PartialBinaryDecoder (AuthenticatorData c 'True)
-> Either Text (AuthenticatorData c 'True))
-> PartialBinaryDecoder (AuthenticatorData c 'True)
-> Either Text (AuthenticatorData c 'True)
forall a b. (a -> b) -> a -> b
$ do
let adRawData :: RawField 'True
adRawData = ByteString -> RawField 'True
M.WithRaw ByteString
strictBytes
RpIdHash
adRpIdHash <-
Digest SHA256 -> RpIdHash
M.RpIdHash (Digest SHA256 -> RpIdHash)
-> (ByteString -> Digest SHA256) -> ByteString -> RpIdHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Digest SHA256) -> Digest SHA256
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Digest SHA256) -> Digest SHA256)
-> (ByteString -> Maybe (Digest SHA256))
-> ByteString
-> Digest SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Digest SHA256)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
Hash.digestFromByteString
(ByteString -> RpIdHash)
-> StateT ByteString (Either Text) ByteString
-> StateT ByteString (Either Text) RpIdHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString -> StateT ByteString (Either Text) ByteString
forall a. Get a -> PartialBinaryDecoder a
runBinary (Int -> Get ByteString
Binary.getByteString Int
32)
Word8
bitFlags <- Get Word8 -> PartialBinaryDecoder Word8
forall a. Get a -> PartialBinaryDecoder a
runBinary Get Word8
Binary.getWord8
let adFlags :: AuthenticatorDataFlags
adFlags =
AuthenticatorDataFlags :: Bool -> Bool -> AuthenticatorDataFlags
M.AuthenticatorDataFlags
{ adfUserPresent :: Bool
M.adfUserPresent = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit Word8
bitFlags Int
0,
adfUserVerified :: Bool
M.adfUserVerified = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit Word8
bitFlags Int
2
}
SignatureCounter
adSignCount <- Word32 -> SignatureCounter
M.SignatureCounter (Word32 -> SignatureCounter)
-> StateT ByteString (Either Text) Word32
-> StateT ByteString (Either Text) SignatureCounter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32 -> StateT ByteString (Either Text) Word32
forall a. Get a -> PartialBinaryDecoder a
runBinary Get Word32
Binary.getWord32be
AttestedCredentialData c 'True
adAttestedCredentialData <- case (SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @c, Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit Word8
bitFlags Int
6) of
(SCeremonyKind c
K.SRegistration, Bool
True) ->
StateT ByteString (Either Text) (AttestedCredentialData c 'True)
PartialBinaryDecoder (AttestedCredentialData 'Registration 'True)
decodeAttestedCredentialData
(SCeremonyKind c
K.SRegistration, Bool
False) ->
Text
-> StateT ByteString (Either Text) (AttestedCredentialData c 'True)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"Expected attested credential data, but there is none"
(SCeremonyKind c
K.SAuthentication, Bool
False) ->
AttestedCredentialData 'Authentication 'True
-> StateT
ByteString
(Either Text)
(AttestedCredentialData 'Authentication 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttestedCredentialData 'Authentication 'True
forall (raw :: Bool). AttestedCredentialData 'Authentication raw
M.NoAttestedCredentialData
(SCeremonyKind c
K.SAuthentication, Bool
True) ->
Text
-> StateT ByteString (Either Text) (AttestedCredentialData c 'True)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"Expected no attested credential data, but there is"
Maybe AuthenticatorExtensionOutputs
adExtensions <-
if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit Word8
bitFlags Int
7
then AuthenticatorExtensionOutputs
-> Maybe AuthenticatorExtensionOutputs
forall a. a -> Maybe a
Just (AuthenticatorExtensionOutputs
-> Maybe AuthenticatorExtensionOutputs)
-> PartialBinaryDecoder AuthenticatorExtensionOutputs
-> StateT
ByteString (Either Text) (Maybe AuthenticatorExtensionOutputs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartialBinaryDecoder AuthenticatorExtensionOutputs
decodeExtensions
else Maybe AuthenticatorExtensionOutputs
-> StateT
ByteString (Either Text) (Maybe AuthenticatorExtensionOutputs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe AuthenticatorExtensionOutputs
forall a. Maybe a
Nothing
AuthenticatorData c 'True
-> PartialBinaryDecoder (AuthenticatorData c 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthenticatorData :: forall (c :: CeremonyKind) (raw :: Bool).
RpIdHash
-> AuthenticatorDataFlags
-> SignatureCounter
-> AttestedCredentialData c raw
-> Maybe AuthenticatorExtensionOutputs
-> RawField raw
-> AuthenticatorData c raw
M.AuthenticatorData {Maybe AuthenticatorExtensionOutputs
AttestedCredentialData c 'True
AuthenticatorDataFlags
SignatureCounter
RpIdHash
RawField 'True
adExtensions :: Maybe AuthenticatorExtensionOutputs
adAttestedCredentialData :: AttestedCredentialData c 'True
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
adRawData :: RawField 'True
adRawData :: RawField 'True
adExtensions :: Maybe AuthenticatorExtensionOutputs
adAttestedCredentialData :: AttestedCredentialData c 'True
adSignCount :: SignatureCounter
adFlags :: AuthenticatorDataFlags
adRpIdHash :: RpIdHash
..}
encodeRawAttestationObject ::
M.AttestationObject raw ->
M.AttestationObject 'True
encodeRawAttestationObject :: AttestationObject raw -> AttestationObject 'True
encodeRawAttestationObject M.AttestationObject {a
AttStmt a
AuthenticatorData 'Registration raw
aoAttStmt :: ()
aoFmt :: ()
aoAuthData :: forall (raw :: Bool).
AttestationObject raw -> AuthenticatorData 'Registration raw
aoAttStmt :: AttStmt a
aoFmt :: a
aoAuthData :: AuthenticatorData 'Registration raw
..} =
AttestationObject :: forall (raw :: Bool) a.
AttestationStatementFormat a =>
AuthenticatorData 'Registration raw
-> a -> AttStmt a -> AttestationObject raw
M.AttestationObject
{ aoAuthData :: AuthenticatorData 'Registration 'True
aoAuthData = AuthenticatorData 'Registration raw
-> AuthenticatorData 'Registration 'True
forall (c :: CeremonyKind) (raw :: Bool).
SingI c =>
AuthenticatorData c raw -> AuthenticatorData c 'True
encodeRawAuthenticatorData AuthenticatorData 'Registration raw
aoAuthData,
a
AttStmt a
aoAttStmt :: AttStmt a
aoFmt :: a
aoAttStmt :: AttStmt a
aoFmt :: a
..
}
stripRawAttestationObject ::
M.AttestationObject raw ->
M.AttestationObject 'False
stripRawAttestationObject :: AttestationObject raw -> AttestationObject 'False
stripRawAttestationObject M.AttestationObject {a
AttStmt a
AuthenticatorData 'Registration raw
aoAttStmt :: AttStmt a
aoFmt :: a
aoAuthData :: AuthenticatorData 'Registration raw
aoAttStmt :: ()
aoFmt :: ()
aoAuthData :: forall (raw :: Bool).
AttestationObject raw -> AuthenticatorData 'Registration raw
..} =
AttestationObject :: forall (raw :: Bool) a.
AttestationStatementFormat a =>
AuthenticatorData 'Registration raw
-> a -> AttStmt a -> AttestationObject raw
M.AttestationObject
{ aoAuthData :: AuthenticatorData 'Registration 'False
aoAuthData = AuthenticatorData 'Registration raw
-> AuthenticatorData 'Registration 'False
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorData c 'False
stripRawAuthenticatorData AuthenticatorData 'Registration raw
aoAuthData,
a
AttStmt a
aoAttStmt :: AttStmt a
aoFmt :: a
aoAttStmt :: AttStmt a
aoFmt :: a
..
}
encodeAttestationObject ::
M.AttestationObject 'True ->
BS.ByteString
encodeAttestationObject :: AttestationObject 'True -> ByteString
encodeAttestationObject M.AttestationObject {a
AttStmt a
AuthenticatorData 'Registration 'True
aoAttStmt :: AttStmt a
aoFmt :: a
aoAuthData :: AuthenticatorData 'Registration 'True
aoAttStmt :: ()
aoFmt :: ()
aoAuthData :: forall (raw :: Bool).
AttestationObject raw -> AuthenticatorData 'Registration raw
..} =
Encoding -> ByteString
CBOR.toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Term -> Encoding
CBOR.encodeTerm Term
term
where
term :: CBOR.Term
term :: Term
term =
[(Term, Term)] -> Term
CBOR.TMap
[ (Text -> Term
CBOR.TString Text
"authData", ByteString -> Term
CBOR.TBytes (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ RawField 'True -> ByteString
M.unRaw (RawField 'True -> ByteString) -> RawField 'True -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthenticatorData 'Registration 'True -> RawField 'True
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
M.adRawData AuthenticatorData 'Registration 'True
aoAuthData),
(Text -> Term
CBOR.TString Text
"fmt", Text -> Term
CBOR.TString (Text -> Term) -> Text -> Term
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. AttestationStatementFormat a => a -> Text
M.asfIdentifier a
aoFmt),
(Text -> Term
CBOR.TString Text
"attStmt", a -> AttStmt a -> Term
forall a. AttestationStatementFormat a => a -> AttStmt a -> Term
M.asfEncode a
aoFmt AttStmt a
aoAttStmt)
]
decodeAttestationObject ::
M.SupportedAttestationStatementFormats ->
BS.ByteString ->
Either Text (M.AttestationObject 'True)
decodeAttestationObject :: SupportedAttestationStatementFormats
-> ByteString -> Either Text (AttestationObject 'True)
decodeAttestationObject SupportedAttestationStatementFormats
supportedFormats ByteString
bytes = do
(ByteString
_consumed, Term
result) <-
ByteString
-> PartialBinaryDecoder (ByteString, Term)
-> Either Text (ByteString, Term)
forall a. ByteString -> PartialBinaryDecoder a -> Either Text a
runPartialBinaryDecoder ByteString
bytes ((forall s. Decoder s Term)
-> PartialBinaryDecoder (ByteString, Term)
forall a.
(forall s. Decoder s a) -> PartialBinaryDecoder (ByteString, a)
runCBOR forall s. Decoder s Term
CBOR.decodeTerm)
[(Term, Term)]
pairs <- case Term
result of
CBOR.TMap [(Term, Term)]
pairs -> [(Term, Term)] -> Either Text [(Term, Term)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Term, Term)]
pairs
Term
_ ->
Text -> Either Text [(Term, Term)]
forall a b. a -> Either a b
Left (Text -> Either Text [(Term, Term)])
-> Text -> Either Text [(Term, Term)]
forall a b. (a -> b) -> a -> b
$
Text
"The attestation object should be a CBOR map, but it's not: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Term -> String
forall a. Show a => a -> String
show Term
result)
case ( Text -> Term
CBOR.TString Text
"authData" Term -> [(Term, Term)] -> Maybe Term
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Term, Term)]
pairs,
Text -> Term
CBOR.TString Text
"fmt" Term -> [(Term, Term)] -> Maybe Term
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Term, Term)]
pairs,
Text -> Term
CBOR.TString Text
"attStmt" Term -> [(Term, Term)] -> Maybe Term
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Term, Term)]
pairs
) of
( Just (CBOR.TBytes ByteString
authDataBytes),
Just (CBOR.TString Text
fmt),
Just (CBOR.TMap [(Term, Term)]
attStmtPairs)
) -> do
AuthenticatorData 'Registration 'True
aoAuthData <- ByteString -> Either Text (AuthenticatorData 'Registration 'True)
forall (c :: CeremonyKind).
SingI c =>
ByteString -> Either Text (AuthenticatorData c 'True)
decodeAuthenticatorData ByteString
authDataBytes
case Text
-> SupportedAttestationStatementFormats
-> Maybe SomeAttestationStatementFormat
M.lookupAttestationStatementFormat Text
fmt SupportedAttestationStatementFormats
supportedFormats of
Maybe SomeAttestationStatementFormat
Nothing -> Text -> Either Text (AttestationObject 'True)
forall a b. a -> Either a b
Left (Text -> Either Text (AttestationObject 'True))
-> Text -> Either Text (AttestationObject 'True)
forall a b. (a -> b) -> a -> b
$ Text
"Unknown attestation statement format: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fmt
Just (M.SomeAttestationStatementFormat a
aoFmt) -> do
HashMap Text Term
attStmtMap <-
[(Text, Term)] -> HashMap Text Term
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
([(Text, Term)] -> HashMap Text Term)
-> Either Text [(Text, Term)] -> Either Text (HashMap Text Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Term, Term) -> Either Text (Text, Term))
-> [(Term, Term)] -> Either Text [(Text, Term)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Term, Term) -> Either Text (Text, Term)
forall b. (Term, b) -> Either Text (Text, b)
textKeyPairs [(Term, Term)]
attStmtPairs
AttStmt a
aoAttStmt <- a -> HashMap Text Term -> Either Text (AttStmt a)
forall a.
AttestationStatementFormat a =>
a -> HashMap Text Term -> Either Text (AttStmt a)
M.asfDecode a
aoFmt HashMap Text Term
attStmtMap
AttestationObject 'True -> Either Text (AttestationObject 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttestationObject :: forall (raw :: Bool) a.
AttestationStatementFormat a =>
AuthenticatorData 'Registration raw
-> a -> AttStmt a -> AttestationObject raw
M.AttestationObject {a
AttStmt a
AuthenticatorData 'Registration 'True
aoAttStmt :: AttStmt a
aoFmt :: a
aoAuthData :: AuthenticatorData 'Registration 'True
aoAttStmt :: AttStmt a
aoFmt :: a
aoAuthData :: AuthenticatorData 'Registration 'True
..}
(Maybe Term, Maybe Term, Maybe Term)
_ ->
Text -> Either Text (AttestationObject 'True)
forall a b. a -> Either a b
Left (Text -> Either Text (AttestationObject 'True))
-> Text -> Either Text (AttestationObject 'True)
forall a b. (a -> b) -> a -> b
$
Text
"The attestation object doesn't have the expected structure of "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(authData: bytes, fmt: string, attStmt: map): "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Term -> String
forall a. Show a => a -> String
show Term
result)
where
textKeyPairs :: (Term, b) -> Either Text (Text, b)
textKeyPairs (CBOR.TString Text
text, b
term) = (Text, b) -> Either Text (Text, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
text, b
term)
textKeyPairs (Term
nonString, b
_) =
Text -> Either Text (Text, b)
forall a b. a -> Either a b
Left (Text -> Either Text (Text, b)) -> Text -> Either Text (Text, b)
forall a b. (a -> b) -> a -> b
$
Text
"Unexpected non-string attestation statement key: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Term -> String
forall a. Show a => a -> String
show Term
nonString)
encodeRawAuthenticatorResponse ::
M.AuthenticatorResponse c raw ->
M.AuthenticatorResponse c 'True
encodeRawAuthenticatorResponse :: AuthenticatorResponse c raw -> AuthenticatorResponse c 'True
encodeRawAuthenticatorResponse M.AuthenticatorResponseRegistration {[AuthenticatorTransport]
AttestationObject raw
CollectedClientData 'Registration raw
arrTransports :: forall (raw :: Bool).
AuthenticatorResponse 'Registration raw -> [AuthenticatorTransport]
arrAttestationObject :: forall (raw :: Bool).
AuthenticatorResponse 'Registration raw -> AttestationObject raw
arrClientData :: forall (raw :: Bool).
AuthenticatorResponse 'Registration raw
-> CollectedClientData 'Registration raw
arrTransports :: [AuthenticatorTransport]
arrAttestationObject :: AttestationObject raw
arrClientData :: CollectedClientData 'Registration raw
..} =
AuthenticatorResponseRegistration :: forall (raw :: Bool).
CollectedClientData 'Registration raw
-> AttestationObject raw
-> [AuthenticatorTransport]
-> AuthenticatorResponse 'Registration raw
M.AuthenticatorResponseRegistration
{ arrClientData :: CollectedClientData 'Registration 'True
arrClientData = CollectedClientData 'Registration raw
-> CollectedClientData 'Registration 'True
forall (c :: CeremonyKind) (raw :: Bool).
SingI c =>
CollectedClientData c raw -> CollectedClientData c 'True
encodeRawCollectedClientData CollectedClientData 'Registration raw
arrClientData,
arrAttestationObject :: AttestationObject 'True
arrAttestationObject = AttestationObject raw -> AttestationObject 'True
forall (raw :: Bool).
AttestationObject raw -> AttestationObject 'True
encodeRawAttestationObject AttestationObject raw
arrAttestationObject,
[AuthenticatorTransport]
arrTransports :: [AuthenticatorTransport]
arrTransports :: [AuthenticatorTransport]
..
}
encodeRawAuthenticatorResponse M.AuthenticatorResponseAuthentication {Maybe UserHandle
AuthenticatorData 'Authentication raw
CollectedClientData 'Authentication raw
AssertionSignature
araUserHandle :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw -> Maybe UserHandle
araSignature :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw -> AssertionSignature
araAuthenticatorData :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw
-> AuthenticatorData 'Authentication raw
araClientData :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw
-> CollectedClientData 'Authentication raw
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
araAuthenticatorData :: AuthenticatorData 'Authentication raw
araClientData :: CollectedClientData 'Authentication raw
..} =
AuthenticatorResponseAuthentication :: forall (raw :: Bool).
CollectedClientData 'Authentication raw
-> AuthenticatorData 'Authentication raw
-> AssertionSignature
-> Maybe UserHandle
-> AuthenticatorResponse 'Authentication raw
M.AuthenticatorResponseAuthentication
{ araClientData :: CollectedClientData 'Authentication 'True
araClientData = CollectedClientData 'Authentication raw
-> CollectedClientData 'Authentication 'True
forall (c :: CeremonyKind) (raw :: Bool).
SingI c =>
CollectedClientData c raw -> CollectedClientData c 'True
encodeRawCollectedClientData CollectedClientData 'Authentication raw
araClientData,
araAuthenticatorData :: AuthenticatorData 'Authentication 'True
araAuthenticatorData = AuthenticatorData 'Authentication raw
-> AuthenticatorData 'Authentication 'True
forall (c :: CeremonyKind) (raw :: Bool).
SingI c =>
AuthenticatorData c raw -> AuthenticatorData c 'True
encodeRawAuthenticatorData AuthenticatorData 'Authentication raw
araAuthenticatorData,
Maybe UserHandle
AssertionSignature
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
..
}
stripRawAuthenticatorResponse ::
M.AuthenticatorResponse c raw ->
M.AuthenticatorResponse c 'False
stripRawAuthenticatorResponse :: AuthenticatorResponse c raw -> AuthenticatorResponse c 'False
stripRawAuthenticatorResponse M.AuthenticatorResponseRegistration {[AuthenticatorTransport]
AttestationObject raw
CollectedClientData 'Registration raw
arrTransports :: [AuthenticatorTransport]
arrAttestationObject :: AttestationObject raw
arrClientData :: CollectedClientData 'Registration raw
arrTransports :: forall (raw :: Bool).
AuthenticatorResponse 'Registration raw -> [AuthenticatorTransport]
arrAttestationObject :: forall (raw :: Bool).
AuthenticatorResponse 'Registration raw -> AttestationObject raw
arrClientData :: forall (raw :: Bool).
AuthenticatorResponse 'Registration raw
-> CollectedClientData 'Registration raw
..} =
AuthenticatorResponseRegistration :: forall (raw :: Bool).
CollectedClientData 'Registration raw
-> AttestationObject raw
-> [AuthenticatorTransport]
-> AuthenticatorResponse 'Registration raw
M.AuthenticatorResponseRegistration
{ arrClientData :: CollectedClientData 'Registration 'False
arrClientData = CollectedClientData 'Registration raw
-> CollectedClientData 'Registration 'False
forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> CollectedClientData c 'False
stripRawCollectedClientData CollectedClientData 'Registration raw
arrClientData,
arrAttestationObject :: AttestationObject 'False
arrAttestationObject = AttestationObject raw -> AttestationObject 'False
forall (raw :: Bool).
AttestationObject raw -> AttestationObject 'False
stripRawAttestationObject AttestationObject raw
arrAttestationObject,
[AuthenticatorTransport]
arrTransports :: [AuthenticatorTransport]
arrTransports :: [AuthenticatorTransport]
..
}
stripRawAuthenticatorResponse M.AuthenticatorResponseAuthentication {Maybe UserHandle
AuthenticatorData 'Authentication raw
CollectedClientData 'Authentication raw
AssertionSignature
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
araAuthenticatorData :: AuthenticatorData 'Authentication raw
araClientData :: CollectedClientData 'Authentication raw
araUserHandle :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw -> Maybe UserHandle
araSignature :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw -> AssertionSignature
araAuthenticatorData :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw
-> AuthenticatorData 'Authentication raw
araClientData :: forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw
-> CollectedClientData 'Authentication raw
..} =
AuthenticatorResponseAuthentication :: forall (raw :: Bool).
CollectedClientData 'Authentication raw
-> AuthenticatorData 'Authentication raw
-> AssertionSignature
-> Maybe UserHandle
-> AuthenticatorResponse 'Authentication raw
M.AuthenticatorResponseAuthentication
{ araClientData :: CollectedClientData 'Authentication 'False
araClientData = CollectedClientData 'Authentication raw
-> CollectedClientData 'Authentication 'False
forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> CollectedClientData c 'False
stripRawCollectedClientData CollectedClientData 'Authentication raw
araClientData,
araAuthenticatorData :: AuthenticatorData 'Authentication 'False
araAuthenticatorData = AuthenticatorData 'Authentication raw
-> AuthenticatorData 'Authentication 'False
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorData c 'False
stripRawAuthenticatorData AuthenticatorData 'Authentication raw
araAuthenticatorData,
Maybe UserHandle
AssertionSignature
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
..
}
encodeRawCredential ::
M.Credential c raw ->
M.Credential c 'True
encodeRawCredential :: Credential c raw -> Credential c 'True
encodeRawCredential M.Credential {AuthenticatorResponse c raw
AuthenticationExtensionsClientOutputs
CredentialId
cClientExtensionResults :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> AuthenticationExtensionsClientOutputs
cResponse :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> AuthenticatorResponse c raw
cIdentifier :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse c raw
cIdentifier :: CredentialId
..} =
Credential :: forall (c :: CeremonyKind) (raw :: Bool).
CredentialId
-> AuthenticatorResponse c raw
-> AuthenticationExtensionsClientOutputs
-> Credential c raw
M.Credential
{ cResponse :: AuthenticatorResponse c 'True
cResponse = AuthenticatorResponse c raw -> AuthenticatorResponse c 'True
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorResponse c raw -> AuthenticatorResponse c 'True
encodeRawAuthenticatorResponse AuthenticatorResponse c raw
cResponse,
AuthenticationExtensionsClientOutputs
CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cIdentifier :: CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cIdentifier :: CredentialId
..
}
stripRawCredential ::
M.Credential c raw ->
M.Credential c 'False
stripRawCredential :: Credential c raw -> Credential c 'False
stripRawCredential M.Credential {AuthenticatorResponse c raw
AuthenticationExtensionsClientOutputs
CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse c raw
cIdentifier :: CredentialId
cClientExtensionResults :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> AuthenticationExtensionsClientOutputs
cResponse :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> AuthenticatorResponse c raw
cIdentifier :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> CredentialId
..} =
Credential :: forall (c :: CeremonyKind) (raw :: Bool).
CredentialId
-> AuthenticatorResponse c raw
-> AuthenticationExtensionsClientOutputs
-> Credential c raw
M.Credential
{ cResponse :: AuthenticatorResponse c 'False
cResponse = AuthenticatorResponse c raw -> AuthenticatorResponse c 'False
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorResponse c raw -> AuthenticatorResponse c 'False
stripRawAuthenticatorResponse AuthenticatorResponse c raw
cResponse,
AuthenticationExtensionsClientOutputs
CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cIdentifier :: CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cIdentifier :: CredentialId
..
}