{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

-- | Stability: experimental
--
-- This module contains Haskell-friendly types for structures used in WebAuthn
-- that are used throughout this library. These types are modelled according to
-- the following conventions:
--
-- * If a structure has the same semantics for both the
--   [registration](https://www.w3.org/TR/webauthn-2/#registration) and
--   [authentication](https://www.w3.org/TR/webauthn-2/#authentication) WebAuthn
--   [ceremonies](https://www.w3.org/TR/webauthn-2/#ceremony), then its type is
--   parametrized by a @c@ parameter of kind 'CeremonyKind'. If such types have
--   differing fields,
--   [GADTs](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/gadt.html)
--   are used to distinguish between them, where the constructor name is the
--   type name with a @...Registration@ or @...Authentication@ suffix
-- * If the raw bytes are needed for verification purposes of a structure, then
--   its type is parametrized by a @raw@ parameter of kind 'Bool'. Only if @raw
--   ~ 'True'@, the raw bytes of the necessary structures has to be present in
--   the type. The type 'RawField' is used as a helper type for this.
-- * In order to avoid duplicate record fields, all fields are prefixed with
--   the initials of the constructor name.
-- * Every type should have a 'ToJSON' instance for pretty-printing purposes.
--   This JSON encoding doesn't correspond to any encoding used for
--   sending/receiving these structures, it's only used for pretty-printing,
--   which is why it doesn't need to be standardized. For encoding these
--   structures from/to JSON for sending/receiving, see the
--   'Crypto.WebAuthn.Model.WebIDL' module
-- #defaultFields#
-- * Fields of the WebAuthn standard that are optional (for writing) but have
--   defaults (making them non-optional for reading) are encoded as
--   non-optional fields, while the defaults are exposed in the
--   'Crypto.WebAuthn.Model.Defaults' module. The alternative of making these
--   fields optional would allow RP not having to specify them, which seems
--   like a less safer option, since the defaults might not be what is really
--   needed, and they might change. The root cause why this decision had to be
--   made is that such assymetrical reading/writing fields don't map nicely to
--   Haskell's records.
--
-- #extensions#
-- TODO:
-- [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-extensions) This library
-- does not currently implement extensions. In order to fully comply with level
-- 2 of the webauthn spec extensions are required. At least, we wish the
-- library to offer a typeclass implementable by relying parties to allow
-- extensions in a scheme similar to the attestation statement formats.
-- Ideally, we would implement all 8 extensions tracked by
-- [IANA](https://www.iana.org/assignments/webauthn/webauthn.xhtml#webauthn-extension-ids).
module Crypto.WebAuthn.Model.Types
  ( -- * Enumerations
    CredentialType (..),
    AuthenticatorTransport (..),
    AuthenticatorAttachment (..),
    ResidentKeyRequirement (..),
    UserVerificationRequirement (..),
    AttestationConveyancePreference (..),
    AttestationChain (..),
    AttestationKind (..),
    AttestationType (..),
    VerifiableAttestationType (..),

    -- * Newtypes
    RpId (..),
    RelyingPartyName (..),
    UserHandle (..),
    generateUserHandle,
    UserAccountDisplayName (..),
    UserAccountName (..),
    CredentialId (..),
    generateCredentialId,
    Challenge (..),
    generateChallenge,
    Timeout (..),
    AssertionSignature (..),
    RpIdHash (..),
    ClientDataHash (..),
    Origin (..),
    SignatureCounter (..),
    PublicKeyBytes (..),

    -- * Extensions (unimplemented, see module documentation)
    AuthenticationExtensionsClientInputs (..),
    AuthenticationExtensionsClientOutputs (..),
    AuthenticatorExtensionOutputs (..),

    -- * Dictionaries
    CredentialRpEntity (..),
    CredentialUserEntity (..),
    CredentialParameters (..),
    CredentialDescriptor (..),
    AuthenticatorSelectionCriteria (..),
    AuthenticatorDataFlags (..),
    CollectedClientData (..),
    AttestedCredentialData (..),
    AuthenticatorData (..),
    AttestationObject (..),
    AuthenticatorResponse (..),

    -- * Attestation Statement Formats
    SomeAttestationType (..),
    AttestationStatementFormat (..),
    SomeAttestationStatementFormat (..),
    SupportedAttestationStatementFormats,
    singletonAttestationStatementFormat,
    lookupAttestationStatementFormat,

    -- * Raw fields
    RawField (..),

    -- * Top-level types
    CredentialOptions (..),
    Credential (..),
  )
where

import qualified Codec.CBOR.Term as CBOR
import Control.Exception (Exception)
import Crypto.Hash (Digest)
import Crypto.Hash.Algorithms (SHA256)
import Crypto.Random (MonadRandom, getRandomBytes)
import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose
import qualified Crypto.WebAuthn.Cose.SignAlg as Cose
import Crypto.WebAuthn.Internal.ToJSONOrphans ()
import Crypto.WebAuthn.Model.Identifier (AAGUID)
import Crypto.WebAuthn.Model.Kinds
  ( AttestationKind (Unverifiable, Verifiable),
    CeremonyKind (Authentication, Registration),
    ProtocolKind (Fido2, FidoU2F),
  )
import Data.Aeson (ToJSON, Value (Null, String), object, (.=))
import Data.Aeson.Types (toJSON)
import qualified Data.ByteString as BS
import Data.HashMap.Strict (HashMap, (!?))
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Hourglass as HG
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import Data.Singletons (SingI, sing)
import Data.String (IsString)
import Data.Text (Text)
import Data.Validation (Validation)
import Data.Word (Word32)
import qualified Data.X509 as X509
import qualified Data.X509.CertificateStore as X509
import GHC.Generics (Generic)
import Type.Reflection (Typeable, eqTypeRep, typeOf, type (:~~:) (HRefl))

-- | A model field parametrized by whether it's empty ('False') or contains raw bytes ('True')
data RawField (raw :: Bool) where
  NoRaw :: RawField 'False
  WithRaw :: {RawField 'True -> ByteString
unRaw :: BS.ByteString} -> RawField 'True

deriving instance Eq (RawField raw)

deriving instance Show (RawField raw)

instance ToJSON (RawField raw) where
  toJSON :: RawField raw -> Value
toJSON RawField raw
NoRaw = Value
"<none>"
  toJSON (WithRaw ByteString
bytes) = ByteString -> Value
forall a. ToJSON a => a -> Value
toJSON ByteString
bytes

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-publickeycredentialtype)
-- This enumeration defines the valid credential types. It is an extension point;
-- values can be added to it in the future, as more credential types are defined.
-- The values of this enumeration are used for versioning the Authentication Assertion
-- and attestation structures according to the type of the authenticator.
--
-- To decode\/encode this type from\/to its standard string, use
-- 'Crypto.WebAuthn.Encoding.Strings.decodeCredentialType'/'Crypto.WebAuthn.Encoding.Strings.encodeCredentialType'.
data CredentialType = CredentialTypePublicKey
  deriving (CredentialType -> CredentialType -> Bool
(CredentialType -> CredentialType -> Bool)
-> (CredentialType -> CredentialType -> Bool) -> Eq CredentialType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialType -> CredentialType -> Bool
$c/= :: CredentialType -> CredentialType -> Bool
== :: CredentialType -> CredentialType -> Bool
$c== :: CredentialType -> CredentialType -> Bool
Eq, Int -> CredentialType -> ShowS
[CredentialType] -> ShowS
CredentialType -> String
(Int -> CredentialType -> ShowS)
-> (CredentialType -> String)
-> ([CredentialType] -> ShowS)
-> Show CredentialType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CredentialType] -> ShowS
$cshowList :: [CredentialType] -> ShowS
show :: CredentialType -> String
$cshow :: CredentialType -> String
showsPrec :: Int -> CredentialType -> ShowS
$cshowsPrec :: Int -> CredentialType -> ShowS
Show, CredentialType
CredentialType -> CredentialType -> Bounded CredentialType
forall a. a -> a -> Bounded a
maxBound :: CredentialType
$cmaxBound :: CredentialType
minBound :: CredentialType
$cminBound :: CredentialType
Bounded, Int -> CredentialType
CredentialType -> Int
CredentialType -> [CredentialType]
CredentialType -> CredentialType
CredentialType -> CredentialType -> [CredentialType]
CredentialType
-> CredentialType -> CredentialType -> [CredentialType]
(CredentialType -> CredentialType)
-> (CredentialType -> CredentialType)
-> (Int -> CredentialType)
-> (CredentialType -> Int)
-> (CredentialType -> [CredentialType])
-> (CredentialType -> CredentialType -> [CredentialType])
-> (CredentialType -> CredentialType -> [CredentialType])
-> (CredentialType
    -> CredentialType -> CredentialType -> [CredentialType])
-> Enum CredentialType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CredentialType
-> CredentialType -> CredentialType -> [CredentialType]
$cenumFromThenTo :: CredentialType
-> CredentialType -> CredentialType -> [CredentialType]
enumFromTo :: CredentialType -> CredentialType -> [CredentialType]
$cenumFromTo :: CredentialType -> CredentialType -> [CredentialType]
enumFromThen :: CredentialType -> CredentialType -> [CredentialType]
$cenumFromThen :: CredentialType -> CredentialType -> [CredentialType]
enumFrom :: CredentialType -> [CredentialType]
$cenumFrom :: CredentialType -> [CredentialType]
fromEnum :: CredentialType -> Int
$cfromEnum :: CredentialType -> Int
toEnum :: Int -> CredentialType
$ctoEnum :: Int -> CredentialType
pred :: CredentialType -> CredentialType
$cpred :: CredentialType -> CredentialType
succ :: CredentialType -> CredentialType
$csucc :: CredentialType -> CredentialType
Enum, Eq CredentialType
Eq CredentialType
-> (CredentialType -> CredentialType -> Ordering)
-> (CredentialType -> CredentialType -> Bool)
-> (CredentialType -> CredentialType -> Bool)
-> (CredentialType -> CredentialType -> Bool)
-> (CredentialType -> CredentialType -> Bool)
-> (CredentialType -> CredentialType -> CredentialType)
-> (CredentialType -> CredentialType -> CredentialType)
-> Ord CredentialType
CredentialType -> CredentialType -> Bool
CredentialType -> CredentialType -> Ordering
CredentialType -> CredentialType -> CredentialType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CredentialType -> CredentialType -> CredentialType
$cmin :: CredentialType -> CredentialType -> CredentialType
max :: CredentialType -> CredentialType -> CredentialType
$cmax :: CredentialType -> CredentialType -> CredentialType
>= :: CredentialType -> CredentialType -> Bool
$c>= :: CredentialType -> CredentialType -> Bool
> :: CredentialType -> CredentialType -> Bool
$c> :: CredentialType -> CredentialType -> Bool
<= :: CredentialType -> CredentialType -> Bool
$c<= :: CredentialType -> CredentialType -> Bool
< :: CredentialType -> CredentialType -> Bool
$c< :: CredentialType -> CredentialType -> Bool
compare :: CredentialType -> CredentialType -> Ordering
$ccompare :: CredentialType -> CredentialType -> Ordering
Ord, (forall x. CredentialType -> Rep CredentialType x)
-> (forall x. Rep CredentialType x -> CredentialType)
-> Generic CredentialType
forall x. Rep CredentialType x -> CredentialType
forall x. CredentialType -> Rep CredentialType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CredentialType x -> CredentialType
$cfrom :: forall x. CredentialType -> Rep CredentialType x
Generic)

instance ToJSON CredentialType where
  toJSON :: CredentialType -> Value
toJSON CredentialType
CredentialTypePublicKey = Value
"CredentialTypePublicKey"

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-transport)
-- [Authenticators](https://www.w3.org/TR/webauthn-2/#authenticator) may implement
-- various [transports](https://www.w3.org/TR/webauthn-2/#enum-transport) for communicating
-- with [clients](https://www.w3.org/TR/webauthn-2/#client). This enumeration defines
-- hints as to how clients might communicate with a particular authenticator in order
-- to obtain an assertion for a specific credential. Note that these hints represent
-- the [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)'s
-- best belief as to how an authenticator may be reached. A [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
-- will typically learn of the supported transports for a [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)
-- via [getTransports()](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-gettransports).
--
-- To decode\/encode this type from\/to its standard string, use
-- 'Crypto.WebAuthn.Encoding.Strings.decodeAuthenticatorTransport'/'Crypto.WebAuthn.Encoding.Strings.encodeAuthenticatorTransport'.
data AuthenticatorTransport
  = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatortransport-usb)
    -- Indicates the respective [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)
    -- can be contacted over removable USB.
    AuthenticatorTransportUSB
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatortransport-nfc)
    -- Indicates the respective [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)
    -- can be contacted over Near Field Communication (NFC).
    AuthenticatorTransportNFC
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatortransport-ble)
    -- Indicates the respective [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)
    -- can be contacted over Bluetooth Smart (Bluetooth Low Energy / BLE).
    AuthenticatorTransportBLE
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatortransport-internal)
    -- Indicates the respective [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)
    -- is contacted using a [client device](https://www.w3.org/TR/webauthn-2/#client-device)-specific
    -- transport, i.e., it is a [platform authenticator](https://www.w3.org/TR/webauthn-2/#platform-authenticators).
    -- These authenticators are not removable from the [client device](https://www.w3.org/TR/webauthn-2/#client-device).
    AuthenticatorTransportInternal
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-transports)
    -- An unknown authenticator transport. Note that according to the current
    -- version 2 of the WebAuthn standard, unknown fields [must be
    -- ignored](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-transports-slot),
    -- which is a bit misleading because such unknown values still need to be
    -- stored. Draft version 3 of the standard [fixes
    -- this](https://github.com/w3c/webauthn/pull/1654).
    AuthenticatorTransportUnknown Text
  deriving (AuthenticatorTransport -> AuthenticatorTransport -> Bool
(AuthenticatorTransport -> AuthenticatorTransport -> Bool)
-> (AuthenticatorTransport -> AuthenticatorTransport -> Bool)
-> Eq AuthenticatorTransport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
$c/= :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
== :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
$c== :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
Eq, Int -> AuthenticatorTransport -> ShowS
[AuthenticatorTransport] -> ShowS
AuthenticatorTransport -> String
(Int -> AuthenticatorTransport -> ShowS)
-> (AuthenticatorTransport -> String)
-> ([AuthenticatorTransport] -> ShowS)
-> Show AuthenticatorTransport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatorTransport] -> ShowS
$cshowList :: [AuthenticatorTransport] -> ShowS
show :: AuthenticatorTransport -> String
$cshow :: AuthenticatorTransport -> String
showsPrec :: Int -> AuthenticatorTransport -> ShowS
$cshowsPrec :: Int -> AuthenticatorTransport -> ShowS
Show, Eq AuthenticatorTransport
Eq AuthenticatorTransport
-> (AuthenticatorTransport -> AuthenticatorTransport -> Ordering)
-> (AuthenticatorTransport -> AuthenticatorTransport -> Bool)
-> (AuthenticatorTransport -> AuthenticatorTransport -> Bool)
-> (AuthenticatorTransport -> AuthenticatorTransport -> Bool)
-> (AuthenticatorTransport -> AuthenticatorTransport -> Bool)
-> (AuthenticatorTransport
    -> AuthenticatorTransport -> AuthenticatorTransport)
-> (AuthenticatorTransport
    -> AuthenticatorTransport -> AuthenticatorTransport)
-> Ord AuthenticatorTransport
AuthenticatorTransport -> AuthenticatorTransport -> Bool
AuthenticatorTransport -> AuthenticatorTransport -> Ordering
AuthenticatorTransport
-> AuthenticatorTransport -> AuthenticatorTransport
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AuthenticatorTransport
-> AuthenticatorTransport -> AuthenticatorTransport
$cmin :: AuthenticatorTransport
-> AuthenticatorTransport -> AuthenticatorTransport
max :: AuthenticatorTransport
-> AuthenticatorTransport -> AuthenticatorTransport
$cmax :: AuthenticatorTransport
-> AuthenticatorTransport -> AuthenticatorTransport
>= :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
$c>= :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
> :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
$c> :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
<= :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
$c<= :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
< :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
$c< :: AuthenticatorTransport -> AuthenticatorTransport -> Bool
compare :: AuthenticatorTransport -> AuthenticatorTransport -> Ordering
$ccompare :: AuthenticatorTransport -> AuthenticatorTransport -> Ordering
Ord, (forall x. AuthenticatorTransport -> Rep AuthenticatorTransport x)
-> (forall x.
    Rep AuthenticatorTransport x -> AuthenticatorTransport)
-> Generic AuthenticatorTransport
forall x. Rep AuthenticatorTransport x -> AuthenticatorTransport
forall x. AuthenticatorTransport -> Rep AuthenticatorTransport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthenticatorTransport x -> AuthenticatorTransport
$cfrom :: forall x. AuthenticatorTransport -> Rep AuthenticatorTransport x
Generic, [AuthenticatorTransport] -> Encoding
[AuthenticatorTransport] -> Value
AuthenticatorTransport -> Encoding
AuthenticatorTransport -> Value
(AuthenticatorTransport -> Value)
-> (AuthenticatorTransport -> Encoding)
-> ([AuthenticatorTransport] -> Value)
-> ([AuthenticatorTransport] -> Encoding)
-> ToJSON AuthenticatorTransport
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AuthenticatorTransport] -> Encoding
$ctoEncodingList :: [AuthenticatorTransport] -> Encoding
toJSONList :: [AuthenticatorTransport] -> Value
$ctoJSONList :: [AuthenticatorTransport] -> Value
toEncoding :: AuthenticatorTransport -> Encoding
$ctoEncoding :: AuthenticatorTransport -> Encoding
toJSON :: AuthenticatorTransport -> Value
$ctoJSON :: AuthenticatorTransport -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-authenticatorattachment)
-- This enumeration’s values describe [authenticators](https://www.w3.org/TR/webauthn-2/#authenticator)'
-- [attachment modalities](https://www.w3.org/TR/webauthn-2/#authenticator-attachment-modality).
-- [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) use this to
-- express a preferred [authenticator attachment modality](https://www.w3.org/TR/webauthn-2/#authenticator-attachment-modality)
-- when calling [@navigator.credentials.create()@](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)
-- to [create a credential](https://www.w3.org/TR/webauthn-2/#sctn-createCredential).
--
-- To decode\/encode this type from\/to its standard string, use
-- 'Crypto.WebAuthn.Encoding.Strings.decodeAuthenticatorAttachment'/'Crypto.WebAuthn.Encoding.Strings.encodeAuthenticatorAttachment'.
data AuthenticatorAttachment
  = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattachment-platform)
    -- This value indicates [platform attachment](https://www.w3.org/TR/webauthn-2/#platform-attachment).
    AuthenticatorAttachmentPlatform
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattachment-cross-platform)
    -- This value indicates [cross-platform attachment](https://www.w3.org/TR/webauthn-2/#cross-platform-attachment).
    AuthenticatorAttachmentCrossPlatform
  deriving (AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
(AuthenticatorAttachment -> AuthenticatorAttachment -> Bool)
-> (AuthenticatorAttachment -> AuthenticatorAttachment -> Bool)
-> Eq AuthenticatorAttachment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
$c/= :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
== :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
$c== :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
Eq, Int -> AuthenticatorAttachment -> ShowS
[AuthenticatorAttachment] -> ShowS
AuthenticatorAttachment -> String
(Int -> AuthenticatorAttachment -> ShowS)
-> (AuthenticatorAttachment -> String)
-> ([AuthenticatorAttachment] -> ShowS)
-> Show AuthenticatorAttachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatorAttachment] -> ShowS
$cshowList :: [AuthenticatorAttachment] -> ShowS
show :: AuthenticatorAttachment -> String
$cshow :: AuthenticatorAttachment -> String
showsPrec :: Int -> AuthenticatorAttachment -> ShowS
$cshowsPrec :: Int -> AuthenticatorAttachment -> ShowS
Show, AuthenticatorAttachment
AuthenticatorAttachment
-> AuthenticatorAttachment -> Bounded AuthenticatorAttachment
forall a. a -> a -> Bounded a
maxBound :: AuthenticatorAttachment
$cmaxBound :: AuthenticatorAttachment
minBound :: AuthenticatorAttachment
$cminBound :: AuthenticatorAttachment
Bounded, Int -> AuthenticatorAttachment
AuthenticatorAttachment -> Int
AuthenticatorAttachment -> [AuthenticatorAttachment]
AuthenticatorAttachment -> AuthenticatorAttachment
AuthenticatorAttachment
-> AuthenticatorAttachment -> [AuthenticatorAttachment]
AuthenticatorAttachment
-> AuthenticatorAttachment
-> AuthenticatorAttachment
-> [AuthenticatorAttachment]
(AuthenticatorAttachment -> AuthenticatorAttachment)
-> (AuthenticatorAttachment -> AuthenticatorAttachment)
-> (Int -> AuthenticatorAttachment)
-> (AuthenticatorAttachment -> Int)
-> (AuthenticatorAttachment -> [AuthenticatorAttachment])
-> (AuthenticatorAttachment
    -> AuthenticatorAttachment -> [AuthenticatorAttachment])
-> (AuthenticatorAttachment
    -> AuthenticatorAttachment -> [AuthenticatorAttachment])
-> (AuthenticatorAttachment
    -> AuthenticatorAttachment
    -> AuthenticatorAttachment
    -> [AuthenticatorAttachment])
-> Enum AuthenticatorAttachment
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AuthenticatorAttachment
-> AuthenticatorAttachment
-> AuthenticatorAttachment
-> [AuthenticatorAttachment]
$cenumFromThenTo :: AuthenticatorAttachment
-> AuthenticatorAttachment
-> AuthenticatorAttachment
-> [AuthenticatorAttachment]
enumFromTo :: AuthenticatorAttachment
-> AuthenticatorAttachment -> [AuthenticatorAttachment]
$cenumFromTo :: AuthenticatorAttachment
-> AuthenticatorAttachment -> [AuthenticatorAttachment]
enumFromThen :: AuthenticatorAttachment
-> AuthenticatorAttachment -> [AuthenticatorAttachment]
$cenumFromThen :: AuthenticatorAttachment
-> AuthenticatorAttachment -> [AuthenticatorAttachment]
enumFrom :: AuthenticatorAttachment -> [AuthenticatorAttachment]
$cenumFrom :: AuthenticatorAttachment -> [AuthenticatorAttachment]
fromEnum :: AuthenticatorAttachment -> Int
$cfromEnum :: AuthenticatorAttachment -> Int
toEnum :: Int -> AuthenticatorAttachment
$ctoEnum :: Int -> AuthenticatorAttachment
pred :: AuthenticatorAttachment -> AuthenticatorAttachment
$cpred :: AuthenticatorAttachment -> AuthenticatorAttachment
succ :: AuthenticatorAttachment -> AuthenticatorAttachment
$csucc :: AuthenticatorAttachment -> AuthenticatorAttachment
Enum, Eq AuthenticatorAttachment
Eq AuthenticatorAttachment
-> (AuthenticatorAttachment -> AuthenticatorAttachment -> Ordering)
-> (AuthenticatorAttachment -> AuthenticatorAttachment -> Bool)
-> (AuthenticatorAttachment -> AuthenticatorAttachment -> Bool)
-> (AuthenticatorAttachment -> AuthenticatorAttachment -> Bool)
-> (AuthenticatorAttachment -> AuthenticatorAttachment -> Bool)
-> (AuthenticatorAttachment
    -> AuthenticatorAttachment -> AuthenticatorAttachment)
-> (AuthenticatorAttachment
    -> AuthenticatorAttachment -> AuthenticatorAttachment)
-> Ord AuthenticatorAttachment
AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
AuthenticatorAttachment -> AuthenticatorAttachment -> Ordering
AuthenticatorAttachment
-> AuthenticatorAttachment -> AuthenticatorAttachment
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AuthenticatorAttachment
-> AuthenticatorAttachment -> AuthenticatorAttachment
$cmin :: AuthenticatorAttachment
-> AuthenticatorAttachment -> AuthenticatorAttachment
max :: AuthenticatorAttachment
-> AuthenticatorAttachment -> AuthenticatorAttachment
$cmax :: AuthenticatorAttachment
-> AuthenticatorAttachment -> AuthenticatorAttachment
>= :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
$c>= :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
> :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
$c> :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
<= :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
$c<= :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
< :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
$c< :: AuthenticatorAttachment -> AuthenticatorAttachment -> Bool
compare :: AuthenticatorAttachment -> AuthenticatorAttachment -> Ordering
$ccompare :: AuthenticatorAttachment -> AuthenticatorAttachment -> Ordering
Ord, (forall x.
 AuthenticatorAttachment -> Rep AuthenticatorAttachment x)
-> (forall x.
    Rep AuthenticatorAttachment x -> AuthenticatorAttachment)
-> Generic AuthenticatorAttachment
forall x. Rep AuthenticatorAttachment x -> AuthenticatorAttachment
forall x. AuthenticatorAttachment -> Rep AuthenticatorAttachment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthenticatorAttachment x -> AuthenticatorAttachment
$cfrom :: forall x. AuthenticatorAttachment -> Rep AuthenticatorAttachment x
Generic, [AuthenticatorAttachment] -> Encoding
[AuthenticatorAttachment] -> Value
AuthenticatorAttachment -> Encoding
AuthenticatorAttachment -> Value
(AuthenticatorAttachment -> Value)
-> (AuthenticatorAttachment -> Encoding)
-> ([AuthenticatorAttachment] -> Value)
-> ([AuthenticatorAttachment] -> Encoding)
-> ToJSON AuthenticatorAttachment
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AuthenticatorAttachment] -> Encoding
$ctoEncodingList :: [AuthenticatorAttachment] -> Encoding
toJSONList :: [AuthenticatorAttachment] -> Value
$ctoJSONList :: [AuthenticatorAttachment] -> Value
toEncoding :: AuthenticatorAttachment -> Encoding
$ctoEncoding :: AuthenticatorAttachment -> Encoding
toJSON :: AuthenticatorAttachment -> Value
$ctoJSON :: AuthenticatorAttachment -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-residentkeyrequirement)
-- This enumeration’s values describe the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)'s
-- requirements for [client-side discoverable credentials](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential)
-- (formerly known as [resident credentials](https://www.w3.org/TR/webauthn-2/#resident-credential)
-- or [resident keys](https://www.w3.org/TR/webauthn-2/#resident-key)):
--
-- To decode\/encode this type from\/to its standard string, use
-- 'Crypto.WebAuthn.Encoding.Strings.decodeResidentKeyRequirement'/'Crypto.WebAuthn.Encoding.Strings.encodeResidentKeyRequirement'.
data ResidentKeyRequirement
  = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-residentkeyrequirement-discouraged)
    -- This value indicates the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- prefers creating a [server-side credential](https://www.w3.org/TR/webauthn-2/#server-side-credential),
    -- but will accept a [client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential).
    ResidentKeyRequirementDiscouraged
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-residentkeyrequirement-preferred)
    -- This value indicates the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- strongly prefers [creating a client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential),
    -- but will accept a [server-side credential](https://www.w3.org/TR/webauthn-2/#server-side-credential).
    -- For example, user agents SHOULD guide the user through setting up [user verification](https://www.w3.org/TR/webauthn-2/#user-verification)
    -- if needed to create a [client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential)
    -- in this case. This takes precedence over the setting of 'coaUserVerification'.
    ResidentKeyRequirementPreferred
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-residentkeyrequirement-required)
    -- This value indicates the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- requires a [client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential),
    -- and is prepared to receive an error if a
    -- [client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential) cannot be created.
    ResidentKeyRequirementRequired
  deriving (ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
(ResidentKeyRequirement -> ResidentKeyRequirement -> Bool)
-> (ResidentKeyRequirement -> ResidentKeyRequirement -> Bool)
-> Eq ResidentKeyRequirement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
$c/= :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
== :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
$c== :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
Eq, Int -> ResidentKeyRequirement -> ShowS
[ResidentKeyRequirement] -> ShowS
ResidentKeyRequirement -> String
(Int -> ResidentKeyRequirement -> ShowS)
-> (ResidentKeyRequirement -> String)
-> ([ResidentKeyRequirement] -> ShowS)
-> Show ResidentKeyRequirement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResidentKeyRequirement] -> ShowS
$cshowList :: [ResidentKeyRequirement] -> ShowS
show :: ResidentKeyRequirement -> String
$cshow :: ResidentKeyRequirement -> String
showsPrec :: Int -> ResidentKeyRequirement -> ShowS
$cshowsPrec :: Int -> ResidentKeyRequirement -> ShowS
Show, ResidentKeyRequirement
ResidentKeyRequirement
-> ResidentKeyRequirement -> Bounded ResidentKeyRequirement
forall a. a -> a -> Bounded a
maxBound :: ResidentKeyRequirement
$cmaxBound :: ResidentKeyRequirement
minBound :: ResidentKeyRequirement
$cminBound :: ResidentKeyRequirement
Bounded, Int -> ResidentKeyRequirement
ResidentKeyRequirement -> Int
ResidentKeyRequirement -> [ResidentKeyRequirement]
ResidentKeyRequirement -> ResidentKeyRequirement
ResidentKeyRequirement
-> ResidentKeyRequirement -> [ResidentKeyRequirement]
ResidentKeyRequirement
-> ResidentKeyRequirement
-> ResidentKeyRequirement
-> [ResidentKeyRequirement]
(ResidentKeyRequirement -> ResidentKeyRequirement)
-> (ResidentKeyRequirement -> ResidentKeyRequirement)
-> (Int -> ResidentKeyRequirement)
-> (ResidentKeyRequirement -> Int)
-> (ResidentKeyRequirement -> [ResidentKeyRequirement])
-> (ResidentKeyRequirement
    -> ResidentKeyRequirement -> [ResidentKeyRequirement])
-> (ResidentKeyRequirement
    -> ResidentKeyRequirement -> [ResidentKeyRequirement])
-> (ResidentKeyRequirement
    -> ResidentKeyRequirement
    -> ResidentKeyRequirement
    -> [ResidentKeyRequirement])
-> Enum ResidentKeyRequirement
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ResidentKeyRequirement
-> ResidentKeyRequirement
-> ResidentKeyRequirement
-> [ResidentKeyRequirement]
$cenumFromThenTo :: ResidentKeyRequirement
-> ResidentKeyRequirement
-> ResidentKeyRequirement
-> [ResidentKeyRequirement]
enumFromTo :: ResidentKeyRequirement
-> ResidentKeyRequirement -> [ResidentKeyRequirement]
$cenumFromTo :: ResidentKeyRequirement
-> ResidentKeyRequirement -> [ResidentKeyRequirement]
enumFromThen :: ResidentKeyRequirement
-> ResidentKeyRequirement -> [ResidentKeyRequirement]
$cenumFromThen :: ResidentKeyRequirement
-> ResidentKeyRequirement -> [ResidentKeyRequirement]
enumFrom :: ResidentKeyRequirement -> [ResidentKeyRequirement]
$cenumFrom :: ResidentKeyRequirement -> [ResidentKeyRequirement]
fromEnum :: ResidentKeyRequirement -> Int
$cfromEnum :: ResidentKeyRequirement -> Int
toEnum :: Int -> ResidentKeyRequirement
$ctoEnum :: Int -> ResidentKeyRequirement
pred :: ResidentKeyRequirement -> ResidentKeyRequirement
$cpred :: ResidentKeyRequirement -> ResidentKeyRequirement
succ :: ResidentKeyRequirement -> ResidentKeyRequirement
$csucc :: ResidentKeyRequirement -> ResidentKeyRequirement
Enum, Eq ResidentKeyRequirement
Eq ResidentKeyRequirement
-> (ResidentKeyRequirement -> ResidentKeyRequirement -> Ordering)
-> (ResidentKeyRequirement -> ResidentKeyRequirement -> Bool)
-> (ResidentKeyRequirement -> ResidentKeyRequirement -> Bool)
-> (ResidentKeyRequirement -> ResidentKeyRequirement -> Bool)
-> (ResidentKeyRequirement -> ResidentKeyRequirement -> Bool)
-> (ResidentKeyRequirement
    -> ResidentKeyRequirement -> ResidentKeyRequirement)
-> (ResidentKeyRequirement
    -> ResidentKeyRequirement -> ResidentKeyRequirement)
-> Ord ResidentKeyRequirement
ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
ResidentKeyRequirement -> ResidentKeyRequirement -> Ordering
ResidentKeyRequirement
-> ResidentKeyRequirement -> ResidentKeyRequirement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ResidentKeyRequirement
-> ResidentKeyRequirement -> ResidentKeyRequirement
$cmin :: ResidentKeyRequirement
-> ResidentKeyRequirement -> ResidentKeyRequirement
max :: ResidentKeyRequirement
-> ResidentKeyRequirement -> ResidentKeyRequirement
$cmax :: ResidentKeyRequirement
-> ResidentKeyRequirement -> ResidentKeyRequirement
>= :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
$c>= :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
> :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
$c> :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
<= :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
$c<= :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
< :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
$c< :: ResidentKeyRequirement -> ResidentKeyRequirement -> Bool
compare :: ResidentKeyRequirement -> ResidentKeyRequirement -> Ordering
$ccompare :: ResidentKeyRequirement -> ResidentKeyRequirement -> Ordering
Ord, (forall x. ResidentKeyRequirement -> Rep ResidentKeyRequirement x)
-> (forall x.
    Rep ResidentKeyRequirement x -> ResidentKeyRequirement)
-> Generic ResidentKeyRequirement
forall x. Rep ResidentKeyRequirement x -> ResidentKeyRequirement
forall x. ResidentKeyRequirement -> Rep ResidentKeyRequirement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResidentKeyRequirement x -> ResidentKeyRequirement
$cfrom :: forall x. ResidentKeyRequirement -> Rep ResidentKeyRequirement x
Generic, [ResidentKeyRequirement] -> Encoding
[ResidentKeyRequirement] -> Value
ResidentKeyRequirement -> Encoding
ResidentKeyRequirement -> Value
(ResidentKeyRequirement -> Value)
-> (ResidentKeyRequirement -> Encoding)
-> ([ResidentKeyRequirement] -> Value)
-> ([ResidentKeyRequirement] -> Encoding)
-> ToJSON ResidentKeyRequirement
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ResidentKeyRequirement] -> Encoding
$ctoEncodingList :: [ResidentKeyRequirement] -> Encoding
toJSONList :: [ResidentKeyRequirement] -> Value
$ctoJSONList :: [ResidentKeyRequirement] -> Value
toEncoding :: ResidentKeyRequirement -> Encoding
$ctoEncoding :: ResidentKeyRequirement -> Encoding
toJSON :: ResidentKeyRequirement -> Value
$ctoJSON :: ResidentKeyRequirement -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-userVerificationRequirement)
-- A [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party) may
-- require [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) for some
-- of its operations but not for others, and may use this type to express its needs.
--
-- To decode\/encode this type from\/to its standard string, use
-- 'Crypto.WebAuthn.Encoding.Strings.decodeUserVerificationRequirement'/'Crypto.WebAuthn.Encoding.Strings.encodeUserVerificationRequirement'.
data UserVerificationRequirement
  = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-userverificationrequirement-required)
    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- requires [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) for the
    -- operation and will fail the operation if the response does not have the
    -- [UV](https://www.w3.org/TR/webauthn-2/#uv) [flag](https://www.w3.org/TR/webauthn-2/#flags) set.
    UserVerificationRequirementRequired
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-userverificationrequirement-preferred)
    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- prefers [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) for the
    -- operation if possible, but will not fail the operation if the response does not have the
    -- [UV](https://www.w3.org/TR/webauthn-2/#uv) [flag](https://www.w3.org/TR/webauthn-2/#flags) set.
    UserVerificationRequirementPreferred
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-userverificationrequirement-discouraged)
    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- does not want [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) employed
    -- during the operation (e.g., in the interest of minimizing disruption to the user interaction flow).
    UserVerificationRequirementDiscouraged
  deriving (UserVerificationRequirement -> UserVerificationRequirement -> Bool
(UserVerificationRequirement
 -> UserVerificationRequirement -> Bool)
-> (UserVerificationRequirement
    -> UserVerificationRequirement -> Bool)
-> Eq UserVerificationRequirement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
$c/= :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
== :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
$c== :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
Eq, Int -> UserVerificationRequirement -> ShowS
[UserVerificationRequirement] -> ShowS
UserVerificationRequirement -> String
(Int -> UserVerificationRequirement -> ShowS)
-> (UserVerificationRequirement -> String)
-> ([UserVerificationRequirement] -> ShowS)
-> Show UserVerificationRequirement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserVerificationRequirement] -> ShowS
$cshowList :: [UserVerificationRequirement] -> ShowS
show :: UserVerificationRequirement -> String
$cshow :: UserVerificationRequirement -> String
showsPrec :: Int -> UserVerificationRequirement -> ShowS
$cshowsPrec :: Int -> UserVerificationRequirement -> ShowS
Show, UserVerificationRequirement
UserVerificationRequirement
-> UserVerificationRequirement
-> Bounded UserVerificationRequirement
forall a. a -> a -> Bounded a
maxBound :: UserVerificationRequirement
$cmaxBound :: UserVerificationRequirement
minBound :: UserVerificationRequirement
$cminBound :: UserVerificationRequirement
Bounded, Int -> UserVerificationRequirement
UserVerificationRequirement -> Int
UserVerificationRequirement -> [UserVerificationRequirement]
UserVerificationRequirement -> UserVerificationRequirement
UserVerificationRequirement
-> UserVerificationRequirement -> [UserVerificationRequirement]
UserVerificationRequirement
-> UserVerificationRequirement
-> UserVerificationRequirement
-> [UserVerificationRequirement]
(UserVerificationRequirement -> UserVerificationRequirement)
-> (UserVerificationRequirement -> UserVerificationRequirement)
-> (Int -> UserVerificationRequirement)
-> (UserVerificationRequirement -> Int)
-> (UserVerificationRequirement -> [UserVerificationRequirement])
-> (UserVerificationRequirement
    -> UserVerificationRequirement -> [UserVerificationRequirement])
-> (UserVerificationRequirement
    -> UserVerificationRequirement -> [UserVerificationRequirement])
-> (UserVerificationRequirement
    -> UserVerificationRequirement
    -> UserVerificationRequirement
    -> [UserVerificationRequirement])
-> Enum UserVerificationRequirement
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UserVerificationRequirement
-> UserVerificationRequirement
-> UserVerificationRequirement
-> [UserVerificationRequirement]
$cenumFromThenTo :: UserVerificationRequirement
-> UserVerificationRequirement
-> UserVerificationRequirement
-> [UserVerificationRequirement]
enumFromTo :: UserVerificationRequirement
-> UserVerificationRequirement -> [UserVerificationRequirement]
$cenumFromTo :: UserVerificationRequirement
-> UserVerificationRequirement -> [UserVerificationRequirement]
enumFromThen :: UserVerificationRequirement
-> UserVerificationRequirement -> [UserVerificationRequirement]
$cenumFromThen :: UserVerificationRequirement
-> UserVerificationRequirement -> [UserVerificationRequirement]
enumFrom :: UserVerificationRequirement -> [UserVerificationRequirement]
$cenumFrom :: UserVerificationRequirement -> [UserVerificationRequirement]
fromEnum :: UserVerificationRequirement -> Int
$cfromEnum :: UserVerificationRequirement -> Int
toEnum :: Int -> UserVerificationRequirement
$ctoEnum :: Int -> UserVerificationRequirement
pred :: UserVerificationRequirement -> UserVerificationRequirement
$cpred :: UserVerificationRequirement -> UserVerificationRequirement
succ :: UserVerificationRequirement -> UserVerificationRequirement
$csucc :: UserVerificationRequirement -> UserVerificationRequirement
Enum, Eq UserVerificationRequirement
Eq UserVerificationRequirement
-> (UserVerificationRequirement
    -> UserVerificationRequirement -> Ordering)
-> (UserVerificationRequirement
    -> UserVerificationRequirement -> Bool)
-> (UserVerificationRequirement
    -> UserVerificationRequirement -> Bool)
-> (UserVerificationRequirement
    -> UserVerificationRequirement -> Bool)
-> (UserVerificationRequirement
    -> UserVerificationRequirement -> Bool)
-> (UserVerificationRequirement
    -> UserVerificationRequirement -> UserVerificationRequirement)
-> (UserVerificationRequirement
    -> UserVerificationRequirement -> UserVerificationRequirement)
-> Ord UserVerificationRequirement
UserVerificationRequirement -> UserVerificationRequirement -> Bool
UserVerificationRequirement
-> UserVerificationRequirement -> Ordering
UserVerificationRequirement
-> UserVerificationRequirement -> UserVerificationRequirement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UserVerificationRequirement
-> UserVerificationRequirement -> UserVerificationRequirement
$cmin :: UserVerificationRequirement
-> UserVerificationRequirement -> UserVerificationRequirement
max :: UserVerificationRequirement
-> UserVerificationRequirement -> UserVerificationRequirement
$cmax :: UserVerificationRequirement
-> UserVerificationRequirement -> UserVerificationRequirement
>= :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
$c>= :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
> :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
$c> :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
<= :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
$c<= :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
< :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
$c< :: UserVerificationRequirement -> UserVerificationRequirement -> Bool
compare :: UserVerificationRequirement
-> UserVerificationRequirement -> Ordering
$ccompare :: UserVerificationRequirement
-> UserVerificationRequirement -> Ordering
Ord, (forall x.
 UserVerificationRequirement -> Rep UserVerificationRequirement x)
-> (forall x.
    Rep UserVerificationRequirement x -> UserVerificationRequirement)
-> Generic UserVerificationRequirement
forall x.
Rep UserVerificationRequirement x -> UserVerificationRequirement
forall x.
UserVerificationRequirement -> Rep UserVerificationRequirement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UserVerificationRequirement x -> UserVerificationRequirement
$cfrom :: forall x.
UserVerificationRequirement -> Rep UserVerificationRequirement x
Generic, [UserVerificationRequirement] -> Encoding
[UserVerificationRequirement] -> Value
UserVerificationRequirement -> Encoding
UserVerificationRequirement -> Value
(UserVerificationRequirement -> Value)
-> (UserVerificationRequirement -> Encoding)
-> ([UserVerificationRequirement] -> Value)
-> ([UserVerificationRequirement] -> Encoding)
-> ToJSON UserVerificationRequirement
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UserVerificationRequirement] -> Encoding
$ctoEncodingList :: [UserVerificationRequirement] -> Encoding
toJSONList :: [UserVerificationRequirement] -> Value
$ctoJSONList :: [UserVerificationRequirement] -> Value
toEncoding :: UserVerificationRequirement -> Encoding
$ctoEncoding :: UserVerificationRequirement -> Encoding
toJSON :: UserVerificationRequirement -> Value
$ctoJSON :: UserVerificationRequirement -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-attestation-convey)
-- [WebAuthn Relying Parties](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party) may use
-- [AttestationConveyancePreference](https://www.w3.org/TR/webauthn-2/#enumdef-attestationconveyancepreference)
-- to specify their preference regarding
-- [attestation conveyance](https://www.w3.org/TR/webauthn-2/#attestation-conveyance) during credential generation.
--
-- To decode\/encode this type from\/to its standard string, use
-- 'Crypto.WebAuthn.Encoding.Strings.decodeAttestationConveyancePreference'/'Crypto.WebAuthn.Encoding.Strings.encodeAttestationConveyancePreference'.
data AttestationConveyancePreference
  = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-attestationconveyancepreference-none)
    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- is not interested in [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)
    -- [attestation](https://www.w3.org/TR/webauthn-2/#attestation). For example, in order to
    -- potentially avoid having to obtain [user consent](https://www.w3.org/TR/webauthn-2/#user-consent)
    -- to relay identifying information to the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party),
    -- or to save a roundtrip to an [Attestation CA](https://www.w3.org/TR/webauthn-2/#attestation-ca)
    -- or [Anonymization CA](https://www.w3.org/TR/webauthn-2/#anonymization-ca). This is the default value.
    AttestationConveyancePreferenceNone
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-attestationconveyancepreference-indirect)
    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- prefers an [attestation](https://www.w3.org/TR/webauthn-2/#attestation) conveyance yielding
    -- verifiable [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement),
    -- but allows the client to decide how to obtain such
    -- [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement).
    -- The client MAY replace the authenticator-generated [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement)
    -- with [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement)
    -- generated by an [Anonymization CA](https://www.w3.org/TR/webauthn-2/#anonymization-ca),
    -- in order to protect the user’s privacy, or to assist [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- with attestation verification in a heterogeneous ecosystem.
    --
    -- Note: There is no guarantee that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- will obtain a verifiable [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement)
    -- in this case. For example, in the case that the authenticator employs
    -- [self attestation](https://www.w3.org/TR/webauthn-2/#self-attestation).
    AttestationConveyancePreferenceIndirect
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-attestationconveyancepreference-direct)
    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- wants to receive the [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement)
    -- as generated by the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator).
    AttestationConveyancePreferenceDirect
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-attestationconveyancepreference-enterprise)
    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- wants to receive an [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement)
    -- that may include uniquely identifying information. This is intended for controlled deployments
    -- within an enterprise where the organization wishes to tie registrations to specific authenticators.
    -- User agents MUST NOT provide such an attestation unless the user agent or authenticator configuration
    -- permits it for the requested 'RpId'.
    --
    -- If permitted, the user agent SHOULD signal to the authenticator
    -- (at [invocation time](https://www.w3.org/TR/webauthn-2/#CreateCred-InvokeAuthnrMakeCred))
    -- that enterprise attestation is requested, and convey the resulting [AAGUID](https://www.w3.org/TR/webauthn-2/#aaguid)
    -- and [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement), unaltered,
    -- to the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party).
    AttestationConveyancePreferenceEnterprise
  deriving (AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
(AttestationConveyancePreference
 -> AttestationConveyancePreference -> Bool)
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference -> Bool)
-> Eq AttestationConveyancePreference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
$c/= :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
== :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
$c== :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
Eq, Int -> AttestationConveyancePreference -> ShowS
[AttestationConveyancePreference] -> ShowS
AttestationConveyancePreference -> String
(Int -> AttestationConveyancePreference -> ShowS)
-> (AttestationConveyancePreference -> String)
-> ([AttestationConveyancePreference] -> ShowS)
-> Show AttestationConveyancePreference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttestationConveyancePreference] -> ShowS
$cshowList :: [AttestationConveyancePreference] -> ShowS
show :: AttestationConveyancePreference -> String
$cshow :: AttestationConveyancePreference -> String
showsPrec :: Int -> AttestationConveyancePreference -> ShowS
$cshowsPrec :: Int -> AttestationConveyancePreference -> ShowS
Show, AttestationConveyancePreference
AttestationConveyancePreference
-> AttestationConveyancePreference
-> Bounded AttestationConveyancePreference
forall a. a -> a -> Bounded a
maxBound :: AttestationConveyancePreference
$cmaxBound :: AttestationConveyancePreference
minBound :: AttestationConveyancePreference
$cminBound :: AttestationConveyancePreference
Bounded, Int -> AttestationConveyancePreference
AttestationConveyancePreference -> Int
AttestationConveyancePreference
-> [AttestationConveyancePreference]
AttestationConveyancePreference -> AttestationConveyancePreference
AttestationConveyancePreference
-> AttestationConveyancePreference
-> [AttestationConveyancePreference]
AttestationConveyancePreference
-> AttestationConveyancePreference
-> AttestationConveyancePreference
-> [AttestationConveyancePreference]
(AttestationConveyancePreference
 -> AttestationConveyancePreference)
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference)
-> (Int -> AttestationConveyancePreference)
-> (AttestationConveyancePreference -> Int)
-> (AttestationConveyancePreference
    -> [AttestationConveyancePreference])
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference
    -> [AttestationConveyancePreference])
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference
    -> [AttestationConveyancePreference])
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference
    -> AttestationConveyancePreference
    -> [AttestationConveyancePreference])
-> Enum AttestationConveyancePreference
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AttestationConveyancePreference
-> AttestationConveyancePreference
-> AttestationConveyancePreference
-> [AttestationConveyancePreference]
$cenumFromThenTo :: AttestationConveyancePreference
-> AttestationConveyancePreference
-> AttestationConveyancePreference
-> [AttestationConveyancePreference]
enumFromTo :: AttestationConveyancePreference
-> AttestationConveyancePreference
-> [AttestationConveyancePreference]
$cenumFromTo :: AttestationConveyancePreference
-> AttestationConveyancePreference
-> [AttestationConveyancePreference]
enumFromThen :: AttestationConveyancePreference
-> AttestationConveyancePreference
-> [AttestationConveyancePreference]
$cenumFromThen :: AttestationConveyancePreference
-> AttestationConveyancePreference
-> [AttestationConveyancePreference]
enumFrom :: AttestationConveyancePreference
-> [AttestationConveyancePreference]
$cenumFrom :: AttestationConveyancePreference
-> [AttestationConveyancePreference]
fromEnum :: AttestationConveyancePreference -> Int
$cfromEnum :: AttestationConveyancePreference -> Int
toEnum :: Int -> AttestationConveyancePreference
$ctoEnum :: Int -> AttestationConveyancePreference
pred :: AttestationConveyancePreference -> AttestationConveyancePreference
$cpred :: AttestationConveyancePreference -> AttestationConveyancePreference
succ :: AttestationConveyancePreference -> AttestationConveyancePreference
$csucc :: AttestationConveyancePreference -> AttestationConveyancePreference
Enum, Eq AttestationConveyancePreference
Eq AttestationConveyancePreference
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference -> Ordering)
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference -> Bool)
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference -> Bool)
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference -> Bool)
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference -> Bool)
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference
    -> AttestationConveyancePreference)
