{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RecordWildCards #-}
module Crypto.WebAuthn.Model.WebIDL.Internal.Decoding
( Decode (..),
DecodeCreated (..),
)
where
import qualified Crypto.WebAuthn.Cose.Algorithm as Cose
import qualified Crypto.WebAuthn.Model.Kinds as K
import qualified Crypto.WebAuthn.Model.Types as M
import qualified Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Decoding as B
import Crypto.WebAuthn.Model.WebIDL.Internal.Convert (Convert (IDL))
import qualified Crypto.WebAuthn.Model.WebIDL.Types as IDL
import qualified Crypto.WebAuthn.WebIDL as IDL
import Data.Coerce (Coercible, coerce)
import Data.Maybe (catMaybes, mapMaybe)
import Data.Singletons (SingI)
import Data.Text (Text)
class Convert a => Decode a where
decode :: IDL a -> Either Text a
default decode :: Coercible (IDL a) a => IDL a -> Either Text a
decode = a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either Text a) -> (IDL a -> a) -> IDL a -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IDL a -> a
coerce
class Convert a => DecodeCreated a where
decodeCreated :: M.SupportedAttestationStatementFormats -> IDL a -> Either Text a
instance Decode a => Decode (Maybe a) where
decode :: IDL (Maybe a) -> Either Text (Maybe a)
decode IDL (Maybe a)
Nothing = Maybe a -> Either Text (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
decode (Just a) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either Text a -> Either Text (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IDL a -> Either Text a
forall a. Decode a => IDL a -> Either Text a
decode IDL a
a
instance Decode M.CredentialId
instance Decode M.AssertionSignature
instance Decode M.UserHandle
instance Decode M.AuthenticationExtensionsClientOutputs where
decode :: IDL AuthenticationExtensionsClientOutputs
-> Either Text AuthenticationExtensionsClientOutputs
decode IDL AuthenticationExtensionsClientOutputs
_ = AuthenticationExtensionsClientOutputs
-> Either Text AuthenticationExtensionsClientOutputs
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthenticationExtensionsClientOutputs :: AuthenticationExtensionsClientOutputs
M.AuthenticationExtensionsClientOutputs {}
instance SingI c => Decode (M.CollectedClientData (c :: K.CeremonyKind) 'True) where
decode :: IDL (CollectedClientData c 'True)
-> Either Text (CollectedClientData c 'True)
decode (IDL.URLEncodedBase64 bytes) = ByteString -> Either Text (CollectedClientData c 'True)
forall (c :: CeremonyKind).
SingI c =>
ByteString -> Either Text (CollectedClientData c 'True)
B.decodeCollectedClientData ByteString
bytes
instance Decode (M.AuthenticatorData 'K.Authentication 'True) where
decode :: IDL (AuthenticatorData 'Authentication 'True)
-> Either Text (AuthenticatorData 'Authentication 'True)
decode (IDL.URLEncodedBase64 bytes) = ByteString -> Either Text (AuthenticatorData 'Authentication 'True)
forall (c :: CeremonyKind).
SingI c =>
ByteString -> Either Text (AuthenticatorData c 'True)
B.decodeAuthenticatorData ByteString
bytes
instance Decode (M.AuthenticatorResponse 'K.Authentication 'True) where
decode :: IDL (AuthenticatorResponse 'Authentication 'True)
-> Either Text (AuthenticatorResponse 'Authentication 'True)
decode IDL.AuthenticatorAssertionResponse {..} = do
CollectedClientData 'Authentication 'True
araClientData <- IDL (CollectedClientData 'Authentication 'True)
-> Either Text (CollectedClientData 'Authentication 'True)
forall a. Decode a => IDL a -> Either Text a
decode ArrayBuffer
IDL (CollectedClientData 'Authentication 'True)
clientDataJSON
AuthenticatorData 'Authentication 'True
araAuthenticatorData <- IDL (AuthenticatorData 'Authentication 'True)
-> Either Text (AuthenticatorData 'Authentication 'True)
forall a. Decode a => IDL a -> Either Text a
decode ArrayBuffer
IDL (AuthenticatorData 'Authentication 'True)
authenticatorData
AssertionSignature
araSignature <- IDL AssertionSignature -> Either Text AssertionSignature
forall a. Decode a => IDL a -> Either Text a
decode ArrayBuffer
IDL AssertionSignature
signature
Maybe UserHandle
araUserHandle <- IDL (Maybe UserHandle) -> Either Text (Maybe UserHandle)
forall a. Decode a => IDL a -> Either Text a
decode Maybe ArrayBuffer
IDL (Maybe UserHandle)
userHandle
AuthenticatorResponse 'Authentication 'True
-> Either Text (AuthenticatorResponse 'Authentication 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticatorResponse 'Authentication 'True
-> Either Text (AuthenticatorResponse 'Authentication 'True))
-> AuthenticatorResponse 'Authentication 'True
-> Either Text (AuthenticatorResponse 'Authentication 'True)
forall a b. (a -> b) -> a -> b
$ AuthenticatorResponseAuthentication :: forall (raw :: Bool).
CollectedClientData 'Authentication raw
-> AuthenticatorData 'Authentication raw
-> AssertionSignature
-> Maybe UserHandle
-> AuthenticatorResponse 'Authentication raw
M.AuthenticatorResponseAuthentication {Maybe UserHandle
AuthenticatorData 'Authentication 'True
CollectedClientData 'Authentication 'True
AssertionSignature
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
araAuthenticatorData :: AuthenticatorData 'Authentication 'True
araClientData :: CollectedClientData 'Authentication 'True
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
araAuthenticatorData :: AuthenticatorData 'Authentication 'True
araClientData :: CollectedClientData 'Authentication 'True
..}
instance Decode (M.Credential 'K.Authentication 'True) where
decode :: IDL (Credential 'Authentication 'True)
-> Either Text (Credential 'Authentication 'True)
decode IDL.PublicKeyCredential {..} = do
CredentialId
cIdentifier <- IDL CredentialId -> Either Text CredentialId
forall a. Decode a => IDL a -> Either Text a
decode ArrayBuffer
IDL CredentialId
rawId
AuthenticatorResponse 'Authentication 'True
cResponse <- IDL (AuthenticatorResponse 'Authentication 'True)
-> Either Text (AuthenticatorResponse 'Authentication 'True)
forall a. Decode a => IDL a -> Either Text a
decode AuthenticatorAssertionResponse
IDL (AuthenticatorResponse 'Authentication 'True)
response
AuthenticationExtensionsClientOutputs
cClientExtensionResults <- IDL AuthenticationExtensionsClientOutputs
-> Either Text AuthenticationExtensionsClientOutputs
forall a. Decode a => IDL a -> Either Text a
decode Map Text Value
IDL AuthenticationExtensionsClientOutputs
clientExtensionResults
Credential 'Authentication 'True
-> Either Text (Credential 'Authentication 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'Authentication 'True
-> Either Text (Credential 'Authentication 'True))
-> Credential 'Authentication 'True
-> Either Text (Credential 'Authentication 'True)
forall a b. (a -> b) -> a -> b
$ Credential :: forall (c :: CeremonyKind) (raw :: Bool).
CredentialId
-> AuthenticatorResponse c raw
-> AuthenticationExtensionsClientOutputs
-> Credential c raw
M.Credential {AuthenticatorResponse 'Authentication 'True
AuthenticationExtensionsClientOutputs
CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse 'Authentication 'True
cIdentifier :: CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse 'Authentication 'True
cIdentifier :: CredentialId
..}
instance Decode M.RpId
instance Decode M.RelyingPartyName
instance Decode M.CredentialRpEntity where
decode :: IDL CredentialRpEntity -> Either Text CredentialRpEntity
decode IDL.PublicKeyCredentialRpEntity {..} = do
Maybe RpId
creId <- IDL (Maybe RpId) -> Either Text (Maybe RpId)
forall a. Decode a => IDL a -> Either Text a
decode Maybe Text
IDL (Maybe RpId)
id
RelyingPartyName
creName <- IDL RelyingPartyName -> Either Text RelyingPartyName
forall a. Decode a => IDL a -> Either Text a
decode Text
IDL RelyingPartyName
name
CredentialRpEntity -> Either Text CredentialRpEntity
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialRpEntity -> Either Text CredentialRpEntity)
-> CredentialRpEntity -> Either Text CredentialRpEntity
forall a b. (a -> b) -> a -> b
$ CredentialRpEntity :: Maybe RpId -> RelyingPartyName -> CredentialRpEntity
M.CredentialRpEntity {Maybe RpId
RelyingPartyName
creName :: RelyingPartyName
creId :: Maybe RpId
creName :: RelyingPartyName
creId :: Maybe RpId
..}
instance Decode M.UserAccountDisplayName
instance Decode M.UserAccountName
instance Decode M.CredentialUserEntity where
decode :: IDL CredentialUserEntity -> Either Text CredentialUserEntity
decode IDL.PublicKeyCredentialUserEntity {..} = do
UserHandle
cueId <- IDL UserHandle -> Either Text UserHandle
forall a. Decode a => IDL a -> Either Text a
decode ArrayBuffer
IDL UserHandle
id
UserAccountDisplayName
cueDisplayName <- IDL UserAccountDisplayName -> Either Text UserAccountDisplayName
forall a. Decode a => IDL a -> Either Text a
decode Text
IDL UserAccountDisplayName
displayName
UserAccountName
cueName <- IDL UserAccountName -> Either Text UserAccountName
forall a. Decode a => IDL a -> Either Text a
decode Text
IDL UserAccountName
name
CredentialUserEntity -> Either Text CredentialUserEntity
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialUserEntity -> Either Text CredentialUserEntity)
-> CredentialUserEntity -> Either Text CredentialUserEntity
forall a b. (a -> b) -> a -> b
$ CredentialUserEntity :: UserHandle
-> UserAccountDisplayName
-> UserAccountName
-> CredentialUserEntity
M.CredentialUserEntity {UserAccountName
UserAccountDisplayName
UserHandle
cueName :: UserAccountName
cueDisplayName :: UserAccountDisplayName
cueId :: UserHandle
cueName :: UserAccountName
cueDisplayName :: UserAccountDisplayName
cueId :: UserHandle
..}
instance Decode M.Challenge
instance Decode Cose.CoseSignAlg where
decode :: IDL CoseSignAlg -> Either Text CoseSignAlg
decode = IDL CoseSignAlg -> Either Text CoseSignAlg
forall a. (Eq a, Num a, Show a) => a -> Either Text CoseSignAlg
Cose.toCoseSignAlg
instance Decode M.Timeout
instance Decode [M.AuthenticatorTransport] where
decode :: IDL [AuthenticatorTransport]
-> Either Text [AuthenticatorTransport]
decode = [AuthenticatorTransport] -> Either Text [AuthenticatorTransport]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([AuthenticatorTransport] -> Either Text [AuthenticatorTransport])
-> ([Text] -> [AuthenticatorTransport])
-> [Text]
-> Either Text [AuthenticatorTransport]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe AuthenticatorTransport)
-> [Text] -> [AuthenticatorTransport]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe AuthenticatorTransport
forall a. (Eq a, IsString a) => a -> Maybe AuthenticatorTransport
decodeTransport
where
decodeTransport :: a -> Maybe AuthenticatorTransport
decodeTransport a
"usb" = AuthenticatorTransport -> Maybe AuthenticatorTransport
forall a. a -> Maybe a
Just AuthenticatorTransport
M.AuthenticatorTransportUSB
decodeTransport a
"nfc" = AuthenticatorTransport -> Maybe AuthenticatorTransport
forall a. a -> Maybe a
Just AuthenticatorTransport
M.AuthenticatorTransportNFC
decodeTransport a
"ble" = AuthenticatorTransport -> Maybe AuthenticatorTransport
forall a. a -> Maybe a
Just AuthenticatorTransport
M.AuthenticatorTransportBLE
decodeTransport a
"internal" = AuthenticatorTransport -> Maybe AuthenticatorTransport
forall a. a -> Maybe a
Just AuthenticatorTransport
M.AuthenticatorTransportInternal
decodeTransport a
_ = Maybe AuthenticatorTransport
forall a. Maybe a
Nothing
instance Decode [M.CredentialDescriptor] where
decode :: IDL [CredentialDescriptor] -> Either Text [CredentialDescriptor]
decode IDL [CredentialDescriptor]
Nothing = [CredentialDescriptor] -> Either Text [CredentialDescriptor]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
decode (Just xs) = [Maybe CredentialDescriptor] -> [CredentialDescriptor]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe CredentialDescriptor] -> [CredentialDescriptor])
-> Either Text [Maybe CredentialDescriptor]
-> Either Text [CredentialDescriptor]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PublicKeyCredentialDescriptor
-> Either Text (Maybe CredentialDescriptor))
-> [PublicKeyCredentialDescriptor]
-> Either Text [Maybe CredentialDescriptor]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PublicKeyCredentialDescriptor
-> Either Text (Maybe CredentialDescriptor)
decodeDescriptor [PublicKeyCredentialDescriptor]
xs
where
decodeDescriptor :: IDL.PublicKeyCredentialDescriptor -> Either Text (Maybe M.CredentialDescriptor)
decodeDescriptor :: PublicKeyCredentialDescriptor
-> Either Text (Maybe CredentialDescriptor)
decodeDescriptor IDL.PublicKeyCredentialDescriptor {$sel:littype:PublicKeyCredentialDescriptor :: PublicKeyCredentialDescriptor -> Text
littype = Text
"public-key", Maybe [Text]
ArrayBuffer
$sel:transports:PublicKeyCredentialDescriptor :: PublicKeyCredentialDescriptor -> Maybe [Text]
$sel:id:PublicKeyCredentialDescriptor :: PublicKeyCredentialDescriptor -> ArrayBuffer
transports :: Maybe [Text]
id :: ArrayBuffer
..} = do
let cdTyp :: CredentialType
cdTyp = CredentialType
M.CredentialTypePublicKey
CredentialId
cdId <- IDL CredentialId -> Either Text CredentialId
forall a. Decode a => IDL a -> Either Text a
decode ArrayBuffer
IDL CredentialId
id
Maybe [AuthenticatorTransport]
cdTransports <- IDL (Maybe [AuthenticatorTransport])
-> Either Text (Maybe [AuthenticatorTransport])
forall a. Decode a => IDL a -> Either Text a
decode Maybe [Text]
IDL (Maybe [AuthenticatorTransport])
transports
Maybe CredentialDescriptor
-> Either Text (Maybe CredentialDescriptor)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe CredentialDescriptor
-> Either Text (Maybe CredentialDescriptor))
-> (CredentialDescriptor -> Maybe CredentialDescriptor)
-> CredentialDescriptor
-> Either Text (Maybe CredentialDescriptor)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CredentialDescriptor -> Maybe CredentialDescriptor
forall a. a -> Maybe a
Just (CredentialDescriptor -> Either Text (Maybe CredentialDescriptor))
-> CredentialDescriptor -> Either Text (Maybe CredentialDescriptor)
forall a b. (a -> b) -> a -> b
$ CredentialDescriptor :: CredentialType
-> CredentialId
-> Maybe [AuthenticatorTransport]
-> CredentialDescriptor
M.CredentialDescriptor {Maybe [AuthenticatorTransport]
CredentialId
CredentialType
cdTransports :: Maybe [AuthenticatorTransport]
cdId :: CredentialId
cdTyp :: CredentialType
cdTransports :: Maybe [AuthenticatorTransport]
cdId :: CredentialId
cdTyp :: CredentialType
..}
decodeDescriptor PublicKeyCredentialDescriptor
_ = Maybe CredentialDescriptor
-> Either Text (Maybe CredentialDescriptor)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CredentialDescriptor
forall a. Maybe a
Nothing
instance Decode M.UserVerificationRequirement where
decode :: IDL UserVerificationRequirement
-> Either Text UserVerificationRequirement
decode (Just "discouraged") = UserVerificationRequirement
-> Either Text UserVerificationRequirement
forall a b. b -> Either a b
Right UserVerificationRequirement
M.UserVerificationRequirementDiscouraged
decode (Just "preferred") = UserVerificationRequirement
-> Either Text UserVerificationRequirement
forall a b. b -> Either a b
Right UserVerificationRequirement
M.UserVerificationRequirementPreferred
decode (Just "required") = UserVerificationRequirement
-> Either Text UserVerificationRequirement
forall a b. b -> Either a b
Right UserVerificationRequirement
M.UserVerificationRequirementRequired
decode IDL UserVerificationRequirement
_ = UserVerificationRequirement
-> Either Text UserVerificationRequirement
forall a b. b -> Either a b
Right UserVerificationRequirement
M.UserVerificationRequirementPreferred
instance Decode M.AuthenticatorSelectionCriteria where
decode :: IDL AuthenticatorSelectionCriteria
-> Either Text AuthenticatorSelectionCriteria
decode IDL.AuthenticatorSelectionCriteria {..} = do
let ascAuthenticatorAttachment :: Maybe AuthenticatorAttachment
ascAuthenticatorAttachment = Text -> Maybe AuthenticatorAttachment
forall a. (Eq a, IsString a) => a -> Maybe AuthenticatorAttachment
decodeAttachment (Text -> Maybe AuthenticatorAttachment)
-> Maybe Text -> Maybe AuthenticatorAttachment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
authenticatorAttachment
ascResidentKey :: ResidentKeyRequirement
ascResidentKey = Maybe Text -> ResidentKeyRequirement
decodeResidentKey Maybe Text
residentKey
UserVerificationRequirement
ascUserVerification <- IDL UserVerificationRequirement
-> Either Text UserVerificationRequirement
forall a. Decode a => IDL a -> Either Text a
decode Maybe Text
IDL UserVerificationRequirement
userVerification
AuthenticatorSelectionCriteria
-> Either Text AuthenticatorSelectionCriteria
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticatorSelectionCriteria
-> Either Text AuthenticatorSelectionCriteria)
-> AuthenticatorSelectionCriteria
-> Either Text AuthenticatorSelectionCriteria
forall a b. (a -> b) -> a -> b
$ AuthenticatorSelectionCriteria :: Maybe AuthenticatorAttachment
-> ResidentKeyRequirement
-> UserVerificationRequirement
-> AuthenticatorSelectionCriteria
M.AuthenticatorSelectionCriteria {Maybe AuthenticatorAttachment
UserVerificationRequirement
ResidentKeyRequirement
ascUserVerification :: UserVerificationRequirement
ascResidentKey :: ResidentKeyRequirement
ascAuthenticatorAttachment :: Maybe AuthenticatorAttachment
ascUserVerification :: UserVerificationRequirement
ascResidentKey :: ResidentKeyRequirement
ascAuthenticatorAttachment :: Maybe AuthenticatorAttachment
..}
where
decodeAttachment :: a -> Maybe AuthenticatorAttachment
decodeAttachment a
"platform" = AuthenticatorAttachment -> Maybe AuthenticatorAttachment
forall a. a -> Maybe a
Just AuthenticatorAttachment
M.AuthenticatorAttachmentPlatform
decodeAttachment a
"cross-platform" = AuthenticatorAttachment -> Maybe AuthenticatorAttachment
forall a. a -> Maybe a
Just AuthenticatorAttachment
M.AuthenticatorAttachmentCrossPlatform
decodeAttachment a
_ = Maybe AuthenticatorAttachment
forall a. Maybe a
Nothing
decodeResidentKey :: Maybe IDL.DOMString -> M.ResidentKeyRequirement
decodeResidentKey :: Maybe Text -> ResidentKeyRequirement
decodeResidentKey (Just Text
"discouraged") = ResidentKeyRequirement
M.ResidentKeyRequirementDiscouraged
decodeResidentKey (Just Text
"preferred") = ResidentKeyRequirement
M.ResidentKeyRequirementPreferred
decodeResidentKey (Just Text
"required") = ResidentKeyRequirement
M.ResidentKeyRequirementRequired
decodeResidentKey Maybe Text
_ = case Maybe Bool
requireResidentKey of
Just Bool
True -> ResidentKeyRequirement
M.ResidentKeyRequirementRequired
Maybe Bool
_ -> ResidentKeyRequirement
M.ResidentKeyRequirementDiscouraged
instance Decode M.AttestationConveyancePreference where
decode :: IDL AttestationConveyancePreference
-> Either Text AttestationConveyancePreference
decode (Just "none") = AttestationConveyancePreference
-> Either Text AttestationConveyancePreference
forall a b. b -> Either a b
Right AttestationConveyancePreference
M.AttestationConveyancePreferenceNone
decode (Just "indirect") = AttestationConveyancePreference
-> Either Text AttestationConveyancePreference
forall a b. b -> Either a b
Right AttestationConveyancePreference
M.AttestationConveyancePreferenceIndirect
decode (Just "direct") = AttestationConveyancePreference
-> Either Text AttestationConveyancePreference
forall a b. b -> Either a b
Right AttestationConveyancePreference
M.AttestationConveyancePreferenceDirect
decode (Just "enterprise") = AttestationConveyancePreference
-> Either Text AttestationConveyancePreference
forall a b. b -> Either a b
Right AttestationConveyancePreference
M.AttestationConveyancePreferenceEnterprise
decode IDL AttestationConveyancePreference
_ = AttestationConveyancePreference
-> Either Text AttestationConveyancePreference
forall a b. b -> Either a b
Right AttestationConveyancePreference
M.AttestationConveyancePreferenceNone
instance Decode [M.CredentialParameters] where
decode :: IDL [CredentialParameters] -> Either Text [CredentialParameters]
decode IDL [CredentialParameters]
xs = [Maybe CredentialParameters] -> [CredentialParameters]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe CredentialParameters] -> [CredentialParameters])
-> Either Text [Maybe CredentialParameters]
-> Either Text [CredentialParameters]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PublicKeyCredentialParameters
-> Either Text (Maybe CredentialParameters))
-> [PublicKeyCredentialParameters]
-> Either Text [Maybe CredentialParameters]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PublicKeyCredentialParameters
-> Either Text (Maybe CredentialParameters)
decodeParam [PublicKeyCredentialParameters]
IDL [CredentialParameters]
xs
where
decodeParam :: IDL.PublicKeyCredentialParameters -> Either Text (Maybe M.CredentialParameters)
decodeParam :: PublicKeyCredentialParameters
-> Either Text (Maybe CredentialParameters)
decodeParam IDL.PublicKeyCredentialParameters {$sel:littype:PublicKeyCredentialParameters :: PublicKeyCredentialParameters -> Text
littype = Text
"public-key", COSEAlgorithmIdentifier
$sel:alg:PublicKeyCredentialParameters :: PublicKeyCredentialParameters -> COSEAlgorithmIdentifier
alg :: COSEAlgorithmIdentifier
..} = do
let cpTyp :: CredentialType
cpTyp = CredentialType
M.CredentialTypePublicKey
CoseSignAlg
cpAlg <- IDL CoseSignAlg -> Either Text CoseSignAlg
forall a. Decode a => IDL a -> Either Text a
decode COSEAlgorithmIdentifier
IDL CoseSignAlg
alg
Maybe CredentialParameters
-> Either Text (Maybe CredentialParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe CredentialParameters
-> Either Text (Maybe CredentialParameters))
-> (CredentialParameters -> Maybe CredentialParameters)
-> CredentialParameters
-> Either Text (Maybe CredentialParameters)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CredentialParameters -> Maybe CredentialParameters
forall a. a -> Maybe a
Just (CredentialParameters -> Either Text (Maybe CredentialParameters))
-> CredentialParameters -> Either Text (Maybe CredentialParameters)
forall a b. (a -> b) -> a -> b
$ CredentialParameters :: CredentialType -> CoseSignAlg -> CredentialParameters
M.CredentialParameters {CoseSignAlg
CredentialType
cpAlg :: CoseSignAlg
cpTyp :: CredentialType
cpAlg :: CoseSignAlg
cpTyp :: CredentialType
..}
decodeParam PublicKeyCredentialParameters
_ = Maybe CredentialParameters
-> Either Text (Maybe CredentialParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CredentialParameters
forall a. Maybe a
Nothing
instance Decode (M.CredentialOptions 'K.Registration) where
decode :: IDL (CredentialOptions 'Registration)
-> Either Text (CredentialOptions 'Registration)
decode IDL.PublicKeyCredentialCreationOptions {..} = do
CredentialRpEntity
corRp <- IDL CredentialRpEntity -> Either Text CredentialRpEntity
forall a. Decode a => IDL a -> Either Text a
decode PublicKeyCredentialRpEntity
IDL CredentialRpEntity
rp
CredentialUserEntity
corUser <- IDL CredentialUserEntity -> Either Text CredentialUserEntity
forall a. Decode a => IDL a -> Either Text a
decode PublicKeyCredentialUserEntity
IDL CredentialUserEntity
user
Challenge
corChallenge <- IDL Challenge -> Either Text Challenge
forall a. Decode a => IDL a -> Either Text a
decode ArrayBuffer
IDL Challenge
challenge
[CredentialParameters]
corPubKeyCredParams <- IDL [CredentialParameters] -> Either Text [CredentialParameters]
forall a. Decode a => IDL a -> Either Text a
decode [PublicKeyCredentialParameters]
IDL [CredentialParameters]
pubKeyCredParams
Maybe Timeout
corTimeout <- IDL (Maybe Timeout) -> Either Text (Maybe Timeout)
forall a. Decode a => IDL a -> Either Text a
decode Maybe UnsignedLong
IDL (Maybe Timeout)
timeout
[CredentialDescriptor]
corExcludeCredentials <- IDL [CredentialDescriptor] -> Either Text [CredentialDescriptor]
forall a. Decode a => IDL a -> Either Text a
decode Maybe [PublicKeyCredentialDescriptor]
IDL [CredentialDescriptor]
excludeCredentials
Maybe AuthenticatorSelectionCriteria
corAuthenticatorSelection <- IDL (Maybe AuthenticatorSelectionCriteria)
-> Either Text (Maybe AuthenticatorSelectionCriteria)
forall a. Decode a => IDL a -> Either Text a
decode Maybe AuthenticatorSelectionCriteria
IDL (Maybe AuthenticatorSelectionCriteria)
authenticatorSelection
AttestationConveyancePreference
corAttestation <- IDL AttestationConveyancePreference
-> Either Text AttestationConveyancePreference
forall a. Decode a => IDL a -> Either Text a
decode Maybe Text
IDL AttestationConveyancePreference
attestation
let corExtensions :: Maybe AuthenticationExtensionsClientInputs
corExtensions = AuthenticationExtensionsClientInputs :: AuthenticationExtensionsClientInputs
M.AuthenticationExtensionsClientInputs {} AuthenticationExtensionsClientInputs
-> Maybe (Map Text Value)
-> Maybe AuthenticationExtensionsClientInputs
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe (Map Text Value)
extensions
CredentialOptions 'Registration
-> Either Text (CredentialOptions 'Registration)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialOptions 'Registration
-> Either Text (CredentialOptions 'Registration))
-> CredentialOptions 'Registration
-> Either Text (CredentialOptions 'Registration)
forall a b. (a -> b) -> a -> b
$ CredentialOptionsRegistration :: CredentialRpEntity
-> CredentialUserEntity
-> Challenge
-> [CredentialParameters]
-> Maybe Timeout
-> [CredentialDescriptor]
-> Maybe AuthenticatorSelectionCriteria
-> AttestationConveyancePreference
-> Maybe AuthenticationExtensionsClientInputs
-> CredentialOptions 'Registration
M.CredentialOptionsRegistration {[CredentialDescriptor]
[CredentialParameters]
Maybe AuthenticatorSelectionCriteria
Maybe AuthenticationExtensionsClientInputs
Maybe Timeout
CredentialUserEntity
CredentialRpEntity
Challenge
AttestationConveyancePreference
corExtensions :: Maybe AuthenticationExtensionsClientInputs
corAttestation :: AttestationConveyancePreference
corAuthenticatorSelection :: Maybe AuthenticatorSelectionCriteria
corExcludeCredentials :: [CredentialDescriptor]
corTimeout :: Maybe Timeout
corPubKeyCredParams :: [CredentialParameters]
corChallenge :: Challenge
corUser :: CredentialUserEntity
corRp :: CredentialRpEntity
corExtensions :: Maybe AuthenticationExtensionsClientInputs
corAttestation :: AttestationConveyancePreference
corAuthenticatorSelection :: Maybe AuthenticatorSelectionCriteria
corExcludeCredentials :: [CredentialDescriptor]
corTimeout :: Maybe Timeout
corPubKeyCredParams :: [CredentialParameters]
corChallenge :: Challenge
corUser :: CredentialUserEntity
corRp :: CredentialRpEntity
..}
instance Decode (M.CredentialOptions 'K.Authentication) where
decode :: IDL (CredentialOptions 'Authentication)
-> Either Text (CredentialOptions 'Authentication)
decode IDL.PublicKeyCredentialRequestOptions {..} = do
Challenge
coaChallenge <- IDL Challenge -> Either Text Challenge
forall a. Decode a => IDL a -> Either Text a
decode ArrayBuffer
IDL Challenge
challenge
Maybe Timeout
coaTimeout <- IDL (Maybe Timeout) -> Either Text (Maybe Timeout)
forall a. Decode a => IDL a -> Either Text a
decode Maybe UnsignedLong
IDL (Maybe Timeout)
timeout
Maybe RpId
coaRpId <- IDL (Maybe RpId) -> Either Text (Maybe RpId)
forall a. Decode a => IDL a -> Either Text a
decode Maybe Text
IDL (Maybe RpId)
rpId
[CredentialDescriptor]
coaAllowCredentials <- IDL [CredentialDescriptor] -> Either Text [CredentialDescriptor]
forall a. Decode a => IDL a -> Either Text a
decode Maybe [PublicKeyCredentialDescriptor]
IDL [CredentialDescriptor]
allowCredentials
UserVerificationRequirement
coaUserVerification <- IDL UserVerificationRequirement
-> Either Text UserVerificationRequirement
forall a. Decode a => IDL a -> Either Text a
decode Maybe Text
IDL UserVerificationRequirement
userVerification
let coaExtensions :: Maybe AuthenticationExtensionsClientInputs
coaExtensions = AuthenticationExtensionsClientInputs :: AuthenticationExtensionsClientInputs
M.AuthenticationExtensionsClientInputs {} AuthenticationExtensionsClientInputs
-> Maybe (Map Text Value)
-> Maybe AuthenticationExtensionsClientInputs
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe (Map Text Value)
extensions
CredentialOptions 'Authentication
-> Either Text (CredentialOptions 'Authentication)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialOptions 'Authentication
-> Either Text (CredentialOptions 'Authentication))
-> CredentialOptions 'Authentication
-> Either Text (CredentialOptions 'Authentication)
forall a b. (a -> b) -> a -> b
$ CredentialOptionsAuthentication :: Challenge
-> Maybe Timeout
-> Maybe RpId
-> [CredentialDescriptor]
-> UserVerificationRequirement
-> Maybe AuthenticationExtensionsClientInputs
-> CredentialOptions 'Authentication
M.CredentialOptionsAuthentication {[CredentialDescriptor]
Maybe AuthenticationExtensionsClientInputs
Maybe Timeout
Maybe RpId
Challenge
UserVerificationRequirement
coaExtensions :: Maybe AuthenticationExtensionsClientInputs
coaUserVerification :: UserVerificationRequirement
coaAllowCredentials :: [CredentialDescriptor]
coaRpId :: Maybe RpId
coaTimeout :: Maybe Timeout
coaChallenge :: Challenge
coaExtensions :: Maybe AuthenticationExtensionsClientInputs
coaUserVerification :: UserVerificationRequirement
coaAllowCredentials :: [CredentialDescriptor]
coaRpId :: Maybe RpId
coaTimeout :: Maybe Timeout
coaChallenge :: Challenge
..}
instance DecodeCreated (M.AttestationObject 'True) where
decodeCreated :: SupportedAttestationStatementFormats
-> IDL (AttestationObject 'True)
-> Either Text (AttestationObject 'True)
decodeCreated SupportedAttestationStatementFormats
supportedFormats (IDL.URLEncodedBase64 bytes) =
SupportedAttestationStatementFormats
-> ByteString -> Either Text (AttestationObject 'True)
B.decodeAttestationObject SupportedAttestationStatementFormats
supportedFormats ByteString
bytes
instance DecodeCreated (M.AuthenticatorResponse 'K.Registration 'True) where
decodeCreated :: SupportedAttestationStatementFormats
-> IDL (AuthenticatorResponse 'Registration 'True)
-> Either Text (AuthenticatorResponse 'Registration 'True)
decodeCreated SupportedAttestationStatementFormats
supportedFormats IDL.AuthenticatorAttestationResponse {..} = do
CollectedClientData 'Registration 'True
arrClientData <- IDL (CollectedClientData 'Registration 'True)
-> Either Text (CollectedClientData 'Registration 'True)
forall a. Decode a => IDL a -> Either Text a
decode ArrayBuffer
IDL (CollectedClientData 'Registration 'True)
clientDataJSON
AttestationObject 'True
arrAttestationObject <- SupportedAttestationStatementFormats
-> IDL (AttestationObject 'True)
-> Either Text (AttestationObject 'True)
forall a.
DecodeCreated a =>
SupportedAttestationStatementFormats -> IDL a -> Either Text a
decodeCreated SupportedAttestationStatementFormats
supportedFormats ArrayBuffer
IDL (AttestationObject 'True)
attestationObject
[AuthenticatorTransport]
arrTransports <- case Maybe [Text]
transports of
Maybe [Text]
Nothing -> [AuthenticatorTransport] -> Either Text [AuthenticatorTransport]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just [Text]
t -> IDL [AuthenticatorTransport]
-> Either Text [AuthenticatorTransport]
forall a. Decode a => IDL a -> Either Text a
decode [Text]
IDL [AuthenticatorTransport]
t
AuthenticatorResponse 'Registration 'True
-> Either Text (AuthenticatorResponse 'Registration 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticatorResponse 'Registration 'True
-> Either Text (AuthenticatorResponse 'Registration 'True))
-> AuthenticatorResponse 'Registration 'True
-> Either Text (AuthenticatorResponse 'Registration 'True)
forall a b. (a -> b) -> a -> b
$ AuthenticatorResponseRegistration :: forall (raw :: Bool).
CollectedClientData 'Registration raw
-> AttestationObject raw
-> [AuthenticatorTransport]
-> AuthenticatorResponse 'Registration raw
M.AuthenticatorResponseRegistration {[AuthenticatorTransport]
AttestationObject 'True
CollectedClientData 'Registration 'True
arrTransports :: [AuthenticatorTransport]
arrAttestationObject :: AttestationObject 'True
arrClientData :: CollectedClientData 'Registration 'True
arrTransports :: [AuthenticatorTransport]
arrAttestationObject :: AttestationObject 'True
arrClientData :: CollectedClientData 'Registration 'True
..}
instance DecodeCreated (M.Credential 'K.Registration 'True) where
decodeCreated :: SupportedAttestationStatementFormats
-> IDL (Credential 'Registration 'True)
-> Either Text (Credential 'Registration 'True)
decodeCreated SupportedAttestationStatementFormats
supportedFormats IDL.PublicKeyCredential {..} = do
CredentialId
cIdentifier <- IDL CredentialId -> Either Text CredentialId
forall a. Decode a => IDL a -> Either Text a
decode ArrayBuffer
IDL CredentialId
rawId
AuthenticatorResponse 'Registration 'True
cResponse <- SupportedAttestationStatementFormats
-> IDL (AuthenticatorResponse 'Registration 'True)
-> Either Text (AuthenticatorResponse 'Registration 'True)
forall a.
DecodeCreated a =>
SupportedAttestationStatementFormats -> IDL a -> Either Text a
decodeCreated SupportedAttestationStatementFormats
supportedFormats AuthenticatorAttestationResponse
IDL (AuthenticatorResponse 'Registration 'True)
response
AuthenticationExtensionsClientOutputs
cClientExtensionResults <- IDL AuthenticationExtensionsClientOutputs
-> Either Text AuthenticationExtensionsClientOutputs
forall a. Decode a => IDL a -> Either Text a
decode Map Text Value
IDL AuthenticationExtensionsClientOutputs
clientExtensionResults
Credential 'Registration 'True
-> Either Text (Credential 'Registration 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'Registration 'True
-> Either Text (Credential 'Registration 'True))
-> Credential 'Registration 'True
-> Either Text (Credential 'Registration 'True)
forall a b. (a -> b) -> a -> b
$ Credential :: forall (c :: CeremonyKind) (raw :: Bool).
CredentialId
-> AuthenticatorResponse c raw
-> AuthenticationExtensionsClientOutputs
-> Credential c raw
M.Credential {AuthenticatorResponse 'Registration 'True
AuthenticationExtensionsClientOutputs
CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse 'Registration 'True
cIdentifier :: CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse 'Registration 'True
cIdentifier :: CredentialId
..}