{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

-- | Stability: internal
-- This module implements decoding\/encoding from\/to
-- [webauthn-json](https://github.com/github/webauthn-json) JSON values to the
-- Haskell types defined in "Crypto.WebAuthn.Model.Types".
module Crypto.WebAuthn.Encoding.Internal.WebAuthnJson
  ( -- * Top-level types
    PublicKeyCredentialCreationOptions (..),
    PublicKeyCredentialRequestOptions (..),
    PublicKeyCredential (..),

    -- * Nested types
    AuthenticatorAttestationResponse (..),
    AuthenticatorAssertionResponse (..),
    PublicKeyCredentialRpEntity (..),
    PublicKeyCredentialUserEntity (..),
    PublicKeyCredentialParameters (..),
    COSEAlgorithmIdentifier,
    PublicKeyCredentialDescriptor (..),
    AuthenticatorSelectionCriteria (..),
    Base64UrlString (..),

    -- * Type classes
    Encode (..),
    Decode (..),
  )
where

import Control.Monad.Except (MonadError, liftEither)
import Control.Monad.Reader (MonadReader (ask))
import qualified Crypto.WebAuthn.Cose.SignAlg as Cose
import qualified Crypto.WebAuthn.Encoding.Binary as B
import qualified Crypto.WebAuthn.Encoding.Strings as S
import Crypto.WebAuthn.Internal.Utils (jsonEncodingOptions)
import qualified Crypto.WebAuthn.Model.Defaults as D
import qualified Crypto.WebAuthn.Model.Kinds as K
import qualified Crypto.WebAuthn.Model.Types as T
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64.URL as Base64Url
import Data.Coerce (Coercible, coerce)
import Data.Int (Int32)
import Data.Kind (Type)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Singletons (SingI)
import Data.Text (Text)
import qualified Data.Text.Encoding as Text
import Data.Word (Word32)
import GHC.Generics (Generic)

-- | A type class to indicate that some Haskell type @a@ can be encoded to a
-- corresponding JSON-serializable webauthn-json type @'JSON' a@ using 'encode'
class Encode a where
  type JSON a :: Type

  -- | Encodes a value to its webauthn-json equivalent
  encode :: a -> JSON a
  default encode :: Coercible a (JSON a) => a -> JSON a
  encode = a -> JSON a
coerce

-- | An extension of 'Encode' to decoding. This typeclass is parametrized by a
-- 'Monad' @m@ since decoding certain structures requires additional
-- information to succeed, specifically
-- 'M.SupportedAttestationStatementFormats', which can be provided with a
-- 'MonadReader' constraint
class Encode a => Decode m a where
  -- | Decodes a webauthn-json type, potentially throwing a 'Text' error
  decode :: MonadError Text m => JSON a -> m a
  default decode :: (MonadError Text m, Coercible (JSON a) a) => JSON a -> m a
  decode = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> (JSON a -> a) -> JSON a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSON a -> a
coerce

-- | Decodes an optional value with a default
decodeWithDefault :: (MonadError Text m, Decode m a) => a -> Maybe (JSON a) -> m a
decodeWithDefault :: forall (m :: * -> *) a.
(MonadError Text m, Decode m a) =>
a -> Maybe (JSON a) -> m a
decodeWithDefault a
def Maybe (JSON a)
Nothing = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def
decodeWithDefault a
_ (Just JSON a
value) = JSON a -> m a
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode JSON a
value

instance (Functor f, Encode a) => Encode (f a) where
  type JSON (f a) = f (JSON a)
  encode :: f a -> JSON (f a)
encode = (a -> JSON a) -> f a -> f (JSON a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> JSON a
forall a. Encode a => a -> JSON a
encode

instance (Traversable f, Decode m a) => Decode m (f a) where
  decode :: MonadError Text m => JSON (f a) -> m (f a)
decode = (JSON a -> m a) -> f (JSON a) -> m (f a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse JSON a -> m a
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode

-- | A base64url encoded string. Its 'Aeson.FromJSON'\/'Aeson.ToJSON' instances
-- do the conversion
newtype Base64UrlString = Base64UrlString {Base64UrlString -> ByteString
unBase64UrlString :: BS.ByteString}
  deriving (Int -> Base64UrlString -> ShowS
[Base64UrlString] -> ShowS
Base64UrlString -> String
(Int -> Base64UrlString -> ShowS)
-> (Base64UrlString -> String)
-> ([Base64UrlString] -> ShowS)
-> Show Base64UrlString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Base64UrlString] -> ShowS
$cshowList :: [Base64UrlString] -> ShowS
show :: Base64UrlString -> String
$cshow :: Base64UrlString -> String
showsPrec :: Int -> Base64UrlString -> ShowS
$cshowsPrec :: Int -> Base64UrlString -> ShowS
Show, Base64UrlString -> Base64UrlString -> Bool
(Base64UrlString -> Base64UrlString -> Bool)
-> (Base64UrlString -> Base64UrlString -> Bool)
-> Eq Base64UrlString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base64UrlString -> Base64UrlString -> Bool
$c/= :: Base64UrlString -> Base64UrlString -> Bool
== :: Base64UrlString -> Base64UrlString -> Bool
$c== :: Base64UrlString -> Base64UrlString -> Bool
Eq)

-- | Decodes a base64url encoded JSON string into the bytes it represents
instance Aeson.FromJSON Base64UrlString where
  parseJSON :: Value -> Parser Base64UrlString
parseJSON = String
-> (Text -> Parser Base64UrlString)
-> Value
-> Parser Base64UrlString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"base64url" ((Text -> Parser Base64UrlString)
 -> Value -> Parser Base64UrlString)
-> (Text -> Parser Base64UrlString)
-> Value
-> Parser Base64UrlString
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    (String -> Parser Base64UrlString)
-> (ByteString -> Parser Base64UrlString)
-> Either String ByteString
-> Parser Base64UrlString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Base64UrlString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Base64UrlString -> Parser Base64UrlString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Base64UrlString -> Parser Base64UrlString)
-> (ByteString -> Base64UrlString)
-> ByteString
-> Parser Base64UrlString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64UrlString
Base64UrlString) (ByteString -> Either String ByteString
Base64Url.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
t)

-- | Encodes bytes using base64url to a JSON string
instance Aeson.ToJSON Base64UrlString where
  toJSON :: Base64UrlString -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value)
-> (Base64UrlString -> Text) -> Base64UrlString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (Base64UrlString -> ByteString) -> Base64UrlString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64Url.encodeUnpadded (ByteString -> ByteString)
-> (Base64UrlString -> ByteString) -> Base64UrlString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64UrlString -> ByteString
unBase64UrlString

instance Encode T.Timeout where
  type JSON T.Timeout = Word32

instance Decode m T.Timeout

instance Encode T.RpId where
  type JSON T.RpId = Text

instance Decode m T.RpId

instance Encode T.RelyingPartyName where
  type JSON T.RelyingPartyName = Text

instance Decode m T.RelyingPartyName

instance Encode T.UserHandle where
  type JSON T.UserHandle = Base64UrlString

instance Decode m T.UserHandle

instance Encode T.UserAccountDisplayName where
  type JSON T.UserAccountDisplayName = Text

instance Decode m T.UserAccountDisplayName

instance Encode T.UserAccountName where
  type JSON T.UserAccountName = Text

instance Decode m T.UserAccountName

instance Encode T.Challenge where
  type JSON T.Challenge = Base64UrlString

instance Decode m T.Challenge

instance Encode T.CredentialId where
  type JSON T.CredentialId = Base64UrlString

instance Decode m T.CredentialId

instance Encode T.AssertionSignature where
  type JSON T.AssertionSignature = Base64UrlString

instance Decode m T.AssertionSignature

{-
Note: The spec often mentions that _client platforms_ must ignore unknown
values, but since we implement a RP, we don't need to concern ourselves with
that.

The only place where we do need to concern ourselves with it is the
[transports](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-transports-slot)
field returned from the client, which in Level 2 of the spec mentions:

> The values SHOULD be members of
> `[AuthenticatorTransport](https://www.w3.org/TR/webauthn-2/#enumdef-authenticatortransport)`
> but [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) MUST
> ignore unknown values.

However that doesn't say what should happen in case of unknown values. This has
been fixed in a more recent version of the spec, see
https://github.com/w3c/webauthn/issues/1587. It will say this in the future:

> The values SHOULD be members of AuthenticatorTransport but Relying Parties
> SHOULD accept and store unknown values.
-}

instance Encode T.CredentialType where
  type JSON T.CredentialType = Text
  encode :: CredentialType -> JSON CredentialType
encode = CredentialType -> Text
CredentialType -> JSON CredentialType
S.encodeCredentialType

instance Decode m T.CredentialType where
  decode :: MonadError Text m => JSON CredentialType -> m CredentialType
decode = Either Text CredentialType -> m CredentialType
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Text CredentialType -> m CredentialType)
-> (Text -> Either Text CredentialType) -> Text -> m CredentialType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text CredentialType
S.decodeCredentialType

instance Encode T.UserVerificationRequirement where
  type JSON T.UserVerificationRequirement = Text
  encode :: UserVerificationRequirement -> JSON UserVerificationRequirement
encode = UserVerificationRequirement -> Text
UserVerificationRequirement -> JSON UserVerificationRequirement
S.encodeUserVerificationRequirement

instance Decode m T.UserVerificationRequirement where
  decode :: MonadError Text m =>
JSON UserVerificationRequirement -> m UserVerificationRequirement
decode = Either Text UserVerificationRequirement
-> m UserVerificationRequirement
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Text UserVerificationRequirement
 -> m UserVerificationRequirement)
-> (Text -> Either Text UserVerificationRequirement)
-> Text
-> m UserVerificationRequirement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text UserVerificationRequirement
S.decodeUserVerificationRequirement

instance Encode T.AuthenticatorAttachment where
  type JSON T.AuthenticatorAttachment = Text
  encode :: AuthenticatorAttachment -> JSON AuthenticatorAttachment
encode = AuthenticatorAttachment -> Text
AuthenticatorAttachment -> JSON AuthenticatorAttachment
S.encodeAuthenticatorAttachment

instance Decode m T.AuthenticatorAttachment where
  decode :: MonadError Text m =>
JSON AuthenticatorAttachment -> m AuthenticatorAttachment
decode = Either Text AuthenticatorAttachment -> m AuthenticatorAttachment
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Text AuthenticatorAttachment -> m AuthenticatorAttachment)
-> (Text -> Either Text AuthenticatorAttachment)
-> Text
-> m AuthenticatorAttachment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text AuthenticatorAttachment
S.decodeAuthenticatorAttachment

instance Encode T.ResidentKeyRequirement where
  type JSON T.ResidentKeyRequirement = Text
  encode :: ResidentKeyRequirement -> JSON ResidentKeyRequirement
encode = ResidentKeyRequirement -> Text
ResidentKeyRequirement -> JSON ResidentKeyRequirement
S.encodeResidentKeyRequirement

instance Decode m T.ResidentKeyRequirement where
  decode :: MonadError Text m =>
JSON ResidentKeyRequirement -> m ResidentKeyRequirement
decode = Either Text ResidentKeyRequirement -> m ResidentKeyRequirement
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Text ResidentKeyRequirement -> m ResidentKeyRequirement)
-> (Text -> Either Text ResidentKeyRequirement)
-> Text
-> m ResidentKeyRequirement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text ResidentKeyRequirement
S.decodeResidentKeyRequirement

instance Encode T.AttestationConveyancePreference where
  type JSON T.AttestationConveyancePreference = Text
  encode :: AttestationConveyancePreference
-> JSON AttestationConveyancePreference
encode = AttestationConveyancePreference -> Text
AttestationConveyancePreference
-> JSON AttestationConveyancePreference
S.encodeAttestationConveyancePreference

instance Decode m T.AttestationConveyancePreference where
  decode :: MonadError Text m =>
JSON AttestationConveyancePreference
-> m AttestationConveyancePreference
decode = Either Text AttestationConveyancePreference
-> m AttestationConveyancePreference
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Text AttestationConveyancePreference
 -> m AttestationConveyancePreference)
-> (Text -> Either Text AttestationConveyancePreference)
-> Text
-> m AttestationConveyancePreference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text AttestationConveyancePreference
S.decodeAttestationConveyancePreference

instance Encode T.AuthenticatorTransport where
  type JSON T.AuthenticatorTransport = Text
  encode :: AuthenticatorTransport -> JSON AuthenticatorTransport
encode = AuthenticatorTransport -> Text
AuthenticatorTransport -> JSON AuthenticatorTransport
S.encodeAuthenticatorTransport

instance Decode m T.AuthenticatorTransport where
  decode :: MonadError Text m =>
JSON AuthenticatorTransport -> m AuthenticatorTransport
decode = AuthenticatorTransport -> m AuthenticatorTransport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticatorTransport -> m AuthenticatorTransport)
-> (Text -> AuthenticatorTransport)
-> Text
-> m AuthenticatorTransport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthenticatorTransport
S.decodeAuthenticatorTransport

instance Encode Cose.CoseSignAlg where
  type JSON Cose.CoseSignAlg = Int32
  encode :: CoseSignAlg -> JSON CoseSignAlg