-> (AttestationConveyancePreference
    -> AttestationConveyancePreference
    -> AttestationConveyancePreference)
-> Ord AttestationConveyancePreference
AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
AttestationConveyancePreference
-> AttestationConveyancePreference -> Ordering
AttestationConveyancePreference
-> AttestationConveyancePreference
-> AttestationConveyancePreference
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AttestationConveyancePreference
-> AttestationConveyancePreference
-> AttestationConveyancePreference
$cmin :: AttestationConveyancePreference
-> AttestationConveyancePreference
-> AttestationConveyancePreference
max :: AttestationConveyancePreference
-> AttestationConveyancePreference
-> AttestationConveyancePreference
$cmax :: AttestationConveyancePreference
-> AttestationConveyancePreference
-> AttestationConveyancePreference
>= :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
$c>= :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
> :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
$c> :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
<= :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
$c<= :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
< :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
$c< :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Bool
compare :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Ordering
$ccompare :: AttestationConveyancePreference
-> AttestationConveyancePreference -> Ordering
Ord, (forall x.
 AttestationConveyancePreference
 -> Rep AttestationConveyancePreference x)
-> (forall x.
    Rep AttestationConveyancePreference x
    -> AttestationConveyancePreference)
-> Generic AttestationConveyancePreference
forall x.
Rep AttestationConveyancePreference x
-> AttestationConveyancePreference
forall x.
AttestationConveyancePreference
-> Rep AttestationConveyancePreference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AttestationConveyancePreference x
-> AttestationConveyancePreference
$cfrom :: forall x.
AttestationConveyancePreference
-> Rep AttestationConveyancePreference x
Generic, [AttestationConveyancePreference] -> Encoding
[AttestationConveyancePreference] -> Value
AttestationConveyancePreference -> Encoding
AttestationConveyancePreference -> Value
(AttestationConveyancePreference -> Value)
-> (AttestationConveyancePreference -> Encoding)
-> ([AttestationConveyancePreference] -> Value)
-> ([AttestationConveyancePreference] -> Encoding)
-> ToJSON AttestationConveyancePreference
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AttestationConveyancePreference] -> Encoding
$ctoEncodingList :: [AttestationConveyancePreference] -> Encoding
toJSONList :: [AttestationConveyancePreference] -> Value
$ctoJSONList :: [AttestationConveyancePreference] -> Value
toEncoding :: AttestationConveyancePreference -> Encoding
$ctoEncoding :: AttestationConveyancePreference -> Encoding
toJSON :: AttestationConveyancePreference -> Value
$ctoJSON :: AttestationConveyancePreference -> Value
ToJSON)

