{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | 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 (CustomJSON (CustomJSON), JSONEncoding)
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)
  deriving (Value -> Parser [PublicKeyCredentialCreationOptions]
Value -> Parser PublicKeyCredentialCreationOptions
(Value -> Parser PublicKeyCredentialCreationOptions)
-> (Value -> Parser [PublicKeyCredentialCreationOptions])
-> FromJSON PublicKeyCredentialCreationOptions
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PublicKeyCredentialCreationOptions]
$cparseJSONList :: Value -> Parser [PublicKeyCredentialCreationOptions]
parseJSON :: Value -> Parser PublicKeyCredentialCreationOptions
$cparseJSON :: Value -> Parser PublicKeyCredentialCreationOptions
Aeson.FromJSON, [PublicKeyCredentialCreationOptions] -> Encoding
[PublicKeyCredentialCreationOptions] -> Value
PublicKeyCredentialCreationOptions -> Encoding
PublicKeyCredentialCreationOptions -> Value
(PublicKeyCredentialCreationOptions -> Value)
-> (PublicKeyCredentialCreationOptions -> Encoding)
-> ([PublicKeyCredentialCreationOptions] -> Value)
-> ([PublicKeyCredentialCreationOptions] -> Encoding)
-> ToJSON PublicKeyCredentialCreationOptions
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PublicKeyCredentialCreationOptions] -> Encoding
$ctoEncodingList :: [PublicKeyCredentialCreationOptions] -> Encoding
toJSONList :: [PublicKeyCredentialCreationOptions] -> Value
$ctoJSONList :: [PublicKeyCredentialCreationOptions] -> Value
toEncoding :: PublicKeyCredentialCreationOptions -> Encoding
$ctoEncoding :: PublicKeyCredentialCreationOptions -> Encoding
toJSON :: PublicKeyCredentialCreationOptions -> Value
$ctoJSON :: PublicKeyCredentialCreationOptions -> Value
Aeson.ToJSON) via JSONEncoding PublicKeyCredentialCreationOptions

-- | [(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)
  deriving (Value -> Parser [PublicKeyCredentialRpEntity]
Value -> Parser PublicKeyCredentialRpEntity
(Value -> Parser PublicKeyCredentialRpEntity)
-> (Value -> Parser [PublicKeyCredentialRpEntity])
-> FromJSON PublicKeyCredentialRpEntity
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PublicKeyCredentialRpEntity]
$cparseJSONList :: Value -> Parser [PublicKeyCredentialRpEntity]
parseJSON :: Value -> Parser PublicKeyCredentialRpEntity
$cparseJSON :: Value -> Parser PublicKeyCredentialRpEntity
Aeson.FromJSON, [PublicKeyCredentialRpEntity] -> Encoding
[PublicKeyCredentialRpEntity] -> Value
PublicKeyCredentialRpEntity -> Encoding
PublicKeyCredentialRpEntity -> Value
(PublicKeyCredentialRpEntity -> Value)
-> (PublicKeyCredentialRpEntity -> Encoding)
-> ([PublicKeyCredentialRpEntity] -> Value)
-> ([PublicKeyCredentialRpEntity] -> Encoding)
-> ToJSON PublicKeyCredentialRpEntity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PublicKeyCredentialRpEntity] -> Encoding
$ctoEncodingList :: [PublicKeyCredentialRpEntity] -> Encoding
toJSONList :: [PublicKeyCredentialRpEntity] -> Value
$ctoJSONList :: [PublicKeyCredentialRpEntity] -> Value
toEncoding :: PublicKeyCredentialRpEntity -> Encoding
$ctoEncoding :: PublicKeyCredentialRpEntity -> Encoding
toJSON :: PublicKeyCredentialRpEntity -> Value
$ctoJSON :: PublicKeyCredentialRpEntity -> Value
Aeson.ToJSON) via JSONEncoding PublicKeyCredentialRpEntity