encode = CoseSignAlg -> JSON CoseSignAlg
forall p. Num p => CoseSignAlg -> p
Cose.fromCoseSignAlg

instance Decode m Cose.CoseSignAlg where
  decode :: MonadError Text m => JSON CoseSignAlg -> m CoseSignAlg
decode = Either Text CoseSignAlg -> m CoseSignAlg
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Text CoseSignAlg -> m CoseSignAlg)
-> (Int32 -> Either Text CoseSignAlg) -> Int32 -> m CoseSignAlg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Either Text CoseSignAlg
forall a. (Eq a, Num a, Show a) => a -> Either Text CoseSignAlg
Cose.toCoseSignAlg

instance Encode T.AuthenticationExtensionsClientInputs where
  type JSON T.AuthenticationExtensionsClientInputs = Map Text Aeson.Value

  -- TODO: Extensions are not implemented by this library, see the TODO in the
  -- module documentation of `Crypto.WebAuthn.Model` for more information.
  encode :: AuthenticationExtensionsClientInputs
-> JSON AuthenticationExtensionsClientInputs
encode T.AuthenticationExtensionsClientInputs {} = JSON AuthenticationExtensionsClientInputs
forall k a. Map k a
Map.empty

instance Decode m T.AuthenticationExtensionsClientInputs where
  -- TODO: Extensions are not implemented by this library, see the TODO in the
  -- module documentation of `Crypto.WebAuthn.Model` for more information.
  decode :: MonadError Text m =>
JSON AuthenticationExtensionsClientInputs
-> m AuthenticationExtensionsClientInputs
decode JSON AuthenticationExtensionsClientInputs
_ = AuthenticationExtensionsClientInputs
-> m AuthenticationExtensionsClientInputs
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthenticationExtensionsClientInputs :: AuthenticationExtensionsClientInputs
T.AuthenticationExtensionsClientInputs {}

instance Encode T.AuthenticationExtensionsClientOutputs where
  type JSON T.AuthenticationExtensionsClientOutputs = Map Text Aeson.Value

  -- TODO: Extensions are not implemented by this library, see the TODO in the
  -- module documentation of `Crypto.WebAuthn.Model` for more information.
  encode :: AuthenticationExtensionsClientOutputs
-> JSON AuthenticationExtensionsClientOutputs
encode T.AuthenticationExtensionsClientOutputs {} = JSON AuthenticationExtensionsClientOutputs
forall k a. Map k a
Map.empty

instance Decode m T.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 :: MonadError Text m =>
JSON AuthenticationExtensionsClientOutputs
-> m AuthenticationExtensionsClientOutputs
decode JSON AuthenticationExtensionsClientOutputs
_ = AuthenticationExtensionsClientOutputs
-> m AuthenticationExtensionsClientOutputs
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthenticationExtensionsClientOutputs :: AuthenticationExtensionsClientOutputs
T.AuthenticationExtensionsClientOutputs {}