-- | An X.509 certificate chain that can be used to verify an attestation
-- statement
data AttestationChain (p :: ProtocolKind) where
  -- | For Fido 2, we can have a chain consisting of multiple certificates.
  Fido2Chain :: NonEmpty X509.SignedCertificate -> AttestationChain 'Fido2
  -- | For Fido U2F, we can only have a single certificate, which is then also
  -- used to generate the 'Crypto.WebAuthn.Identifier.SubjectKeyIdentifier' from
  FidoU2FCert :: X509.SignedCertificate -> AttestationChain 'FidoU2F

deriving instance Eq (AttestationChain p)

deriving instance Show (AttestationChain p)

instance ToJSON (AttestationChain p) where
  toJSON :: AttestationChain p -> Value
toJSON (Fido2Chain NonEmpty SignedCertificate
chain) = NonEmpty SignedCertificate -> Value
forall a. ToJSON a => a -> Value
toJSON NonEmpty SignedCertificate
chain
  toJSON (FidoU2FCert SignedCertificate
cert) = [SignedCertificate] -> Value
forall a. ToJSON a => a -> Value
toJSON [SignedCertificate
cert]

-- | An [attestation type](https://www.w3.org/TR/webauthn-2/#attestation-type)
-- that is verifiable, indicating that we can have trusted information about
-- the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) that
-- created the [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)
data VerifiableAttestationType
  = -- | [Attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement)
    -- conveying [attestations](https://www.w3.org/TR/webauthn-2/#attestation) of
    -- [type](https://www.w3.org/TR/webauthn-2/#attestation-type)
    -- [AttCA](https://www.w3.org/TR/webauthn-2/#attca) or
    -- [AnonCA](https://www.w3.org/TR/webauthn-2/#anonca) use the same data
    -- structure as those of [type](https://www.w3.org/TR/webauthn-2/#attestation-type)
    -- [Basic](https://www.w3.org/TR/webauthn-2/#basic), so the three attestation
    -- types are, in general, distinguishable only with externally provided knowledge regarding the contents
    -- of the [attestation certificates](https://www.w3.org/TR/webauthn-2/#attestation-certificate)
    -- conveyed in the [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement).
    VerifiableAttestationTypeUncertain
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#basic-attestation)
    -- In the case of basic attestation [UAFProtocol](https://www.w3.org/TR/webauthn-2/#biblio-uafprotocol),
    -- the authenticator’s [attestation key pair](https://www.w3.org/TR/webauthn-2/#attestation-key-pair)
    -- is specific to an authenticator "model", i.e., a "batch" of authenticators.
    -- Thus, authenticators of the same, or similar, model often share the same
    -- [attestation key pair](https://www.w3.org/TR/webauthn-2/#attestation-key-pair).
    -- See [§ 14.4.1 Attestation Privacy](https://www.w3.org/TR/webauthn-2/#sctn-attestation-privacy)
    -- for further information.
    VerifiableAttestationTypeBasic
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#attca)
    -- In this case, an [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)
    -- is based on a Trusted Platform Module (TPM) and holds an authenticator-specific
    -- "endorsement key" (EK). This key is used to securely communicate with a
    -- trusted third party, the [Attestation CA](https://www.w3.org/TR/webauthn-2/#attestation-ca)
    -- [TCG-CMCProfile-AIKCertEnroll](https://www.w3.org/TR/webauthn-2/#biblio-tcg-cmcprofile-aikcertenroll)
    -- (formerly known as a "Privacy CA"). The [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)
    -- can generate multiple attestation identity key pairs (AIK) and requests an
    -- [Attestation CA](https://www.w3.org/TR/webauthn-2/#attestation-ca) to
    -- issue an AIK certificate for each. Using this approach, such an
    -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) can
    -- limit the exposure of the EK (which is a global correlation handle) to
    -- Attestation CA(s). AIKs can be requested for each
    -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)\-generated
    -- [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)
    -- individually, and conveyed to [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- as [attestation certificates](https://www.w3.org/TR/webauthn-2/#attestation-certificate).
    VerifiableAttestationTypeAttCA
  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#anonca)
    -- In this case, the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)
    -- uses an [Anonymization CA](https://www.w3.org/TR/webauthn-2/#anonymization-ca)
    -- which dynamically generates per-[credential](https://w3c.github.io/webappsec-credential-management/#concept-credential)
    -- [attestation certificates](https://www.w3.org/TR/webauthn-2/#attestation-certificate)
    -- such that the [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement)
    -- presented to [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- do not provide uniquely identifiable information, e.g., that might be used for tracking purposes.
    VerifiableAttestationTypeAnonCA
  deriving (VerifiableAttestationType -> VerifiableAttestationType -> Bool
(VerifiableAttestationType -> VerifiableAttestationType -> Bool)
-> (VerifiableAttestationType -> VerifiableAttestationType -> Bool)
-> Eq VerifiableAttestationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
$c/= :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
== :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
$c== :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
Eq, Int -> VerifiableAttestationType -> ShowS
[VerifiableAttestationType] -> ShowS
VerifiableAttestationType -> String
(Int -> VerifiableAttestationType -> ShowS)
-> (VerifiableAttestationType -> String)
-> ([VerifiableAttestationType] -> ShowS)
-> Show VerifiableAttestationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerifiableAttestationType] -> ShowS
$cshowList :: [VerifiableAttestationType] -> ShowS
show :: VerifiableAttestationType -> String
$cshow :: VerifiableAttestationType -> String
showsPrec :: Int -> VerifiableAttestationType -> ShowS
$cshowsPrec :: Int -> VerifiableAttestationType -> ShowS
Show, VerifiableAttestationType
VerifiableAttestationType
-> VerifiableAttestationType -> Bounded VerifiableAttestationType
forall a. a -> a -> Bounded a
maxBound :: VerifiableAttestationType
$cmaxBound :: VerifiableAttestationType
minBound :: VerifiableAttestationType
$cminBound :: VerifiableAttestationType
Bounded, Int -> VerifiableAttestationType
VerifiableAttestationType -> Int
VerifiableAttestationType -> [VerifiableAttestationType]
VerifiableAttestationType -> VerifiableAttestationType
VerifiableAttestationType
-> VerifiableAttestationType -> [VerifiableAttestationType]
VerifiableAttestationType
-> VerifiableAttestationType
-> VerifiableAttestationType
-> [VerifiableAttestationType]
(VerifiableAttestationType -> VerifiableAttestationType)
-> (VerifiableAttestationType -> VerifiableAttestationType)
-> (Int -> VerifiableAttestationType)
-> (VerifiableAttestationType -> Int)
-> (VerifiableAttestationType -> [VerifiableAttestationType])
-> (VerifiableAttestationType
    -> VerifiableAttestationType -> [VerifiableAttestationType])
-> (VerifiableAttestationType
    -> VerifiableAttestationType -> [VerifiableAttestationType])
-> (VerifiableAttestationType
    -> VerifiableAttestationType
    -> VerifiableAttestationType
    -> [VerifiableAttestationType])
-> Enum VerifiableAttestationType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VerifiableAttestationType
-> VerifiableAttestationType
-> VerifiableAttestationType
-> [VerifiableAttestationType]
$cenumFromThenTo :: VerifiableAttestationType
-> VerifiableAttestationType
-> VerifiableAttestationType
-> [VerifiableAttestationType]
enumFromTo :: VerifiableAttestationType
-> VerifiableAttestationType -> [VerifiableAttestationType]
$cenumFromTo :: VerifiableAttestationType
-> VerifiableAttestationType -> [VerifiableAttestationType]
enumFromThen :: VerifiableAttestationType
-> VerifiableAttestationType -> [VerifiableAttestationType]
$cenumFromThen :: VerifiableAttestationType
-> VerifiableAttestationType -> [VerifiableAttestationType]
enumFrom :: VerifiableAttestationType -> [VerifiableAttestationType]
$cenumFrom :: VerifiableAttestationType -> [VerifiableAttestationType]
fromEnum :: VerifiableAttestationType -> Int
$cfromEnum :: VerifiableAttestationType -> Int
toEnum :: Int -> VerifiableAttestationType
$ctoEnum :: Int -> VerifiableAttestationType
pred :: VerifiableAttestationType -> VerifiableAttestationType
$cpred :: VerifiableAttestationType -> VerifiableAttestationType
succ :: VerifiableAttestationType -> VerifiableAttestationType
$csucc :: VerifiableAttestationType -> VerifiableAttestationType
Enum, Eq VerifiableAttestationType
Eq VerifiableAttestationType
-> (VerifiableAttestationType
    -> VerifiableAttestationType -> Ordering)
-> (VerifiableAttestationType -> VerifiableAttestationType -> Bool)
-> (VerifiableAttestationType -> VerifiableAttestationType -> Bool)
-> (VerifiableAttestationType -> VerifiableAttestationType -> Bool)
-> (VerifiableAttestationType -> VerifiableAttestationType -> Bool)
-> (VerifiableAttestationType
    -> VerifiableAttestationType -> VerifiableAttestationType)
-> (VerifiableAttestationType
    -> VerifiableAttestationType -> VerifiableAttestationType)
-> Ord VerifiableAttestationType
VerifiableAttestationType -> VerifiableAttestationType -> Bool
VerifiableAttestationType -> VerifiableAttestationType -> Ordering
VerifiableAttestationType
-> VerifiableAttestationType -> VerifiableAttestationType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VerifiableAttestationType
-> VerifiableAttestationType -> VerifiableAttestationType
$cmin :: VerifiableAttestationType
-> VerifiableAttestationType -> VerifiableAttestationType
max :: VerifiableAttestationType
-> VerifiableAttestationType -> VerifiableAttestationType
$cmax :: VerifiableAttestationType
-> VerifiableAttestationType -> VerifiableAttestationType
>= :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
$c>= :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
> :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
$c> :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
<= :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
$c<= :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
< :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
$c< :: VerifiableAttestationType -> VerifiableAttestationType -> Bool
compare :: VerifiableAttestationType -> VerifiableAttestationType -> Ordering
$ccompare :: VerifiableAttestationType -> VerifiableAttestationType -> Ordering
Ord, (forall x.
 VerifiableAttestationType -> Rep VerifiableAttestationType x)
-> (forall x.
    Rep VerifiableAttestationType x -> VerifiableAttestationType)
-> Generic VerifiableAttestationType
forall x.
Rep VerifiableAttestationType x -> VerifiableAttestationType
forall x.
VerifiableAttestationType -> Rep VerifiableAttestationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep VerifiableAttestationType x -> VerifiableAttestationType
$cfrom :: forall x.
VerifiableAttestationType -> Rep VerifiableAttestationType x
Generic, [VerifiableAttestationType] -> Encoding
[VerifiableAttestationType] -> Value
VerifiableAttestationType -> Encoding
VerifiableAttestationType -> Value
(VerifiableAttestationType -> Value)
-> (VerifiableAttestationType -> Encoding)
-> ([VerifiableAttestationType] -> Value)
-> ([VerifiableAttestationType] -> Encoding)
-> ToJSON VerifiableAttestationType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VerifiableAttestationType] -> Encoding
$ctoEncodingList :: [VerifiableAttestationType] -> Encoding
toJSONList :: [VerifiableAttestationType] -> Value
$ctoJSONList :: [VerifiableAttestationType] -> Value
toEncoding :: VerifiableAttestationType -> Encoding
$ctoEncoding :: VerifiableAttestationType -> Encoding
toJSON :: VerifiableAttestationType -> Value
$ctoJSON :: VerifiableAttestationType -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-attestation-types)
-- WebAuthn supports several [attestation types](https://www.w3.org/TR/webauthn-2/#attestation-type),
-- defining the semantics of [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement)
-- and their underlying trust models:
data AttestationType (k :: AttestationKind) where
  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#none)
  -- In this case, no attestation information is available. See also
  -- [§ 8.7 None Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-none-attestation).
  AttestationTypeNone :: AttestationType 'Unverifiable
  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#self-attestation)
  -- In the case of [self attestation](https://www.w3.org/TR/webauthn-2/#self-attestation),
  -- also known as surrogate basic attestation [UAFProtocol](https://www.w3.org/TR/webauthn-2/#biblio-uafprotocol),
  -- the Authenticator does not have any specific [attestation key pair](https://www.w3.org/TR/webauthn-2/#attestation-key-pair).
  -- Instead it uses the [credential private key](https://www.w3.org/TR/webauthn-2/#credential-private-key)
  -- to create the [attestation signature](https://www.w3.org/TR/webauthn-2/#attestation-signature).
  -- Authenticators without meaningful protection measures for an
  -- [attestation private key](https://www.w3.org/TR/webauthn-2/#attestation-private-key)
  -- typically use this attestation type.
  AttestationTypeSelf :: AttestationType 'Unverifiable
  -- | Grouping of attestations that are verifiable by a certificate chain
  AttestationTypeVerifiable ::
    { -- | The type of verifiable attestation
      forall (p :: ProtocolKind).
AttestationType ('Verifiable p) -> VerifiableAttestationType
atvType :: VerifiableAttestationType,
      -- | The certificate chain of this attestation type, can be used to
      -- validate the authenticator model
      forall (p :: ProtocolKind).
AttestationType ('Verifiable p) -> AttestationChain p
atvChain :: AttestationChain p
    } ->
    AttestationType ('Verifiable p)

deriving instance Eq (AttestationType k)

deriving instance Show (AttestationType k)

instance ToJSON (AttestationType k) where
  toJSON :: AttestationType k -> Value
toJSON AttestationType k
AttestationTypeNone =
    [Pair] -> Value
object
      [ Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AttestationTypeNone"
      ]
  toJSON AttestationType k
AttestationTypeSelf =
    [Pair] -> Value
object
      [ Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AttestationTypeSelf"
      ]
  toJSON AttestationTypeVerifiable {VerifiableAttestationType
AttestationChain p
atvChain :: AttestationChain p
atvType :: VerifiableAttestationType
atvChain :: forall (p :: ProtocolKind).
AttestationType ('Verifiable p) -> AttestationChain p
atvType :: forall (p :: ProtocolKind).
AttestationType ('Verifiable p) -> VerifiableAttestationType
..} =
    [Pair] -> Value
object
      [ Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AttestationTypeVerifiable",
        Key
"atvType" Key -> VerifiableAttestationType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= VerifiableAttestationType
atvType,
        Key
"atvChain" Key -> AttestationChain p -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AttestationChain p
atvChain
      ]

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#rp-id)
-- A [valid domain string](https://url.spec.whatwg.org/#valid-domain-string)
-- identifying the [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)
-- on whose behalf a given [registration](https://www.w3.org/TR/webauthn-2/#registration)
-- or [authentication ceremony](https://www.w3.org/TR/webauthn-2/#authentication) is being performed.
-- A [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)
-- can only be used for [authentication](https://www.w3.org/TR/webauthn-2/#authentication)
-- with the same entity (as identified by 'RpId') it was registered with.
--
-- By default, the 'RpId' for a WebAuthn operation is set to the caller’s
-- [origin](https://html.spec.whatwg.org/multipage/webappapis.html#concept-settings-object-origin)'s
-- [effective domain](https://html.spec.whatwg.org/multipage/origin.html#concept-origin-effective-domain).
-- This default MAY be overridden by the caller, as long as the caller-specified 'RpId' value
-- [is a registrable domain suffix of or is equal to](https://html.spec.whatwg.org/multipage/origin.html#is-a-registrable-domain-suffix-of-or-is-equal-to)
-- the caller’s [origin](https://html.spec.whatwg.org/multipage/webappapis.html#concept-settings-object-origin)'s
-- [effective domain](https://html.spec.whatwg.org/multipage/origin.html#concept-origin-effective-domain).
--
-- TODO: 'RpId' is used for both <https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrpentity-id>
-- and <https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-rpid>, but the former
-- uses DOMString, while the latter uses USVString. Is this a bug in the spec or is there an actual difference?
newtype RpId = RpId {RpId -> Text
unRpId :: Text}
  deriving (RpId -> RpId -> Bool
(RpId -> RpId -> Bool) -> (RpId -> RpId -> Bool) -> Eq RpId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpId -> RpId -> Bool
$c/= :: RpId -> RpId -> Bool
== :: RpId -> RpId -> Bool
$c== :: RpId -> RpId -> Bool
Eq, Int -> RpId -> ShowS
[RpId] -> ShowS
RpId -> String
(Int -> RpId -> ShowS)
-> (RpId -> String) -> ([RpId] -> ShowS) -> Show RpId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpId] -> ShowS
$cshowList :: [RpId] -> ShowS
show :: RpId -> String
$cshow :: RpId -> String
showsPrec :: Int -> RpId -> ShowS
$cshowsPrec :: Int -> RpId -> ShowS
Show, Eq RpId
Eq RpId
-> (RpId -> RpId -> Ordering)
-> (RpId -> RpId -> Bool)
-> (RpId -> RpId -> Bool)
-> (RpId -> RpId -> Bool)
-> (RpId -> RpId -> Bool)
-> (RpId -> RpId -> RpId)
-> (RpId -> RpId -> RpId)
-> Ord RpId
RpId -> RpId -> Bool
RpId -> RpId -> Ordering
RpId -> RpId -> RpId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RpId -> RpId -> RpId
$cmin :: RpId -> RpId -> RpId
max :: RpId -> RpId -> RpId
$cmax :: RpId -> RpId -> RpId
>= :: RpId -> RpId -> Bool
$c>= :: RpId -> RpId -> Bool
> :: RpId -> RpId -> Bool
$c> :: RpId -> RpId -> Bool
<= :: RpId -> RpId -> Bool
$c<= :: RpId -> RpId -> Bool
< :: RpId -> RpId -> Bool
$c< :: RpId -> RpId -> Bool
compare :: RpId -> RpId -> Ordering
$ccompare :: RpId -> RpId -> Ordering
Ord)
  deriving newtype (String -> RpId
(String -> RpId) -> IsString RpId
forall a. (String -> a) -> IsString a
fromString :: String -> RpId
$cfromString :: String -> RpId
IsString, [RpId] -> Encoding
[RpId] -> Value
RpId -> Encoding
RpId -> Value
(RpId -> Value)
-> (RpId -> Encoding)
-> ([RpId] -> Value)
-> ([RpId] -> Encoding)
-> ToJSON RpId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RpId] -> Encoding
$ctoEncodingList :: [RpId] -> Encoding
toJSONList :: [RpId] -> Value
$ctoJSONList :: [RpId] -> Value
toEncoding :: RpId -> Encoding
$ctoEncoding :: RpId -> Encoding
toJSON :: RpId -> Value
$ctoJSON :: RpId -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)
-- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability)
-- identifier for the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party),
-- intended only for display. For example, "ACME Corporation", "Wonderful Widgets, Inc." or "ОАО Примертех".
--
-- - [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) SHOULD perform
-- enforcement, as prescribed in Section 2.3 of [RFC8266](https://www.w3.org/TR/webauthn-2/#biblio-rfc8266)
-- for the Nickname Profile of the PRECIS FreeformClass [RFC8264](https://www.w3.org/TR/webauthn-2/#biblio-rfc8264),
-- when setting 'RelyingPartyName's value, or displaying the value to the user.
-- - This string MAY contain language and direction metadata. [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)
-- SHOULD consider providing this information. See [§ 6.4.2 Language and Direction Encoding](https://www.w3.org/TR/webauthn-2/#sctn-strings-langdir)
-- about how this metadata is encoded.
newtype RelyingPartyName = RelyingPartyName {RelyingPartyName -> Text
unRelyingPartyName :: Text}
  deriving (RelyingPartyName -> RelyingPartyName -> Bool
(RelyingPartyName -> RelyingPartyName -> Bool)
-> (RelyingPartyName -> RelyingPartyName -> Bool)
-> Eq RelyingPartyName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelyingPartyName -> RelyingPartyName -> Bool
$c/= :: RelyingPartyName -> RelyingPartyName -> Bool
== :: RelyingPartyName -> RelyingPartyName -> Bool
$c== :: RelyingPartyName -> RelyingPartyName -> Bool
Eq, Int -> RelyingPartyName -> ShowS
[RelyingPartyName] -> ShowS
RelyingPartyName -> String
(Int -> RelyingPartyName -> ShowS)
-> (RelyingPartyName -> String)
-> ([RelyingPartyName] -> ShowS)
-> Show RelyingPartyName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelyingPartyName] -> ShowS
$cshowList :: [RelyingPartyName] -> ShowS
show :: RelyingPartyName -> String
$cshow :: RelyingPartyName -> String
showsPrec :: Int -> RelyingPartyName -> ShowS
$cshowsPrec :: Int -> RelyingPartyName -> ShowS
Show)
  deriving newtype (String -> RelyingPartyName
(String -> RelyingPartyName) -> IsString RelyingPartyName
forall a. (String -> a) -> IsString a
fromString :: String -> RelyingPartyName
$cfromString :: String -> RelyingPartyName
IsString, [RelyingPartyName] -> Encoding
[RelyingPartyName] -> Value
RelyingPartyName -> Encoding
RelyingPartyName -> Value
(RelyingPartyName -> Value)
-> (RelyingPartyName -> Encoding)
-> ([RelyingPartyName] -> Value)
-> ([RelyingPartyName] -> Encoding)
-> ToJSON RelyingPartyName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RelyingPartyName] -> Encoding
$ctoEncodingList :: [RelyingPartyName] -> Encoding
toJSONList :: [RelyingPartyName] -> Value
$ctoJSONList :: [RelyingPartyName] -> Value
toEncoding :: RelyingPartyName -> Encoding
$ctoEncoding :: RelyingPartyName -> Encoding
toJSON :: RelyingPartyName -> Value
$ctoJSON :: RelyingPartyName -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#user-handle)
-- The user handle is specified by a [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party),
-- as the value of 'id', and used to [map](https://www.w3.org/TR/webauthn-2/#authenticator-credentials-map)
-- a specific [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)
-- to a specific user account with the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party).
-- Authenticators in turn [map](https://www.w3.org/TR/webauthn-2/#authenticator-credentials-map)
-- [RP IDs](https://www.w3.org/TR/webauthn-2/#rp-id) and user handle pairs to [public key credential sources](https://www.w3.org/TR/webauthn-2/#public-key-credential-source).
-- A user handle is an opaque [byte sequence](https://infra.spec.whatwg.org/#byte-sequence)
-- with a maximum size of 64 bytes, and is not meant to be displayed to the user.
newtype UserHandle = UserHandle {UserHandle -> ByteString
unUserHandle :: BS.ByteString}
  deriving (UserHandle -> UserHandle -> Bool
(UserHandle -> UserHandle -> Bool)
-> (UserHandle -> UserHandle -> Bool) -> Eq UserHandle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserHandle -> UserHandle -> Bool
$c/= :: UserHandle -> UserHandle -> Bool
== :: UserHandle -> UserHandle -> Bool
$c== :: UserHandle -> UserHandle -> Bool
Eq, Int -> UserHandle -> ShowS
[UserHandle] -> ShowS
UserHandle -> String
(Int -> UserHandle -> ShowS)
-> (UserHandle -> String)
-> ([UserHandle] -> ShowS)
-> Show UserHandle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserHandle] -> ShowS
$cshowList :: [UserHandle] -> ShowS
show :: UserHandle -> String
$cshow :: UserHandle -> String
showsPrec :: Int -> UserHandle -> ShowS
$cshowsPrec :: Int -> UserHandle -> ShowS
Show, Eq UserHandle
Eq UserHandle
-> (UserHandle -> UserHandle -> Ordering)
-> (UserHandle -> UserHandle -> Bool)
-> (UserHandle -> UserHandle -> Bool)
-> (UserHandle -> UserHandle -> Bool)
-> (UserHandle -> UserHandle -> Bool)
-> (UserHandle -> UserHandle -> UserHandle)
-> (UserHandle -> UserHandle -> UserHandle)
-> Ord UserHandle
UserHandle -> UserHandle -> Bool
UserHandle -> UserHandle -> Ordering
UserHandle -> UserHandle -> UserHandle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UserHandle -> UserHandle -> UserHandle
$cmin :: UserHandle -> UserHandle -> UserHandle
max :: UserHandle -> UserHandle -> UserHandle
$cmax :: UserHandle -> UserHandle -> UserHandle
>= :: UserHandle -> UserHandle -> Bool
$c>= :: UserHandle -> UserHandle -> Bool
> :: UserHandle -> UserHandle -> Bool
$c> :: UserHandle -> UserHandle -> Bool
<= :: UserHandle -> UserHandle -> Bool
$c<= :: UserHandle -> UserHandle -> Bool
< :: UserHandle -> UserHandle -> Bool
$c< :: UserHandle -> UserHandle -> Bool
compare :: UserHandle -> UserHandle -> Ordering
$ccompare :: UserHandle -> UserHandle -> Ordering
Ord)
  deriving newtype ([UserHandle] -> Encoding
[UserHandle] -> Value
UserHandle -> Encoding
UserHandle -> Value
(UserHandle -> Value)
-> (UserHandle -> Encoding)
-> ([UserHandle] -> Value)
-> ([UserHandle] -> Encoding)
-> ToJSON UserHandle
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UserHandle] -> Encoding
$ctoEncodingList :: [UserHandle] -> Encoding
toJSONList :: [UserHandle] -> Value
$ctoJSONList :: [UserHandle] -> Value
toEncoding :: UserHandle -> Encoding
$ctoEncoding :: UserHandle -> Encoding
toJSON :: UserHandle -> Value
$ctoJSON :: UserHandle -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#user-handle)
-- A user handle is an opaque [byte sequence](https://infra.spec.whatwg.org/#byte-sequence)
-- with a maximum size of 64 bytes, and is not meant to be displayed to the user.
generateUserHandle :: MonadRandom m => m UserHandle
generateUserHandle :: forall (m :: * -> *). MonadRandom m => m UserHandle
generateUserHandle = ByteString -> UserHandle
UserHandle (ByteString -> UserHandle) -> m ByteString -> m UserHandle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
16

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-displayname)
-- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability) name for the user account,
-- intended only for display. For example, "Alex Müller" or "田中倫". The Relying Party SHOULD
-- let the user choose this, and SHOULD NOT restrict the choice more than necessary.
--
-- - [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) SHOULD perform
-- enforcement, as prescribed in Section 2.3 of [RFC8266](https://www.w3.org/TR/webauthn-2/#biblio-rfc8266)
-- for the Nickname Profile of the PRECIS FreeformClass [RFC8264](https://www.w3.org/TR/webauthn-2/#biblio-rfc8264),
-- when setting 'cueDisplayName's value, or displaying the value to the user.
-- - This string MAY contain language and direction metadata. [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)
-- SHOULD consider providing this information. See [§ 6.4.2 Language and Direction Encoding](https://www.w3.org/TR/webauthn-2/#sctn-strings-langdir)
-- about how this metadata is encoded.
newtype UserAccountDisplayName = UserAccountDisplayName {UserAccountDisplayName -> Text
unUserAccountDisplayName :: Text}
  deriving (UserAccountDisplayName -> UserAccountDisplayName -> Bool
(UserAccountDisplayName -> UserAccountDisplayName -> Bool)
-> (UserAccountDisplayName -> UserAccountDisplayName -> Bool)
-> Eq UserAccountDisplayName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserAccountDisplayName -> UserAccountDisplayName -> Bool
$c/= :: UserAccountDisplayName -> UserAccountDisplayName -> Bool
== :: UserAccountDisplayName -> UserAccountDisplayName -> Bool
$c== :: UserAccountDisplayName -> UserAccountDisplayName -> Bool
Eq, Int -> UserAccountDisplayName -> ShowS
[UserAccountDisplayName] -> ShowS
UserAccountDisplayName -> String
(Int -> UserAccountDisplayName -> ShowS)
-> (UserAccountDisplayName -> String)
-> ([UserAccountDisplayName] -> ShowS)
-> Show UserAccountDisplayName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserAccountDisplayName] -> ShowS
$cshowList :: [UserAccountDisplayName] -> ShowS
show :: UserAccountDisplayName -> String
$cshow :: UserAccountDisplayName -> String
showsPrec :: Int -> UserAccountDisplayName -> ShowS
$cshowsPrec :: Int -> UserAccountDisplayName -> ShowS
Show)
  deriving newtype (String -> UserAccountDisplayName
(String -> UserAccountDisplayName)
-> IsString UserAccountDisplayName
forall a. (String -> a) -> IsString a
fromString :: String -> UserAccountDisplayName
$cfromString :: String -> UserAccountDisplayName
IsString, [UserAccountDisplayName] -> Encoding
[UserAccountDisplayName] -> Value
UserAccountDisplayName -> Encoding
UserAccountDisplayName -> Value
(UserAccountDisplayName -> Value)
-> (UserAccountDisplayName -> Encoding)
-> ([UserAccountDisplayName] -> Value)
-> ([UserAccountDisplayName] -> Encoding)
-> ToJSON UserAccountDisplayName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UserAccountDisplayName] -> Encoding
$ctoEncodingList :: [UserAccountDisplayName] -> Encoding
toJSONList :: [UserAccountDisplayName] -> Value
$ctoJSONList :: [UserAccountDisplayName] -> Value
toEncoding :: UserAccountDisplayName -> Encoding
$ctoEncoding :: UserAccountDisplayName -> Encoding
toJSON :: UserAccountDisplayName -> Value
$ctoJSON :: UserAccountDisplayName -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)
-- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability) identifier for a user account.
-- It is intended only for display, i.e., aiding the user in determining the difference between user accounts with
-- similar 'cueDisplayName's. For example, "alexm", "alex.mueller@example.com" or "+14255551234".
--
-- - The [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) MAY let the user choose this value.
--   The [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) SHOULD perform enforcement,
--   as prescribed in Section 3.4.3 of [RFC8265](https://www.w3.org/TR/webauthn-2/#biblio-rfc8265)
--   for the UsernameCasePreserved Profile of the PRECIS IdentifierClass
--   [RFC8264](https://www.w3.org/TR/webauthn-2/#biblio-rfc8264), when setting 'UserAccountName's value,
--   or displaying the value to the user.
-- - This string MAY contain language and direction metadata.
--   [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) SHOULD consider providing this information.
--   See [§ 6.4.2 Language and Direction Encoding](https://www.w3.org/TR/webauthn-2/#sctn-strings-langdir)
--   about how this metadata is encoded.
newtype UserAccountName = UserAccountName {UserAccountName -> Text
unUserAccountName :: Text}
  deriving (UserAccountName -> UserAccountName -> Bool
(UserAccountName -> UserAccountName -> Bool)
-> (UserAccountName -> UserAccountName -> Bool)
-> Eq UserAccountName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserAccountName -> UserAccountName -> Bool
$c/= :: UserAccountName -> UserAccountName -> Bool
== :: UserAccountName -> UserAccountName -> Bool
$c== :: UserAccountName -> UserAccountName -> Bool
Eq, Int -> UserAccountName -> ShowS
[UserAccountName] -> ShowS
UserAccountName -> String
(Int -> UserAccountName -> ShowS)
-> (UserAccountName -> String)
-> ([UserAccountName] -> ShowS)
-> Show UserAccountName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserAccountName] -> ShowS
$cshowList :: [UserAccountName] -> ShowS
show :: UserAccountName -> String
$cshow :: UserAccountName -> String
showsPrec :: Int -> UserAccountName -> ShowS
$cshowsPrec :: Int -> UserAccountName -> ShowS
Show)
  deriving newtype (String -> UserAccountName
(String -> UserAccountName) -> IsString UserAccountName
forall a. (String -> a) -> IsString a
fromString :: String -> UserAccountName
$cfromString :: String -> UserAccountName
IsString, [UserAccountName] -> Encoding
[UserAccountName] -> Value
UserAccountName -> Encoding
UserAccountName -> Value
(UserAccountName -> Value)
-> (UserAccountName -> Encoding)
-> ([UserAccountName] -> Value)
-> ([UserAccountName] -> Encoding)
-> ToJSON UserAccountName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UserAccountName] -> Encoding
$ctoEncodingList :: [UserAccountName] -> Encoding
toJSONList :: [UserAccountName] -> Value
$ctoJSONList :: [UserAccountName] -> Value
toEncoding :: UserAccountName -> Encoding
$ctoEncoding :: UserAccountName -> Encoding
toJSON :: UserAccountName -> Value
$ctoJSON :: UserAccountName -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#credential-id)
-- A probabilistically-unique [byte sequence](https://infra.spec.whatwg.org/#byte-sequence)
-- identifying a [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential-source)
-- source and its [authentication assertions](https://www.w3.org/TR/webauthn-2/#authentication-assertion).
newtype CredentialId = CredentialId {CredentialId -> ByteString
unCredentialId :: BS.ByteString}
  deriving (CredentialId -> CredentialId -> Bool
(CredentialId -> CredentialId -> Bool)
-> (CredentialId -> CredentialId -> Bool) -> Eq CredentialId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialId -> CredentialId -> Bool
$c/= :: CredentialId -> CredentialId -> Bool
== :: CredentialId -> CredentialId -> Bool
$c== :: CredentialId -> CredentialId -> Bool
Eq, Int -> CredentialId -> ShowS
[CredentialId] -> ShowS
CredentialId -> String
(Int -> CredentialId -> ShowS)
-> (CredentialId -> String)
-> ([CredentialId] -> ShowS)
-> Show CredentialId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CredentialId] -> ShowS
$cshowList :: [CredentialId] -> ShowS
show :: CredentialId -> String
$cshow :: CredentialId -> String
showsPrec :: Int -> CredentialId -> ShowS
$cshowsPrec :: Int -> CredentialId -> ShowS
Show, Eq CredentialId
Eq CredentialId
-> (CredentialId -> CredentialId -> Ordering)
-> (CredentialId -> CredentialId -> Bool)
-> (CredentialId -> CredentialId -> Bool)
-> (CredentialId -> CredentialId -> Bool)
-> (CredentialId -> CredentialId -> Bool)
-> (CredentialId -> CredentialId -> CredentialId)
-> (CredentialId -> CredentialId -> CredentialId)
-> Ord CredentialId
CredentialId -> CredentialId -> Bool
CredentialId -> CredentialId -> Ordering
CredentialId -> CredentialId -> CredentialId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CredentialId -> CredentialId -> CredentialId
$cmin :: CredentialId -> CredentialId -> CredentialId
max :: CredentialId -> CredentialId -> CredentialId
$cmax :: CredentialId -> CredentialId -> CredentialId
>= :: CredentialId -> CredentialId -> Bool
$c>= :: CredentialId -> CredentialId -> Bool
> :: CredentialId -> CredentialId -> Bool
$c> :: CredentialId -> CredentialId -> Bool
<= :: CredentialId -> CredentialId -> Bool
$c<= :: CredentialId -> CredentialId -> Bool
< :: CredentialId -> CredentialId -> Bool
$c< :: CredentialId -> CredentialId -> Bool
compare :: CredentialId -> CredentialId -> Ordering
$ccompare :: CredentialId -> CredentialId -> Ordering
Ord)
  deriving newtype ([CredentialId] -> Encoding
[CredentialId] -> Value
CredentialId -> Encoding
CredentialId -> Value
(CredentialId -> Value)
-> (CredentialId -> Encoding)
-> ([CredentialId] -> Value)
-> ([CredentialId] -> Encoding)
-> ToJSON CredentialId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CredentialId] -> Encoding
$ctoEncodingList :: [CredentialId] -> Encoding
toJSONList :: [CredentialId] -> Value
$ctoJSONList :: [CredentialId] -> Value
toEncoding :: CredentialId -> Encoding
$ctoEncoding :: CredentialId -> Encoding
toJSON :: CredentialId -> Value
$ctoJSON :: CredentialId -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#credential-id)
-- Generates a random 'CredentialId' using 16 random bytes.
-- This is only useful for authenticators, not for relying parties.
-- This function is only included for completeness and testing purposes.
generateCredentialId :: MonadRandom m => m CredentialId
generateCredentialId :: forall (m :: * -> *). MonadRandom m => m CredentialId
generateCredentialId = ByteString -> CredentialId
CredentialId (ByteString -> CredentialId) -> m ByteString -> m CredentialId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
16

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges)
-- This member contains a challenge intended to be used for generating the newly
-- created credential’s attestation object. See the [§ 13.4.3 Cryptographic Challenges](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges)
-- security consideration.
newtype Challenge = Challenge {Challenge -> ByteString
unChallenge :: BS.ByteString}
  deriving (Challenge -> Challenge -> Bool
(Challenge -> Challenge -> Bool)
-> (Challenge -> Challenge -> Bool) -> Eq Challenge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Challenge -> Challenge -> Bool
$c/= :: Challenge -> Challenge -> Bool
== :: Challenge -> Challenge -> Bool
$c== :: Challenge -> Challenge -> Bool
Eq, Int -> Challenge -> ShowS
[Challenge] -> ShowS
Challenge -> String
(Int -> Challenge -> ShowS)
-> (Challenge -> String)
-> ([Challenge] -> ShowS)
-> Show Challenge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Challenge] -> ShowS
$cshowList :: [Challenge] -> ShowS
show :: Challenge -> String
$cshow :: Challenge -> String
showsPrec :: Int -> Challenge -> ShowS
$cshowsPrec :: Int -> Challenge -> ShowS
Show, Eq Challenge
Eq Challenge
-> (Challenge -> Challenge -> Ordering)
-> (Challenge -> Challenge -> Bool)
-> (Challenge -> Challenge -> Bool)
-> (Challenge -> Challenge -> Bool)
-> (Challenge -> Challenge -> Bool)
-> (Challenge -> Challenge -> Challenge)
-> (Challenge -> Challenge -> Challenge)
-> Ord Challenge
Challenge -> Challenge -> Bool
Challenge -> Challenge -> Ordering
Challenge -> Challenge -> Challenge
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Challenge -> Challenge -> Challenge
$cmin :: Challenge -> Challenge -> Challenge
max :: Challenge -> Challenge -> Challenge
$cmax :: Challenge -> Challenge -> Challenge
>= :: Challenge -> Challenge -> Bool
$c>= :: Challenge -> Challenge -> Bool
> :: Challenge -> Challenge -> Bool
$c> :: Challenge -> Challenge -> Bool
<= :: Challenge -> Challenge -> Bool
$c<= :: Challenge -> Challenge -> Bool
< :: Challenge -> Challenge -> Bool
$c< :: Challenge -> Challenge -> Bool
compare :: Challenge -> Challenge -> Ordering
$ccompare :: Challenge -> Challenge -> Ordering
Ord)
  deriving newtype ([Challenge] -> Encoding
[Challenge] -> Value
Challenge -> Encoding
Challenge -> Value
(Challenge -> Value)
-> (Challenge -> Encoding)
-> ([Challenge] -> Value)
-> ([Challenge] -> Encoding)
-> ToJSON Challenge
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Challenge] -> Encoding
$ctoEncodingList :: [Challenge] -> Encoding
toJSONList :: [Challenge] -> Value
$ctoJSONList :: [Challenge] -> Value
toEncoding :: Challenge -> Encoding
$ctoEncoding :: Challenge -> Encoding
toJSON :: Challenge -> Value
$ctoJSON :: Challenge -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges)
-- In order to prevent replay attacks, the challenges MUST contain enough entropy
-- to make guessing them infeasible. Challenges SHOULD therefore be at least 16 bytes long.
generateChallenge :: MonadRandom m => m Challenge
generateChallenge :: forall (m :: * -> *). MonadRandom m => m Challenge
generateChallenge = ByteString -> Challenge
Challenge (ByteString -> Challenge) -> m ByteString -> m Challenge
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
16

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-timeout)
-- This member specifies a time, in milliseconds, that the caller is willing to wait for the call to complete.
-- This is treated as a hint, and MAY be overridden by the [client](https://www.w3.org/TR/webauthn-2/#client).
newtype Timeout = Timeout {Timeout -> Word32
unTimeout :: Word32}
  deriving (Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c== :: Timeout -> Timeout -> Bool
Eq, Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timeout] -> ShowS
$cshowList :: [Timeout] -> ShowS
show :: Timeout -> String
$cshow :: Timeout -> String
showsPrec :: Int -> Timeout -> ShowS
$cshowsPrec :: Int -> Timeout -> ShowS
Show)
  deriving newtype ([Timeout] -> Encoding
[Timeout] -> Value
Timeout -> Encoding
Timeout -> Value
(Timeout -> Value)
-> (Timeout -> Encoding)
-> ([Timeout] -> Value)
-> ([Timeout] -> Encoding)
-> ToJSON Timeout
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Timeout] -> Encoding
$ctoEncodingList :: [Timeout] -> Encoding
toJSONList :: [Timeout] -> Value
$ctoJSONList :: [Timeout] -> Value
toEncoding :: Timeout -> Encoding
$ctoEncoding :: Timeout -> Encoding
toJSON :: Timeout -> Value
$ctoJSON :: Timeout -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#assertion-signature)
-- An assertion signature is produced when the
-- [authenticatorGetAssertion](https://www.w3.org/TR/webauthn-2/#authenticatorgetassertion)
-- method is invoked. It represents an assertion by the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)
-- that the user has [consented](https://www.w3.org/TR/webauthn-2/#user-consent)
-- to a specific transaction, such as logging in, or completing a purchase. Thus,
-- an [assertion signature](https://www.w3.org/TR/webauthn-2/#assertion-signature)
-- asserts that the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)
-- possessing a particular [credential private key](https://www.w3.org/TR/webauthn-2/#credential-private-key)
-- has established, to the best of its ability, that the user requesting this transaction
-- is the same user who [consented](https://www.w3.org/TR/webauthn-2/#user-consent)
-- to creating that particular [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential).
-- It also asserts additional information, termed [client data](https://www.w3.org/TR/webauthn-2/#client-data),
-- that may be useful to the caller, such as the means by which
-- [user consent](https://www.w3.org/TR/webauthn-2/#user-consent) was provided,
-- and the prompt shown to the user by the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator).
-- The [assertion signature](https://www.w3.org/TR/webauthn-2/#assertion-signature)
-- format is illustrated in [Figure 4, below](https://www.w3.org/TR/webauthn-2/#fig-signature).
newtype AssertionSignature = AssertionSignature {AssertionSignature -> ByteString
unAssertionSignature :: BS.ByteString}
  deriving (AssertionSignature -> AssertionSignature -> Bool
(AssertionSignature -> AssertionSignature -> Bool)
-> (AssertionSignature -> AssertionSignature -> Bool)
-> Eq AssertionSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionSignature -> AssertionSignature -> Bool
$c/= :: AssertionSignature -> AssertionSignature -> Bool
== :: AssertionSignature -> AssertionSignature -> Bool
$c== :: AssertionSignature -> AssertionSignature -> Bool
Eq, Int -> AssertionSignature -> ShowS
[AssertionSignature] -> ShowS
AssertionSignature -> String
(Int -> AssertionSignature -> ShowS)
-> (AssertionSignature -> String)
-> ([AssertionSignature] -> ShowS)
-> Show AssertionSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssertionSignature] -> ShowS
$cshowList :: [AssertionSignature] -> ShowS
show :: AssertionSignature -> String
$cshow :: AssertionSignature -> String
showsPrec :: Int -> AssertionSignature -> ShowS
$cshowsPrec :: Int -> AssertionSignature -> ShowS
Show)
  deriving newtype ([AssertionSignature] -> Encoding
[AssertionSignature] -> Value
AssertionSignature -> Encoding
AssertionSignature -> Value
(AssertionSignature -> Value)
-> (AssertionSignature -> Encoding)
-> ([AssertionSignature] -> Value)
-> ([AssertionSignature] -> Encoding)
-> ToJSON AssertionSignature
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AssertionSignature] -> Encoding
$ctoEncodingList :: [AssertionSignature] -> Encoding
toJSONList :: [AssertionSignature] -> Value
$ctoJSONList :: [AssertionSignature] -> Value
toEncoding :: AssertionSignature -> Encoding
$ctoEncoding :: AssertionSignature -> Encoding
toJSON :: AssertionSignature -> Value
$ctoJSON :: AssertionSignature -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#rpidhash)
-- SHA-256 hash of the [RP ID](https://www.w3.org/TR/webauthn-2/#rp-id) the
-- [credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) is
-- [scoped](https://www.w3.org/TR/webauthn-2/#scope) to.
newtype RpIdHash = RpIdHash {RpIdHash -> Digest SHA256
unRpIdHash :: Digest SHA256}
  deriving (RpIdHash -> RpIdHash -> Bool
(RpIdHash -> RpIdHash -> Bool)
-> (RpIdHash -> RpIdHash -> Bool) -> Eq RpIdHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpIdHash -> RpIdHash -> Bool
$c/= :: RpIdHash -> RpIdHash -> Bool
== :: RpIdHash -> RpIdHash -> Bool
$c== :: RpIdHash -> RpIdHash -> Bool
Eq, Int -> RpIdHash -> ShowS
[RpIdHash] -> ShowS
RpIdHash -> String
(Int -> RpIdHash -> ShowS)
-> (RpIdHash -> String) -> ([RpIdHash] -> ShowS) -> Show RpIdHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpIdHash] -> ShowS
$cshowList :: [RpIdHash] -> ShowS
show :: RpIdHash -> String
$cshow :: RpIdHash -> String
showsPrec :: Int -> RpIdHash -> ShowS
$cshowsPrec :: Int -> RpIdHash -> ShowS
Show)
  deriving newtype ([RpIdHash] -> Encoding
[RpIdHash] -> Value
RpIdHash -> Encoding
RpIdHash -> Value
(RpIdHash -> Value)
-> (RpIdHash -> Encoding)
-> ([RpIdHash] -> Value)
-> ([RpIdHash] -> Encoding)
-> ToJSON RpIdHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RpIdHash] -> Encoding
$ctoEncodingList :: [RpIdHash] -> Encoding
toJSONList :: [RpIdHash] -> Value
$ctoJSONList :: [RpIdHash] -> Value
toEncoding :: RpIdHash -> Encoding
$ctoEncoding :: RpIdHash -> Encoding
toJSON :: RpIdHash -> Value
$ctoJSON :: RpIdHash -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#collectedclientdata-hash-of-the-serialized-client-data)
-- This is the hash (computed using SHA-256) of the [JSON-compatible serialization of client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-json-compatible-serialization-of-client-data),
-- as constructed by the client.
newtype ClientDataHash = ClientDataHash {ClientDataHash -> Digest SHA256
unClientDataHash :: Digest SHA256}
  deriving (ClientDataHash -> ClientDataHash -> Bool
(ClientDataHash -> ClientDataHash -> Bool)
-> (ClientDataHash -> ClientDataHash -> Bool) -> Eq ClientDataHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientDataHash -> ClientDataHash -> Bool
$c/= :: ClientDataHash -> ClientDataHash -> Bool
== :: ClientDataHash -> ClientDataHash -> Bool
$c== :: ClientDataHash -> ClientDataHash -> Bool
Eq, Int -> ClientDataHash -> ShowS
[ClientDataHash] -> ShowS
ClientDataHash -> String
(Int -> ClientDataHash -> ShowS)
-> (ClientDataHash -> String)
-> ([ClientDataHash] -> ShowS)
-> Show ClientDataHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientDataHash] -> ShowS
$cshowList :: [ClientDataHash] -> ShowS
show :: ClientDataHash -> String
$cshow :: ClientDataHash -> String
showsPrec :: Int -> ClientDataHash -> ShowS
$cshowsPrec :: Int -> ClientDataHash -> ShowS
Show)
  deriving newtype ([ClientDataHash] -> Encoding
[ClientDataHash] -> Value
ClientDataHash -> Encoding
ClientDataHash -> Value
(ClientDataHash -> Value)
-> (ClientDataHash -> Encoding)
-> ([ClientDataHash] -> Value)
-> ([ClientDataHash] -> Encoding)
-> ToJSON ClientDataHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ClientDataHash] -> Encoding
$ctoEncodingList :: [ClientDataHash] -> Encoding
toJSONList :: [ClientDataHash] -> Value
$ctoJSONList :: [ClientDataHash] -> Value
toEncoding :: ClientDataHash -> Encoding
$ctoEncoding :: ClientDataHash -> Encoding
toJSON :: ClientDataHash -> Value
$ctoJSON :: ClientDataHash -> Value
ToJSON)

-- | [(spec)](https://html.spec.whatwg.org/multipage/origin.html#concept-origin)
newtype Origin = Origin {Origin -> Text
unOrigin :: Text}
  deriving (Origin -> Origin -> Bool
(Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool) -> Eq Origin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Origin -> Origin -> Bool
$c/= :: Origin -> Origin -> Bool
== :: Origin -> Origin -> Bool
$c== :: Origin -> Origin -> Bool
Eq, Int -> Origin -> ShowS
[Origin] -> ShowS
Origin -> String
(Int -> Origin -> ShowS)
-> (Origin -> String) -> ([Origin] -> ShowS) -> Show Origin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Origin] -> ShowS
$cshowList :: [Origin] -> ShowS
show :: Origin -> String
$cshow :: Origin -> String
showsPrec :: Int -> Origin -> ShowS
$cshowsPrec :: Int -> Origin -> ShowS
Show)
  deriving newtype (String -> Origin
(String -> Origin) -> IsString Origin
forall a. (String -> a) -> IsString a
fromString :: String -> Origin
$cfromString :: String -> Origin
IsString, [Origin] -> Encoding
[Origin] -> Value
Origin -> Encoding
Origin -> Value
(Origin -> Value)
-> (Origin -> Encoding)
-> ([Origin] -> Value)
-> ([Origin] -> Encoding)
-> ToJSON Origin
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Origin] -> Encoding
$ctoEncodingList :: [Origin] -> Encoding
toJSONList :: [Origin] -> Value
$ctoJSONList :: [Origin] -> Value
toEncoding :: Origin -> Encoding
$ctoEncoding :: Origin -> Encoding
toJSON :: Origin -> Value
$ctoJSON :: Origin -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#signcount)
-- [Signature counter](https://www.w3.org/TR/webauthn-2/#signature-counter)
newtype SignatureCounter = SignatureCounter {SignatureCounter -> Word32
unSignatureCounter :: Word32}
  deriving (SignatureCounter -> SignatureCounter -> Bool
(SignatureCounter -> SignatureCounter -> Bool)
-> (SignatureCounter -> SignatureCounter -> Bool)
-> Eq SignatureCounter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureCounter -> SignatureCounter -> Bool
$c/= :: SignatureCounter -> SignatureCounter -> Bool
== :: SignatureCounter -> SignatureCounter -> Bool
$c== :: SignatureCounter -> SignatureCounter -> Bool
Eq, Int -> SignatureCounter -> ShowS
[SignatureCounter] -> ShowS
SignatureCounter -> String
(Int -> SignatureCounter -> ShowS)
-> (SignatureCounter -> String)
-> ([SignatureCounter] -> ShowS)
-> Show SignatureCounter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureCounter] -> ShowS
$cshowList :: [SignatureCounter] -> ShowS
show :: SignatureCounter -> String
$cshow :: SignatureCounter -> String
showsPrec :: Int -> SignatureCounter -> ShowS
$cshowsPrec :: Int -> SignatureCounter -> ShowS
Show)
  deriving newtype (Integer -> SignatureCounter
SignatureCounter -> SignatureCounter
SignatureCounter -> SignatureCounter -> SignatureCounter
(SignatureCounter -> SignatureCounter -> SignatureCounter)
-> (SignatureCounter -> SignatureCounter -> SignatureCounter)
-> (SignatureCounter -> SignatureCounter -> SignatureCounter)
-> (SignatureCounter -> SignatureCounter)
-> (SignatureCounter -> SignatureCounter)
-> (SignatureCounter -> SignatureCounter)
-> (Integer -> SignatureCounter)
-> Num SignatureCounter
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> SignatureCounter
$cfromInteger :: Integer -> SignatureCounter
signum :: SignatureCounter -> SignatureCounter
$csignum :: SignatureCounter -> SignatureCounter
abs :: SignatureCounter -> SignatureCounter
$cabs :: SignatureCounter -> SignatureCounter
negate :: SignatureCounter -> SignatureCounter
$cnegate :: SignatureCounter -> SignatureCounter
* :: SignatureCounter -> SignatureCounter -> SignatureCounter
$c* :: SignatureCounter -> SignatureCounter -> SignatureCounter
- :: SignatureCounter -> SignatureCounter -> SignatureCounter
$c- :: SignatureCounter -> SignatureCounter -> SignatureCounter
+ :: SignatureCounter -> SignatureCounter -> SignatureCounter
$c+ :: SignatureCounter -> SignatureCounter -> SignatureCounter
Num, Eq SignatureCounter
Eq SignatureCounter
-> (SignatureCounter -> SignatureCounter -> Ordering)
-> (SignatureCounter -> SignatureCounter -> Bool)
-> (SignatureCounter -> SignatureCounter -> Bool)
-> (SignatureCounter -> SignatureCounter -> Bool)
-> (SignatureCounter -> SignatureCounter -> Bool)
-> (SignatureCounter -> SignatureCounter -> SignatureCounter)
-> (SignatureCounter -> SignatureCounter -> SignatureCounter)
-> Ord SignatureCounter
SignatureCounter -> SignatureCounter -> Bool
SignatureCounter -> SignatureCounter -> Ordering
SignatureCounter -> SignatureCounter -> SignatureCounter
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SignatureCounter -> SignatureCounter -> SignatureCounter
$cmin :: SignatureCounter -> SignatureCounter -> SignatureCounter
max :: SignatureCounter -> SignatureCounter -> SignatureCounter
$cmax :: SignatureCounter -> SignatureCounter -> SignatureCounter
>= :: SignatureCounter -> SignatureCounter -> Bool
$c>= :: SignatureCounter -> SignatureCounter -> Bool
> :: SignatureCounter -> SignatureCounter -> Bool
$c> :: SignatureCounter -> SignatureCounter -> Bool
<= :: SignatureCounter -> SignatureCounter -> Bool
$c<= :: SignatureCounter -> SignatureCounter -> Bool
< :: SignatureCounter -> SignatureCounter -> Bool
$c< :: SignatureCounter -> SignatureCounter -> Bool
compare :: SignatureCounter -> SignatureCounter -> Ordering
$ccompare :: SignatureCounter -> SignatureCounter -> Ordering
Ord, [SignatureCounter] -> Encoding
[SignatureCounter] -> Value
SignatureCounter -> Encoding
SignatureCounter -> Value
(SignatureCounter -> Value)
-> (SignatureCounter -> Encoding)
-> ([SignatureCounter] -> Value)
-> ([SignatureCounter] -> Encoding)
-> ToJSON SignatureCounter
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SignatureCounter] -> Encoding
$ctoEncodingList :: [SignatureCounter] -> Encoding
toJSONList :: [SignatureCounter] -> Value
$ctoJSONList :: [SignatureCounter] -> Value
toEncoding :: SignatureCounter -> Encoding
$ctoEncoding :: SignatureCounter -> Encoding
toJSON :: SignatureCounter -> Value
$ctoJSON :: SignatureCounter -> Value
ToJSON)

-- | The encoding of a 'Cose.CosePublicKey'
newtype PublicKeyBytes = PublicKeyBytes {PublicKeyBytes -> ByteString
unPublicKeyBytes :: BS.ByteString}
  deriving (PublicKeyBytes -> PublicKeyBytes -> Bool
(PublicKeyBytes -> PublicKeyBytes -> Bool)
-> (PublicKeyBytes -> PublicKeyBytes -> Bool) -> Eq PublicKeyBytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKeyBytes -> PublicKeyBytes -> Bool
$c/= :: PublicKeyBytes -> PublicKeyBytes -> Bool
== :: PublicKeyBytes -> PublicKeyBytes -> Bool
$c== :: PublicKeyBytes -> PublicKeyBytes -> Bool
Eq, Int -> PublicKeyBytes -> ShowS
[PublicKeyBytes] -> ShowS
PublicKeyBytes -> String
(Int -> PublicKeyBytes -> ShowS)
-> (PublicKeyBytes -> String)
-> ([PublicKeyBytes] -> ShowS)
-> Show PublicKeyBytes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKeyBytes] -> ShowS
$cshowList :: [PublicKeyBytes] -> ShowS
show :: PublicKeyBytes -> String
$cshow :: PublicKeyBytes -> String
showsPrec :: Int -> PublicKeyBytes -> ShowS
$cshowsPrec :: Int -> PublicKeyBytes -> ShowS
Show)
  deriving newtype ([PublicKeyBytes] -> Encoding
[PublicKeyBytes] -> Value
PublicKeyBytes -> Encoding
PublicKeyBytes -> Value
(PublicKeyBytes -> Value)
-> (PublicKeyBytes -> Encoding)
-> ([PublicKeyBytes] -> Value)
-> ([PublicKeyBytes] -> Encoding)
-> ToJSON PublicKeyBytes
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PublicKeyBytes] -> Encoding
$ctoEncodingList :: [PublicKeyBytes] -> Encoding
toJSONList :: [PublicKeyBytes] -> Value
$ctoJSONList :: [PublicKeyBytes] -> Value
toEncoding :: PublicKeyBytes -> Encoding
$ctoEncoding :: PublicKeyBytes -> Encoding
toJSON :: PublicKeyBytes -> Value
$ctoJSON :: PublicKeyBytes -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authentication-extensions-client-inputs)
-- This is a dictionary containing the [client extension input](https://www.w3.org/TR/webauthn-2/#client-extension-input)
-- values for zero or more [WebAuthn Extensions](https://www.w3.org/TR/webauthn-2/#webauthn-extensions).
-- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model.Types#extensions".
data AuthenticationExtensionsClientInputs = AuthenticationExtensionsClientInputs
  {
  }
  deriving (AuthenticationExtensionsClientInputs
-> AuthenticationExtensionsClientInputs -> Bool
(AuthenticationExtensionsClientInputs
 -> AuthenticationExtensionsClientInputs -> Bool)
-> (AuthenticationExtensionsClientInputs
    -> AuthenticationExtensionsClientInputs -> Bool)
-> Eq AuthenticationExtensionsClientInputs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticationExtensionsClientInputs
-> AuthenticationExtensionsClientInputs -> Bool
$c/= :: AuthenticationExtensionsClientInputs
-> AuthenticationExtensionsClientInputs -> Bool
== :: AuthenticationExtensionsClientInputs
-> AuthenticationExtensionsClientInputs -> Bool
$c== :: AuthenticationExtensionsClientInputs
-> AuthenticationExtensionsClientInputs -> Bool
Eq, Int -> AuthenticationExtensionsClientInputs -> ShowS
[AuthenticationExtensionsClientInputs] -> ShowS
AuthenticationExtensionsClientInputs -> String
(Int -> AuthenticationExtensionsClientInputs -> ShowS)
-> (AuthenticationExtensionsClientInputs -> String)
-> ([AuthenticationExtensionsClientInputs] -> ShowS)
-> Show AuthenticationExtensionsClientInputs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationExtensionsClientInputs] -> ShowS
$cshowList :: [AuthenticationExtensionsClientInputs] -> ShowS
show :: AuthenticationExtensionsClientInputs -> String
$cshow :: AuthenticationExtensionsClientInputs -> String
showsPrec :: Int -> AuthenticationExtensionsClientInputs -> ShowS
$cshowsPrec :: Int -> AuthenticationExtensionsClientInputs -> ShowS
Show)

instance ToJSON AuthenticationExtensionsClientInputs where
  toJSON :: AuthenticationExtensionsClientInputs -> Value
toJSON AuthenticationExtensionsClientInputs
_ = [Pair] -> Value
object []

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authentication-extensions-client-outputs)
-- This is a dictionary containing the [client extension output](https://www.w3.org/TR/webauthn-2/#client-extension-output)
-- values for zero or more [WebAuthn Extensions](https://www.w3.org/TR/webauthn-2/#webauthn-extensions).
-- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model.Types#extensions".
data AuthenticationExtensionsClientOutputs = AuthenticationExtensionsClientOutputs
  {
  }
  deriving (AuthenticationExtensionsClientOutputs
-> AuthenticationExtensionsClientOutputs -> Bool
(AuthenticationExtensionsClientOutputs
 -> AuthenticationExtensionsClientOutputs -> Bool)
-> (AuthenticationExtensionsClientOutputs
    -> AuthenticationExtensionsClientOutputs -> Bool)
-> Eq AuthenticationExtensionsClientOutputs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticationExtensionsClientOutputs
-> AuthenticationExtensionsClientOutputs -> Bool
$c/= :: AuthenticationExtensionsClientOutputs
-> AuthenticationExtensionsClientOutputs -> Bool
== :: AuthenticationExtensionsClientOutputs
-> AuthenticationExtensionsClientOutputs -> Bool
$c== :: AuthenticationExtensionsClientOutputs
-> AuthenticationExtensionsClientOutputs -> Bool
Eq, Int -> AuthenticationExtensionsClientOutputs -> ShowS
[AuthenticationExtensionsClientOutputs] -> ShowS
AuthenticationExtensionsClientOutputs -> String
(Int -> AuthenticationExtensionsClientOutputs -> ShowS)
-> (AuthenticationExtensionsClientOutputs -> String)
-> ([AuthenticationExtensionsClientOutputs] -> ShowS)
-> Show AuthenticationExtensionsClientOutputs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationExtensionsClientOutputs] -> ShowS
$cshowList :: [AuthenticationExtensionsClientOutputs] -> ShowS
show :: AuthenticationExtensionsClientOutputs -> String
$cshow :: AuthenticationExtensionsClientOutputs -> String
showsPrec :: Int -> AuthenticationExtensionsClientOutputs -> ShowS
$cshowsPrec :: Int -> AuthenticationExtensionsClientOutputs -> ShowS
Show)

instance ToJSON AuthenticationExtensionsClientOutputs where
  toJSON :: AuthenticationExtensionsClientOutputs -> Value
toJSON AuthenticationExtensionsClientOutputs
_ = [Pair] -> Value
object []

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#authenticator-extension-output)
data AuthenticatorExtensionOutputs = AuthenticatorExtensionOutputs
  {
  }
  deriving (AuthenticatorExtensionOutputs
-> AuthenticatorExtensionOutputs -> Bool
(AuthenticatorExtensionOutputs
 -> AuthenticatorExtensionOutputs -> Bool)
-> (AuthenticatorExtensionOutputs
    -> AuthenticatorExtensionOutputs -> Bool)
-> Eq AuthenticatorExtensionOutputs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatorExtensionOutputs
-> AuthenticatorExtensionOutputs -> Bool
$c/= :: AuthenticatorExtensionOutputs
-> AuthenticatorExtensionOutputs -> Bool
== :: AuthenticatorExtensionOutputs
-> AuthenticatorExtensionOutputs -> Bool
$c== :: AuthenticatorExtensionOutputs
-> AuthenticatorExtensionOutputs -> Bool
Eq, Int -> AuthenticatorExtensionOutputs -> ShowS
[AuthenticatorExtensionOutputs] -> ShowS
AuthenticatorExtensionOutputs -> String
(Int -> AuthenticatorExtensionOutputs -> ShowS)
-> (AuthenticatorExtensionOutputs -> String)
-> ([AuthenticatorExtensionOutputs] -> ShowS)
-> Show AuthenticatorExtensionOutputs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatorExtensionOutputs] -> ShowS
$cshowList :: [AuthenticatorExtensionOutputs] -> ShowS
show :: AuthenticatorExtensionOutputs -> String
$cshow :: AuthenticatorExtensionOutputs -> String
showsPrec :: Int -> AuthenticatorExtensionOutputs -> ShowS
$cshowsPrec :: Int -> AuthenticatorExtensionOutputs -> ShowS
Show)

instance ToJSON AuthenticatorExtensionOutputs where
  toJSON :: AuthenticatorExtensionOutputs -> Value
toJSON AuthenticatorExtensionOutputs
_ = [Pair] -> Value
object []

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-rp-credential-params)
-- The 'CredentialRpEntity' dictionary is used to supply additional
-- [Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party) attributes when creating a new credential.
data CredentialRpEntity = CredentialRpEntity
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrpentity-id)
    -- A unique identifier for the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- entity, which sets the 'RpId'.
    CredentialRpEntity -> Maybe RpId
creId :: Maybe RpId,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)
    -- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability)
    -- identifier for the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party),
    -- intended only for display. For example, "ACME Corporation", "Wonderful Widgets, Inc." or "ОАО Примертех".
    CredentialRpEntity -> RelyingPartyName
creName :: RelyingPartyName
  }
  deriving (CredentialRpEntity -> CredentialRpEntity -> Bool
(CredentialRpEntity -> CredentialRpEntity -> Bool)
-> (CredentialRpEntity -> CredentialRpEntity -> Bool)
-> Eq CredentialRpEntity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialRpEntity -> CredentialRpEntity -> Bool
$c/= :: CredentialRpEntity -> CredentialRpEntity -> Bool
== :: CredentialRpEntity -> CredentialRpEntity -> Bool
$c== :: CredentialRpEntity -> CredentialRpEntity -> Bool
Eq, Int -> CredentialRpEntity -> ShowS
[CredentialRpEntity] -> ShowS
CredentialRpEntity -> String
(Int -> CredentialRpEntity -> ShowS)
-> (CredentialRpEntity -> String)
-> ([CredentialRpEntity] -> ShowS)
-> Show CredentialRpEntity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CredentialRpEntity] -> ShowS
$cshowList :: [CredentialRpEntity] -> ShowS
show :: CredentialRpEntity -> String
$cshow :: CredentialRpEntity -> String
showsPrec :: Int -> CredentialRpEntity -> ShowS
$cshowsPrec :: Int -> CredentialRpEntity -> ShowS
Show, (forall x. CredentialRpEntity -> Rep CredentialRpEntity x)
-> (forall x. Rep CredentialRpEntity x -> CredentialRpEntity)
-> Generic CredentialRpEntity
forall x. Rep CredentialRpEntity x -> CredentialRpEntity
forall x. CredentialRpEntity -> Rep CredentialRpEntity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CredentialRpEntity x -> CredentialRpEntity
$cfrom :: forall x. CredentialRpEntity -> Rep CredentialRpEntity x
Generic, [CredentialRpEntity] -> Encoding
[CredentialRpEntity] -> Value
CredentialRpEntity -> Encoding
CredentialRpEntity -> Value
(CredentialRpEntity -> Value)
-> (CredentialRpEntity -> Encoding)
-> ([CredentialRpEntity] -> Value)
-> ([CredentialRpEntity] -> Encoding)
-> ToJSON CredentialRpEntity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CredentialRpEntity] -> Encoding
$ctoEncodingList :: [CredentialRpEntity] -> Encoding
toJSONList :: [CredentialRpEntity] -> Value
$ctoJSONList :: [CredentialRpEntity] -> Value
toEncoding :: CredentialRpEntity -> Encoding
$ctoEncoding :: CredentialRpEntity -> Encoding
toJSON :: CredentialRpEntity -> Value
$ctoJSON :: CredentialRpEntity -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-user-credential-params)
-- The 'CredentialUserEntity' dictionary is used to supply additional
-- user account attributes when creating a new credential.
data CredentialUserEntity = CredentialUserEntity
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-id)
    -- The 'UserHandle' of the user account entity.
    -- To ensure secure operation, authentication and authorization decisions MUST
    -- be made on the basis of this 'cueId' member, not the 'cueDisplayName' nor 'cueName' members.
    -- See Section 6.1 of [RFC8266](https://www.w3.org/TR/webauthn-2/#biblio-rfc8266).
    -- The 'UserHandle' MUST NOT contain personally identifying information about the user, such as a username
    -- or e-mail address; see [§ 14.6.1 User Handle Contents](https://www.w3.org/TR/webauthn-2/#sctn-user-handle-privacy)
    -- for details. The user handle MUST NOT be empty, though it MAY be null.
    -- NOTE: We don't allow encoding it as null here, because it isn't an
    -- allowed value in the client, see <https://www.w3.org/TR/webauthn-2/#sctn-createCredential>
    -- This was confirmed and a fix was merged: <https://github.com/w3c/webauthn/pull/1600>
    CredentialUserEntity -> UserHandle
cueId :: UserHandle,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-displayname)
    -- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability) name for the user account,
    -- intended only for display. For example, "Alex Müller" or "田中倫".
    CredentialUserEntity -> UserAccountDisplayName
cueDisplayName :: UserAccountDisplayName,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)
    -- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability) identifier for a user account.
    -- It is intended only for display, i.e., aiding the user in determining the difference between user
    -- accounts with similar 'cueDisplayName's. For example, "alexm", "alex.mueller@example.com" or "+14255551234".
    CredentialUserEntity -> UserAccountName
cueName :: UserAccountName
  }
  deriving (CredentialUserEntity -> CredentialUserEntity -> Bool
(CredentialUserEntity -> CredentialUserEntity -> Bool)
-> (CredentialUserEntity -> CredentialUserEntity -> Bool)
-> Eq CredentialUserEntity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialUserEntity -> CredentialUserEntity -> Bool
$c/= :: CredentialUserEntity -> CredentialUserEntity -> Bool
== :: CredentialUserEntity -> CredentialUserEntity -> Bool
$c== :: CredentialUserEntity -> CredentialUserEntity -> Bool
Eq, Int -> CredentialUserEntity -> ShowS
[CredentialUserEntity] -> ShowS
CredentialUserEntity -> String
(Int -> CredentialUserEntity -> ShowS)
-> (CredentialUserEntity -> String)
-> ([CredentialUserEntity] -> ShowS)
-> Show CredentialUserEntity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CredentialUserEntity] -> ShowS
$cshowList :: [CredentialUserEntity] -> ShowS
show :: CredentialUserEntity -> String
$cshow :: CredentialUserEntity -> String
showsPrec :: Int -> CredentialUserEntity -> ShowS
$cshowsPrec :: Int -> CredentialUserEntity -> ShowS
Show, (forall x. CredentialUserEntity -> Rep CredentialUserEntity x)
-> (forall x. Rep CredentialUserEntity x -> CredentialUserEntity)
-> Generic CredentialUserEntity
forall x. Rep CredentialUserEntity x -> CredentialUserEntity
forall x. CredentialUserEntity -> Rep CredentialUserEntity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CredentialUserEntity x -> CredentialUserEntity
$cfrom :: forall x. CredentialUserEntity -> Rep CredentialUserEntity x
Generic, [CredentialUserEntity] -> Encoding
[CredentialUserEntity] -> Value
CredentialUserEntity -> Encoding
CredentialUserEntity -> Value
(CredentialUserEntity -> Value)
-> (CredentialUserEntity -> Encoding)
-> ([CredentialUserEntity] -> Value)
-> ([CredentialUserEntity] -> Encoding)
-> ToJSON CredentialUserEntity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CredentialUserEntity] -> Encoding
$ctoEncodingList :: [CredentialUserEntity] -> Encoding
toJSONList :: [CredentialUserEntity] -> Value
$ctoJSONList :: [CredentialUserEntity] -> Value
toEncoding :: CredentialUserEntity -> Encoding
$ctoEncoding :: CredentialUserEntity -> Encoding
toJSON :: CredentialUserEntity -> Value
$ctoJSON :: CredentialUserEntity -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-credential-params)
-- This dictionary is used to supply additional parameters when creating a new credential.
data CredentialParameters = CredentialParameters
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialparameters-type)
    -- This member specifies the type of credential to be created.
    CredentialParameters -> CredentialType
cpTyp :: CredentialType,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialparameters-alg)
    -- This member specifies the cryptographic signature algorithm with which the newly
    -- generated credential will be used, and thus also the type of asymmetric
    -- key pair to be generated, e.g., RSA or Elliptic Curve.
    CredentialParameters -> CoseSignAlg
cpAlg :: Cose.CoseSignAlg
  }
  deriving (CredentialParameters -> CredentialParameters -> Bool
(CredentialParameters -> CredentialParameters -> Bool)
-> (CredentialParameters -> CredentialParameters -> Bool)
-> Eq CredentialParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialParameters -> CredentialParameters -> Bool
$c/= :: CredentialParameters -> CredentialParameters -> Bool
== :: CredentialParameters -> CredentialParameters -> Bool
$c== :: CredentialParameters -> CredentialParameters -> Bool
Eq, Int -> CredentialParameters -> ShowS
[CredentialParameters] -> ShowS
CredentialParameters -> String
(Int -> CredentialParameters -> ShowS)
-> (CredentialParameters -> String)
-> ([CredentialParameters] -> ShowS)
-> Show CredentialParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CredentialParameters] -> ShowS
$cshowList :: [CredentialParameters] -> ShowS
show :: CredentialParameters -> String
$cshow :: CredentialParameters -> String
showsPrec :: Int -> CredentialParameters -> ShowS
$cshowsPrec :: Int -> CredentialParameters -> ShowS
Show, (forall x. CredentialParameters -> Rep CredentialParameters x)
-> (forall x. Rep CredentialParameters x -> CredentialParameters)
-> Generic CredentialParameters
forall x. Rep CredentialParameters x -> CredentialParameters
forall x. CredentialParameters -> Rep CredentialParameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CredentialParameters x -> CredentialParameters
$cfrom :: forall x. CredentialParameters -> Rep CredentialParameters x
Generic, [CredentialParameters] -> Encoding
[CredentialParameters] -> Value
CredentialParameters -> Encoding
CredentialParameters -> Value
(CredentialParameters -> Value)
-> (CredentialParameters -> Encoding)
-> ([CredentialParameters] -> Value)
-> ([CredentialParameters] -> Encoding)
-> ToJSON CredentialParameters
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CredentialParameters] -> Encoding
$ctoEncodingList :: [CredentialParameters] -> Encoding
toJSONList :: [CredentialParameters] -> Value
$ctoJSONList :: [CredentialParameters] -> Value
toEncoding :: CredentialParameters -> Encoding
$ctoEncoding :: CredentialParameters -> Encoding
toJSON :: CredentialParameters -> Value
$ctoJSON :: CredentialParameters -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialdescriptor)
-- This dictionary contains the attributes that are specified by a caller when referring to a
-- [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) as an input parameter to the
-- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) or
-- [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) methods.
-- It mirrors the fields of the 'Credential' object returned by the latter methods.
data CredentialDescriptor = CredentialDescriptor
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-type)
    -- This member contains the type of the [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) the caller is referring to.
    CredentialDescriptor -> CredentialType
cdTyp :: CredentialType,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-id)
    -- This member contains the [credential ID](https://www.w3.org/TR/webauthn-2/#credential-id) of the
    -- [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) the caller is referring to.
    CredentialDescriptor -> CredentialId
cdId :: CredentialId,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-transports)
    -- This OPTIONAL member contains a hint as to how the [client](https://www.w3.org/TR/webauthn-2/#client)
    -- might communicate with the [managing authenticator](https://www.w3.org/TR/webauthn-2/#public-key-credential-source-managing-authenticator)
    -- of the [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) the caller is referring to.
    CredentialDescriptor -> Maybe [AuthenticatorTransport]
cdTransports :: Maybe [AuthenticatorTransport]
  }
  deriving (CredentialDescriptor -> CredentialDescriptor -> Bool
(CredentialDescriptor -> CredentialDescriptor -> Bool)
-> (CredentialDescriptor -> CredentialDescriptor -> Bool)
-> Eq CredentialDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialDescriptor -> CredentialDescriptor -> Bool
$c/= :: CredentialDescriptor -> CredentialDescriptor -> Bool
== :: CredentialDescriptor -> CredentialDescriptor -> Bool
$c== :: CredentialDescriptor -> CredentialDescriptor -> Bool
Eq, Int -> CredentialDescriptor -> ShowS
[CredentialDescriptor] -> ShowS
CredentialDescriptor -> String
(Int -> CredentialDescriptor -> ShowS)
-> (CredentialDescriptor -> String)
-> ([CredentialDescriptor] -> ShowS)
-> Show CredentialDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CredentialDescriptor] -> ShowS
$cshowList :: [CredentialDescriptor] -> ShowS
show :: CredentialDescriptor -> String
$cshow :: CredentialDescriptor -> String
showsPrec :: Int -> CredentialDescriptor -> ShowS
$cshowsPrec :: Int -> CredentialDescriptor -> ShowS
Show, (forall x. CredentialDescriptor -> Rep CredentialDescriptor x)
-> (forall x. Rep CredentialDescriptor x -> CredentialDescriptor)
-> Generic CredentialDescriptor
forall x. Rep CredentialDescriptor x -> CredentialDescriptor
forall x. CredentialDescriptor -> Rep CredentialDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CredentialDescriptor x -> CredentialDescriptor
$cfrom :: forall x. CredentialDescriptor -> Rep CredentialDescriptor x
Generic, [CredentialDescriptor] -> Encoding
[CredentialDescriptor] -> Value
CredentialDescriptor -> Encoding
CredentialDescriptor -> Value
(CredentialDescriptor -> Value)
-> (CredentialDescriptor -> Encoding)
-> ([CredentialDescriptor] -> Value)
-> ([CredentialDescriptor] -> Encoding)
-> ToJSON CredentialDescriptor
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CredentialDescriptor] -> Encoding
$ctoEncodingList :: [CredentialDescriptor] -> Encoding
toJSONList :: [CredentialDescriptor] -> Value
$ctoJSONList :: [CredentialDescriptor] -> Value
toEncoding :: CredentialDescriptor -> Encoding
$ctoEncoding :: CredentialDescriptor -> Encoding
toJSON :: CredentialDescriptor -> Value
$ctoJSON :: CredentialDescriptor -> Value
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-authenticatorselectioncriteria)
-- [WebAuthn Relying Parties](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)
-- may use the 'AuthenticatorSelectionCriteria' dictionary to specify their
-- requirements regarding authenticator attributes.
data AuthenticatorSelectionCriteria = AuthenticatorSelectionCriteria
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-authenticatorattachment)
    -- If this member is present, eligible authenticators are filtered to
    -- only authenticators attached with the specified [§ 5.4.5 Authenticator
    -- Attachment Enumeration (enum AuthenticatorAttachment)](https://www.w3.org/TR/webauthn-2/#enum-attachment).
    AuthenticatorSelectionCriteria -> Maybe AuthenticatorAttachment
ascAuthenticatorAttachment :: Maybe AuthenticatorAttachment,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-residentkey)
    -- Specifies the extent to which the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
    -- desires to create a [client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential).
    -- For historical reasons the naming retains the deprecated “resident” terminology.
    -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.ascResidentKeyDefault'.
    AuthenticatorSelectionCriteria -> ResidentKeyRequirement
ascResidentKey :: ResidentKeyRequirement,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-userverification)
    -- This member describes the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)'s
    -- requirements regarding [user verification](https://www.w3.org/TR/webauthn-2/#user-verification)
    -- for the [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)
    -- operation. Eligible authenticators are filtered to only those capable of satisfying this requirement.
    -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.ascUserVerificationDefault'.
    AuthenticatorSelectionCriteria -> UserVerificationRequirement
ascUserVerification :: UserVerificationRequirement
  }
  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, [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
ToJSON)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#flags)
data AuthenticatorDataFlags = AuthenticatorDataFlags
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#concept-user-present)
    -- Upon successful completion of a [user presence test](https://www.w3.org/TR/webauthn-2/#test-of-user-presence),
    -- the user is said to be "[present](https://www.w3.org/TR/webauthn-2/#concept-user-present)".
    AuthenticatorDataFlags -> Bool
adfUserPresent :: Bool,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#concept-user-verified)
    -- Upon successful completion of a [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) process,
    -- the user is said to be "[verified](https://www.w3.org/TR/webauthn-2/#concept-user-verified)".
    AuthenticatorDataFlags -> Bool
adfUserVerified :: Bool
  }
  deriving (AuthenticatorDataFlags -> AuthenticatorDataFlags -> Bool
(AuthenticatorDataFlags -> AuthenticatorDataFlags -> Bool)
-> (AuthenticatorDataFlags -> AuthenticatorDataFlags -> Bool)
-> Eq AuthenticatorDataFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatorDataFlags -> AuthenticatorDataFlags -> Bool
$c/= :: AuthenticatorDataFlags -> AuthenticatorDataFlags -> Bool
== :: AuthenticatorDataFlags -> AuthenticatorDataFlags -> Bool
$c== :: AuthenticatorDataFlags -> AuthenticatorDataFlags -> Bool
Eq, Int -> AuthenticatorDataFlags -> ShowS
[AuthenticatorDataFlags] -> ShowS
AuthenticatorDataFlags -> String
(Int -> AuthenticatorDataFlags -> ShowS)
-> (AuthenticatorDataFlags -> String)
-> ([AuthenticatorDataFlags] -> ShowS)
-> Show AuthenticatorDataFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatorDataFlags] -> ShowS
$cshowList :: [AuthenticatorDataFlags] -> ShowS
show :: AuthenticatorDataFlags -> String
$cshow :: AuthenticatorDataFlags -> String
showsPrec :: Int -> AuthenticatorDataFlags -> ShowS
$cshowsPrec :: Int -> AuthenticatorDataFlags -> ShowS
Show, (forall x. AuthenticatorDataFlags -> Rep AuthenticatorDataFlags x)
-> (forall x.
    Rep AuthenticatorDataFlags x -> AuthenticatorDataFlags)
-> Generic AuthenticatorDataFlags
forall x. Rep AuthenticatorDataFlags x -> AuthenticatorDataFlags
forall x. AuthenticatorDataFlags -> Rep AuthenticatorDataFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthenticatorDataFlags x -> AuthenticatorDataFlags
$cfrom :: forall x. AuthenticatorDataFlags -> Rep AuthenticatorDataFlags x
Generic, [AuthenticatorDataFlags] -> Encoding
[AuthenticatorDataFlags] -> Value
AuthenticatorDataFlags -> Encoding
AuthenticatorDataFlags -> Value
(AuthenticatorDataFlags -> Value)
-> (AuthenticatorDataFlags -> Encoding)
-> ([AuthenticatorDataFlags] -> Value)
-> ([AuthenticatorDataFlags] -> Encoding)
-> ToJSON AuthenticatorDataFlags
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AuthenticatorDataFlags] -> Encoding
$ctoEncodingList :: [AuthenticatorDataFlags] -> Encoding
toJSONList :: [AuthenticatorDataFlags] -> Value
$ctoJSONList :: [AuthenticatorDataFlags] -> Value
toEncoding :: AuthenticatorDataFlags -> Encoding
$ctoEncoding :: AuthenticatorDataFlags -> Encoding
toJSON :: AuthenticatorDataFlags -> Value
$ctoJSON :: AuthenticatorDataFlags -> Value
ToJSON)

-- | A type encompassing the credential options, both for
-- [creation](https://www.w3.org/TR/webauthn-2/#dictionary-makecredentialoptions)
-- and
-- [requesting](https://www.w3.org/TR/webauthn-2/#dictionary-assertion-options).
-- The CeremonyKind araument specifies which.
--
-- Values of this type are send to the client to
-- [create](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)
-- and
-- [get](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)
-- a credential. After they have been sent, they have to be stored awaiting the
-- response from the client for further validation. At least the following
-- fields have to be stored, the others are not currently used.
--
--  For `Crypto.WebAuthn.Operation.Registration.verifyRegistrationResponse`:
--
-- - `corChallenge`
-- - `ascUserVerification` of `corAuthenticatorSelection`
-- - `corPubKeyCredParams`
-- - `corUser` (of which `cueId` is used in the
--   `Crypto.WebAuthn.Operation.Registration.verifyRegistrationResponse`, and it
--   and the other fields are need to be stored permanently by the relying party
--   as the user entity).
--
--  For `Crypto.WebAuthn.Operation.Authentication.verifyAuthenticationResponse`:
--
-- - `coaChallenge`
-- - `coaUserVerification`
-- - `coaAllowCredentials`
--
-- Depending on implementation choices by the RP, some of these fields might
-- additionally be constants, and could thus also be omitted when storing.
data CredentialOptions (c :: CeremonyKind) where
  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-makecredentialoptions)
  CredentialOptionsRegistration ::
    { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-rp)
      -- This member contains data about the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)
      -- responsible for the request.
      CredentialOptions 'Registration -> CredentialRpEntity
corRp :: CredentialRpEntity,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-user)
      -- This member contains data about the user account for which the
      -- [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) is requesting attestation.
      CredentialOptions 'Registration -> CredentialUserEntity
corUser :: CredentialUserEntity,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-challenge)
      -- This member contains a challenge intended to be used for generating the newly created
      -- credential’s attestation object. See the [§ 13.4.3 Cryptographic Challenges](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges)
      -- security consideration.
      CredentialOptions 'Registration -> Challenge
corChallenge :: Challenge,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-pubkeycredparams)
      -- This member contains information about the desired properties of the credential to be created.
      -- The sequence is ordered from most preferred to least preferred.
      -- The [client](https://www.w3.org/TR/webauthn-2/#client) makes a best-effort
      -- to create the most preferred credential that it can.
      CredentialOptions 'Registration -> [CredentialParameters]
corPubKeyCredParams :: [CredentialParameters],
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-timeout)
      -- This member specifies a time, in milliseconds, that the caller is willing to wait for the call to complete.
      -- This is treated as a hint, and MAY be overridden by the [client](https://www.w3.org/TR/webauthn-2/#client).
      CredentialOptions 'Registration -> Maybe Timeout
corTimeout :: Maybe Timeout,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-excludecredentials)
      -- This member is intended for use by [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)
      -- that wish to limit the creation of multiple credentials for the same account on a single authenticator.
      -- The [client](https://www.w3.org/TR/webauthn-2/#client) is requested to return an error if the new credential
      -- would be created on an authenticator that also contains one of the credentials enumerated in this parameter.
      -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.corExcludeCredentials'.
      CredentialOptions 'Registration -> [CredentialDescriptor]
corExcludeCredentials :: [CredentialDescriptor],
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-authenticatorselection)
      -- This member is intended for use by [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)
      -- that wish to select the appropriate authenticators to participate in the
      -- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) operation.
      CredentialOptions 'Registration
-> Maybe AuthenticatorSelectionCriteria
corAuthenticatorSelection :: Maybe AuthenticatorSelectionCriteria,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-attestation)
      -- This member is intended for use by [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)
      -- that wish to express their preference for [attestation conveyance](https://www.w3.org/TR/webauthn-2/#attestation-conveyance).
      -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.corAttestationDefault'.
      CredentialOptions 'Registration -> AttestationConveyancePreference
corAttestation :: AttestationConveyancePreference,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-extensions)
      -- This member contains additional parameters requesting additional processing by the client and authenticator.
      -- For example, the caller may request that only authenticators with certain capabilities be used to create the credential,
      -- or that particular information be returned in the [attestation object](https://www.w3.org/TR/webauthn-2/#attestation-object).
      -- Some extensions are defined in [§ 9 WebAuthn Extensions](https://www.w3.org/TR/webauthn-2/#sctn-extensions);
      -- consult the IANA "WebAuthn Extension Identifiers" registry [IANA-WebAuthn-Registries](https://www.w3.org/TR/webauthn-2/#biblio-iana-webauthn-registries)
      -- established by [RFC8809](https://www.w3.org/TR/webauthn-2/#biblio-rfc8809) for an up-to-date
      -- list of registered [WebAuthn Extensions](https://www.w3.org/TR/webauthn-2/#webauthn-extensions).
      -- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model.Types#extensions".
      CredentialOptions 'Registration
-> Maybe AuthenticationExtensionsClientInputs
corExtensions :: Maybe AuthenticationExtensionsClientInputs
    } ->
    CredentialOptions 'Registration
  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-assertion-options)
  -- The 'CredentialOptionsAuthentication' dictionary supplies `[get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)`
  -- with the data it needs to generate an assertion.
  CredentialOptionsAuthentication ::
    { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-challenge)
      -- This member represents a challenge that the selected [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) signs,
      -- along with other data, when producing an [authentication assertion](https://www.w3.org/TR/webauthn-2/#authentication-assertion).
      -- See the [§ 13.4.3 Cryptographic Challenges](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges) security consideration.
      CredentialOptions 'Authentication -> Challenge
coaChallenge :: Challenge,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-timeout)
      -- This OPTIONAL member specifies a time, in milliseconds, that the caller is willing to wait for the call to complete.
      -- The value is treated as a hint, and MAY be overridden by the [client](https://www.w3.org/TR/webauthn-2/#client).
      CredentialOptions 'Authentication -> Maybe Timeout
coaTimeout :: Maybe Timeout,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-rpid)
      -- This OPTIONAL member specifies the [relying party identifier](https://www.w3.org/TR/webauthn-2/#relying-party-identifier) claimed by the caller.
      -- If omitted, its value will be the `[CredentialsContainer](https://w3c.github.io/webappsec-credential-management/#credentialscontainer)`
      -- object’s [relevant settings object](https://html.spec.whatwg.org/multipage/webappapis.html#relevant-settings-object)'s
      -- [origin](https://html.spec.whatwg.org/multipage/webappapis.html#concept-settings-object-origin)'s
      -- [effective domain](https://html.spec.whatwg.org/multipage/origin.html#concept-origin-effective-domain).
      CredentialOptions 'Authentication -> Maybe RpId
coaRpId :: Maybe RpId,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-allowcredentials)
      -- This OPTIONAL member contains a list of 'CredentialDescriptor'
      -- objects representing [public key credentials](https://www.w3.org/TR/webauthn-2/#public-key-credential) acceptable to the caller,
      -- in descending order of the caller’s preference (the first item in the list is the most preferred credential, and so on down the list).
      -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.coaAllowCredentialsDefault'.
      CredentialOptions 'Authentication -> [CredentialDescriptor]
coaAllowCredentials :: [CredentialDescriptor],
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-userverification)
      -- This OPTIONAL member describes the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)'s requirements regarding
      -- [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) for the
      -- `[get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)` operation.
      -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.coaUserVerificationDefault'.
      CredentialOptions 'Authentication -> UserVerificationRequirement
coaUserVerification :: UserVerificationRequirement,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-extensions)
      -- This OPTIONAL member contains additional parameters requesting additional processing by the client and authenticator.
      -- For example, if transaction confirmation is sought from the user, then the prompt string might be included as an extension.
      -- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model.Types#extensions".
      CredentialOptions 'Authentication
-> Maybe AuthenticationExtensionsClientInputs
coaExtensions :: Maybe AuthenticationExtensionsClientInputs
    } ->
    CredentialOptions 'Authentication

deriving instance Eq (CredentialOptions c)

deriving instance Show (CredentialOptions c)

instance ToJSON (CredentialOptions c) where
  toJSON :: CredentialOptions c -> Value
toJSON 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 :: 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
..} =
    [Pair] -> Value
object
      [ Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"CredentialOptionsRegistration",
        Key
"corRp" Key -> CredentialRpEntity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CredentialRpEntity
corRp,
        Key
"corUser" Key -> CredentialUserEntity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CredentialUserEntity
corUser,
        Key
"corChallenge" Key -> Challenge -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Challenge
corChallenge,
        Key
"corPubKeyCredParams" Key -> [CredentialParameters] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [CredentialParameters]
corPubKeyCredParams,
        Key
"corTimeout" Key -> Maybe Timeout -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Timeout
corTimeout,
        Key
"corExcludeCredentials" Key -> [CredentialDescriptor] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [CredentialDescriptor]
corExcludeCredentials,
        Key
"corAuthenticatorSelection" Key -> Maybe AuthenticatorSelectionCriteria -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe AuthenticatorSelectionCriteria
corAuthenticatorSelection,
        Key
"corAttestation" Key -> AttestationConveyancePreference -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AttestationConveyancePreference
corAttestation,
        Key
"corExtensions" Key -> Maybe AuthenticationExtensionsClientInputs -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe AuthenticationExtensionsClientInputs
corExtensions
      ]
  toJSON 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 :: 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
..} =
    [Pair] -> Value
object
      [ Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"CredentialOptionsAuthentication",
        Key
"coaChallenge" Key -> Challenge -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Challenge
coaChallenge,
        Key
"coaTimeout" Key -> Maybe Timeout -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Timeout
coaTimeout,
        Key
"coaRpId" Key -> Maybe RpId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe RpId
coaRpId,
        Key
"coaAllowCredentials" Key -> [CredentialDescriptor] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [CredentialDescriptor]
coaAllowCredentials,
        Key
"coaUserVerification" Key -> UserVerificationRequirement -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UserVerificationRequirement
coaUserVerification,
        Key
"coaExtensions" Key -> Maybe AuthenticationExtensionsClientInputs -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe AuthenticationExtensionsClientInputs
coaExtensions
      ]

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-client-data)
-- The client data represents the contextual bindings of both the
-- [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)
-- and the [client](https://www.w3.org/TR/webauthn-2/#client).
--
-- For binary serialization of thes type, see
-- "Crypto.WebAuthn.Encoding.Binary". If decoded with
-- 'Crypto.WebAuthn.Encoding.Binary.decodeCollectedClientData', the
-- 'ccdRawData' field is filled out with the raw bytes, while
-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawCollectedClientData' can be used
-- to fill out this field when constructing this value otherwise. Unchecked
-- invariant: If @raw ~ 'True'@, then
-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawCollectedClientData c = c',
-- ensuring that the 'ccdRawData' field should always correspond to its
-- encoding. This means that if @raw ~ 'True'@, it's not safe to modify
-- individual fields. To make changes, first use
-- 'Crypto.WebAuthn.Encoding.Binary.stripRawCollectedClientData', make the
-- changes on the result, then call
-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawCollectedClientData' on that. Note
-- however that any modifications also invalidate signatures over the binary
-- data, specifically 'araSignature' and 'aoAttStmt'.
data CollectedClientData (c :: CeremonyKind) raw = CollectedClientData
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-challenge)
    -- This member contains the challenge provided by the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party).
    -- See the [§ 13.4.3 Cryptographic Challenges](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges) security consideration.
    forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Challenge
ccdChallenge :: Challenge,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-origin)
    -- This member contains the fully qualified [origin](https://html.spec.whatwg.org/multipage/origin.html#concept-origin)
    -- of the requester, as provided to the authenticator by the client, in the syntax
    -- defined by [RFC6454](https://www.w3.org/TR/webauthn-2/#biblio-rfc6454).
    forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Origin
ccdOrigin :: Origin,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-crossorigin)
    -- This member contains the inverse of the @sameOriginWithAncestors@ araument value
    -- that was passed into the [internal method](https://tc39.github.io/ecma262/#sec-object-internal-methods-and-internal-slots).
    forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Maybe Bool
ccdCrossOrigin :: Maybe Bool,
    -- | Raw data of the client data, for verification purposes.
    forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> RawField raw
ccdRawData :: RawField raw
    -- TODO: This library does not implement token binding, this is in
    -- anticipation of version 3 of the webauthn spec that likely removes this
    -- field in its entirety. Discussion can be found in
    -- [the relevant PR](https://github.com/w3c/webauthn/pull/1630).
    -- Chromium and Firefox both don't propagate this field.
    -- Once v3 of the webauthn has been released, and this library is updated
    -- to the new spec, this field and related references can be removed.
    -- tokenBinding :: Maybe TokenBinding,
  }
  deriving (CollectedClientData c raw -> CollectedClientData c raw -> Bool
(CollectedClientData c raw -> CollectedClientData c raw -> Bool)
-> (CollectedClientData c raw -> CollectedClientData c raw -> Bool)
-> Eq (CollectedClientData c raw)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> CollectedClientData c raw -> Bool
/= :: CollectedClientData c raw -> CollectedClientData c raw -> Bool
$c/= :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> CollectedClientData c raw -> Bool
== :: CollectedClientData c raw -> CollectedClientData c raw -> Bool
$c== :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> CollectedClientData c raw -> Bool
Eq, Int -> CollectedClientData c raw -> ShowS
[CollectedClientData c raw] -> ShowS
CollectedClientData c raw -> String
(Int -> CollectedClientData c raw -> ShowS)
-> (CollectedClientData c raw -> String)
-> ([CollectedClientData c raw] -> ShowS)
-> Show (CollectedClientData c raw)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (c :: CeremonyKind) (raw :: Bool).
Int -> CollectedClientData c raw -> ShowS
forall (c :: CeremonyKind) (raw :: Bool).
[CollectedClientData c raw] -> ShowS
forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> String
showList :: [CollectedClientData c raw] -> ShowS
$cshowList :: forall (c :: CeremonyKind) (raw :: Bool).
[CollectedClientData c raw] -> ShowS
show :: CollectedClientData c raw -> String
$cshow :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> String
showsPrec :: Int -> CollectedClientData c raw -> ShowS
$cshowsPrec :: forall (c :: CeremonyKind) (raw :: Bool).
Int -> CollectedClientData c raw -> ShowS
Show)

instance SingI c => ToJSON (CollectedClientData (c :: CeremonyKind) raw) where
  toJSON :: CollectedClientData c raw -> Value
toJSON CollectedClientData {Maybe Bool
Origin
Challenge
RawField raw
ccdRawData :: RawField raw
ccdCrossOrigin :: Maybe Bool
ccdOrigin :: Origin
ccdChallenge :: Challenge
ccdRawData :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> RawField raw
ccdCrossOrigin :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Maybe Bool
ccdOrigin :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Origin
ccdChallenge :: forall (c :: CeremonyKind) (raw :: Bool).
CollectedClientData c raw -> Challenge
..} =
    [Pair] -> Value
object
      [ Key
"webauthnKind" Key -> SCeremonyKind c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall {k} (a :: k). SingI a => Sing a
forall (a :: CeremonyKind). SingI a => Sing a
sing @c,
        Key
"ccdChallenge" Key -> Challenge -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Challenge
ccdChallenge,
        Key
"ccdOrigin" Key -> Origin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Origin
ccdOrigin,
        Key
"ccdCrossOrigin" Key -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
ccdCrossOrigin,
        Key
"ccdRawData" Key -> RawField raw -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RawField raw
ccdRawData
      ]

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-attested-credential-data)
-- Attested credential data is a variable-length byte array added to the
-- [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)
-- when generating an [attestation object](https://www.w3.org/TR/webauthn-2/#attestation-object)
-- for a given credential.
data AttestedCredentialData (c :: CeremonyKind) raw where
  AttestedCredentialData ::
    { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#aaguid)
      forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> AAGUID
acdAaguid :: AAGUID,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialid)
      forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CredentialId
acdCredentialId :: CredentialId,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialpublickey)
      forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CosePublicKey
acdCredentialPublicKey :: Cose.CosePublicKey,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialpublickey)
      forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> RawField raw