-- | [(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)
  deriving (Value -> Parser [PublicKeyCredentialUserEntity]
Value -> Parser PublicKeyCredentialUserEntity
(Value -> Parser PublicKeyCredentialUserEntity)
-> (Value -> Parser [PublicKeyCredentialUserEntity])
-> FromJSON PublicKeyCredentialUserEntity
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PublicKeyCredentialUserEntity]
$cparseJSONList :: Value -> Parser [PublicKeyCredentialUserEntity]
parseJSON :: Value -> Parser PublicKeyCredentialUserEntity
$cparseJSON :: Value -> Parser PublicKeyCredentialUserEntity
Aeson.FromJSON, [PublicKeyCredentialUserEntity] -> Encoding
[PublicKeyCredentialUserEntity] -> Value
PublicKeyCredentialUserEntity -> Encoding
PublicKeyCredentialUserEntity -> Value
(PublicKeyCredentialUserEntity -> Value)
-> (PublicKeyCredentialUserEntity -> Encoding)
-> ([PublicKeyCredentialUserEntity] -> Value)
-> ([PublicKeyCredentialUserEntity] -> Encoding)
-> ToJSON PublicKeyCredentialUserEntity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PublicKeyCredentialUserEntity] -> Encoding
$ctoEncodingList :: [PublicKeyCredentialUserEntity] -> Encoding
toJSONList :: [PublicKeyCredentialUserEntity] -> Value
$ctoJSONList :: [PublicKeyCredentialUserEntity] -> Value
toEncoding :: PublicKeyCredentialUserEntity -> Encoding
$ctoEncoding :: PublicKeyCredentialUserEntity -> Encoding
toJSON :: PublicKeyCredentialUserEntity -> Value
$ctoJSON :: PublicKeyCredentialUserEntity -> Value
Aeson.ToJSON) via JSONEncoding PublicKeyCredentialUserEntity

-- | [(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)
  deriving (Value -> Parser [PublicKeyCredentialParameters]
Value -> Parser PublicKeyCredentialParameters
(Value -> Parser PublicKeyCredentialParameters)
-> (Value -> Parser [PublicKeyCredentialParameters])
-> FromJSON PublicKeyCredentialParameters
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PublicKeyCredentialParameters]
$cparseJSONList :: Value -> Parser [PublicKeyCredentialParameters]
parseJSON :: Value -> Parser PublicKeyCredentialParameters
$cparseJSON :: Value -> Parser PublicKeyCredentialParameters
Aeson.FromJSON, [PublicKeyCredentialParameters] -> Encoding
[PublicKeyCredentialParameters] -> Value
PublicKeyCredentialParameters -> Encoding
PublicKeyCredentialParameters -> Value
(PublicKeyCredentialParameters -> Value)
-> (PublicKeyCredentialParameters -> Encoding)
-> ([PublicKeyCredentialParameters] -> Value)
-> ([PublicKeyCredentialParameters] -> Encoding)
-> ToJSON PublicKeyCredentialParameters
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PublicKeyCredentialParameters] -> Encoding
$ctoEncodingList :: [PublicKeyCredentialParameters] -> Encoding
toJSONList :: [PublicKeyCredentialParameters] -> Value
$ctoJSONList :: [PublicKeyCredentialParameters] -> Value
toEncoding :: PublicKeyCredentialParameters -> Encoding
$ctoEncoding :: PublicKeyCredentialParameters -> Encoding
toJSON :: PublicKeyCredentialParameters -> Value
$ctoJSON :: PublicKeyCredentialParameters -> Value
Aeson.ToJSON) via JSONEncoding PublicKeyCredentialParameters

-- | [(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)
  deriving (Value -> Parser [PublicKeyCredentialDescriptor]
Value -> Parser PublicKeyCredentialDescriptor
(Value -> Parser PublicKeyCredentialDescriptor)
-> (Value -> Parser [PublicKeyCredentialDescriptor])
-> FromJSON PublicKeyCredentialDescriptor
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PublicKeyCredentialDescriptor]
$cparseJSONList :: Value -> Parser [PublicKeyCredentialDescriptor]
parseJSON :: Value -> Parser PublicKeyCredentialDescriptor
$cparseJSON :: Value -> Parser PublicKeyCredentialDescriptor
Aeson.FromJSON, [PublicKeyCredentialDescriptor] -> Encoding
[PublicKeyCredentialDescriptor] -> Value
PublicKeyCredentialDescriptor -> Encoding
PublicKeyCredentialDescriptor -> Value
(PublicKeyCredentialDescriptor -> Value)
-> (PublicKeyCredentialDescriptor -> Encoding)
-> ([PublicKeyCredentialDescriptor] -> Value)
-> ([PublicKeyCredentialDescriptor] -> Encoding)
-> ToJSON PublicKeyCredentialDescriptor
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PublicKeyCredentialDescriptor] -> Encoding
$ctoEncodingList :: [PublicKeyCredentialDescriptor] -> Encoding
toJSONList :: [PublicKeyCredentialDescriptor] -> Value
$ctoJSONList :: [PublicKeyCredentialDescriptor] -> Value
toEncoding :: PublicKeyCredentialDescriptor -> Encoding
$ctoEncoding :: PublicKeyCredentialDescriptor -> Encoding
toJSON :: PublicKeyCredentialDescriptor -> Value
$ctoJSON :: PublicKeyCredentialDescriptor -> Value
Aeson.ToJSON) via JSONEncoding PublicKeyCredentialDescriptor