instance SingI c => Encode (T.CollectedClientData (c :: K.CeremonyKind) 'True) where
  type JSON (T.CollectedClientData c 'True) = Base64UrlString
  encode :: CollectedClientData c 'True -> JSON (CollectedClientData c 'True)
encode = ByteString -> Base64UrlString
Base64UrlString (ByteString -> Base64UrlString)
-> (CollectedClientData c 'True -> ByteString)
-> CollectedClientData c 'True
-> Base64UrlString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawField 'True -> ByteString
T.unRaw (RawField 'True -> ByteString)
-> (CollectedClientData c 'True -> RawField 'True)
-> CollectedClientData c 'True
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollectedClientData c 'True -> RawField 'True
forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> RawField raw
T.ccdRawData

instance SingI c => Decode m (T.CollectedClientData (c :: K.CeremonyKind) 'True) where
  decode :: MonadError Text m =>
JSON (CollectedClientData c 'True)
-> m (CollectedClientData c 'True)
decode = Either Text (CollectedClientData c 'True)
-> m (CollectedClientData c 'True)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Text (CollectedClientData c 'True)
 -> m (CollectedClientData c 'True))
-> (Base64UrlString -> Either Text (CollectedClientData c 'True))
-> Base64UrlString
-> m (CollectedClientData c 'True)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text (CollectedClientData c 'True)
forall (c :: CeremonyKind).
SingI c =>
ByteString -> Either Text (CollectedClientData c 'True)
B.decodeCollectedClientData (ByteString -> Either Text (CollectedClientData c 'True))
-> (Base64UrlString -> ByteString)
-> Base64UrlString
-> Either Text (CollectedClientData c 'True)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64UrlString -> ByteString
unBase64UrlString

instance Encode (T.AttestationObject 'True) where
  type JSON (T.AttestationObject 'True) = Base64UrlString
  encode :: AttestationObject 'True -> JSON (AttestationObject 'True)
encode = ByteString -> Base64UrlString
Base64UrlString (ByteString -> Base64UrlString)
-> (AttestationObject 'True -> ByteString)
-> AttestationObject 'True
-> Base64UrlString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttestationObject 'True -> ByteString
B.encodeAttestationObject

instance
  MonadReader T.SupportedAttestationStatementFormats m =>
  Decode m (T.AttestationObject 'True)
  where
  decode :: MonadError Text m =>
JSON (AttestationObject 'True) -> m (AttestationObject 'True)
decode (Base64UrlString ByteString
bytes) = do
    SupportedAttestationStatementFormats
supportedFormats <- m SupportedAttestationStatementFormats
forall r (m :: * -> *). MonadReader r m => m r
ask
    Either Text (AttestationObject 'True)
-> m (AttestationObject 'True)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Text (AttestationObject 'True)
 -> m (AttestationObject 'True))
-> Either Text (AttestationObject 'True)
-> m (AttestationObject 'True)
forall a b. (a -> b) -> a -> b
$ SupportedAttestationStatementFormats
-> ByteString -> Either Text (AttestationObject 'True)
B.decodeAttestationObject SupportedAttestationStatementFormats
supportedFormats ByteString
bytes

instance Encode (T.AuthenticatorData 'K.Authentication 'True) where
  type JSON (T.AuthenticatorData 'K.Authentication 'True) = Base64UrlString
  encode :: AuthenticatorData 'Authentication 'True
-> JSON (AuthenticatorData 'Authentication 'True)
encode = ByteString -> Base64UrlString
Base64UrlString (ByteString -> Base64UrlString)
-> (AuthenticatorData 'Authentication 'True -> ByteString)
-> AuthenticatorData 'Authentication 'True
-> Base64UrlString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawField 'True -> ByteString
T.unRaw (RawField 'True -> ByteString)
-> (AuthenticatorData 'Authentication 'True -> RawField 'True)
-> AuthenticatorData 'Authentication 'True
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthenticatorData 'Authentication 'True -> RawField 'True
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
T.adRawData

instance Decode m (T.AuthenticatorData 'K.Authentication 'True) where
  decode :: MonadError Text m =>
JSON (AuthenticatorData 'Authentication 'True)
-> m (AuthenticatorData 'Authentication 'True)
decode = Either Text (AuthenticatorData 'Authentication 'True)
-> m (AuthenticatorData 'Authentication 'True)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Text (AuthenticatorData 'Authentication 'True)
 -> m (AuthenticatorData 'Authentication 'True))
-> (Base64UrlString
    -> Either Text (AuthenticatorData 'Authentication 'True))
-> Base64UrlString
-> m (AuthenticatorData 'Authentication 'True)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text (AuthenticatorData 'Authentication 'True)
forall (c :: CeremonyKind).
SingI c =>
ByteString -> Either Text (AuthenticatorData c 'True)
B.decodeAuthenticatorData (ByteString
 -> Either Text (AuthenticatorData 'Authentication 'True))
-> (Base64UrlString -> ByteString)
-> Base64UrlString
-> Either Text (AuthenticatorData 'Authentication 'True)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64UrlString -> ByteString
unBase64UrlString

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-makecredentialoptions)
data PublicKeyCredentialCreationOptions = PublicKeyCredentialCreationOptions
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-rp)
    PublicKeyCredentialCreationOptions -> PublicKeyCredentialRpEntity
rp :: PublicKeyCredentialRpEntity,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-user)
    PublicKeyCredentialCreationOptions -> PublicKeyCredentialUserEntity
user :: PublicKeyCredentialUserEntity,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-challenge)
    PublicKeyCredentialCreationOptions -> Base64UrlString
challenge :: Base64UrlString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-pubkeycredparams)
    PublicKeyCredentialCreationOptions
-> [PublicKeyCredentialParameters]
pubKeyCredParams :: [PublicKeyCredentialParameters],
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-timeout)
    PublicKeyCredentialCreationOptions -> Maybe Word32
timeout :: Maybe Word32,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-excludecredentials)
    PublicKeyCredentialCreationOptions
-> Maybe [PublicKeyCredentialDescriptor]
excludeCredentials :: Maybe [PublicKeyCredentialDescriptor],
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-authenticatorselection)
    PublicKeyCredentialCreationOptions
-> Maybe AuthenticatorSelectionCriteria
authenticatorSelection :: Maybe AuthenticatorSelectionCriteria,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-attestation)
    PublicKeyCredentialCreationOptions -> Maybe Text
attestation :: Maybe Text,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-extensions)
    PublicKeyCredentialCreationOptions -> Maybe (Map Text Value)
extensions :: Maybe (Map Text Aeson.Value)
  }
  deriving (PublicKeyCredentialCreationOptions
-> PublicKeyCredentialCreationOptions -> Bool
(PublicKeyCredentialCreationOptions
 -> PublicKeyCredentialCreationOptions -> Bool)
-> (PublicKeyCredentialCreationOptions
    -> PublicKeyCredentialCreationOptions -> Bool)
-> Eq PublicKeyCredentialCreationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKeyCredentialCreationOptions
-> PublicKeyCredentialCreationOptions -> Bool
$c/= :: PublicKeyCredentialCreationOptions
-> PublicKeyCredentialCreationOptions -> Bool
== :: PublicKeyCredentialCreationOptions
-> PublicKeyCredentialCreationOptions -> Bool
$c== :: PublicKeyCredentialCreationOptions
-> PublicKeyCredentialCreationOptions -> Bool
Eq, Int -> PublicKeyCredentialCreationOptions -> ShowS
[PublicKeyCredentialCreationOptions] -> ShowS
PublicKeyCredentialCreationOptions -> String
(Int -> PublicKeyCredentialCreationOptions -> ShowS)
-> (PublicKeyCredentialCreationOptions -> String)
-> ([PublicKeyCredentialCreationOptions] -> ShowS)
-> Show PublicKeyCredentialCreationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKeyCredentialCreationOptions] -> ShowS
$cshowList :: [PublicKeyCredentialCreationOptions] -> ShowS
show :: PublicKeyCredentialCreationOptions -> String
$cshow :: PublicKeyCredentialCreationOptions -> String
showsPrec :: Int -> PublicKeyCredentialCreationOptions -> ShowS
$cshowsPrec :: Int -> PublicKeyCredentialCreationOptions -> ShowS
Show, (forall x.
 PublicKeyCredentialCreationOptions
 -> Rep PublicKeyCredentialCreationOptions x)
-> (forall x.
    Rep PublicKeyCredentialCreationOptions x
    -> PublicKeyCredentialCreationOptions)
-> Generic PublicKeyCredentialCreationOptions
forall x.
Rep PublicKeyCredentialCreationOptions x
-> PublicKeyCredentialCreationOptions
forall x.
PublicKeyCredentialCreationOptions
-> Rep PublicKeyCredentialCreationOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PublicKeyCredentialCreationOptions x
-> PublicKeyCredentialCreationOptions
$cfrom :: forall x.
PublicKeyCredentialCreationOptions
-> Rep PublicKeyCredentialCreationOptions x
Generic)

instance Aeson.FromJSON PublicKeyCredentialCreationOptions where
  parseJSON :: Value -> Parser PublicKeyCredentialCreationOptions
parseJSON = Options -> Value -> Parser PublicKeyCredentialCreationOptions
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
jsonEncodingOptions

instance Aeson.ToJSON PublicKeyCredentialCreationOptions where
  toJSON :: PublicKeyCredentialCreationOptions -> Value
toJSON = Options -> PublicKeyCredentialCreationOptions -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
jsonEncodingOptions

instance Encode (T.CredentialOptions 'K.Registration) where
  type JSON (T.CredentialOptions 'K.Registration) = PublicKeyCredentialCreationOptions
  encode :: CredentialOptions 'Registration
-> JSON (CredentialOptions 'Registration)
encode T.CredentialOptionsRegistration {[CredentialDescriptor]
[CredentialParameters]
Maybe AuthenticatorSelectionCriteria
Maybe AuthenticationExtensionsClientInputs
Maybe Timeout
CredentialUserEntity
CredentialRpEntity
Challenge
AttestationConveyancePreference
corExtensions :: CredentialOptions 'Registration
-> Maybe AuthenticationExtensionsClientInputs
corAttestation :: CredentialOptions 'Registration -> AttestationConveyancePreference
corAuthenticatorSelection :: CredentialOptions 'Registration
-> Maybe AuthenticatorSelectionCriteria
corExcludeCredentials :: CredentialOptions 'Registration -> [CredentialDescriptor]
corTimeout :: CredentialOptions 'Registration -> Maybe Timeout
corPubKeyCredParams :: CredentialOptions 'Registration -> [CredentialParameters]
corChallenge :: CredentialOptions 'Registration -> Challenge
corUser :: CredentialOptions 'Registration -> CredentialUserEntity
corRp :: CredentialOptions 'Registration -> CredentialRpEntity
corExtensions :: Maybe AuthenticationExtensionsClientInputs
corAttestation :: AttestationConveyancePreference
corAuthenticatorSelection :: Maybe AuthenticatorSelectionCriteria
corExcludeCredentials :: [CredentialDescriptor]
corTimeout :: Maybe Timeout
corPubKeyCredParams :: [CredentialParameters]
corChallenge :: Challenge
corUser :: CredentialUserEntity
corRp :: CredentialRpEntity
..} =
    PublicKeyCredentialCreationOptions :: PublicKeyCredentialRpEntity
-> PublicKeyCredentialUserEntity
-> Base64UrlString
-> [PublicKeyCredentialParameters]
-> Maybe Word32
-> Maybe [PublicKeyCredentialDescriptor]
-> Maybe AuthenticatorSelectionCriteria
-> Maybe Text
-> Maybe (Map Text Value)
-> PublicKeyCredentialCreationOptions
PublicKeyCredentialCreationOptions
      { $sel:rp:PublicKeyCredentialCreationOptions :: PublicKeyCredentialRpEntity
rp = CredentialRpEntity -> JSON CredentialRpEntity
forall a. Encode a => a -> JSON a
encode CredentialRpEntity
corRp,
        $sel:user:PublicKeyCredentialCreationOptions :: PublicKeyCredentialUserEntity
user = CredentialUserEntity -> JSON CredentialUserEntity
forall a. Encode a => a -> JSON a
encode CredentialUserEntity
corUser,
        $sel:challenge:PublicKeyCredentialCreationOptions :: Base64UrlString
challenge = Challenge -> JSON Challenge
forall a. Encode a => a -> JSON a
encode Challenge
corChallenge,
        $sel:pubKeyCredParams:PublicKeyCredentialCreationOptions :: [PublicKeyCredentialParameters]
pubKeyCredParams = [CredentialParameters] -> JSON [CredentialParameters]
forall a. Encode a => a -> JSON a
encode [CredentialParameters]
corPubKeyCredParams,
        $sel:timeout:PublicKeyCredentialCreationOptions :: Maybe Word32
timeout = Maybe Timeout -> JSON (Maybe Timeout)
forall a. Encode a => a -> JSON a
encode Maybe Timeout
corTimeout,
        $sel:excludeCredentials:PublicKeyCredentialCreationOptions :: Maybe [PublicKeyCredentialDescriptor]
excludeCredentials = [PublicKeyCredentialDescriptor]
-> Maybe [PublicKeyCredentialDescriptor]
forall a. a -> Maybe a
Just ([PublicKeyCredentialDescriptor]
 -> Maybe [PublicKeyCredentialDescriptor])
-> [PublicKeyCredentialDescriptor]
-> Maybe [PublicKeyCredentialDescriptor]
forall a b. (a -> b) -> a -> b
$ [CredentialDescriptor] -> JSON [CredentialDescriptor]
forall a. Encode a => a -> JSON a
encode [CredentialDescriptor]
corExcludeCredentials,
        $sel:authenticatorSelection:PublicKeyCredentialCreationOptions :: Maybe AuthenticatorSelectionCriteria
authenticatorSelection = Maybe AuthenticatorSelectionCriteria
-> JSON (Maybe AuthenticatorSelectionCriteria)
forall a. Encode a => a -> JSON a
encode Maybe AuthenticatorSelectionCriteria
corAuthenticatorSelection,
        $sel:attestation:PublicKeyCredentialCreationOptions :: Maybe Text
attestation = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ AttestationConveyancePreference
-> JSON AttestationConveyancePreference
forall a. Encode a => a -> JSON a
encode AttestationConveyancePreference
corAttestation,
        $sel:extensions:PublicKeyCredentialCreationOptions :: Maybe (Map Text Value)
extensions = Maybe AuthenticationExtensionsClientInputs
-> JSON (Maybe AuthenticationExtensionsClientInputs)
forall a. Encode a => a -> JSON a
encode Maybe AuthenticationExtensionsClientInputs
corExtensions
      }

instance Decode m (T.CredentialOptions 'K.Registration) where
  decode :: MonadError Text m =>
JSON (CredentialOptions 'Registration)
-> m (CredentialOptions 'Registration)
decode PublicKeyCredentialCreationOptions {[PublicKeyCredentialParameters]
Maybe [PublicKeyCredentialDescriptor]
Maybe Word32
Maybe Text
Maybe (Map Text Value)
Maybe AuthenticatorSelectionCriteria
PublicKeyCredentialUserEntity
PublicKeyCredentialRpEntity
Base64UrlString
extensions :: Maybe (Map Text Value)
attestation :: Maybe Text
authenticatorSelection :: Maybe AuthenticatorSelectionCriteria
excludeCredentials :: Maybe [PublicKeyCredentialDescriptor]
timeout :: Maybe Word32
pubKeyCredParams :: [PublicKeyCredentialParameters]
challenge :: Base64UrlString
user :: PublicKeyCredentialUserEntity
rp :: PublicKeyCredentialRpEntity
$sel:extensions:PublicKeyCredentialCreationOptions :: PublicKeyCredentialCreationOptions -> Maybe (Map Text Value)
$sel:attestation:PublicKeyCredentialCreationOptions :: PublicKeyCredentialCreationOptions -> Maybe Text
$sel:authenticatorSelection:PublicKeyCredentialCreationOptions :: PublicKeyCredentialCreationOptions
-> Maybe AuthenticatorSelectionCriteria
$sel:excludeCredentials:PublicKeyCredentialCreationOptions :: PublicKeyCredentialCreationOptions
-> Maybe [PublicKeyCredentialDescriptor]
$sel:timeout:PublicKeyCredentialCreationOptions :: PublicKeyCredentialCreationOptions -> Maybe Word32
$sel:pubKeyCredParams:PublicKeyCredentialCreationOptions :: PublicKeyCredentialCreationOptions
-> [PublicKeyCredentialParameters]
$sel:challenge:PublicKeyCredentialCreationOptions :: PublicKeyCredentialCreationOptions -> Base64UrlString
$sel:user:PublicKeyCredentialCreationOptions :: PublicKeyCredentialCreationOptions -> PublicKeyCredentialUserEntity
$sel:rp:PublicKeyCredentialCreationOptions :: PublicKeyCredentialCreationOptions -> PublicKeyCredentialRpEntity
..} = do
    CredentialRpEntity
corRp <- JSON CredentialRpEntity -> m CredentialRpEntity
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode PublicKeyCredentialRpEntity
JSON CredentialRpEntity
rp
    CredentialUserEntity
corUser <- JSON CredentialUserEntity -> m CredentialUserEntity
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode PublicKeyCredentialUserEntity
JSON CredentialUserEntity
user
    Challenge
corChallenge <- JSON Challenge -> m Challenge
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Base64UrlString
JSON Challenge
challenge
    [CredentialParameters]
corPubKeyCredParams <- JSON [CredentialParameters] -> m [CredentialParameters]
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode [PublicKeyCredentialParameters]
JSON [CredentialParameters]
pubKeyCredParams
    Maybe Timeout
corTimeout <- JSON (Maybe Timeout) -> m (Maybe Timeout)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Maybe Word32
JSON (Maybe Timeout)
timeout
    [CredentialDescriptor]
corExcludeCredentials <- [CredentialDescriptor]
-> Maybe (JSON [CredentialDescriptor]) -> m [CredentialDescriptor]
forall (m :: * -> *) a.
(MonadError Text m, Decode m a) =>
a -> Maybe (JSON a) -> m a
decodeWithDefault [CredentialDescriptor]
D.corExcludeCredentialsDefault Maybe [PublicKeyCredentialDescriptor]
Maybe (JSON [CredentialDescriptor])
excludeCredentials
    Maybe AuthenticatorSelectionCriteria
corAuthenticatorSelection <- JSON (Maybe AuthenticatorSelectionCriteria)
-> m (Maybe AuthenticatorSelectionCriteria)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Maybe AuthenticatorSelectionCriteria
JSON (Maybe AuthenticatorSelectionCriteria)
authenticatorSelection
    AttestationConveyancePreference
corAttestation <- AttestationConveyancePreference
-> Maybe (JSON AttestationConveyancePreference)
-> m AttestationConveyancePreference
forall (m :: * -> *) a.
(MonadError Text m, Decode m a) =>
a -> Maybe (JSON a) -> m a
decodeWithDefault AttestationConveyancePreference
D.corAttestationDefault Maybe Text
Maybe (JSON AttestationConveyancePreference)
attestation
    Maybe AuthenticationExtensionsClientInputs
corExtensions <- JSON (Maybe AuthenticationExtensionsClientInputs)
-> m (Maybe AuthenticationExtensionsClientInputs)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Maybe (Map Text Value)
JSON (Maybe AuthenticationExtensionsClientInputs)
extensions
    CredentialOptions 'Registration
-> m (CredentialOptions 'Registration)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialOptions 'Registration
 -> m (CredentialOptions 'Registration))
-> CredentialOptions 'Registration
-> m (CredentialOptions 'Registration)
forall a b. (a -> b) -> a -> b
$ CredentialOptionsRegistration :: CredentialRpEntity
-> CredentialUserEntity
-> Challenge
-> [CredentialParameters]
-> Maybe Timeout
-> [CredentialDescriptor]
-> Maybe AuthenticatorSelectionCriteria
-> AttestationConveyancePreference
-> Maybe AuthenticationExtensionsClientInputs
-> CredentialOptions 'Registration
T.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)
data PublicKeyCredentialRequestOptions = PublicKeyCredentialRequestOptions
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-challenge)
    PublicKeyCredentialRequestOptions -> Base64UrlString
challenge :: Base64UrlString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-timeout)
    PublicKeyCredentialRequestOptions -> Maybe Word32
timeout :: Maybe Word32,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-rpid)
    PublicKeyCredentialRequestOptions -> Maybe Text
rpId :: Maybe Text,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-allowcredentials)
    PublicKeyCredentialRequestOptions
-> Maybe [PublicKeyCredentialDescriptor]
allowCredentials :: Maybe [PublicKeyCredentialDescriptor],
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-userverification)
    PublicKeyCredentialRequestOptions -> Maybe Text
userVerification :: Maybe Text,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-extensions)
    PublicKeyCredentialRequestOptions -> Maybe (Map Text Value)
extensions :: Maybe (Map Text Aeson.Value)
  }
  deriving (PublicKeyCredentialRequestOptions
-> PublicKeyCredentialRequestOptions -> Bool
(PublicKeyCredentialRequestOptions
 -> PublicKeyCredentialRequestOptions -> Bool)
-> (PublicKeyCredentialRequestOptions
    -> PublicKeyCredentialRequestOptions -> Bool)
-> Eq PublicKeyCredentialRequestOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKeyCredentialRequestOptions
-> PublicKeyCredentialRequestOptions -> Bool
$c/= :: PublicKeyCredentialRequestOptions
-> PublicKeyCredentialRequestOptions -> Bool
== :: PublicKeyCredentialRequestOptions
-> PublicKeyCredentialRequestOptions -> Bool
$c== :: PublicKeyCredentialRequestOptions
-> PublicKeyCredentialRequestOptions -> Bool
Eq, Int -> PublicKeyCredentialRequestOptions -> ShowS
[PublicKeyCredentialRequestOptions] -> ShowS
PublicKeyCredentialRequestOptions -> String
(Int -> PublicKeyCredentialRequestOptions -> ShowS)
-> (PublicKeyCredentialRequestOptions -> String)
-> ([PublicKeyCredentialRequestOptions] -> ShowS)
-> Show PublicKeyCredentialRequestOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKeyCredentialRequestOptions] -> ShowS
$cshowList :: [PublicKeyCredentialRequestOptions] -> ShowS
show :: PublicKeyCredentialRequestOptions -> String
$cshow :: PublicKeyCredentialRequestOptions -> String
showsPrec :: Int -> PublicKeyCredentialRequestOptions -> ShowS
$cshowsPrec :: Int -> PublicKeyCredentialRequestOptions -> ShowS
Show, (forall x.
 PublicKeyCredentialRequestOptions
 -> Rep PublicKeyCredentialRequestOptions x)
-> (forall x.
    Rep PublicKeyCredentialRequestOptions x
    -> PublicKeyCredentialRequestOptions)
-> Generic PublicKeyCredentialRequestOptions
forall x.
Rep PublicKeyCredentialRequestOptions x
-> PublicKeyCredentialRequestOptions
forall x.
PublicKeyCredentialRequestOptions
-> Rep PublicKeyCredentialRequestOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PublicKeyCredentialRequestOptions x
-> PublicKeyCredentialRequestOptions
$cfrom :: forall x.
PublicKeyCredentialRequestOptions
-> Rep PublicKeyCredentialRequestOptions x
Generic)

instance Aeson.FromJSON PublicKeyCredentialRequestOptions where
  parseJSON :: Value -> Parser PublicKeyCredentialRequestOptions
parseJSON = Options -> Value -> Parser PublicKeyCredentialRequestOptions
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
jsonEncodingOptions

instance Aeson.ToJSON PublicKeyCredentialRequestOptions where
  toJSON :: PublicKeyCredentialRequestOptions -> Value
toJSON = Options -> PublicKeyCredentialRequestOptions -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
jsonEncodingOptions

instance Encode (T.CredentialOptions 'K.Authentication) where
  type JSON (T.CredentialOptions 'K.Authentication) = PublicKeyCredentialRequestOptions
  encode :: CredentialOptions 'Authentication
-> JSON (CredentialOptions 'Authentication)
encode T.CredentialOptionsAuthentication {[CredentialDescriptor]
Maybe AuthenticationExtensionsClientInputs
Maybe Timeout
Maybe RpId
Challenge
UserVerificationRequirement
coaExtensions :: CredentialOptions 'Authentication
-> Maybe AuthenticationExtensionsClientInputs
coaUserVerification :: CredentialOptions 'Authentication -> UserVerificationRequirement
coaAllowCredentials :: CredentialOptions 'Authentication -> [CredentialDescriptor]
coaRpId :: CredentialOptions 'Authentication -> Maybe RpId
coaTimeout :: CredentialOptions 'Authentication -> Maybe Timeout
coaChallenge :: CredentialOptions 'Authentication -> Challenge
coaExtensions :: Maybe AuthenticationExtensionsClientInputs
coaUserVerification :: UserVerificationRequirement
coaAllowCredentials :: [CredentialDescriptor]
coaRpId :: Maybe RpId
coaTimeout :: Maybe Timeout
coaChallenge :: Challenge
..} =
    PublicKeyCredentialRequestOptions :: Base64UrlString
-> Maybe Word32
-> Maybe Text
-> Maybe [PublicKeyCredentialDescriptor]
-> Maybe Text
-> Maybe (Map Text Value)
-> PublicKeyCredentialRequestOptions
PublicKeyCredentialRequestOptions
      { $sel:challenge:PublicKeyCredentialRequestOptions :: Base64UrlString
challenge = Challenge -> JSON Challenge
forall a. Encode a => a -> JSON a
encode Challenge
coaChallenge,
        $sel:timeout:PublicKeyCredentialRequestOptions :: Maybe Word32
timeout = Maybe Timeout -> JSON (Maybe Timeout)
forall a. Encode a => a -> JSON a
encode Maybe Timeout
coaTimeout,
        $sel:rpId:PublicKeyCredentialRequestOptions :: Maybe Text
rpId = Maybe RpId -> JSON (Maybe RpId)
forall a. Encode a => a -> JSON a
encode Maybe RpId
coaRpId,
        $sel:allowCredentials:PublicKeyCredentialRequestOptions :: Maybe [PublicKeyCredentialDescriptor]
allowCredentials = [PublicKeyCredentialDescriptor]
-> Maybe [PublicKeyCredentialDescriptor]
forall a. a -> Maybe a
Just ([PublicKeyCredentialDescriptor]
 -> Maybe [PublicKeyCredentialDescriptor])
-> [PublicKeyCredentialDescriptor]
-> Maybe [PublicKeyCredentialDescriptor]
forall a b. (a -> b) -> a -> b
$ [CredentialDescriptor] -> JSON [CredentialDescriptor]
forall a. Encode a => a -> JSON a
encode [CredentialDescriptor]
coaAllowCredentials,
        $sel:userVerification:PublicKeyCredentialRequestOptions :: Maybe Text
userVerification = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ UserVerificationRequirement -> JSON UserVerificationRequirement
forall a. Encode a => a -> JSON a
encode UserVerificationRequirement
coaUserVerification,
        $sel:extensions:PublicKeyCredentialRequestOptions :: Maybe (Map Text Value)
extensions = Maybe AuthenticationExtensionsClientInputs
-> JSON (Maybe AuthenticationExtensionsClientInputs)
forall a. Encode a => a -> JSON a
encode Maybe AuthenticationExtensionsClientInputs
coaExtensions
      }

instance Decode m (T.CredentialOptions 'K.Authentication) where
  decode :: MonadError Text m =>
JSON (CredentialOptions 'Authentication)
-> m (CredentialOptions 'Authentication)
decode PublicKeyCredentialRequestOptions {Maybe [PublicKeyCredentialDescriptor]
Maybe Word32
Maybe Text
Maybe (Map Text Value)
Base64UrlString
extensions :: Maybe (Map Text Value)
userVerification :: Maybe Text
allowCredentials :: Maybe [PublicKeyCredentialDescriptor]
rpId :: Maybe Text
timeout :: Maybe Word32
challenge :: Base64UrlString
$sel:extensions:PublicKeyCredentialRequestOptions :: PublicKeyCredentialRequestOptions -> Maybe (Map Text Value)
$sel:userVerification:PublicKeyCredentialRequestOptions :: PublicKeyCredentialRequestOptions -> Maybe Text
$sel:allowCredentials:PublicKeyCredentialRequestOptions :: PublicKeyCredentialRequestOptions
-> Maybe [PublicKeyCredentialDescriptor]
$sel:rpId:PublicKeyCredentialRequestOptions :: PublicKeyCredentialRequestOptions -> Maybe Text
$sel:timeout:PublicKeyCredentialRequestOptions :: PublicKeyCredentialRequestOptions -> Maybe Word32
$sel:challenge:PublicKeyCredentialRequestOptions :: PublicKeyCredentialRequestOptions -> Base64UrlString
..} = do
    Challenge
coaChallenge <- JSON Challenge -> m Challenge
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Base64UrlString
JSON Challenge
challenge
    Maybe Timeout
coaTimeout <- JSON (Maybe Timeout) -> m (Maybe Timeout)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Maybe Word32
JSON (Maybe Timeout)
timeout
    Maybe RpId
coaRpId <- JSON (Maybe RpId) -> m (Maybe RpId)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Maybe Text
JSON (Maybe RpId)
rpId
    [CredentialDescriptor]
coaAllowCredentials <- [CredentialDescriptor]
-> Maybe (JSON [CredentialDescriptor]) -> m [CredentialDescriptor]
forall (m :: * -> *) a.
(MonadError Text m, Decode m a) =>
a -> Maybe (JSON a) -> m a
decodeWithDefault [CredentialDescriptor]
D.coaAllowCredentialsDefault Maybe [PublicKeyCredentialDescriptor]
Maybe (JSON [CredentialDescriptor])
allowCredentials
    UserVerificationRequirement
coaUserVerification <- UserVerificationRequirement
-> Maybe (JSON UserVerificationRequirement)
-> m UserVerificationRequirement
forall (m :: * -> *) a.
(MonadError Text m, Decode m a) =>
a -> Maybe (JSON a) -> m a
decodeWithDefault UserVerificationRequirement
D.coaUserVerificationDefault Maybe Text
Maybe (JSON UserVerificationRequirement)
userVerification
    Maybe AuthenticationExtensionsClientInputs
coaExtensions <- JSON (Maybe AuthenticationExtensionsClientInputs)
-> m (Maybe AuthenticationExtensionsClientInputs)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Maybe (Map Text Value)
JSON (Maybe AuthenticationExtensionsClientInputs)
extensions
    CredentialOptions 'Authentication
-> m (CredentialOptions 'Authentication)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialOptions 'Authentication
 -> m (CredentialOptions 'Authentication))
-> CredentialOptions 'Authentication
-> m (CredentialOptions 'Authentication)
forall a b. (a -> b) -> a -> b
$ CredentialOptionsAuthentication :: Challenge
-> Maybe Timeout
-> Maybe RpId
-> [CredentialDescriptor]
-> UserVerificationRequirement
-> Maybe AuthenticationExtensionsClientInputs
-> CredentialOptions 'Authentication
T.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/#dictionary-rp-credential-params)
data PublicKeyCredentialRpEntity = PublicKeyCredentialRpEntity
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrpentity-id)
    PublicKeyCredentialRpEntity -> Maybe Text
id :: Maybe Text,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)
    PublicKeyCredentialRpEntity -> Text
name :: Text
  }
  deriving (PublicKeyCredentialRpEntity -> PublicKeyCredentialRpEntity -> Bool
(PublicKeyCredentialRpEntity
 -> PublicKeyCredentialRpEntity -> Bool)
-> (PublicKeyCredentialRpEntity
    -> PublicKeyCredentialRpEntity -> Bool)
-> Eq PublicKeyCredentialRpEntity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKeyCredentialRpEntity -> PublicKeyCredentialRpEntity -> Bool
$c/= :: PublicKeyCredentialRpEntity -> PublicKeyCredentialRpEntity -> Bool
== :: PublicKeyCredentialRpEntity -> PublicKeyCredentialRpEntity -> Bool
$c== :: PublicKeyCredentialRpEntity -> PublicKeyCredentialRpEntity -> Bool
Eq, Int -> PublicKeyCredentialRpEntity -> ShowS
[PublicKeyCredentialRpEntity] -> ShowS
PublicKeyCredentialRpEntity -> String
(Int -> PublicKeyCredentialRpEntity -> ShowS)
-> (PublicKeyCredentialRpEntity -> String)
-> ([PublicKeyCredentialRpEntity] -> ShowS)
-> Show PublicKeyCredentialRpEntity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKeyCredentialRpEntity] -> ShowS
$cshowList :: [PublicKeyCredentialRpEntity] -> ShowS
show :: PublicKeyCredentialRpEntity -> String
$cshow :: PublicKeyCredentialRpEntity -> String
showsPrec :: Int -> PublicKeyCredentialRpEntity -> ShowS
$cshowsPrec :: Int -> PublicKeyCredentialRpEntity -> ShowS
Show, (forall x.
 PublicKeyCredentialRpEntity -> Rep PublicKeyCredentialRpEntity x)
-> (forall x.
    Rep PublicKeyCredentialRpEntity x -> PublicKeyCredentialRpEntity)
-> Generic PublicKeyCredentialRpEntity
forall x.
Rep PublicKeyCredentialRpEntity x -> PublicKeyCredentialRpEntity
forall x.
PublicKeyCredentialRpEntity -> Rep PublicKeyCredentialRpEntity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PublicKeyCredentialRpEntity x -> PublicKeyCredentialRpEntity
$cfrom :: forall x.
PublicKeyCredentialRpEntity -> Rep PublicKeyCredentialRpEntity x
Generic)

instance Aeson.FromJSON PublicKeyCredentialRpEntity where
  parseJSON :: Value -> Parser PublicKeyCredentialRpEntity
parseJSON = Options -> Value -> Parser PublicKeyCredentialRpEntity
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
jsonEncodingOptions

instance Aeson.ToJSON PublicKeyCredentialRpEntity where
  toJSON :: PublicKeyCredentialRpEntity -> Value
toJSON = Options -> PublicKeyCredentialRpEntity -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
jsonEncodingOptions

instance Encode T.CredentialRpEntity where
  type JSON T.CredentialRpEntity = PublicKeyCredentialRpEntity
  encode :: CredentialRpEntity -> JSON CredentialRpEntity
encode T.CredentialRpEntity {Maybe RpId
RelyingPartyName
creName :: CredentialRpEntity -> RelyingPartyName
creId :: CredentialRpEntity -> Maybe RpId
creName :: RelyingPartyName
creId :: Maybe RpId
..} =
    PublicKeyCredentialRpEntity :: Maybe Text -> Text -> PublicKeyCredentialRpEntity
PublicKeyCredentialRpEntity
      { $sel:id:PublicKeyCredentialRpEntity :: Maybe Text
id = Maybe RpId -> JSON (Maybe RpId)
forall a. Encode a => a -> JSON a
encode Maybe RpId
creId,
        $sel:name:PublicKeyCredentialRpEntity :: Text
name = RelyingPartyName -> JSON RelyingPartyName
forall a. Encode a => a -> JSON a
encode RelyingPartyName
creName
      }

instance Decode m T.CredentialRpEntity where
  decode :: MonadError Text m =>
JSON CredentialRpEntity -> m CredentialRpEntity
decode PublicKeyCredentialRpEntity {Maybe Text
Text
name :: Text
id :: Maybe Text
$sel:name:PublicKeyCredentialRpEntity :: PublicKeyCredentialRpEntity -> Text
$sel:id:PublicKeyCredentialRpEntity :: PublicKeyCredentialRpEntity -> Maybe Text
..} = do
    Maybe RpId
creId <- JSON (Maybe RpId) -> m (Maybe RpId)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Maybe Text
JSON (Maybe RpId)
id
    RelyingPartyName
creName <- JSON RelyingPartyName -> m RelyingPartyName
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Text
JSON RelyingPartyName
name
    CredentialRpEntity -> m CredentialRpEntity
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialRpEntity -> m CredentialRpEntity)
-> CredentialRpEntity -> m CredentialRpEntity
forall a b. (a -> b) -> a -> b
$ CredentialRpEntity :: Maybe RpId -> RelyingPartyName -> CredentialRpEntity
T.CredentialRpEntity {Maybe RpId
RelyingPartyName
creName :: RelyingPartyName
creId :: Maybe RpId
creName :: RelyingPartyName
creId :: Maybe RpId
..}

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-user-credential-params)
data PublicKeyCredentialUserEntity = PublicKeyCredentialUserEntity
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-id)
    PublicKeyCredentialUserEntity -> Base64UrlString
id :: Base64UrlString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-displayname)
    PublicKeyCredentialUserEntity -> Text
displayName :: Text,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)
    PublicKeyCredentialUserEntity -> Text
name :: Text
  }
  deriving (PublicKeyCredentialUserEntity
-> PublicKeyCredentialUserEntity -> Bool
(PublicKeyCredentialUserEntity
 -> PublicKeyCredentialUserEntity -> Bool)
-> (PublicKeyCredentialUserEntity
    -> PublicKeyCredentialUserEntity -> Bool)
-> Eq PublicKeyCredentialUserEntity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKeyCredentialUserEntity
-> PublicKeyCredentialUserEntity -> Bool
$c/= :: PublicKeyCredentialUserEntity
-> PublicKeyCredentialUserEntity -> Bool
== :: PublicKeyCredentialUserEntity
-> PublicKeyCredentialUserEntity -> Bool
$c== :: PublicKeyCredentialUserEntity
-> PublicKeyCredentialUserEntity -> Bool
Eq, Int -> PublicKeyCredentialUserEntity -> ShowS
[PublicKeyCredentialUserEntity] -> ShowS
PublicKeyCredentialUserEntity -> String
(Int -> PublicKeyCredentialUserEntity -> ShowS)
-> (PublicKeyCredentialUserEntity -> String)
-> ([PublicKeyCredentialUserEntity] -> ShowS)
-> Show PublicKeyCredentialUserEntity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKeyCredentialUserEntity] -> ShowS
$cshowList :: [PublicKeyCredentialUserEntity] -> ShowS
show :: PublicKeyCredentialUserEntity -> String
$cshow :: PublicKeyCredentialUserEntity -> String
showsPrec :: Int -> PublicKeyCredentialUserEntity -> ShowS
$cshowsPrec :: Int -> PublicKeyCredentialUserEntity -> ShowS
Show, (forall x.
 PublicKeyCredentialUserEntity
 -> Rep PublicKeyCredentialUserEntity x)
-> (forall x.
    Rep PublicKeyCredentialUserEntity x
    -> PublicKeyCredentialUserEntity)
-> Generic PublicKeyCredentialUserEntity
forall x.
Rep PublicKeyCredentialUserEntity x
-> PublicKeyCredentialUserEntity
forall x.
PublicKeyCredentialUserEntity
-> Rep PublicKeyCredentialUserEntity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PublicKeyCredentialUserEntity x
-> PublicKeyCredentialUserEntity
$cfrom :: forall x.
PublicKeyCredentialUserEntity
-> Rep PublicKeyCredentialUserEntity x
Generic)

instance Aeson.FromJSON PublicKeyCredentialUserEntity where
  parseJSON :: Value -> Parser PublicKeyCredentialUserEntity
parseJSON = Options -> Value -> Parser PublicKeyCredentialUserEntity
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
jsonEncodingOptions

instance Aeson.ToJSON PublicKeyCredentialUserEntity where
  toJSON :: PublicKeyCredentialUserEntity -> Value
toJSON = Options -> PublicKeyCredentialUserEntity -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
jsonEncodingOptions

instance Encode T.CredentialUserEntity where
  type JSON T.CredentialUserEntity = PublicKeyCredentialUserEntity
  encode :: CredentialUserEntity -> JSON CredentialUserEntity
encode T.CredentialUserEntity {UserAccountName
UserAccountDisplayName
UserHandle
cueName :: CredentialUserEntity -> UserAccountName
cueDisplayName :: CredentialUserEntity -> UserAccountDisplayName
cueId :: CredentialUserEntity -> UserHandle
cueName :: UserAccountName
cueDisplayName :: UserAccountDisplayName
cueId :: UserHandle
..} =
    PublicKeyCredentialUserEntity :: Base64UrlString -> Text -> Text -> PublicKeyCredentialUserEntity
PublicKeyCredentialUserEntity
      { $sel:id:PublicKeyCredentialUserEntity :: Base64UrlString
id = UserHandle -> JSON UserHandle
forall a. Encode a => a -> JSON a
encode UserHandle
cueId,
        $sel:displayName:PublicKeyCredentialUserEntity :: Text
displayName = UserAccountDisplayName -> JSON UserAccountDisplayName
forall a. Encode a => a -> JSON a
encode UserAccountDisplayName
cueDisplayName,
        $sel:name:PublicKeyCredentialUserEntity :: Text
name = UserAccountName -> JSON UserAccountName
forall a. Encode a => a -> JSON a
encode UserAccountName
cueName
      }

instance Decode m T.CredentialUserEntity where
  decode :: MonadError Text m =>
JSON CredentialUserEntity -> m CredentialUserEntity
decode PublicKeyCredentialUserEntity {Text
Base64UrlString
name :: Text
displayName :: Text
id :: Base64UrlString
$sel:name:PublicKeyCredentialUserEntity :: PublicKeyCredentialUserEntity -> Text
$sel:displayName:PublicKeyCredentialUserEntity :: PublicKeyCredentialUserEntity -> Text
$sel:id:PublicKeyCredentialUserEntity :: PublicKeyCredentialUserEntity -> Base64UrlString
..} = do
    UserHandle
cueId <- JSON UserHandle -> m UserHandle
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Base64UrlString
JSON UserHandle
id
    UserAccountDisplayName
cueDisplayName <- JSON UserAccountDisplayName -> m UserAccountDisplayName
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Text
JSON UserAccountDisplayName
displayName
    UserAccountName
cueName <- JSON UserAccountName -> m UserAccountName
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Text
JSON UserAccountName
name
    CredentialUserEntity -> m CredentialUserEntity
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialUserEntity -> m CredentialUserEntity)
-> CredentialUserEntity -> m CredentialUserEntity
forall a b. (a -> b) -> a -> b
$ CredentialUserEntity :: UserHandle
-> UserAccountDisplayName
-> UserAccountName
-> CredentialUserEntity
T.CredentialUserEntity {UserAccountName
UserAccountDisplayName
UserHandle
cueName :: UserAccountName
cueDisplayName :: UserAccountDisplayName
cueId :: UserHandle
cueName :: UserAccountName
cueDisplayName :: UserAccountDisplayName
cueId :: UserHandle
..}

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-credential-params)
data PublicKeyCredentialParameters = PublicKeyCredentialParameters
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialparameters-type)
    PublicKeyCredentialParameters -> Text
littype :: Text,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialparameters-alg)
    PublicKeyCredentialParameters -> Int32
alg :: COSEAlgorithmIdentifier
  }
  deriving (PublicKeyCredentialParameters
-> PublicKeyCredentialParameters -> Bool
(PublicKeyCredentialParameters
 -> PublicKeyCredentialParameters -> Bool)
-> (PublicKeyCredentialParameters
    -> PublicKeyCredentialParameters -> Bool)
-> Eq PublicKeyCredentialParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKeyCredentialParameters
-> PublicKeyCredentialParameters -> Bool
$c/= :: PublicKeyCredentialParameters
-> PublicKeyCredentialParameters -> Bool
== :: PublicKeyCredentialParameters
-> PublicKeyCredentialParameters -> Bool
$c== :: PublicKeyCredentialParameters
-> PublicKeyCredentialParameters -> Bool
Eq, Int -> PublicKeyCredentialParameters -> ShowS
[PublicKeyCredentialParameters] -> ShowS
PublicKeyCredentialParameters -> String
(Int -> PublicKeyCredentialParameters -> ShowS)
-> (PublicKeyCredentialParameters -> String)
-> ([PublicKeyCredentialParameters] -> ShowS)
-> Show PublicKeyCredentialParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKeyCredentialParameters] -> ShowS
$cshowList :: [PublicKeyCredentialParameters] -> ShowS
show :: PublicKeyCredentialParameters -> String
$cshow :: PublicKeyCredentialParameters -> String
showsPrec :: Int -> PublicKeyCredentialParameters -> ShowS
$cshowsPrec :: Int -> PublicKeyCredentialParameters -> ShowS
Show, (forall x.
 PublicKeyCredentialParameters
 -> Rep PublicKeyCredentialParameters x)
-> (forall x.
    Rep PublicKeyCredentialParameters x
    -> PublicKeyCredentialParameters)
-> Generic PublicKeyCredentialParameters
forall x.
Rep PublicKeyCredentialParameters x
-> PublicKeyCredentialParameters
forall x.
PublicKeyCredentialParameters
-> Rep PublicKeyCredentialParameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PublicKeyCredentialParameters x
-> PublicKeyCredentialParameters
$cfrom :: forall x.
PublicKeyCredentialParameters
-> Rep PublicKeyCredentialParameters x
Generic)

instance Aeson.FromJSON PublicKeyCredentialParameters where
  parseJSON :: Value -> Parser PublicKeyCredentialParameters
parseJSON = Options -> Value -> Parser PublicKeyCredentialParameters
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
jsonEncodingOptions

instance Aeson.ToJSON PublicKeyCredentialParameters where
  toJSON :: PublicKeyCredentialParameters -> Value
toJSON = Options -> PublicKeyCredentialParameters -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
jsonEncodingOptions

instance Encode T.CredentialParameters where
  type JSON T.CredentialParameters = PublicKeyCredentialParameters
  encode :: CredentialParameters -> JSON CredentialParameters
encode T.CredentialParameters {CoseSignAlg
CredentialType
cpAlg :: CredentialParameters -> CoseSignAlg
cpTyp :: CredentialParameters -> CredentialType
cpAlg :: CoseSignAlg
cpTyp :: CredentialType
..} =
    PublicKeyCredentialParameters :: Text -> Int32 -> PublicKeyCredentialParameters
PublicKeyCredentialParameters
      { $sel:littype:PublicKeyCredentialParameters :: Text
littype = CredentialType -> JSON CredentialType
forall a. Encode a => a -> JSON a
encode CredentialType
cpTyp,
        $sel:alg:PublicKeyCredentialParameters :: Int32
alg = CoseSignAlg -> JSON CoseSignAlg
forall a. Encode a => a -> JSON a
encode CoseSignAlg
cpAlg
      }

instance Decode m T.CredentialParameters where
  decode :: MonadError Text m =>
JSON CredentialParameters -> m CredentialParameters
decode PublicKeyCredentialParameters {Int32
Text
alg :: Int32
littype :: Text
$sel:alg:PublicKeyCredentialParameters :: PublicKeyCredentialParameters -> Int32
$sel:littype:PublicKeyCredentialParameters :: PublicKeyCredentialParameters -> Text
..} = do
    CredentialType
cpTyp <- JSON CredentialType -> m CredentialType
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Text
JSON CredentialType
littype
    CoseSignAlg
cpAlg <- JSON CoseSignAlg -> m CoseSignAlg
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Int32
JSON CoseSignAlg
alg
    CredentialParameters -> m CredentialParameters
forall (f :: * -> *) a. Applicative f => a -> f a
pure CredentialParameters :: CredentialType -> CoseSignAlg -> CredentialParameters
T.CredentialParameters {CoseSignAlg
CredentialType
cpAlg :: CoseSignAlg
cpTyp :: CredentialType
cpAlg :: CoseSignAlg
cpTyp :: CredentialType
..}

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-alg-identifier)
type COSEAlgorithmIdentifier = Int32

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialdescriptor)
data PublicKeyCredentialDescriptor = PublicKeyCredentialDescriptor
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-type)
    PublicKeyCredentialDescriptor -> Text
littype :: Text,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-id)
    PublicKeyCredentialDescriptor -> Base64UrlString
