{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RecordWildCards #-}

-- | Stability: internal
-- This module handles the decoding of structures returned by the
-- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)
-- and [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)
-- methods while [Registering a New Credential](https://www.w3.org/TR/webauthn-2/#sctn-registering-a-new-credential)
-- and [Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion) respectively.
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)

-- | @'Decode' a@ indicates that the Haskell-specific type @a@ can be
-- decoded from the more generic JavaScript type @'IDL' a@ with the 'decode' function.
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

-- | Like 'Decode', but with a 'decodeCreated' function that also takes a
-- 'M.SupportedAttestationStatementFormats' in order to allow decoding to depend
-- on the supported attestation formats.
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
  -- TODO: Extensions are not implemented by this library, see the TODO in the
  -- module documentation of `Crypto.WebAuthn.Model` for more information.
  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
  -- The specification does not inspect the algorithm until
  -- assertion/attestation. We implement the check here to go to a Haskell
  -- type. Erring on the side of caution by failing to parse if an unsupported
  -- alg was encountered.
  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

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-transport)
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

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-credential-descriptor)
-- [The type] member contains the type of the public key credential the caller
-- is referring to. The value SHOULD be a member of
-- PublicKeyCredentialType but client platforms MUST ignore any
-- PublicKeyCredentialDescriptor with an unknown type.
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

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-userVerificationRequirement)
-- The value SHOULD be a member of UserVerificationRequirement but client
-- platforms MUST ignore unknown values, treating an unknown value as if the
-- member does not exist. The default is "preferred".
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

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-authenticatorSelection)
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
      -- Any unknown values must be ignored, treating them as if the member does not exist
      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

      -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-residentkey)
      -- The value SHOULD be a member of ResidentKeyRequirement but client platforms
      -- MUST ignore unknown values, treating an unknown value as if the member does not
      -- exist. If no value is given then the effective value is required if
      -- requireResidentKey is true or discouraged if it is false or absent.
      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

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-attestationconveyancepreference)
-- Its values SHOULD be members of AttestationConveyancePreference. Client
-- platforms MUST ignore unknown values, treating an unknown value as if the
-- member does not exist. Its default value is "none".
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

-- [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialparameters)
-- [The type] member specifies the type of credential to be created. The value SHOULD
-- be a member of PublicKeyCredentialType but client platforms MUST ignore
-- unknown values, ignoring any PublicKeyCredentialParameters with an unknown
-- type.
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

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-makecredentialoptions)
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
..}

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-assertion-options)
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
..}

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object)
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
..}