{-# LANGUAGE DuplicateRecordFields #-}

-- | Stability: experimental
-- This module models direct representations of JavaScript objects interacting with the
-- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)
-- and [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) methods, as used by [Webauthn2](https://www.w3.org/TR/webauthn-2).
-- Note that these types don't encode the semantics of their values. E.g. if the JavaScript object has a @DOMString@
-- field, but only values @"foo"@ and @"bar"@ are possible, the type is still encoded as a generic 'IDL.DOMString'.
-- This allows us to match the specification very closely, deferring decoding of these values to another module.
-- This module also implements 'Aeson.FromJSON' and 'Aeson.ToJSON' instances of its types, which are compatible with
-- [webauthn-json](https://github.com/github/webauthn-json)'s JSON schema.
--
-- The defined types are
--
-- - 'PublicKeyCredentialCreationOptions' and all its subtypes. Passed as the
--   [publicKey](https://www.w3.org/TR/webauthn-2/#dom-credentialcreationoptions-publickey) field to the
--   [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) method
--   in step 2 of [§ 7.1 Registering a New Credential](https://www.w3.org/TR/webauthn-2/#sctn-registering-a-new-credential)
-- - 'PublicKeyCredentialRequestOptions' and all its subtypes. Passed as the
--   [publicKey](https://www.w3.org/TR/webauthn-2/#dom-credentialrequestoptions-publickey) field to the
--   [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) method
--   in step 2 of [§ 7.2 Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion)
-- - @'PublicKeyCredential' response@ and all its subtypes. Responses of the
--   [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) (in which case @response ~ 'AuthenticatorAttestationResponse'@) and
--   [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) (in which case @response ~ 'AuthenticatorAssertionResponse'@ methods.
module Crypto.WebAuthn.Model.WebIDL.Types
  ( -- * Top-level types
    PublicKeyCredentialCreationOptions (..),
    PublicKeyCredentialRequestOptions (..),
    PublicKeyCredential (..),

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

import Crypto.WebAuthn.Internal.Utils (jsonEncodingOptions)
import qualified Crypto.WebAuthn.WebIDL as IDL
import qualified Data.Aeson as Aeson
import Data.Map (Map)
import Data.Text (Text)
import GHC.Generics (Generic)

-- | [(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 -> BufferSource
challenge :: IDL.BufferSource,
    -- | [(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 UnsignedLong
timeout :: Maybe IDL.UnsignedLong,
    -- | [(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 DOMString
attestation :: Maybe IDL.DOMString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-extensions)
    PublicKeyCredentialCreationOptions -> Maybe (Map DOMString 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

-- | [(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 DOMString
id :: Maybe IDL.DOMString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)
    PublicKeyCredentialRpEntity -> DOMString
name :: IDL.DOMString
  }
  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

-- | [(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 -> BufferSource
id :: IDL.BufferSource,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-displayname)
    PublicKeyCredentialUserEntity -> DOMString
displayName :: IDL.DOMString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)
    PublicKeyCredentialUserEntity -> DOMString
name :: IDL.DOMString
  }
  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

-- | [(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 -> DOMString
littype :: IDL.DOMString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialparameters-alg)
    PublicKeyCredentialParameters -> COSEAlgorithmIdentifier
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

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

-- | [(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 -> DOMString
littype :: IDL.DOMString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-id)
    PublicKeyCredentialDescriptor -> BufferSource
id :: IDL.BufferSource,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-transports)
    PublicKeyCredentialDescriptor -> Maybe [DOMString]
transports :: Maybe [IDL.DOMString]
  }
  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

-- | [(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 DOMString
authenticatorAttachment :: Maybe IDL.DOMString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-residentkey)
    AuthenticatorSelectionCriteria -> Maybe DOMString
residentKey :: Maybe IDL.DOMString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-requireresidentkey)
    AuthenticatorSelectionCriteria -> Maybe Bool
requireResidentKey :: Maybe IDL.Boolean,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-userverification)
    AuthenticatorSelectionCriteria -> Maybe DOMString
userVerification :: Maybe IDL.DOMString
  }
  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

-- | [(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 -> BufferSource
challenge :: IDL.BufferSource,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-timeout)
    PublicKeyCredentialRequestOptions -> Maybe UnsignedLong
timeout :: Maybe IDL.UnsignedLong,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-rpid)
    PublicKeyCredentialRequestOptions -> Maybe DOMString
rpId :: Maybe IDL.USVString,
    -- | [(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 DOMString
userVerification :: Maybe IDL.DOMString,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-extensions)
    PublicKeyCredentialRequestOptions -> Maybe (Map DOMString 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

-- | [(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)
    PublicKeyCredential response -> BufferSource
rawId :: IDL.ArrayBuffer,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-response)
    PublicKeyCredential response -> response
response :: response,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-getclientextensionresults)
    PublicKeyCredential response -> Map DOMString 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

-- | [(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 -> BufferSource
clientDataJSON :: IDL.ArrayBuffer,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-attestationobject)
    AuthenticatorAttestationResponse -> BufferSource
attestationObject :: IDL.ArrayBuffer,
    -- | [(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 [DOMString]
transports :: Maybe [IDL.DOMString]
  }
  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

-- | [(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 -> BufferSource
clientDataJSON :: IDL.ArrayBuffer,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-authenticatordata)
    AuthenticatorAssertionResponse -> BufferSource
authenticatorData :: IDL.ArrayBuffer,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-signature)
    AuthenticatorAssertionResponse -> BufferSource
signature :: IDL.ArrayBuffer,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-userhandle)
    AuthenticatorAssertionResponse -> Maybe BufferSource
userHandle :: Maybe IDL.ArrayBuffer
  }
  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