id :: Base64UrlString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-transports)
    PublicKeyCredentialDescriptor -> Maybe [Text]
transports :: Maybe [Text]
  }
  deriving (PublicKeyCredentialDescriptor
-> PublicKeyCredentialDescriptor -> Bool
(PublicKeyCredentialDescriptor
 -> PublicKeyCredentialDescriptor -> Bool)
-> (PublicKeyCredentialDescriptor
    -> PublicKeyCredentialDescriptor -> Bool)
-> Eq PublicKeyCredentialDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKeyCredentialDescriptor
-> PublicKeyCredentialDescriptor -> Bool
$c/= :: PublicKeyCredentialDescriptor
-> PublicKeyCredentialDescriptor -> Bool
== :: PublicKeyCredentialDescriptor
-> PublicKeyCredentialDescriptor -> Bool
$c== :: PublicKeyCredentialDescriptor
-> PublicKeyCredentialDescriptor -> Bool
Eq, Int -> PublicKeyCredentialDescriptor -> ShowS
[PublicKeyCredentialDescriptor] -> ShowS
PublicKeyCredentialDescriptor -> String
(Int -> PublicKeyCredentialDescriptor -> ShowS)
-> (PublicKeyCredentialDescriptor -> String)
-> ([PublicKeyCredentialDescriptor] -> ShowS)
-> Show PublicKeyCredentialDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKeyCredentialDescriptor] -> ShowS
$cshowList :: [PublicKeyCredentialDescriptor] -> ShowS
show :: PublicKeyCredentialDescriptor -> String
$cshow :: PublicKeyCredentialDescriptor -> String
showsPrec :: Int -> PublicKeyCredentialDescriptor -> ShowS
$cshowsPrec :: Int -> PublicKeyCredentialDescriptor -> ShowS
Show, (forall x.
 PublicKeyCredentialDescriptor
 -> Rep PublicKeyCredentialDescriptor x)