-- | [(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)
  deriving (Value -> Parser [AuthenticatorSelectionCriteria]
Value -> Parser AuthenticatorSelectionCriteria
(Value -> Parser AuthenticatorSelectionCriteria)
-> (Value -> Parser [AuthenticatorSelectionCriteria])
-> FromJSON AuthenticatorSelectionCriteria
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AuthenticatorSelectionCriteria]
$cparseJSONList :: Value -> Parser [AuthenticatorSelectionCriteria]
parseJSON :: Value -> Parser AuthenticatorSelectionCriteria
$cparseJSON :: Value -> Parser AuthenticatorSelectionCriteria
Aeson.FromJSON, [AuthenticatorSelectionCriteria] -> Encoding
[AuthenticatorSelectionCriteria] -> Value
AuthenticatorSelectionCriteria -> Encoding
AuthenticatorSelectionCriteria -> Value
(AuthenticatorSelectionCriteria -> Value)
-> (AuthenticatorSelectionCriteria -> Encoding)
-> ([AuthenticatorSelectionCriteria] -> Value)
-> ([AuthenticatorSelectionCriteria] -> Encoding)
-> ToJSON AuthenticatorSelectionCriteria
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AuthenticatorSelectionCriteria] -> Encoding
$ctoEncodingList :: [AuthenticatorSelectionCriteria] -> Encoding
toJSONList :: [AuthenticatorSelectionCriteria] -> Value
$ctoJSONList :: [AuthenticatorSelectionCriteria] -> Value
toEncoding :: AuthenticatorSelectionCriteria -> Encoding
$ctoEncoding :: AuthenticatorSelectionCriteria -> Encoding
toJSON :: AuthenticatorSelectionCriteria -> Value
$ctoJSON :: AuthenticatorSelectionCriteria -> Value
Aeson.ToJSON) via JSONEncoding AuthenticatorSelectionCriteria

-- | [(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)
  deriving (Value -> Parser [PublicKeyCredentialRequestOptions]
Value -> Parser PublicKeyCredentialRequestOptions
(Value -> Parser PublicKeyCredentialRequestOptions)
-> (Value -> Parser [PublicKeyCredentialRequestOptions])
-> FromJSON PublicKeyCredentialRequestOptions
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PublicKeyCredentialRequestOptions]
$cparseJSONList :: Value -> Parser [PublicKeyCredentialRequestOptions]
parseJSON :: Value -> Parser PublicKeyCredentialRequestOptions
$cparseJSON :: Value -> Parser PublicKeyCredentialRequestOptions
Aeson.FromJSON, [PublicKeyCredentialRequestOptions] -> Encoding
[PublicKeyCredentialRequestOptions] -> Value
PublicKeyCredentialRequestOptions -> Encoding
PublicKeyCredentialRequestOptions -> Value
(PublicKeyCredentialRequestOptions -> Value)
-> (PublicKeyCredentialRequestOptions -> Encoding)
-> ([PublicKeyCredentialRequestOptions] -> Value)
-> ([PublicKeyCredentialRequestOptions] -> Encoding)
-> ToJSON PublicKeyCredentialRequestOptions
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PublicKeyCredentialRequestOptions] -> Encoding
$ctoEncodingList :: [PublicKeyCredentialRequestOptions] -> Encoding
toJSONList :: [PublicKeyCredentialRequestOptions] -> Value
$ctoJSONList :: [PublicKeyCredentialRequestOptions] -> Value
toEncoding :: PublicKeyCredentialRequestOptions -> Encoding
$ctoEncoding :: PublicKeyCredentialRequestOptions -> Encoding
toJSON :: PublicKeyCredentialRequestOptions -> Value
$ctoJSON :: PublicKeyCredentialRequestOptions -> Value
Aeson.ToJSON) via JSONEncoding PublicKeyCredentialRequestOptions