acdCredentialPublicKeyBytes :: RawField raw
    } ->
    AttestedCredentialData 'Registration raw
  NoAttestedCredentialData ::
    AttestedCredentialData 'Authentication raw

deriving instance Eq (AttestedCredentialData c raw)

deriving instance Show (AttestedCredentialData c raw)

instance ToJSON (AttestedCredentialData c raw) where
  toJSON :: AttestedCredentialData c raw -> Value
toJSON AttestedCredentialData {CosePublicKey
AAGUID
CredentialId
RawField raw
acdCredentialPublicKeyBytes :: RawField raw
acdCredentialPublicKey :: CosePublicKey
acdCredentialId :: CredentialId
acdAaguid :: AAGUID
acdCredentialPublicKeyBytes :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> RawField raw
acdCredentialPublicKey :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CosePublicKey
acdCredentialId :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> CredentialId
acdAaguid :: forall (raw :: Bool).
AttestedCredentialData 'Registration raw -> AAGUID
..} =
    [Pair] -> Value
object
      [ Key
"acdAaguid" Key -> AAGUID -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AAGUID
acdAaguid,
        Key
"acdCredentialId" Key -> CredentialId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CredentialId
acdCredentialId,
        Key
"acdCredentialPublicKey" Key -> CosePublicKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CosePublicKey
acdCredentialPublicKey,
        Key
"acdCredentialPublicKeyBytes" Key -> RawField raw -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RawField raw
acdCredentialPublicKeyBytes
      ]
  toJSON NoAttestedCredentialData {} = Value