-> (forall x.
    Rep PublicKeyCredentialDescriptor x
    -> PublicKeyCredentialDescriptor)
-> Generic PublicKeyCredentialDescriptor
forall x.
Rep PublicKeyCredentialDescriptor x
-> PublicKeyCredentialDescriptor
forall x.
PublicKeyCredentialDescriptor
-> Rep PublicKeyCredentialDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PublicKeyCredentialDescriptor x
-> PublicKeyCredentialDescriptor
$cfrom :: forall x.
PublicKeyCredentialDescriptor
-> Rep PublicKeyCredentialDescriptor x
Generic)

instance Aeson.FromJSON PublicKeyCredentialDescriptor where
  parseJSON :: Value -> Parser PublicKeyCredentialDescriptor
parseJSON = Options -> Value -> Parser PublicKeyCredentialDescriptor
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
jsonEncodingOptions

instance Aeson.ToJSON PublicKeyCredentialDescriptor where
  toJSON :: PublicKeyCredentialDescriptor -> Value
toJSON = Options -> PublicKeyCredentialDescriptor -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
jsonEncodingOptions

instance Encode T.CredentialDescriptor where
  type JSON T.CredentialDescriptor = PublicKeyCredentialDescriptor
  encode :: CredentialDescriptor -> JSON CredentialDescriptor