-- | [(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)

deriving via
  JSONEncoding (PublicKeyCredential response)
  instance
    Aeson.FromJSON response =>
    Aeson.FromJSON (PublicKeyCredential response)

deriving via
  JSONEncoding (PublicKeyCredential response)
  instance
    Aeson.ToJSON response =>
    Aeson.ToJSON (PublicKeyCredential response)

-- | [(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
  }
  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)
  deriving (Value -> Parser [AuthenticatorAttestationResponse]
Value -> Parser AuthenticatorAttestationResponse
(Value -> Parser AuthenticatorAttestationResponse)
-> (Value -> Parser [AuthenticatorAttestationResponse])
-> FromJSON AuthenticatorAttestationResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AuthenticatorAttestationResponse]
$cparseJSONList :: Value -> Parser [AuthenticatorAttestationResponse]
parseJSON :: Value -> Parser AuthenticatorAttestationResponse
$cparseJSON :: Value -> Parser AuthenticatorAttestationResponse
Aeson.FromJSON, [AuthenticatorAttestationResponse] -> Encoding
[AuthenticatorAttestationResponse] -> Value
AuthenticatorAttestationResponse -> Encoding
AuthenticatorAttestationResponse -> Value
(AuthenticatorAttestationResponse -> Value)
-> (AuthenticatorAttestationResponse -> Encoding)
-> ([AuthenticatorAttestationResponse] -> Value)
-> ([AuthenticatorAttestationResponse] -> Encoding)
-> ToJSON AuthenticatorAttestationResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AuthenticatorAttestationResponse] -> Encoding
$ctoEncodingList :: [AuthenticatorAttestationResponse] -> Encoding
toJSONList :: [AuthenticatorAttestationResponse] -> Value
$ctoJSONList :: [AuthenticatorAttestationResponse] -> Value
toEncoding :: AuthenticatorAttestationResponse -> Encoding
$ctoEncoding :: AuthenticatorAttestationResponse -> Encoding
toJSON :: AuthenticatorAttestationResponse -> Value
$ctoJSON :: AuthenticatorAttestationResponse -> Value
Aeson.ToJSON) via JSONEncoding AuthenticatorAttestationResponse

-- | [(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)
  deriving (Value -> Parser [AuthenticatorAssertionResponse]
Value -> Parser AuthenticatorAssertionResponse
(Value -> Parser AuthenticatorAssertionResponse)
-> (Value -> Parser [AuthenticatorAssertionResponse])
-> FromJSON AuthenticatorAssertionResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AuthenticatorAssertionResponse]
$cparseJSONList :: Value -> Parser [AuthenticatorAssertionResponse]
parseJSON :: Value -> Parser AuthenticatorAssertionResponse
$cparseJSON :: Value -> Parser AuthenticatorAssertionResponse
Aeson.FromJSON, [AuthenticatorAssertionResponse] -> Encoding
[AuthenticatorAssertionResponse] -> Value
AuthenticatorAssertionResponse -> Encoding
AuthenticatorAssertionResponse -> Value
(AuthenticatorAssertionResponse -> Value)
-> (AuthenticatorAssertionResponse -> Encoding)
-> ([AuthenticatorAssertionResponse] -> Value)
-> ([AuthenticatorAssertionResponse] -> Encoding)
-> ToJSON AuthenticatorAssertionResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AuthenticatorAssertionResponse] -> Encoding
$ctoEncodingList :: [AuthenticatorAssertionResponse] -> Encoding
toJSONList :: [AuthenticatorAssertionResponse] -> Value
$ctoJSONList :: [AuthenticatorAssertionResponse] -> Value
toEncoding :: AuthenticatorAssertionResponse -> Encoding
$ctoEncoding :: AuthenticatorAssertionResponse -> Encoding
toJSON :: AuthenticatorAssertionResponse -> Value
$ctoJSON :: AuthenticatorAssertionResponse -> Value
Aeson.ToJSON) via JSONEncoding AuthenticatorAssertionResponse