Null

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-authenticator-data)
-- The authenticator data structure encodes contextual bindings made by the
-- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator). These
-- bindings are controlled by the authenticator itself, and derive their trust
-- from the [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)'s
-- assessment of the security properties of the authenticator. In one extreme case,
-- the authenticator may be embedded in the client, and its bindings may be no
-- more trustworthy than the [client data](https://www.w3.org/TR/webauthn-2/#client-data).
-- At the other extreme, the authenticator may be a discrete entity with high-security
-- hardware and software, connected to the client over a secure channel. In both cases,
-- the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) receives
-- the [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)
-- in the same format, and uses its knowledge of the authenticator to make trust decisions.
--
-- For the binary serialization of this type, see
-- "Crypto.WebAuthn.Encoding.Binary". If decoded with
-- 'Crypto.WebAuthn.Encoding.Binary.decodeAuthenticatorData', the 'adRawData'
-- field is filled out with the binary serialization, while
-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAuthenticatorData' can be used to
-- fill out this field when constructing this value otherwise. This also
-- applies to raw 'acdCredentialPublicKeyBytes' field in
-- 'adAttestedCredentialData'. Unchecked invariant: If @raw ~ 'True'@, then
-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAuthenticatorData d = d', ensuring
-- that the 'adRawData' and 'acdCredentialPublicKeyBytes' fields should always
-- correspond to their respective binary serializations. This means that if
-- @raw ~ 'True'@, it's not safe to modify individual fields. To make changes,
-- first use 'Crypto.WebAuthn.Encoding.Binary.stripRawAuthenticatorData', make
-- the changes on the result, then call
-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAuthenticatorData' on that. Note
-- however that any modifications also invalidate signatures over the binary
-- data, specifically 'araSignature' and 'aoAttStmt'.
data AuthenticatorData (c :: CeremonyKind) raw = AuthenticatorData
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#rpidhash)
    -- SHA-256 hash of the [RP ID](https://www.w3.org/TR/webauthn-2/#rp-id) the
    -- [credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) is
    -- [scoped](https://www.w3.org/TR/webauthn-2/#scope) to.
    forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RpIdHash
adRpIdHash :: RpIdHash,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#flags)
    forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorDataFlags
adFlags :: AuthenticatorDataFlags,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#signcount)
    -- [Signature counter](https://www.w3.org/TR/webauthn-2/#signature-counter)
    forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> SignatureCounter
adSignCount :: SignatureCounter,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#attestedcredentialdata)
    -- [attested credential data](https://www.w3.org/TR/webauthn-2/#attested-credential-data) (if present)
    forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AttestedCredentialData c raw
adAttestedCredentialData :: AttestedCredentialData c raw,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#authdataextensions)
    -- Extension-defined [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)
    forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> Maybe AuthenticatorExtensionOutputs
adExtensions :: Maybe AuthenticatorExtensionOutputs,
    -- | Raw encoded data for verification purposes
    forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> RawField raw
adRawData :: RawField raw
  }
  deriving (AuthenticatorData c raw -> AuthenticatorData c raw -> Bool
(AuthenticatorData c raw -> AuthenticatorData c raw -> Bool)
-> (AuthenticatorData c raw -> AuthenticatorData c raw -> Bool)
-> Eq (AuthenticatorData c raw)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorData c raw -> Bool
/= :: AuthenticatorData c raw -> AuthenticatorData c raw -> Bool
$c/= :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorData c raw -> Bool
== :: AuthenticatorData c raw -> AuthenticatorData c raw -> Bool
$c== :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> AuthenticatorData c raw -> Bool
Eq, Int -> AuthenticatorData c raw -> ShowS
[AuthenticatorData c raw] -> ShowS
AuthenticatorData c raw -> String
(Int -> AuthenticatorData c raw -> ShowS)
-> (AuthenticatorData c raw -> String)
-> ([AuthenticatorData c raw] -> ShowS)
-> Show (AuthenticatorData c raw)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (c :: CeremonyKind) (raw :: Bool).
Int -> AuthenticatorData c raw -> ShowS
forall (c :: CeremonyKind) (raw :: Bool).
[AuthenticatorData c raw] -> ShowS
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> String
showList :: [AuthenticatorData c raw] -> ShowS
$cshowList :: forall (c :: CeremonyKind) (raw :: Bool).
[AuthenticatorData c raw] -> ShowS
show :: AuthenticatorData c raw -> String
$cshow :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> String
showsPrec :: Int -> AuthenticatorData c raw -> ShowS
$cshowsPrec :: forall (c :: CeremonyKind) (raw :: Bool).
Int -> AuthenticatorData c raw -> ShowS
Show, (forall x.
 AuthenticatorData c raw -> Rep (AuthenticatorData c raw) x)
-> (forall x.
    Rep (AuthenticatorData c raw) x -> AuthenticatorData c raw)
-> Generic (AuthenticatorData c raw)
forall x.
Rep (AuthenticatorData c raw) x -> AuthenticatorData c raw
forall x.
AuthenticatorData c raw -> Rep (AuthenticatorData c raw) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (c :: CeremonyKind) (raw :: Bool) x.
Rep (AuthenticatorData c raw) x -> AuthenticatorData c raw
forall (c :: CeremonyKind) (raw :: Bool) x.
AuthenticatorData c raw -> Rep (AuthenticatorData c raw) x
$cto :: forall (c :: CeremonyKind) (raw :: Bool) x.
Rep (AuthenticatorData c raw) x -> AuthenticatorData c raw
$cfrom :: forall (c :: CeremonyKind) (raw :: Bool) x.
AuthenticatorData c raw -> Rep (AuthenticatorData c raw) x
Generic, [AuthenticatorData c raw] -> Encoding
[AuthenticatorData c raw] -> Value
AuthenticatorData c raw -> Encoding
AuthenticatorData c raw -> Value
(AuthenticatorData c raw -> Value)
-> (AuthenticatorData c raw -> Encoding)
-> ([AuthenticatorData c raw] -> Value)
-> ([AuthenticatorData c raw] -> Encoding)
-> ToJSON (AuthenticatorData c raw)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (c :: CeremonyKind) (raw :: Bool).
[AuthenticatorData c raw] -> Encoding
forall (c :: CeremonyKind) (raw :: Bool).
[AuthenticatorData c raw] -> Value
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> Encoding
forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> Value
toEncodingList :: [AuthenticatorData c raw] -> Encoding
$ctoEncodingList :: forall (c :: CeremonyKind) (raw :: Bool).
[AuthenticatorData c raw] -> Encoding
toJSONList :: [AuthenticatorData c raw] -> Value
$ctoJSONList :: forall (c :: CeremonyKind) (raw :: Bool).
[AuthenticatorData c raw] -> Value
toEncoding :: AuthenticatorData c raw -> Encoding
$ctoEncoding :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> Encoding
toJSON :: AuthenticatorData c raw -> Value
$ctoJSON :: forall (c :: CeremonyKind) (raw :: Bool).
AuthenticatorData c raw -> Value
ToJSON)

-- | The result from verifying an attestation statement.
-- Either the result is verifiable, in which case @k ~ 'Verifiable'@, the
-- 'AttestationType' contains a verifiable certificate chain.
-- Or the result is not verifiable, in which case @k ~ 'Unverifiable'@, the
-- 'AttestationType' is None or Self.
data SomeAttestationType = forall k. SomeAttestationType (AttestationType k)

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats)
-- This class is used to specify an [attestation statement format](https://www.w3.org/TR/webauthn-2/#attestation-statement-format)'s
-- [identifier](https://www.w3.org/TR/webauthn-2/#sctn-attstn-fmt-ids)
-- and [attestation statement structure](https://www.w3.org/TR/webauthn-2/#attestation-statement)
class
  ( Eq (AttStmt a),
    Show (AttStmt a),
    ToJSON (AttStmt a),
    Typeable a,
    Show a,
    Exception (AttStmtVerificationError a)
  ) =>
  AttestationStatementFormat a
  where
  -- | The type of a fully-decoded and structurally valid attestation statement
  type AttStmt a :: Type

  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-attstn-fmt-ids)
  -- Attestation statement formats are identified by a string, called an attestation
  -- statement format identifier, chosen by the author of the
  -- [attestation statement format](https://www.w3.org/TR/webauthn-2/#attestation-statement-format).
  --
  -- Attestation statement format identifiers SHOULD be registered in the IANA "WebAuthn Attestation Statement Format Identifiers" registry
  -- [IANA-WebAuthn-Registries](https://www.w3.org/TR/webauthn-2/#biblio-iana-webauthn-registries)
  -- established by [RFC8809](https://www.w3.org/TR/webauthn-2/#biblio-rfc8809).
  -- All registered attestation statement format identifiers are unique amongst
  -- themselves as a matter of course.
  --
  -- Unregistered attestation statement format identifiers SHOULD use lowercase
  -- reverse domain-name naming, using a domain name registered by the developer,
  -- in order to assure uniqueness of the identifier. All attestation statement
  -- format identifiers MUST be a maximum of 32 octets in length and MUST
  -- consist only of printable USASCII characters, excluding backslash and
  -- doublequote, i.e., VCHAR as defined in [RFC5234](https://www.w3.org/TR/webauthn-2/#biblio-rfc5234)
  -- but without %x22 and %x5c.
  --
  -- Note: This means attestation statement format identifiers based on domain
  -- names MUST incorporate only LDH Labels [RFC5890](https://www.w3.org/TR/webauthn-2/#biblio-rfc5890).
  --
  -- Attestation statement formats that may exist in multiple versions SHOULD
  -- include a version in their identifier. In effect, different versions are
  -- thus treated as different formats, e.g., @packed2@ as a new version of the
  -- [§ 8.2 Packed Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-packed-attestation).
  asfIdentifier :: a -> Text

  -- | The type of verification errors that can occur when verifying this
  -- attestation statement using 'asfVerify'
  type AttStmtVerificationError a :: Type

  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#verification-procedure)
  -- The procedure to verify an [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement)
  asfVerify ::
    a ->
    HG.DateTime ->
    AttStmt a ->
    AuthenticatorData 'Registration 'True ->
    ClientDataHash ->
    Validation (NonEmpty (AttStmtVerificationError a)) SomeAttestationType

  -- | The trusted root certificates specifically for this attestation
  -- statement format. For attestation statement chain validation, these
  -- certificates are used, in addition to the ones from the metadata registry
  --
  -- [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-registering-a-new-credential) step 20:
  -- If validation is successful, obtain a list of acceptable trust anchors
  -- (i.e. attestation root certificates) for that attestation type and
  -- attestation statement format fmt, from a trusted source or from policy.
  --
  -- While for the attestation statement formats we implement, none of them use
  -- the 'VerifiableAttestationType', it is implied that it could be used by
  -- the above sentence from the spec.
  asfTrustAnchors ::
    a ->
    VerifiableAttestationType ->
    X509.CertificateStore

  -- | A decoder for the attestation statement [syntax](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats).
  -- The @attStmt@ CBOR map is given as an input. See
  -- [Generating an Attestation Object](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object)
  asfDecode ::
    a ->
    HashMap Text CBOR.Term ->
    Either Text (AttStmt a)

  -- | An encoder for the attestation statement [syntax](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats).
  -- The @attStmt@ CBOR map is expected as the result. See
  -- [Generating an Attestation Object](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object)
  asfEncode ::
    a ->
    AttStmt a ->
    CBOR.Term

-- | An arbitrary [attestation statement format](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats).
-- In contrast to 'AttestationStatementFormat', this type can be put into a list.
-- This is used for 'singletonAttestationStatementFormat'
data SomeAttestationStatementFormat
  = forall a.
    AttestationStatementFormat a =>
    SomeAttestationStatementFormat a

-- | A type representing the set of supported attestation statement formats.
-- The constructor is intentionally not exported, use
-- 'singletonAttestationStatementFormat' instead to construct it and
-- 'lookupAttestationStatementFormat' to look up formats. '<>' can be used to
-- combine multiple formats. 'mempty' can be used for not supporting any formats.
newtype SupportedAttestationStatementFormats
  = -- HashMap invariant: asfIdentifier (hm ! k) == k
    SupportedAttestationStatementFormats (HashMap Text SomeAttestationStatementFormat)
  deriving newtype (NonEmpty SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
(SupportedAttestationStatementFormats
 -> SupportedAttestationStatementFormats
 -> SupportedAttestationStatementFormats)
-> (NonEmpty SupportedAttestationStatementFormats
    -> SupportedAttestationStatementFormats)
-> (forall b.
    Integral b =>
    b
    -> SupportedAttestationStatementFormats
    -> SupportedAttestationStatementFormats)
-> Semigroup SupportedAttestationStatementFormats
forall b.
Integral b =>
b
-> SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b.
Integral b =>
b
-> SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
$cstimes :: forall b.
Integral b =>
b
-> SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
sconcat :: NonEmpty SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
$csconcat :: NonEmpty SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
<> :: SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
$c<> :: SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
Semigroup, Semigroup SupportedAttestationStatementFormats
SupportedAttestationStatementFormats
Semigroup SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
-> (SupportedAttestationStatementFormats
    -> SupportedAttestationStatementFormats
    -> SupportedAttestationStatementFormats)
-> ([SupportedAttestationStatementFormats]
    -> SupportedAttestationStatementFormats)
-> Monoid SupportedAttestationStatementFormats
[SupportedAttestationStatementFormats]
-> SupportedAttestationStatementFormats
SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [SupportedAttestationStatementFormats]
-> SupportedAttestationStatementFormats
$cmconcat :: [SupportedAttestationStatementFormats]
-> SupportedAttestationStatementFormats
mappend :: SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
$cmappend :: SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
-> SupportedAttestationStatementFormats
mempty :: SupportedAttestationStatementFormats
$cmempty :: SupportedAttestationStatementFormats
Monoid)

-- | Creates a `SupportedAttestationStatementFormats`-Map containing a single
-- supported format.
singletonAttestationStatementFormat :: SomeAttestationStatementFormat -> SupportedAttestationStatementFormats
singletonAttestationStatementFormat :: SomeAttestationStatementFormat
-> SupportedAttestationStatementFormats
singletonAttestationStatementFormat someFormat :: SomeAttestationStatementFormat
someFormat@(SomeAttestationStatementFormat a
format) =
  HashMap Text SomeAttestationStatementFormat
-> SupportedAttestationStatementFormats
SupportedAttestationStatementFormats (HashMap Text SomeAttestationStatementFormat
 -> SupportedAttestationStatementFormats)
-> HashMap Text SomeAttestationStatementFormat
-> SupportedAttestationStatementFormats
forall a b. (a -> b) -> a -> b
$ Text
-> SomeAttestationStatementFormat
-> HashMap Text SomeAttestationStatementFormat
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (a -> Text
forall a. AttestationStatementFormat a => a -> Text
asfIdentifier a
format) SomeAttestationStatementFormat
someFormat

-- | Attempt to find the desired attestation statement format in a map of
-- supported formats. Can then be used to perform attestation.
lookupAttestationStatementFormat ::
  -- | The desired format, e.g. "android-safetynet" or "none"
  Text ->
  -- | The [attestation statement formats](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats)
  -- that should be supported. The value of 'Crypto.WebAuthn.allSupportedFormats'
  -- can be passed here, but additional or custom formats may also be used if needed.
  SupportedAttestationStatementFormats ->
  Maybe SomeAttestationStatementFormat
lookupAttestationStatementFormat :: Text
-> SupportedAttestationStatementFormats
-> Maybe SomeAttestationStatementFormat
lookupAttestationStatementFormat Text
id (SupportedAttestationStatementFormats HashMap Text SomeAttestationStatementFormat
sasf) = HashMap Text SomeAttestationStatementFormat
sasf HashMap Text SomeAttestationStatementFormat
-> Text -> Maybe SomeAttestationStatementFormat
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Text
id

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#attestation-object)
--
-- For the [binary
-- serialization](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object)
-- of this type, see "Crypto.WebAuthn.Encoding.Binary". If decoded with
-- 'Crypto.WebAuthn.Encoding.Binary.decodeAttestationObject', the 'aoAuthData'
-- field is filled out with the binary serialization of its fields, while
-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAttestationObject' can be used to
-- fill out this field when constructing this value otherwise. Unchecked
-- invariant: If @raw ~ 'True'@, then
-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAttestationObject o = o', ensuring
-- that the binary fields of the 'aoAuthData' field should always correspond to
-- their respective serializations. This means that if @raw ~ 'True'@, it's not
-- safe to modify individual fields. To make changes, first use
-- 'Crypto.WebAuthn.Encoding.Binary.stripRawAttestationObject', make the
-- changes on the result, then call
-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAttestationObject' on that. Note
-- however that any modifications also invalidate signatures over the binary
-- data, specifically 'aoAttStmt'. The
-- 'Crypto.WebAuthn.Encoding.Binary.encodeAttestationObject' can be used to get
-- the binary encoding of this type when @raw ~ 'True'@.
data AttestationObject raw = forall a.
  AttestationStatementFormat a =>
  AttestationObject
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#authenticator-data)
    -- The authenticator data structure encodes contextual bindings made by the
    -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator).
    -- These bindings are controlled by the authenticator itself, and derive
    -- their trust from the [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)'s
    -- assessment of the security properties of the authenticator. In one
    -- extreme case, the authenticator may be embedded in the client, and its
    -- bindings may be no more trustworthy than the [client data](https://www.w3.org/TR/webauthn-2/#client-data).
    -- At the other extreme, the authenticator may be a discrete entity with high-security hardware
    -- and software, connected to the client over a secure channel. In both cases,
    -- the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) receives
    -- the [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)
    -- in the same format, and uses its knowledge of the authenticator to make trust decisions.
    forall (raw :: Bool).
AttestationObject raw -> AuthenticatorData 'Registration raw
aoAuthData :: AuthenticatorData 'Registration raw,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#attestation-statement-format)
    -- The attestation statement format is the manner in which the signature is
    -- represented and the various contextual bindings are incorporated into
    -- the attestation statement by the
    -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator). In
    -- other words, this defines the syntax of the statement. Various existing
    -- components and OS platforms (such as TPMs and the Android OS) have
    -- previously defined [attestation statement
    -- formats](https://www.w3.org/TR/webauthn-2/#attestation-statement-format).
    -- This specification supports a variety of such formats in an extensible
    -- way, as defined in [§ 6.5.2 Attestation Statement
    -- Formats](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats).
    -- The formats themselves are identified by strings, as described in [§ 8.1
    -- Attestation Statement Format
    -- Identifiers](https://www.w3.org/TR/webauthn-2/#sctn-attstn-fmt-ids).
    --
    -- This value is of a type that's an instance of
    -- 'AttestationStatementFormat', which encodes everything needed about the
    -- attestation statement.
    ()
aoFmt :: a,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#attestation-statement)
    -- The [(spec)](https://www.w3.org/TR/webauthn-2/#attestation-statement) is
    -- a specific type of signed data object, containing statements about a
    -- [public key
    -- credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)
    -- itself and the
    -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) that
    -- created it. It contains an [attestation
    -- signature](https://www.w3.org/TR/webauthn-2/#attestation-signature)
    -- created using the key of the attesting authority (except for the case of
    -- [self attestation](https://www.w3.org/TR/webauthn-2/#self-attestation),
    -- when it is created using the [credential private
    -- key](https://www.w3.org/TR/webauthn-2/#credential-private-key)).
    ()
aoAttStmt :: AttStmt a
  }

instance Eq (AttestationObject raw) where
  AttestationObject {aoAuthData :: forall (raw :: Bool).
AttestationObject raw -> AuthenticatorData 'Registration raw
aoAuthData = AuthenticatorData 'Registration raw
lAuthData, aoFmt :: ()
aoFmt = a
lFmt, aoAttStmt :: ()
aoAttStmt = AttStmt a
lAttStmt}
    == :: AttestationObject raw -> AttestationObject raw -> Bool
== AttestationObject {aoAuthData :: forall (raw :: Bool).
AttestationObject raw -> AuthenticatorData 'Registration raw
aoAuthData = AuthenticatorData 'Registration raw
rAuthData, aoFmt :: ()
aoFmt = a
rFmt, aoAttStmt :: ()
aoAttStmt = AttStmt a
rAttStmt} =
      AuthenticatorData 'Registration raw
lAuthData AuthenticatorData 'Registration raw
-> AuthenticatorData 'Registration raw -> Bool
forall a. Eq a => a -> a -> Bool
== AuthenticatorData 'Registration raw
rAuthData
        -- We need to use some simple reflection in order to be able to compare the attestation statements
        Bool -> Bool -> Bool
&& case TypeRep a -> TypeRep a -> Maybe (a :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep (a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
lFmt) (a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
rFmt) of
          Just a :~~: a
HRefl -> AttStmt a
lAttStmt AttStmt a -> AttStmt a -> Bool
forall a. Eq a => a -> a -> Bool
== AttStmt a
AttStmt a
rAttStmt
          Maybe (a :~~: a)
Nothing -> Bool
False

deriving instance Show (AttestationObject raw)

instance ToJSON (AttestationObject raw) where
  toJSON :: AttestationObject raw -> Value
toJSON AttestationObject {a
AttStmt a
AuthenticatorData 'Registration raw
aoAttStmt :: AttStmt a
aoFmt :: a
aoAuthData :: AuthenticatorData 'Registration raw
aoAttStmt :: ()
aoFmt :: ()
aoAuthData :: forall (raw :: Bool).
AttestationObject raw -> AuthenticatorData 'Registration raw
..} =
    [Pair] -> Value
object
      [ Key
"aoAuthData" Key -> AuthenticatorData 'Registration raw -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AuthenticatorData 'Registration raw
aoAuthData,
        Key
"aoFmt" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a -> Text
forall a. AttestationStatementFormat a => a -> Text
asfIdentifier a
aoFmt,
        Key
"aoAttStmt" Key -> AttStmt a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AttStmt a
aoAttStmt
      ]

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#authenticatorresponse)
-- [Authenticators](https://www.w3.org/TR/webauthn-2/#authenticator) respond to
-- [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) requests by
-- returning an object derived from the `[AuthenticatorResponse](https://www.w3.org/TR/webauthn-2/#authenticatorresponse)` interface
data AuthenticatorResponse (c :: CeremonyKind) raw where
  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authenticatorattestationresponse)
  -- The [AuthenticatorAttestationResponse](https://www.w3.org/TR/webauthn-2/#authenticatorattestationresponse)
  -- interface represents the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)'s response
  -- to a client’s request for the creation of a new
  -- [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential).
  -- It contains information about the new credential that can be used to identify
  -- it for later use, and metadata that can be used by the
  -- [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)
  -- to assess the characteristics of the credential during registration.
  AuthenticatorResponseRegistration ::
    { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson)
      -- This attribute, inherited from `[AuthenticatorResponse](https://www.w3.org/TR/webauthn-2/#authenticatorresponse)`,
      -- contains the [JSON-compatible serialization of client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-json-compatible-serialization-of-client-data)
      -- (see [§ 6.5 Attestation](https://www.w3.org/TR/webauthn-2/#sctn-attestation))
      -- passed to the authenticator by the client in order to generate this credential.
      -- The exact JSON serialization MUST be preserved, as the
      -- [hash of the serialized client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-hash-of-the-serialized-client-data) has been computed over it.
      forall (raw :: Bool).
AuthenticatorResponse 'Registration raw
-> CollectedClientData 'Registration raw
arrClientData :: CollectedClientData 'Registration raw,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-attestationobject)
      -- This attribute contains an [attestation object](https://www.w3.org/TR/webauthn-2/#attestation-object),
      -- which is opaque to, and cryptographically protected against tampering by, the client.
      -- The [attestation object](https://www.w3.org/TR/webauthn-2/#attestation-object) contains both
      -- [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data) and an
      -- [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement).
      -- The former contains the AAGUID, a unique [credential ID](https://www.w3.org/TR/webauthn-2/#credential-id),
      -- and the [credential public key](https://www.w3.org/TR/webauthn-2/#credential-public-key).
      -- The contents of the [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement)
      -- are determined by the [attestation statement format](https://www.w3.org/TR/webauthn-2/#attestation-statement-format)
      -- used by the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator).
      -- It also contains any additional information that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)'s
      -- server requires to validate the [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement),
      -- as well as to decode and validate the [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)
      -- along with the [JSON-compatible serialization of client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-json-compatible-serialization-of-client-data).
      -- For more details, see [§ 6.5 Attestation](https://www.w3.org/TR/webauthn-2/#sctn-attestation),
      -- [§ 6.5.4 Generating an Attestation Object](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object),
      -- and [Figure 6](https://www.w3.org/TR/webauthn-2/#fig-attStructs).
      forall (raw :: Bool).
AuthenticatorResponse 'Registration raw -> AttestationObject raw
arrAttestationObject :: AttestationObject raw,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-gettransports)
      -- This [internal slot](https://tc39.github.io/ecma262/#sec-object-internal-methods-and-internal-slots)
      -- contains a sequence of zero or more unique `[DOMString](https://heycam.github.io/webidl/#idl-DOMString)`s
      -- in lexicoaraphical order. These values are the transports that the
      -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) is believed to support,
      -- or an empty sequence if the information is unavailable.
      forall (raw :: Bool).
AuthenticatorResponse 'Registration raw -> [AuthenticatorTransport]
arrTransports :: [AuthenticatorTransport]
    } ->
    AuthenticatorResponse 'Registration raw
  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#authenticatorassertionresponse)
  -- The [AuthenticatorAssertionResponse](https://www.w3.org/TR/webauthn-2/#authenticatorassertionresponse) interface represents an
  -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)'s response
  -- to a client’s request for generation of a new
  -- [authentication assertion](https://www.w3.org/TR/webauthn-2/#authentication-assertion)
  -- given the [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)'s
  -- challenge and OPTIONAL list of credentials it is aware of. This response
  -- contains a cryptographic signature proving possession of the
  -- [credential private key](https://www.w3.org/TR/webauthn-2/#credential-private-key),
  -- and optionally evidence of [user consent](https://www.w3.org/TR/webauthn-2/#user-consent)
  -- to a specific transaction.
  AuthenticatorResponseAuthentication ::
    { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson)
      -- This attribute, inherited from `[AuthenticatorResponse](https://www.w3.org/TR/webauthn-2/#authenticatorresponse)`,
      -- contains the [JSON-compatible serialization of client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-json-compatible-serialization-of-client-data)
      -- (see [§ 6.5 Attestation](https://www.w3.org/TR/webauthn-2/#sctn-attestation))
      -- passed to the authenticator by the client in order to generate this credential.
      -- The exact JSON serialization MUST be preserved, as the
      -- [hash of the serialized client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-hash-of-the-serialized-client-data) has been computed over it.
      forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw
-> CollectedClientData 'Authentication raw
araClientData :: CollectedClientData 'Authentication raw,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-authenticatordata)
      -- This attribute contains the [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)
      -- returned by the authenticator. See [§ 6.1 Authenticator Data](https://www.w3.org/TR/webauthn-2/#sctn-authenticator-data).
      forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw
-> AuthenticatorData 'Authentication raw
araAuthenticatorData :: AuthenticatorData 'Authentication raw,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-signature)
      -- This attribute contains the raw [assertion
      -- signature](https://www.w3.org/TR/webauthn-2/#assertion-signature)
      -- returned from the authenticator.
      -- See [§ 6.3.3 The authenticatorGetAssertion Operation](https://www.w3.org/TR/webauthn-2/#sctn-op-get-assertion).
      forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw -> AssertionSignature
araSignature :: AssertionSignature,
      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-userhandle)
      -- This attribute contains the [user handle](https://www.w3.org/TR/webauthn-2/#user-handle)
      -- returned from the authenticator, or null if the authenticator did not return a
      -- [user handle](https://www.w3.org/TR/webauthn-2/#user-handle). See
      -- [§ 6.3.3 The authenticatorGetAssertion Operation](https://www.w3.org/TR/webauthn-2/#sctn-op-get-assertion).
      forall (raw :: Bool).
AuthenticatorResponse 'Authentication raw -> Maybe UserHandle
araUserHandle :: Maybe UserHandle
    } ->
    AuthenticatorResponse 'Authentication raw

deriving instance Eq (AuthenticatorResponse c raw)

deriving instance Show (AuthenticatorResponse c raw)

instance ToJSON (AuthenticatorResponse c raw) where
  toJSON :: AuthenticatorResponse c raw -> Value
toJSON AuthenticatorResponseRegistration {[AuthenticatorTransport]
AttestationObject raw
CollectedClientData 'Registration raw
arrTransports :: [AuthenticatorTransport]
arrAttestationObject :: AttestationObject raw
arrClientData :: CollectedClientData 'Registration raw
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
..} =
    [Pair] -> Value
object
      [ Key
"arrClientData" Key -> CollectedClientData 'Registration raw -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CollectedClientData 'Registration raw
arrClientData,
        Key
"arrAttestationObject" Key -> AttestationObject raw -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AttestationObject raw
arrAttestationObject
      ]
  toJSON AuthenticatorResponseAuthentication {Maybe UserHandle
AuthenticatorData 'Authentication raw
CollectedClientData 'Authentication raw
AssertionSignature
araUserHandle :: Maybe UserHandle
araSignature :: AssertionSignature
araAuthenticatorData :: AuthenticatorData 'Authentication raw
araClientData :: CollectedClientData 'Authentication raw
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
..} =
    [Pair] -> Value
object
      [ Key
"araClientData" Key -> CollectedClientData 'Authentication raw -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CollectedClientData 'Authentication raw
araClientData,
        Key
"araAuthenticatorData" Key -> AuthenticatorData 'Authentication raw -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AuthenticatorData 'Authentication raw
araAuthenticatorData,
        Key
"araSignature" Key -> AssertionSignature -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AssertionSignature
araSignature,
        Key
"araUserHandle" Key -> Maybe UserHandle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserHandle
araUserHandle
      ]

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-pkcredential)
-- The 'Credential' interface contains the attributes that are returned to the caller when a new credential is created, or a new assertion is requested.
--
-- This type has nested fields which use a binary encoding that needs to be
-- preserved for verification purposes. The binary encoding of these fields can
-- be removed or recomputed using functions from
-- "Crypto.WebAuthn.Encoding.Binary". Specifically
-- 'Crypto.WebAuthn.Encoding.Binary.stripRawCredential' and
-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawCredential' respectively.
-- Unchecked invariant: If @raw ~ 'True'@, then
-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawCredential c = c', ensuring that
-- the binary fields should always correspond to the values respective
-- serializations. This means that if @raw ~ 'True'@, it's not safe to modify
-- individual fields. To make changes, first use
-- 'Crypto.WebAuthn.Encoding.Binary.stripRawCredential', make the changes on
-- the result, then call 'Crypto.WebAuthn.Encoding.Binary.encodeRawCredential'
-- on that. Note however that any modifications also invalidate signatures over
-- the binary data, specifically 'araSignature' and 'aoAttStmt'.
data Credential (c :: CeremonyKind) raw = Credential
  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-identifier-slot)
    -- Contains the [credential ID](https://www.w3.org/TR/webauthn-2/#credential-id),
    -- chosen by the authenticator. The [credential ID](https://www.w3.org/TR/webauthn-2/#credential-id)
    -- is used to look up credentials for use, and is therefore expected to be globally
    -- unique with high probability across all credentials of the same type, across all authenticators.
    forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> CredentialId
cIdentifier :: CredentialId,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-response)
    -- This attribute contains the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)'s
    -- response to the client’s request to either create a [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential),
    -- or generate an [authentication assertion](https://www.w3.org/TR/webauthn-2/#authentication-assertion).
    -- If the `[PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#publickeycredential)`
    -- is created in response to `[create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)`,
    -- this attribute’s value will be an `[AuthenticatorAttestationResponse](https://www.w3.org/TR/webauthn-2/#authenticatorattestationresponse)`,
    -- otherwise, the `[PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#publickeycredential)`
    -- was created in response to `[get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)`,
    -- and this attribute’s value will be an `[AuthenticatorAssertionResponse](https://www.w3.org/TR/webauthn-2/#authenticatorassertionresponse)`.
    forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> AuthenticatorResponse c raw
cResponse :: AuthenticatorResponse c raw,
    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-getclientextensionresults)
    -- This operation returns the value of `[[[clientExtensionsResults]]](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-clientextensionsresults-slot)`,
    -- which is a [map](https://infra.spec.whatwg.org/#ordered-map) containing
    -- [extension identifier](https://www.w3.org/TR/webauthn-2/#extension-identifier) →
    -- [client extension output](https://www.w3.org/TR/webauthn-2/#client-extension-output) entries produced
    -- by the extension’s [client extension processing](https://www.w3.org/TR/webauthn-2/#client-extension-processing).
    forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> AuthenticationExtensionsClientOutputs
cClientExtensionResults :: AuthenticationExtensionsClientOutputs
  }
  deriving (Credential c raw -> Credential c raw -> Bool
(Credential c raw -> Credential c raw -> Bool)
-> (Credential c raw -> Credential c raw -> Bool)
-> Eq (Credential c raw)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> Credential c raw -> Bool
/= :: Credential c raw -> Credential c raw -> Bool
$c/= :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> Credential c raw -> Bool
== :: Credential c raw -> Credential c raw -> Bool
$c== :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> Credential c raw -> Bool
Eq, Int -> Credential c raw -> ShowS
[Credential c raw] -> ShowS
Credential c raw -> String
(Int -> Credential c raw -> ShowS)
-> (Credential c raw -> String)
-> ([Credential c raw] -> ShowS)
-> Show (Credential c raw)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (c :: CeremonyKind) (raw :: Bool).
Int -> Credential c raw -> ShowS
forall (c :: CeremonyKind) (raw :: Bool).
[Credential c raw] -> ShowS
forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> String
showList :: [Credential c raw] -> ShowS
$cshowList :: forall (c :: CeremonyKind) (raw :: Bool).
[Credential c raw] -> ShowS
show :: Credential c raw -> String
$cshow :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> String
showsPrec :: Int -> Credential c raw -> ShowS
$cshowsPrec :: forall (c :: CeremonyKind) (raw :: Bool).
Int -> Credential c raw -> ShowS
Show, (forall x. Credential c raw -> Rep (Credential c raw) x)
-> (forall x. Rep (Credential c raw) x -> Credential c raw)
-> Generic (Credential c raw)
forall x. Rep (Credential c raw) x -> Credential c raw
forall x. Credential c raw -> Rep (Credential c raw) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (c :: CeremonyKind) (raw :: Bool) x.
Rep (Credential c raw) x -> Credential c raw
forall (c :: CeremonyKind) (raw :: Bool) x.
Credential c raw -> Rep (Credential c raw) x
$cto :: forall (c :: CeremonyKind) (raw :: Bool) x.
Rep (Credential c raw) x -> Credential c raw
$cfrom :: forall (c :: CeremonyKind) (raw :: Bool) x.
Credential c raw -> Rep (Credential c raw) x
Generic, [Credential c raw] -> Encoding
[Credential c raw] -> Value
Credential c raw -> Encoding
Credential c raw -> Value
(Credential c raw -> Value)
-> (Credential c raw -> Encoding)
-> ([Credential c raw] -> Value)
-> ([Credential c raw] -> Encoding)
-> ToJSON (Credential c raw)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (c :: CeremonyKind) (raw :: Bool).
[Credential c raw] -> Encoding
forall (c :: CeremonyKind) (raw :: Bool).
[Credential c raw] -> Value
forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> Encoding
forall (c :: CeremonyKind) (raw :: Bool). Credential c raw -> Value
toEncodingList :: [Credential c raw] -> Encoding
$ctoEncodingList :: forall (c :: CeremonyKind) (raw :: Bool).
[Credential c raw] -> Encoding
toJSONList :: [Credential c raw] -> Value
$ctoJSONList :: forall (c :: CeremonyKind) (raw :: Bool).
[Credential c raw] -> Value
toEncoding :: Credential c raw -> Encoding
$ctoEncoding :: forall (c :: CeremonyKind) (raw :: Bool).
Credential c raw -> Encoding
toJSON :: Credential c raw -> Value
$ctoJSON :: forall (c :: CeremonyKind) (raw :: Bool). Credential c raw -> Value
ToJSON)