encode T.CredentialDescriptor {Maybe [AuthenticatorTransport]
CredentialId
CredentialType
cdTransports :: CredentialDescriptor -> Maybe [AuthenticatorTransport]
cdId :: CredentialDescriptor -> CredentialId
cdTyp :: CredentialDescriptor -> CredentialType
cdTransports :: Maybe [AuthenticatorTransport]
cdId :: CredentialId
cdTyp :: CredentialType
..} =
    PublicKeyCredentialDescriptor :: Text
-> Base64UrlString -> Maybe [Text] -> PublicKeyCredentialDescriptor
PublicKeyCredentialDescriptor
      { $sel:littype:PublicKeyCredentialDescriptor :: Text
littype = CredentialType -> JSON CredentialType
forall a. Encode a => a -> JSON a
encode CredentialType
cdTyp,
        $sel:id:PublicKeyCredentialDescriptor :: Base64UrlString
id = CredentialId -> JSON CredentialId
forall a. Encode a => a -> JSON a
encode CredentialId
cdId,
        $sel:transports:PublicKeyCredentialDescriptor :: Maybe [Text]
transports = Maybe [AuthenticatorTransport]
-> JSON (Maybe [AuthenticatorTransport])
forall a. Encode a => a -> JSON a
encode Maybe [AuthenticatorTransport]
cdTransports
      }

instance Decode m T.CredentialDescriptor where
  decode :: MonadError Text m =>
JSON CredentialDescriptor -> m CredentialDescriptor
decode PublicKeyCredentialDescriptor {Maybe [Text]
Text
Base64UrlString
transports :: Maybe [Text]
id :: Base64UrlString
littype :: Text
$sel:transports:PublicKeyCredentialDescriptor :: PublicKeyCredentialDescriptor -> Maybe [Text]
$sel:id:PublicKeyCredentialDescriptor :: PublicKeyCredentialDescriptor -> Base64UrlString
$sel:littype:PublicKeyCredentialDescriptor :: PublicKeyCredentialDescriptor -> Text
..} = do
    CredentialType
cdTyp <- JSON CredentialType -> m CredentialType
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Text
JSON CredentialType
littype
    CredentialId
cdId <- JSON CredentialId -> m CredentialId
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Base64UrlString
JSON CredentialId
id
    Maybe [AuthenticatorTransport]
cdTransports <- JSON (Maybe [AuthenticatorTransport])
-> m (Maybe [AuthenticatorTransport])
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Maybe [Text]
JSON (Maybe [AuthenticatorTransport])
transports
    CredentialDescriptor -> m CredentialDescriptor
forall (f :: * -> *) a. Applicative f => a -> f a
pure CredentialDescriptor :: CredentialType
-> CredentialId
-> Maybe [AuthenticatorTransport]
-> CredentialDescriptor
T.CredentialDescriptor {Maybe [AuthenticatorTransport]
CredentialId
CredentialType
cdTransports :: Maybe [AuthenticatorTransport]
cdId :: CredentialId
cdTyp :: CredentialType
cdTransports :: Maybe [AuthenticatorTransport]
cdId :: CredentialId
cdTyp :: CredentialType
..}

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-authenticatorselectioncriteria)
data AuthenticatorSelectionCriteria = AuthenticatorSelectionCriteria
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-authenticatorattachment)
    AuthenticatorSelectionCriteria -> Maybe Text
authenticatorAttachment :: Maybe Text,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-residentkey)
    AuthenticatorSelectionCriteria -> Maybe Text
residentKey :: Maybe Text,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-requireresidentkey)
    AuthenticatorSelectionCriteria -> Maybe Bool
requireResidentKey :: Maybe Bool,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-userverification)
    AuthenticatorSelectionCriteria -> Maybe Text
userVerification :: Maybe Text
  }
  deriving (AuthenticatorSelectionCriteria
-> AuthenticatorSelectionCriteria -> Bool
(AuthenticatorSelectionCriteria
 -> AuthenticatorSelectionCriteria -> Bool)
-> (AuthenticatorSelectionCriteria
    -> AuthenticatorSelectionCriteria -> Bool)
-> Eq AuthenticatorSelectionCriteria
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatorSelectionCriteria
-> AuthenticatorSelectionCriteria -> Bool
$c/= :: AuthenticatorSelectionCriteria
-> AuthenticatorSelectionCriteria -> Bool
== :: AuthenticatorSelectionCriteria
-> AuthenticatorSelectionCriteria -> Bool
$c== :: AuthenticatorSelectionCriteria
-> AuthenticatorSelectionCriteria -> Bool
Eq, Int -> AuthenticatorSelectionCriteria -> ShowS
[AuthenticatorSelectionCriteria] -> ShowS
AuthenticatorSelectionCriteria -> String
(Int -> AuthenticatorSelectionCriteria -> ShowS)
-> (AuthenticatorSelectionCriteria -> String)
-> ([AuthenticatorSelectionCriteria] -> ShowS)
-> Show AuthenticatorSelectionCriteria
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatorSelectionCriteria] -> ShowS
$cshowList :: [AuthenticatorSelectionCriteria] -> ShowS
show :: AuthenticatorSelectionCriteria -> String
$cshow :: AuthenticatorSelectionCriteria -> String
showsPrec :: Int -> AuthenticatorSelectionCriteria -> ShowS
$cshowsPrec :: Int -> AuthenticatorSelectionCriteria -> ShowS
Show, (forall x.
 AuthenticatorSelectionCriteria
 -> Rep AuthenticatorSelectionCriteria x)
-> (forall x.
    Rep AuthenticatorSelectionCriteria x
    -> AuthenticatorSelectionCriteria)
-> Generic AuthenticatorSelectionCriteria
forall x.
Rep AuthenticatorSelectionCriteria x
-> AuthenticatorSelectionCriteria
forall x.
AuthenticatorSelectionCriteria
-> Rep AuthenticatorSelectionCriteria x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthenticatorSelectionCriteria x
-> AuthenticatorSelectionCriteria
$cfrom :: forall x.
AuthenticatorSelectionCriteria
-> Rep AuthenticatorSelectionCriteria x
Generic)

instance Aeson.FromJSON AuthenticatorSelectionCriteria where
  parseJSON :: Value -> Parser AuthenticatorSelectionCriteria
parseJSON = Options -> Value -> Parser AuthenticatorSelectionCriteria
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
jsonEncodingOptions

instance Aeson.ToJSON AuthenticatorSelectionCriteria where
  toJSON :: AuthenticatorSelectionCriteria -> Value
toJSON = Options -> AuthenticatorSelectionCriteria -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
jsonEncodingOptions

instance Encode T.AuthenticatorSelectionCriteria where
  type JSON T.AuthenticatorSelectionCriteria = AuthenticatorSelectionCriteria
  encode :: AuthenticatorSelectionCriteria
-> JSON AuthenticatorSelectionCriteria
encode T.AuthenticatorSelectionCriteria {Maybe AuthenticatorAttachment
UserVerificationRequirement
ResidentKeyRequirement
ascUserVerification :: AuthenticatorSelectionCriteria -> UserVerificationRequirement
ascResidentKey :: AuthenticatorSelectionCriteria -> ResidentKeyRequirement
ascAuthenticatorAttachment :: AuthenticatorSelectionCriteria -> Maybe AuthenticatorAttachment
ascUserVerification :: UserVerificationRequirement
ascResidentKey :: ResidentKeyRequirement
ascAuthenticatorAttachment :: Maybe AuthenticatorAttachment
..} =
    AuthenticatorSelectionCriteria :: Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> AuthenticatorSelectionCriteria
AuthenticatorSelectionCriteria
      { $sel:authenticatorAttachment:AuthenticatorSelectionCriteria :: Maybe Text
authenticatorAttachment = Maybe AuthenticatorAttachment
-> JSON (Maybe AuthenticatorAttachment)
forall a. Encode a => a -> JSON a
encode Maybe AuthenticatorAttachment
ascAuthenticatorAttachment,
        $sel:residentKey:AuthenticatorSelectionCriteria :: Maybe Text
residentKey = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ResidentKeyRequirement -> JSON ResidentKeyRequirement
forall a. Encode a => a -> JSON a
encode ResidentKeyRequirement
ascResidentKey,
        -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-requireresidentkey)
        -- Relying Parties SHOULD set it to true if, and only if, residentKey is set to required.
        $sel:requireResidentKey:AuthenticatorSelectionCriteria :: Maybe Bool
requireResidentKey = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (ResidentKeyRequirement
ascResidentKey ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
forall a. Eq a => a -> a -> Bool
== ResidentKeyRequirement
T.ResidentKeyRequirementRequired),
        $sel:userVerification:AuthenticatorSelectionCriteria :: Maybe Text
userVerification = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ UserVerificationRequirement -> JSON UserVerificationRequirement
forall a. Encode a => a -> JSON a
encode UserVerificationRequirement
ascUserVerification
      }

instance Decode m T.AuthenticatorSelectionCriteria where
  decode :: MonadError Text m =>
JSON AuthenticatorSelectionCriteria
-> m AuthenticatorSelectionCriteria
decode AuthenticatorSelectionCriteria {Maybe Bool
Maybe Text
userVerification :: Maybe Text
requireResidentKey :: Maybe Bool
residentKey :: Maybe Text
authenticatorAttachment :: Maybe Text
$sel:userVerification:AuthenticatorSelectionCriteria :: AuthenticatorSelectionCriteria -> Maybe Text
$sel:requireResidentKey:AuthenticatorSelectionCriteria :: AuthenticatorSelectionCriteria -> Maybe Bool
$sel:residentKey:AuthenticatorSelectionCriteria :: AuthenticatorSelectionCriteria -> Maybe Text
$sel:authenticatorAttachment:AuthenticatorSelectionCriteria :: AuthenticatorSelectionCriteria -> Maybe Text
..} = do
    Maybe AuthenticatorAttachment
ascAuthenticatorAttachment <- JSON (Maybe AuthenticatorAttachment)
-> m (Maybe AuthenticatorAttachment)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Maybe Text
JSON (Maybe AuthenticatorAttachment)
authenticatorAttachment
    ResidentKeyRequirement
ascResidentKey <- ResidentKeyRequirement
-> Maybe (JSON ResidentKeyRequirement) -> m ResidentKeyRequirement
forall (m :: * -> *) a.
(MonadError Text m, Decode m a) =>
a -> Maybe (JSON a) -> m a
decodeWithDefault (Maybe Bool -> ResidentKeyRequirement
D.ascResidentKeyDefault Maybe Bool
requireResidentKey) Maybe Text
Maybe (JSON ResidentKeyRequirement)
residentKey
    UserVerificationRequirement
ascUserVerification <- UserVerificationRequirement
-> Maybe (JSON UserVerificationRequirement)
-> m UserVerificationRequirement
forall (m :: * -> *) a.
(MonadError Text m, Decode m a) =>
a -> Maybe (JSON a) -> m a
decodeWithDefault UserVerificationRequirement
D.ascUserVerificationDefault Maybe Text
Maybe (JSON UserVerificationRequirement)
userVerification
    AuthenticatorSelectionCriteria -> m AuthenticatorSelectionCriteria
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticatorSelectionCriteria
 -> m AuthenticatorSelectionCriteria)
-> AuthenticatorSelectionCriteria
-> m AuthenticatorSelectionCriteria
forall a b. (a -> b) -> a -> b
$ AuthenticatorSelectionCriteria :: Maybe AuthenticatorAttachment
-> ResidentKeyRequirement
-> UserVerificationRequirement
-> AuthenticatorSelectionCriteria
T.AuthenticatorSelectionCriteria {Maybe AuthenticatorAttachment
UserVerificationRequirement
ResidentKeyRequirement
ascUserVerification :: UserVerificationRequirement
ascResidentKey :: ResidentKeyRequirement
ascAuthenticatorAttachment :: Maybe AuthenticatorAttachment
ascUserVerification :: UserVerificationRequirement
ascResidentKey :: ResidentKeyRequirement
ascAuthenticatorAttachment :: Maybe AuthenticatorAttachment
..}

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-pkcredential)
data PublicKeyCredential response = PublicKeyCredential
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-identifier-slot)
    forall response. PublicKeyCredential response -> Base64UrlString
rawId :: Base64UrlString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-response)
    forall response. PublicKeyCredential response -> response
response :: response,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-getclientextensionresults)
    forall response. PublicKeyCredential response -> Map Text Value
clientExtensionResults :: Map Text Aeson.Value
  }
  deriving (PublicKeyCredential response
-> PublicKeyCredential response -> Bool
(PublicKeyCredential response
 -> PublicKeyCredential response -> Bool)
-> (PublicKeyCredential response
    -> PublicKeyCredential response -> Bool)
-> Eq (PublicKeyCredential response)
forall response.
Eq response =>
PublicKeyCredential response
-> PublicKeyCredential response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKeyCredential response
-> PublicKeyCredential response -> Bool
$c/= :: forall response.
Eq response =>
PublicKeyCredential response
-> PublicKeyCredential response -> Bool
== :: PublicKeyCredential response
-> PublicKeyCredential response -> Bool
$c== :: forall response.
Eq response =>
PublicKeyCredential response
-> PublicKeyCredential response -> Bool
Eq, Int -> PublicKeyCredential response -> ShowS
[PublicKeyCredential response] -> ShowS
PublicKeyCredential response -> String
(Int -> PublicKeyCredential response -> ShowS)
-> (PublicKeyCredential response -> String)
-> ([PublicKeyCredential response] -> ShowS)
-> Show (PublicKeyCredential response)
forall response.
Show response =>
Int -> PublicKeyCredential response -> ShowS
forall response.
Show response =>
[PublicKeyCredential response] -> ShowS
forall response.
Show response =>
PublicKeyCredential response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKeyCredential response] -> ShowS
$cshowList :: forall response.
Show response =>
[PublicKeyCredential response] -> ShowS
show :: PublicKeyCredential response -> String
$cshow :: forall response.
Show response =>
PublicKeyCredential response -> String
showsPrec :: Int -> PublicKeyCredential response -> ShowS
$cshowsPrec :: forall response.
Show response =>
Int -> PublicKeyCredential response -> ShowS
Show, (forall x.
 PublicKeyCredential response
 -> Rep (PublicKeyCredential response) x)
-> (forall x.
    Rep (PublicKeyCredential response) x
    -> PublicKeyCredential response)
-> Generic (PublicKeyCredential response)
forall x.
Rep (PublicKeyCredential response) x
-> PublicKeyCredential response
forall x.
PublicKeyCredential response
-> Rep (PublicKeyCredential response) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall response x.
Rep (PublicKeyCredential response) x
-> PublicKeyCredential response
forall response x.
PublicKeyCredential response
-> Rep (PublicKeyCredential response) x
$cto :: forall response x.
Rep (PublicKeyCredential response) x
-> PublicKeyCredential response
$cfrom :: forall response x.
PublicKeyCredential response
-> Rep (PublicKeyCredential response) x
Generic)

instance Aeson.FromJSON response => Aeson.FromJSON (PublicKeyCredential response) where
  parseJSON :: Value -> Parser (PublicKeyCredential response)
parseJSON = Options -> Value -> Parser (PublicKeyCredential response)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
jsonEncodingOptions

instance Aeson.ToJSON response => Aeson.ToJSON (PublicKeyCredential response) where
  toJSON :: PublicKeyCredential response -> Value
toJSON = Options -> PublicKeyCredential response -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
jsonEncodingOptions

instance Encode (T.Credential 'K.Registration 'True) where
  type JSON (T.Credential 'K.Registration 'True) = PublicKeyCredential AuthenticatorAttestationResponse
  encode :: Credential 'Registration 'True
-> JSON (Credential 'Registration 'True)
encode T.Credential {AuthenticatorResponse 'Registration 'True
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 'Registration 'True
cIdentifier :: CredentialId
..} =
    PublicKeyCredential :: forall response.
Base64UrlString
-> response -> Map Text Value -> PublicKeyCredential response
PublicKeyCredential
      { $sel:rawId:PublicKeyCredential :: Base64UrlString
rawId = CredentialId -> JSON CredentialId
forall a. Encode a => a -> JSON a
encode CredentialId
cIdentifier,
        $sel:response:PublicKeyCredential :: AuthenticatorAttestationResponse
response = AuthenticatorResponse 'Registration 'True
-> JSON (AuthenticatorResponse 'Registration 'True)
forall a. Encode a => a -> JSON a
encode AuthenticatorResponse 'Registration 'True
cResponse,
        $sel:clientExtensionResults:PublicKeyCredential :: Map Text Value
clientExtensionResults = AuthenticationExtensionsClientOutputs
-> JSON AuthenticationExtensionsClientOutputs
forall a. Encode a => a -> JSON a
encode AuthenticationExtensionsClientOutputs
cClientExtensionResults
      }

instance
  MonadReader T.SupportedAttestationStatementFormats m =>
  Decode m (T.Credential 'K.Registration 'True)
  where
  decode :: MonadError Text m =>
JSON (Credential 'Registration 'True)
-> m (Credential 'Registration 'True)
decode PublicKeyCredential {Map Text Value
AuthenticatorAttestationResponse
Base64UrlString
clientExtensionResults :: Map Text Value
response :: AuthenticatorAttestationResponse
rawId :: Base64UrlString
$sel:clientExtensionResults:PublicKeyCredential :: forall response. PublicKeyCredential response -> Map Text Value
$sel:response:PublicKeyCredential :: forall response. PublicKeyCredential response -> response
$sel:rawId:PublicKeyCredential :: forall response. PublicKeyCredential response -> Base64UrlString
..} = do
    CredentialId
cIdentifier <- JSON CredentialId -> m CredentialId
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Base64UrlString
JSON CredentialId
rawId
    AuthenticatorResponse 'Registration 'True
cResponse <- JSON (AuthenticatorResponse 'Registration 'True)
-> m (AuthenticatorResponse 'Registration 'True)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode AuthenticatorAttestationResponse
JSON (AuthenticatorResponse 'Registration 'True)
response
    AuthenticationExtensionsClientOutputs
cClientExtensionResults <- JSON AuthenticationExtensionsClientOutputs
-> m AuthenticationExtensionsClientOutputs
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Map Text Value
JSON AuthenticationExtensionsClientOutputs
clientExtensionResults
    Credential 'Registration 'True
-> m (Credential 'Registration 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'Registration 'True
 -> m (Credential 'Registration 'True))
-> Credential 'Registration 'True
-> m (Credential 'Registration 'True)
forall a b. (a -> b) -> a -> b
$ Credential :: forall (c :: CeremonyKind) (raw :: Bool).
CredentialId
-> AuthenticatorResponse c raw
-> AuthenticationExtensionsClientOutputs
-> Credential c raw
T.Credential {AuthenticatorResponse 'Registration 'True
AuthenticationExtensionsClientOutputs
CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse 'Registration 'True
cIdentifier :: CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse 'Registration 'True
cIdentifier :: CredentialId
..}

instance Encode (T.Credential 'K.Authentication 'True) where
  type JSON (T.Credential 'K.Authentication 'True) = PublicKeyCredential AuthenticatorAssertionResponse
  encode :: Credential 'Authentication 'True
-> JSON (Credential 'Authentication 'True)
encode T.Credential {AuthenticatorResponse 'Authentication 'True
AuthenticationExtensionsClientOutputs
CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse 'Authentication 'True
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
..} =
    PublicKeyCredential :: forall response.
Base64UrlString
-> response -> Map Text Value -> PublicKeyCredential response
PublicKeyCredential
      { $sel:rawId:PublicKeyCredential :: Base64UrlString
rawId = CredentialId -> JSON CredentialId
forall a. Encode a => a -> JSON a
encode CredentialId
cIdentifier,
        $sel:response:PublicKeyCredential :: AuthenticatorAssertionResponse
response = AuthenticatorResponse 'Authentication 'True
-> JSON (AuthenticatorResponse 'Authentication 'True)
forall a. Encode a => a -> JSON a
encode AuthenticatorResponse 'Authentication 'True
cResponse,
        $sel:clientExtensionResults:PublicKeyCredential :: Map Text Value
clientExtensionResults = AuthenticationExtensionsClientOutputs
-> JSON AuthenticationExtensionsClientOutputs
forall a. Encode a => a -> JSON a
encode AuthenticationExtensionsClientOutputs
cClientExtensionResults
      }

instance Decode m (T.Credential 'K.Authentication 'True) where
  decode :: MonadError Text m =>
JSON (Credential 'Authentication 'True)
-> m (Credential 'Authentication 'True)
decode PublicKeyCredential {Map Text Value
AuthenticatorAssertionResponse
Base64UrlString
clientExtensionResults :: Map Text Value
response :: AuthenticatorAssertionResponse
rawId :: Base64UrlString
$sel:clientExtensionResults:PublicKeyCredential :: forall response. PublicKeyCredential response -> Map Text Value
$sel:response:PublicKeyCredential :: forall response. PublicKeyCredential response -> response
$sel:rawId:PublicKeyCredential :: forall response. PublicKeyCredential response -> Base64UrlString
..} = do
    CredentialId
cIdentifier <- JSON CredentialId -> m CredentialId
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Base64UrlString
JSON CredentialId
rawId
    AuthenticatorResponse 'Authentication 'True
cResponse <- JSON (AuthenticatorResponse 'Authentication 'True)
-> m (AuthenticatorResponse 'Authentication 'True)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode AuthenticatorAssertionResponse
JSON (AuthenticatorResponse 'Authentication 'True)
response
    AuthenticationExtensionsClientOutputs
cClientExtensionResults <- JSON AuthenticationExtensionsClientOutputs
-> m AuthenticationExtensionsClientOutputs
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Map Text Value
JSON AuthenticationExtensionsClientOutputs
clientExtensionResults
    Credential 'Authentication 'True
-> m (Credential 'Authentication 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'Authentication 'True
 -> m (Credential 'Authentication 'True))
-> Credential 'Authentication 'True
-> m (Credential 'Authentication 'True)
forall a b. (a -> b) -> a -> b
$ Credential :: forall (c :: CeremonyKind) (raw :: Bool).
CredentialId
-> AuthenticatorResponse c raw
-> AuthenticationExtensionsClientOutputs
-> Credential c raw
T.Credential {AuthenticatorResponse 'Authentication 'True
AuthenticationExtensionsClientOutputs
CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse 'Authentication 'True
cIdentifier :: CredentialId
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
cResponse :: AuthenticatorResponse 'Authentication 'True
cIdentifier :: CredentialId
..}

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authenticatorattestationresponse)
data AuthenticatorAttestationResponse = AuthenticatorAttestationResponse
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson)
    AuthenticatorAttestationResponse -> Base64UrlString
clientDataJSON :: Base64UrlString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-attestationobject)
    AuthenticatorAttestationResponse -> Base64UrlString
attestationObject :: Base64UrlString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-transports-slot)
    -- This field is only being propagated by webauthn-json [since recently](https://github.com/github/webauthn-json/pull/44),
    -- which is why we allow absence of this value
    AuthenticatorAttestationResponse -> Maybe [Text]
transports :: Maybe [Text]
  }
  deriving (AuthenticatorAttestationResponse
-> AuthenticatorAttestationResponse -> Bool
(AuthenticatorAttestationResponse
 -> AuthenticatorAttestationResponse -> Bool)
-> (AuthenticatorAttestationResponse
    -> AuthenticatorAttestationResponse -> Bool)
-> Eq AuthenticatorAttestationResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatorAttestationResponse
-> AuthenticatorAttestationResponse -> Bool
$c/= :: AuthenticatorAttestationResponse
-> AuthenticatorAttestationResponse -> Bool
== :: AuthenticatorAttestationResponse
-> AuthenticatorAttestationResponse -> Bool
$c== :: AuthenticatorAttestationResponse
-> AuthenticatorAttestationResponse -> Bool
Eq, Int -> AuthenticatorAttestationResponse -> ShowS
[AuthenticatorAttestationResponse] -> ShowS
AuthenticatorAttestationResponse -> String
(Int -> AuthenticatorAttestationResponse -> ShowS)
-> (AuthenticatorAttestationResponse -> String)
-> ([AuthenticatorAttestationResponse] -> ShowS)
-> Show AuthenticatorAttestationResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatorAttestationResponse] -> ShowS
$cshowList :: [AuthenticatorAttestationResponse] -> ShowS
show :: AuthenticatorAttestationResponse -> String
$cshow :: AuthenticatorAttestationResponse -> String
showsPrec :: Int -> AuthenticatorAttestationResponse -> ShowS
$cshowsPrec :: Int -> AuthenticatorAttestationResponse -> ShowS
Show, (forall x.
 AuthenticatorAttestationResponse
 -> Rep AuthenticatorAttestationResponse x)
-> (forall x.
    Rep AuthenticatorAttestationResponse x
    -> AuthenticatorAttestationResponse)
-> Generic AuthenticatorAttestationResponse
forall x.
Rep AuthenticatorAttestationResponse x
-> AuthenticatorAttestationResponse
forall x.
AuthenticatorAttestationResponse
-> Rep AuthenticatorAttestationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthenticatorAttestationResponse x
-> AuthenticatorAttestationResponse
$cfrom :: forall x.
AuthenticatorAttestationResponse
-> Rep AuthenticatorAttestationResponse x
Generic)

instance Aeson.FromJSON AuthenticatorAttestationResponse where
  parseJSON :: Value -> Parser AuthenticatorAttestationResponse
parseJSON = Options -> Value -> Parser AuthenticatorAttestationResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
jsonEncodingOptions

instance Aeson.ToJSON AuthenticatorAttestationResponse where
  toJSON :: AuthenticatorAttestationResponse -> Value
toJSON = Options -> AuthenticatorAttestationResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
jsonEncodingOptions

instance Encode (T.AuthenticatorResponse 'K.Registration 'True) where
  type JSON (T.AuthenticatorResponse 'K.Registration 'True) = AuthenticatorAttestationResponse
  encode :: AuthenticatorResponse 'Registration 'True
-> JSON (AuthenticatorResponse 'Registration 'True)
encode T.AuthenticatorResponseRegistration {[AuthenticatorTransport]
AttestationObject 'True
CollectedClientData 'Registration 'True
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 'True
arrClientData :: CollectedClientData 'Registration 'True
..} =
    AuthenticatorAttestationResponse :: Base64UrlString
-> Base64UrlString
-> Maybe [Text]
-> AuthenticatorAttestationResponse
AuthenticatorAttestationResponse
      { $sel:clientDataJSON:AuthenticatorAttestationResponse :: Base64UrlString
clientDataJSON = CollectedClientData 'Registration 'True
-> JSON (CollectedClientData 'Registration 'True)
forall a. Encode a => a -> JSON a
encode CollectedClientData 'Registration 'True
arrClientData,
        $sel:attestationObject:AuthenticatorAttestationResponse :: Base64UrlString
attestationObject = AttestationObject 'True -> JSON (AttestationObject 'True)
forall a. Encode a => a -> JSON a
encode AttestationObject 'True
arrAttestationObject,
        $sel:transports:AuthenticatorAttestationResponse :: Maybe [Text]
transports = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ [AuthenticatorTransport] -> JSON [AuthenticatorTransport]
forall a. Encode a => a -> JSON a
encode [AuthenticatorTransport]
arrTransports
      }

instance
  MonadReader T.SupportedAttestationStatementFormats m =>
  Decode m (T.AuthenticatorResponse 'K.Registration 'True)
  where
  decode :: MonadError Text m =>
JSON (AuthenticatorResponse 'Registration 'True)
-> m (AuthenticatorResponse 'Registration 'True)
decode AuthenticatorAttestationResponse {Maybe [Text]
Base64UrlString
transports :: Maybe [Text]
attestationObject :: Base64UrlString
clientDataJSON :: Base64UrlString
$sel:transports:AuthenticatorAttestationResponse :: AuthenticatorAttestationResponse -> Maybe [Text]
$sel:attestationObject:AuthenticatorAttestationResponse :: AuthenticatorAttestationResponse -> Base64UrlString
$sel:clientDataJSON:AuthenticatorAttestationResponse :: AuthenticatorAttestationResponse -> Base64UrlString
..} = do
    CollectedClientData 'Registration 'True
arrClientData <- JSON (CollectedClientData 'Registration 'True)
-> m (CollectedClientData 'Registration 'True)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Base64UrlString
JSON (CollectedClientData 'Registration 'True)
clientDataJSON
    AttestationObject 'True
arrAttestationObject <- JSON (AttestationObject 'True) -> m (AttestationObject 'True)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Base64UrlString
JSON (AttestationObject 'True)
attestationObject
    -- Older webauthn-json versions don't add that field
    [AuthenticatorTransport]
arrTransports <- [AuthenticatorTransport]
-> Maybe (JSON [AuthenticatorTransport])
-> m [AuthenticatorTransport]
forall (m :: * -> *) a.
(MonadError Text m, Decode m a) =>
a -> Maybe (JSON a) -> m a
decodeWithDefault [] Maybe [Text]
Maybe (JSON [AuthenticatorTransport])
transports
    AuthenticatorResponse 'Registration 'True
-> m (AuthenticatorResponse 'Registration 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticatorResponse 'Registration 'True
 -> m (AuthenticatorResponse 'Registration 'True))
-> AuthenticatorResponse 'Registration 'True
-> m (AuthenticatorResponse 'Registration 'True)
forall a b. (a -> b) -> a -> b
$ AuthenticatorResponseRegistration :: forall (raw :: Bool).
CollectedClientData 'Registration raw
-> AttestationObject raw
-> [AuthenticatorTransport]
-> AuthenticatorResponse 'Registration raw
T.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
..}

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authenticatorassertionresponse)
data AuthenticatorAssertionResponse = AuthenticatorAssertionResponse
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson)
    AuthenticatorAssertionResponse -> Base64UrlString
clientDataJSON :: Base64UrlString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-authenticatordata)
    AuthenticatorAssertionResponse -> Base64UrlString
authenticatorData :: Base64UrlString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-signature)
    AuthenticatorAssertionResponse -> Base64UrlString
signature :: Base64UrlString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-userhandle)
    AuthenticatorAssertionResponse -> Maybe Base64UrlString
userHandle :: Maybe Base64UrlString
  }
  deriving (AuthenticatorAssertionResponse
-> AuthenticatorAssertionResponse -> Bool
(AuthenticatorAssertionResponse
 -> AuthenticatorAssertionResponse -> Bool)
-> (AuthenticatorAssertionResponse
    -> AuthenticatorAssertionResponse -> Bool)
-> Eq AuthenticatorAssertionResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatorAssertionResponse
-> AuthenticatorAssertionResponse -> Bool
$c/= :: AuthenticatorAssertionResponse
-> AuthenticatorAssertionResponse -> Bool
== :: AuthenticatorAssertionResponse
-> AuthenticatorAssertionResponse -> Bool
$c== :: AuthenticatorAssertionResponse
-> AuthenticatorAssertionResponse -> Bool
Eq, Int -> AuthenticatorAssertionResponse -> ShowS
[AuthenticatorAssertionResponse] -> ShowS
AuthenticatorAssertionResponse -> String
(Int -> AuthenticatorAssertionResponse -> ShowS)
-> (AuthenticatorAssertionResponse -> String)
-> ([AuthenticatorAssertionResponse] -> ShowS)
-> Show AuthenticatorAssertionResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatorAssertionResponse] -> ShowS
$cshowList :: [AuthenticatorAssertionResponse] -> ShowS
show :: AuthenticatorAssertionResponse -> String
$cshow :: AuthenticatorAssertionResponse -> String
showsPrec :: Int -> AuthenticatorAssertionResponse -> ShowS
$cshowsPrec :: Int -> AuthenticatorAssertionResponse -> ShowS
Show, (forall x.
 AuthenticatorAssertionResponse
 -> Rep AuthenticatorAssertionResponse x)
-> (forall x.
    Rep AuthenticatorAssertionResponse x
    -> AuthenticatorAssertionResponse)
-> Generic AuthenticatorAssertionResponse
forall x.
Rep AuthenticatorAssertionResponse x
-> AuthenticatorAssertionResponse
forall x.
AuthenticatorAssertionResponse
-> Rep AuthenticatorAssertionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthenticatorAssertionResponse x
-> AuthenticatorAssertionResponse
$cfrom :: forall x.
AuthenticatorAssertionResponse
-> Rep AuthenticatorAssertionResponse x
Generic)

instance Aeson.FromJSON AuthenticatorAssertionResponse where
  parseJSON :: Value -> Parser AuthenticatorAssertionResponse
parseJSON = Options -> Value -> Parser AuthenticatorAssertionResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
jsonEncodingOptions

instance Aeson.ToJSON AuthenticatorAssertionResponse where
  toJSON :: AuthenticatorAssertionResponse -> Value
toJSON = Options -> AuthenticatorAssertionResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
jsonEncodingOptions

instance Encode (T.AuthenticatorResponse 'K.Authentication 'True) where
  type JSON (T.AuthenticatorResponse 'K.Authentication 'True) = AuthenticatorAssertionResponse
  encode :: AuthenticatorResponse 'Authentication 'True
-> JSON (AuthenticatorResponse 'Authentication 'True)
encode T.AuthenticatorResponseAuthentication {Maybe UserHandle
AuthenticatorData 'Authentication 'True
CollectedClientData 'Authentication 'True
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 'True
araClientData :: CollectedClientData 'Authentication 'True
..} =
    AuthenticatorAssertionResponse :: Base64UrlString
-> Base64UrlString
-> Base64UrlString
-> Maybe Base64UrlString
-> AuthenticatorAssertionResponse
AuthenticatorAssertionResponse
      { $sel:clientDataJSON:AuthenticatorAssertionResponse :: Base64UrlString
clientDataJSON = CollectedClientData 'Authentication 'True
-> JSON (CollectedClientData 'Authentication 'True)
forall a. Encode a => a -> JSON a
encode CollectedClientData 'Authentication 'True
araClientData,
        $sel:authenticatorData:AuthenticatorAssertionResponse :: Base64UrlString
authenticatorData = AuthenticatorData 'Authentication 'True
-> JSON (AuthenticatorData 'Authentication 'True)
forall a. Encode a => a -> JSON a
encode AuthenticatorData 'Authentication 'True
araAuthenticatorData,
        $sel:signature:AuthenticatorAssertionResponse :: Base64UrlString
signature = AssertionSignature -> JSON AssertionSignature
forall a. Encode a => a -> JSON a
encode AssertionSignature
araSignature,
        $sel:userHandle:AuthenticatorAssertionResponse :: Maybe Base64UrlString
userHandle = Maybe UserHandle -> JSON (Maybe UserHandle)
forall a. Encode a => a -> JSON a
encode Maybe UserHandle
araUserHandle
      }

instance Decode m (T.AuthenticatorResponse 'K.Authentication 'True) where
  decode :: MonadError Text m =>
JSON (AuthenticatorResponse 'Authentication 'True)
-> m (AuthenticatorResponse 'Authentication 'True)
decode AuthenticatorAssertionResponse {Maybe Base64UrlString
Base64UrlString
userHandle :: Maybe Base64UrlString
signature :: Base64UrlString
authenticatorData :: Base64UrlString
clientDataJSON :: Base64UrlString
$sel:userHandle:AuthenticatorAssertionResponse :: AuthenticatorAssertionResponse -> Maybe Base64UrlString
$sel:signature:AuthenticatorAssertionResponse :: AuthenticatorAssertionResponse -> Base64UrlString
$sel:authenticatorData:AuthenticatorAssertionResponse :: AuthenticatorAssertionResponse -> Base64UrlString
$sel:clientDataJSON:AuthenticatorAssertionResponse :: AuthenticatorAssertionResponse -> Base64UrlString
..} = do
    CollectedClientData 'Authentication 'True
araClientData <- JSON (CollectedClientData 'Authentication 'True)
-> m (CollectedClientData 'Authentication 'True)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Base64UrlString
JSON (CollectedClientData 'Authentication 'True)
clientDataJSON
    AuthenticatorData 'Authentication 'True
araAuthenticatorData <- JSON (AuthenticatorData 'Authentication 'True)
-> m (AuthenticatorData 'Authentication 'True)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Base64UrlString
JSON (AuthenticatorData 'Authentication 'True)
authenticatorData
    AssertionSignature
araSignature <- JSON AssertionSignature -> m AssertionSignature
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Base64UrlString
JSON AssertionSignature
signature
    Maybe UserHandle
araUserHandle <- JSON (Maybe UserHandle) -> m (Maybe UserHandle)
forall (m :: * -> *) a.
(Decode m a, MonadError Text m) =>
JSON a -> m a
decode Maybe Base64UrlString
JSON (Maybe UserHandle)
userHandle
    AuthenticatorResponse 'Authentication 'True
-> m (AuthenticatorResponse 'Authentication 'True)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticatorResponse 'Authentication 'True
 -> m (AuthenticatorResponse 'Authentication 'True))
-> AuthenticatorResponse 'Authentication 'True
-> m (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
T.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
..}