{-# LANGUAGE DuplicateRecordFields #-}

-- | Stability: experimental
-- Type definitions directly corresponding to the
-- [FIDO Metadata Service](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html)
-- specification.
module Crypto.WebAuthn.Metadata.Statement.WebIDL
  ( -- * Types
    AAGUID (..),
    CodeAccuracyDescriptor (..),
    BiometricAccuracyDescriptor (..),
    PatternAccuracyDescriptor (..),
    VerificationMethodDescriptor (..),
    VerificationMethodANDCombinations (..),
    RgbPaletteEntry (..),
    DisplayPNGCharacteristicsDescriptor (..),
    EcdaaTrustAnchor (..),
    ExtensionDescriptor (..),
    AlternativeDescriptions (..),
    AuthenticatorGetInfo (..),
    ProtocolFamily (..),

    -- * Metadata Statement
    MetadataStatement (..),
  )
where

import Crypto.WebAuthn.Internal.Utils (enumJSONEncodingOptions, jsonEncodingOptions)
import qualified Crypto.WebAuthn.Metadata.FidoRegistry as Registry
import qualified Crypto.WebAuthn.Metadata.UAF as UAF
import qualified Crypto.WebAuthn.Metadata.WebIDL as IDL
import qualified Data.Aeson as Aeson
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Text (Text)
import GHC.Generics (Generic)

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#authenticator-attestation-guid-aaguid-typedef)
newtype AAGUID = AAGUID IDL.DOMString
  deriving (Int -> AAGUID -> ShowS
[AAGUID] -> ShowS
AAGUID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AAGUID] -> ShowS
$cshowList :: [AAGUID] -> ShowS
show :: AAGUID -> String
$cshow :: AAGUID -> String
showsPrec :: Int -> AAGUID -> ShowS
$cshowsPrec :: Int -> AAGUID -> ShowS
Show, AAGUID -> AAGUID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AAGUID -> AAGUID -> Bool
$c/= :: AAGUID -> AAGUID -> Bool
== :: AAGUID -> AAGUID -> Bool
$c== :: AAGUID -> AAGUID -> Bool
Eq)
  deriving newtype (Value -> Parser [AAGUID]
Value -> Parser AAGUID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AAGUID]
$cparseJSONList :: Value -> Parser [AAGUID]
parseJSON :: Value -> Parser AAGUID
$cparseJSON :: Value -> Parser AAGUID
Aeson.FromJSON, [AAGUID] -> Encoding
[AAGUID] -> Value
AAGUID -> Encoding
AAGUID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AAGUID] -> Encoding
$ctoEncodingList :: [AAGUID] -> Encoding
toJSONList :: [AAGUID] -> Value
$ctoJSONList :: [AAGUID] -> Value
toEncoding :: AAGUID -> Encoding
$ctoEncoding :: AAGUID -> Encoding
toJSON :: AAGUID -> Value
$ctoJSON :: AAGUID -> Value
Aeson.ToJSON)

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#codeaccuracydescriptor-dictionary)
data CodeAccuracyDescriptor = CodeAccuracyDescriptor
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-codeaccuracydescriptor-base)
    CodeAccuracyDescriptor -> UnsignedShort
base :: IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-codeaccuracydescriptor-minlength)
    CodeAccuracyDescriptor -> UnsignedShort
minLength :: IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-codeaccuracydescriptor-maxretries)
    CodeAccuracyDescriptor -> Maybe UnsignedShort
maxRetries :: Maybe IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-codeaccuracydescriptor-blockslowdown)
    CodeAccuracyDescriptor -> Maybe UnsignedShort
blockSlowdown :: Maybe IDL.UnsignedShort
  }
  deriving (Int -> CodeAccuracyDescriptor -> ShowS
[CodeAccuracyDescriptor] -> ShowS
CodeAccuracyDescriptor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeAccuracyDescriptor] -> ShowS
$cshowList :: [CodeAccuracyDescriptor] -> ShowS
show :: CodeAccuracyDescriptor -> String
$cshow :: CodeAccuracyDescriptor -> String
showsPrec :: Int -> CodeAccuracyDescriptor -> ShowS
$cshowsPrec :: Int -> CodeAccuracyDescriptor -> ShowS
Show, CodeAccuracyDescriptor -> CodeAccuracyDescriptor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeAccuracyDescriptor -> CodeAccuracyDescriptor -> Bool
$c/= :: CodeAccuracyDescriptor -> CodeAccuracyDescriptor -> Bool
== :: CodeAccuracyDescriptor -> CodeAccuracyDescriptor -> Bool
$c== :: CodeAccuracyDescriptor -> CodeAccuracyDescriptor -> Bool
Eq, forall x. Rep CodeAccuracyDescriptor x -> CodeAccuracyDescriptor
forall x. CodeAccuracyDescriptor -> Rep CodeAccuracyDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CodeAccuracyDescriptor x -> CodeAccuracyDescriptor
$cfrom :: forall x. CodeAccuracyDescriptor -> Rep CodeAccuracyDescriptor x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#biometricaccuracydescriptor-dictionary)
data BiometricAccuracyDescriptor = BiometricAccuracyDescriptor
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-biometricaccuracydescriptor-selfattestedfrr)
    BiometricAccuracyDescriptor -> Maybe Double
selfAttestedFRR :: Maybe IDL.Double,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-biometricaccuracydescriptor-selfattestedfar)
    BiometricAccuracyDescriptor -> Maybe Double
selfAttestedFAR :: Maybe IDL.Double,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-biometricaccuracydescriptor-maxtemplates)
    BiometricAccuracyDescriptor -> Maybe UnsignedShort
maxTemplates :: Maybe IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-biometricaccuracydescriptor-maxretries)
    BiometricAccuracyDescriptor -> Maybe UnsignedShort
maxRetries :: Maybe IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-biometricaccuracydescriptor-blockslowdown)
    BiometricAccuracyDescriptor -> Maybe UnsignedShort
blockSlowdown :: Maybe IDL.UnsignedShort
  }
  deriving (Int -> BiometricAccuracyDescriptor -> ShowS
[BiometricAccuracyDescriptor] -> ShowS
BiometricAccuracyDescriptor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BiometricAccuracyDescriptor] -> ShowS
$cshowList :: [BiometricAccuracyDescriptor] -> ShowS
show :: BiometricAccuracyDescriptor -> String
$cshow :: BiometricAccuracyDescriptor -> String
showsPrec :: Int -> BiometricAccuracyDescriptor -> ShowS
$cshowsPrec :: Int -> BiometricAccuracyDescriptor -> ShowS
Show, BiometricAccuracyDescriptor -> BiometricAccuracyDescriptor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BiometricAccuracyDescriptor -> BiometricAccuracyDescriptor -> Bool
$c/= :: BiometricAccuracyDescriptor -> BiometricAccuracyDescriptor -> Bool
== :: BiometricAccuracyDescriptor -> BiometricAccuracyDescriptor -> Bool
$c== :: BiometricAccuracyDescriptor -> BiometricAccuracyDescriptor -> Bool
Eq, forall x.
Rep BiometricAccuracyDescriptor x -> BiometricAccuracyDescriptor
forall x.
BiometricAccuracyDescriptor -> Rep BiometricAccuracyDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BiometricAccuracyDescriptor x -> BiometricAccuracyDescriptor
$cfrom :: forall x.
BiometricAccuracyDescriptor -> Rep BiometricAccuracyDescriptor x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#patternaccuracydescriptor-dictionary)
data PatternAccuracyDescriptor = PatternAccuracyDescriptor
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-patternaccuracydescriptor-mincomplexity)
    -- FIXME: The spec declares this as an unsigned long, but the blob they
    -- provide has a value in it (34359738368) that doesn't fit into an
    -- unsigned long. See <https://github.com/tweag/webauthn/issues/68>.
    PatternAccuracyDescriptor -> UnsignedLongLong
minComplexity :: IDL.UnsignedLongLong,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-patternaccuracydescriptor-maxretries)
    PatternAccuracyDescriptor -> Maybe UnsignedShort
maxRetries :: Maybe IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-patternaccuracydescriptor-blockslowdown)
    PatternAccuracyDescriptor -> Maybe UnsignedShort
blockSlowdown :: Maybe IDL.UnsignedShort
  }
  deriving (Int -> PatternAccuracyDescriptor -> ShowS
[PatternAccuracyDescriptor] -> ShowS
PatternAccuracyDescriptor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatternAccuracyDescriptor] -> ShowS
$cshowList :: [PatternAccuracyDescriptor] -> ShowS
show :: PatternAccuracyDescriptor -> String
$cshow :: PatternAccuracyDescriptor -> String
showsPrec :: Int -> PatternAccuracyDescriptor -> ShowS
$cshowsPrec :: Int -> PatternAccuracyDescriptor -> ShowS
Show, PatternAccuracyDescriptor -> PatternAccuracyDescriptor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatternAccuracyDescriptor -> PatternAccuracyDescriptor -> Bool
$c/= :: PatternAccuracyDescriptor -> PatternAccuracyDescriptor -> Bool
== :: PatternAccuracyDescriptor -> PatternAccuracyDescriptor -> Bool
$c== :: PatternAccuracyDescriptor -> PatternAccuracyDescriptor -> Bool
Eq, forall x.
Rep PatternAccuracyDescriptor x -> PatternAccuracyDescriptor
forall x.
PatternAccuracyDescriptor -> Rep PatternAccuracyDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PatternAccuracyDescriptor x -> PatternAccuracyDescriptor
$cfrom :: forall x.
PatternAccuracyDescriptor -> Rep PatternAccuracyDescriptor x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#verificationmethoddescriptor-dictionary)
data VerificationMethodDescriptor = VerificationMethodDescriptor
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-verificationmethoddescriptor-userverificationmethod)
    VerificationMethodDescriptor -> UserVerificationMethod
userVerificationMethod :: Registry.UserVerificationMethod,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-verificationmethoddescriptor-cadesc)
    VerificationMethodDescriptor -> Maybe CodeAccuracyDescriptor
caDesc :: Maybe CodeAccuracyDescriptor,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-verificationmethoddescriptor-badesc)
    VerificationMethodDescriptor -> Maybe BiometricAccuracyDescriptor
baDesc :: Maybe BiometricAccuracyDescriptor,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-verificationmethoddescriptor-padesc)
    VerificationMethodDescriptor -> Maybe PatternAccuracyDescriptor
paDesc :: Maybe PatternAccuracyDescriptor
  }
  deriving (Int -> VerificationMethodDescriptor -> ShowS
[VerificationMethodDescriptor] -> ShowS
VerificationMethodDescriptor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerificationMethodDescriptor] -> ShowS
$cshowList :: [VerificationMethodDescriptor] -> ShowS
show :: VerificationMethodDescriptor -> String
$cshow :: VerificationMethodDescriptor -> String
showsPrec :: Int -> VerificationMethodDescriptor -> ShowS
$cshowsPrec :: Int -> VerificationMethodDescriptor -> ShowS
Show, VerificationMethodDescriptor
-> VerificationMethodDescriptor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerificationMethodDescriptor
-> VerificationMethodDescriptor -> Bool
$c/= :: VerificationMethodDescriptor
-> VerificationMethodDescriptor -> Bool
== :: VerificationMethodDescriptor
-> VerificationMethodDescriptor -> Bool
$c== :: VerificationMethodDescriptor
-> VerificationMethodDescriptor -> Bool
Eq, forall x.
Rep VerificationMethodDescriptor x -> VerificationMethodDescriptor
forall x.
VerificationMethodDescriptor -> Rep VerificationMethodDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep VerificationMethodDescriptor x -> VerificationMethodDescriptor
$cfrom :: forall x.
VerificationMethodDescriptor -> Rep VerificationMethodDescriptor x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#verificationmethodandcombinations-typedef)
newtype VerificationMethodANDCombinations = VerificationMethodANDCombinations (NonEmpty VerificationMethodDescriptor)
  deriving (Int -> VerificationMethodANDCombinations -> ShowS
[VerificationMethodANDCombinations] -> ShowS
VerificationMethodANDCombinations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerificationMethodANDCombinations] -> ShowS
$cshowList :: [VerificationMethodANDCombinations] -> ShowS
show :: VerificationMethodANDCombinations -> String
$cshow :: VerificationMethodANDCombinations -> String
showsPrec :: Int -> VerificationMethodANDCombinations -> ShowS
$cshowsPrec :: Int -> VerificationMethodANDCombinations -> ShowS
Show, VerificationMethodANDCombinations
-> VerificationMethodANDCombinations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerificationMethodANDCombinations
-> VerificationMethodANDCombinations -> Bool
$c/= :: VerificationMethodANDCombinations
-> VerificationMethodANDCombinations -> Bool
== :: VerificationMethodANDCombinations
-> VerificationMethodANDCombinations -> Bool
$c== :: VerificationMethodANDCombinations
-> VerificationMethodANDCombinations -> Bool
Eq)
  deriving newtype (Value -> Parser [VerificationMethodANDCombinations]
Value -> Parser VerificationMethodANDCombinations
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VerificationMethodANDCombinations]
$cparseJSONList :: Value -> Parser [VerificationMethodANDCombinations]
parseJSON :: Value -> Parser VerificationMethodANDCombinations
$cparseJSON :: Value -> Parser VerificationMethodANDCombinations
Aeson.FromJSON, [VerificationMethodANDCombinations] -> Encoding
[VerificationMethodANDCombinations] -> Value
VerificationMethodANDCombinations -> Encoding
VerificationMethodANDCombinations -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VerificationMethodANDCombinations] -> Encoding
$ctoEncodingList :: [VerificationMethodANDCombinations] -> Encoding
toJSONList :: [VerificationMethodANDCombinations] -> Value
$ctoJSONList :: [VerificationMethodANDCombinations] -> Value
toEncoding :: VerificationMethodANDCombinations -> Encoding
$ctoEncoding :: VerificationMethodANDCombinations -> Encoding
toJSON :: VerificationMethodANDCombinations -> Value
$ctoJSON :: VerificationMethodANDCombinations -> Value
Aeson.ToJSON)

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#rgbpaletteentry-dictionary)
data RgbPaletteEntry = RgbPaletteEntry
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-rgbpaletteentry-r)
    RgbPaletteEntry -> UnsignedShort
r :: IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-rgbpaletteentry-g)
    RgbPaletteEntry -> UnsignedShort
g :: IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-rgbpaletteentry-b)
    RgbPaletteEntry -> UnsignedShort
b :: IDL.UnsignedShort
  }
  deriving (Int -> RgbPaletteEntry -> ShowS
[RgbPaletteEntry] -> ShowS
RgbPaletteEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RgbPaletteEntry] -> ShowS
$cshowList :: [RgbPaletteEntry] -> ShowS
show :: RgbPaletteEntry -> String
$cshow :: RgbPaletteEntry -> String
showsPrec :: Int -> RgbPaletteEntry -> ShowS
$cshowsPrec :: Int -> RgbPaletteEntry -> ShowS
Show, RgbPaletteEntry -> RgbPaletteEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RgbPaletteEntry -> RgbPaletteEntry -> Bool
$c/= :: RgbPaletteEntry -> RgbPaletteEntry -> Bool
== :: RgbPaletteEntry -> RgbPaletteEntry -> Bool
$c== :: RgbPaletteEntry -> RgbPaletteEntry -> Bool
Eq, forall x. Rep RgbPaletteEntry x -> RgbPaletteEntry
forall x. RgbPaletteEntry -> Rep RgbPaletteEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RgbPaletteEntry x -> RgbPaletteEntry
$cfrom :: forall x. RgbPaletteEntry -> Rep RgbPaletteEntry x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#displaypngcharacteristicsdescriptor-dictionary)
data DisplayPNGCharacteristicsDescriptor = DisplayPNGCharacteristicsDescriptor
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-width)
    DisplayPNGCharacteristicsDescriptor -> UnsignedLong
width :: IDL.UnsignedLong,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-height)
    DisplayPNGCharacteristicsDescriptor -> UnsignedLong
height :: IDL.UnsignedLong,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-bitdepth)
    DisplayPNGCharacteristicsDescriptor -> Octet
bitDepth :: IDL.Octet,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-colortype)
    DisplayPNGCharacteristicsDescriptor -> Octet
colorType :: IDL.Octet,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-compression)
    DisplayPNGCharacteristicsDescriptor -> Octet
compression :: IDL.Octet,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-filter)
    DisplayPNGCharacteristicsDescriptor -> Octet
filter :: IDL.Octet,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-interlace)
    DisplayPNGCharacteristicsDescriptor -> Octet
interlace :: IDL.Octet,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-plte)
    DisplayPNGCharacteristicsDescriptor
-> Maybe (NonEmpty RgbPaletteEntry)
plte :: Maybe (NonEmpty RgbPaletteEntry)
  }
  deriving (Int -> DisplayPNGCharacteristicsDescriptor -> ShowS
[DisplayPNGCharacteristicsDescriptor] -> ShowS
DisplayPNGCharacteristicsDescriptor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayPNGCharacteristicsDescriptor] -> ShowS
$cshowList :: [DisplayPNGCharacteristicsDescriptor] -> ShowS
show :: DisplayPNGCharacteristicsDescriptor -> String
$cshow :: DisplayPNGCharacteristicsDescriptor -> String
showsPrec :: Int -> DisplayPNGCharacteristicsDescriptor -> ShowS
$cshowsPrec :: Int -> DisplayPNGCharacteristicsDescriptor -> ShowS
Show, DisplayPNGCharacteristicsDescriptor
-> DisplayPNGCharacteristicsDescriptor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayPNGCharacteristicsDescriptor
-> DisplayPNGCharacteristicsDescriptor -> Bool
$c/= :: DisplayPNGCharacteristicsDescriptor
-> DisplayPNGCharacteristicsDescriptor -> Bool
== :: DisplayPNGCharacteristicsDescriptor
-> DisplayPNGCharacteristicsDescriptor -> Bool
$c== :: DisplayPNGCharacteristicsDescriptor
-> DisplayPNGCharacteristicsDescriptor -> Bool
Eq, forall x.
Rep DisplayPNGCharacteristicsDescriptor x
-> DisplayPNGCharacteristicsDescriptor
forall x.
DisplayPNGCharacteristicsDescriptor
-> Rep DisplayPNGCharacteristicsDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisplayPNGCharacteristicsDescriptor x
-> DisplayPNGCharacteristicsDescriptor
$cfrom :: forall x.
DisplayPNGCharacteristicsDescriptor
-> Rep DisplayPNGCharacteristicsDescriptor x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#ecdaatrustanchor-dictionary)
data EcdaaTrustAnchor = EcdaaTrustAnchor
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-x)
    EcdaaTrustAnchor -> DOMString
litX :: IDL.DOMString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-y)
    EcdaaTrustAnchor -> DOMString
litY :: IDL.DOMString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-c)
    EcdaaTrustAnchor -> DOMString
c :: IDL.DOMString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-sx)
    EcdaaTrustAnchor -> DOMString
sx :: IDL.DOMString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-sy)
    EcdaaTrustAnchor -> DOMString
sy :: IDL.DOMString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-g1curve)
    EcdaaTrustAnchor -> DOMString
litG1Curve :: IDL.DOMString
  }
  deriving (Int -> EcdaaTrustAnchor -> ShowS
[EcdaaTrustAnchor] -> ShowS
EcdaaTrustAnchor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EcdaaTrustAnchor] -> ShowS
$cshowList :: [EcdaaTrustAnchor] -> ShowS
show :: EcdaaTrustAnchor -> String
$cshow :: EcdaaTrustAnchor -> String
showsPrec :: Int -> EcdaaTrustAnchor -> ShowS
$cshowsPrec :: Int -> EcdaaTrustAnchor -> ShowS
Show, EcdaaTrustAnchor -> EcdaaTrustAnchor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EcdaaTrustAnchor -> EcdaaTrustAnchor -> Bool
$c/= :: EcdaaTrustAnchor -> EcdaaTrustAnchor -> Bool
== :: EcdaaTrustAnchor -> EcdaaTrustAnchor -> Bool
$c== :: EcdaaTrustAnchor -> EcdaaTrustAnchor -> Bool
Eq, forall x. Rep EcdaaTrustAnchor x -> EcdaaTrustAnchor
forall x. EcdaaTrustAnchor -> Rep EcdaaTrustAnchor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EcdaaTrustAnchor x -> EcdaaTrustAnchor
$cfrom :: forall x. EcdaaTrustAnchor -> Rep EcdaaTrustAnchor x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#extensiondescriptor-dictionary)
data ExtensionDescriptor = ExtensionDescriptor
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-extensiondescriptor-id)
    ExtensionDescriptor -> DOMString
id :: IDL.DOMString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-extensiondescriptor-tag)
    ExtensionDescriptor -> Maybe UnsignedShort
tag :: Maybe IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-extensiondescriptor-data)
    ExtensionDescriptor -> Maybe DOMString
litdata :: Maybe IDL.DOMString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-extensiondescriptor-fail_if_unknown)
    ExtensionDescriptor -> Bool
fail_if_unknown :: IDL.Boolean
  }
  deriving (Int -> ExtensionDescriptor -> ShowS
[ExtensionDescriptor] -> ShowS
ExtensionDescriptor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtensionDescriptor] -> ShowS
$cshowList :: [ExtensionDescriptor] -> ShowS
show :: ExtensionDescriptor -> String
$cshow :: ExtensionDescriptor -> String
showsPrec :: Int -> ExtensionDescriptor -> ShowS
$cshowsPrec :: Int -> ExtensionDescriptor -> ShowS
Show, ExtensionDescriptor -> ExtensionDescriptor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtensionDescriptor -> ExtensionDescriptor -> Bool
$c/= :: ExtensionDescriptor -> ExtensionDescriptor -> Bool
== :: ExtensionDescriptor -> ExtensionDescriptor -> Bool
$c== :: ExtensionDescriptor -> ExtensionDescriptor -> Bool
Eq, forall x. Rep ExtensionDescriptor x -> ExtensionDescriptor
forall x. ExtensionDescriptor -> Rep ExtensionDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtensionDescriptor x -> ExtensionDescriptor
$cfrom :: forall x. ExtensionDescriptor -> Rep ExtensionDescriptor x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#alternativedescriptions-dictionary)
-- TODO: Replace Text with
-- <https://hackage.haskell.org/package/aeson-2.0.2.0/docs/Data-Aeson-Key.html#t:Key>
-- when updating aeson. Updating aeson is currently blocked by
-- <https://github.com/fumieval/deriving-aeson/issues/16>.
newtype AlternativeDescriptions = AlternativeDescriptions (Map Text IDL.DOMString)
  deriving (Int -> AlternativeDescriptions -> ShowS
[AlternativeDescriptions] -> ShowS
AlternativeDescriptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlternativeDescriptions] -> ShowS
$cshowList :: [AlternativeDescriptions] -> ShowS
show :: AlternativeDescriptions -> String
$cshow :: AlternativeDescriptions -> String
showsPrec :: Int -> AlternativeDescriptions -> ShowS
$cshowsPrec :: Int -> AlternativeDescriptions -> ShowS
Show, AlternativeDescriptions -> AlternativeDescriptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlternativeDescriptions -> AlternativeDescriptions -> Bool
$c/= :: AlternativeDescriptions -> AlternativeDescriptions -> Bool
== :: AlternativeDescriptions -> AlternativeDescriptions -> Bool
$c== :: AlternativeDescriptions -> AlternativeDescriptions -> Bool
Eq)
  deriving newtype (Value -> Parser [AlternativeDescriptions]
Value -> Parser AlternativeDescriptions
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AlternativeDescriptions]
$cparseJSONList :: Value -> Parser [AlternativeDescriptions]
parseJSON :: Value -> Parser AlternativeDescriptions
$cparseJSON :: Value -> Parser AlternativeDescriptions
Aeson.FromJSON, [AlternativeDescriptions] -> Encoding
[AlternativeDescriptions] -> Value
AlternativeDescriptions -> Encoding
AlternativeDescriptions -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AlternativeDescriptions] -> Encoding
$ctoEncodingList :: [AlternativeDescriptions] -> Encoding
toJSONList :: [AlternativeDescriptions] -> Value
$ctoJSONList :: [AlternativeDescriptions] -> Value
toEncoding :: AlternativeDescriptions -> Encoding
$ctoEncoding :: AlternativeDescriptions -> Encoding
toJSON :: AlternativeDescriptions -> Value
$ctoJSON :: AlternativeDescriptions -> Value
Aeson.ToJSON)

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#authenticatorgetinfo-dictionary)
newtype AuthenticatorGetInfo
  = -- TODO: Replace Text with
    -- <https://hackage.haskell.org/package/aeson-2.0.2.0/docs/Data-Aeson-Key.html#t:Key>
    -- when updating aeson. Updating aeson is currently blocked by
    -- <https://github.com/fumieval/deriving-aeson/issues/16>.
    -- FIXME: The spec wrongfully declares the values to be DOMString's when
    -- they really aren't in the provided blob. See:
    -- <https://github.com/tweag/webauthn/issues/68>
    AuthenticatorGetInfo (Map Text Aeson.Value)
  deriving (Int -> AuthenticatorGetInfo -> ShowS
[AuthenticatorGetInfo] -> ShowS
AuthenticatorGetInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatorGetInfo] -> ShowS
$cshowList :: [AuthenticatorGetInfo] -> ShowS
show :: AuthenticatorGetInfo -> String
$cshow :: AuthenticatorGetInfo -> String
showsPrec :: Int -> AuthenticatorGetInfo -> ShowS
$cshowsPrec :: Int -> AuthenticatorGetInfo -> ShowS
Show, AuthenticatorGetInfo -> AuthenticatorGetInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatorGetInfo -> AuthenticatorGetInfo -> Bool
$c/= :: AuthenticatorGetInfo -> AuthenticatorGetInfo -> Bool
== :: AuthenticatorGetInfo -> AuthenticatorGetInfo -> Bool
$c== :: AuthenticatorGetInfo -> AuthenticatorGetInfo -> Bool
Eq)
  deriving newtype (Value -> Parser [AuthenticatorGetInfo]
Value -> Parser AuthenticatorGetInfo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AuthenticatorGetInfo]
$cparseJSONList :: Value -> Parser [AuthenticatorGetInfo]
parseJSON :: Value -> Parser AuthenticatorGetInfo
$cparseJSON :: Value -> Parser AuthenticatorGetInfo
Aeson.FromJSON, [AuthenticatorGetInfo] -> Encoding
[AuthenticatorGetInfo] -> Value
AuthenticatorGetInfo -> Encoding
AuthenticatorGetInfo -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AuthenticatorGetInfo] -> Encoding
$ctoEncodingList :: [AuthenticatorGetInfo] -> Encoding
toJSONList :: [AuthenticatorGetInfo] -> Value
$ctoJSONList :: [AuthenticatorGetInfo] -> Value
toEncoding :: AuthenticatorGetInfo -> Encoding
$ctoEncoding :: AuthenticatorGetInfo -> Encoding
toJSON :: AuthenticatorGetInfo -> Value
$ctoJSON :: AuthenticatorGetInfo -> Value
Aeson.ToJSON)

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#metadata-keys)
data MetadataStatement = MetadataStatement
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-legalheader)
    MetadataStatement -> DOMString
legalHeader :: IDL.DOMString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-aaid)
    MetadataStatement -> Maybe AAID
aaid :: Maybe UAF.AAID,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-aaguid)
    MetadataStatement -> Maybe AAGUID
aaguid :: Maybe AAGUID,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationcertificatekeyidentifiers)
    MetadataStatement -> Maybe (NonEmpty KeyIdentifier)
attestationCertificateKeyIdentifiers :: Maybe (NonEmpty UAF.KeyIdentifier),
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-description)
    MetadataStatement -> DOMString
description :: IDL.DOMString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-alternativedescriptions)
    MetadataStatement -> Maybe AlternativeDescriptions
alternativeDescriptions :: Maybe AlternativeDescriptions,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticatorversion)
    MetadataStatement -> UnsignedLong
authenticatorVersion :: IDL.UnsignedLong,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-protocolfamily)
    MetadataStatement -> ProtocolFamily
protocolFamily :: ProtocolFamily,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-schema)
    MetadataStatement -> UnsignedShort
schema :: IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-upv)
    MetadataStatement -> NonEmpty Version
upv :: NonEmpty UAF.Version,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticationalgorithms)
    MetadataStatement -> NonEmpty AuthenticationAlgorithm
authenticationAlgorithms :: NonEmpty Registry.AuthenticationAlgorithm,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-publickeyalgandencodings)
    MetadataStatement -> NonEmpty PublicKeyRepresentationFormat
publicKeyAlgAndEncodings :: NonEmpty Registry.PublicKeyRepresentationFormat,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationtypes)
    MetadataStatement -> NonEmpty AuthenticatorAttestationType
attestationTypes :: NonEmpty Registry.AuthenticatorAttestationType,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-userverificationdetails)
    MetadataStatement -> NonEmpty VerificationMethodANDCombinations
userVerificationDetails :: NonEmpty VerificationMethodANDCombinations,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-keyprotection)
    MetadataStatement -> NonEmpty KeyProtectionType
keyProtection :: NonEmpty Registry.KeyProtectionType,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-iskeyrestricted)
    MetadataStatement -> Maybe Bool
isKeyRestricted :: Maybe IDL.Boolean,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-isfreshuserverificationrequired)
    MetadataStatement -> Maybe Bool
isFreshUserVerificationRequired :: Maybe IDL.Boolean,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-matcherprotection)
    MetadataStatement -> NonEmpty MatcherProtectionType
matcherProtection :: NonEmpty Registry.MatcherProtectionType,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-cryptostrength)
    MetadataStatement -> Maybe UnsignedShort
cryptoStrength :: Maybe IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attachmenthint)
    MetadataStatement -> NonEmpty AuthenticatorAttachmentHint
attachmentHint :: NonEmpty Registry.AuthenticatorAttachmentHint,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplay)
    MetadataStatement -> [TransactionConfirmationDisplayType]
tcDisplay :: [Registry.TransactionConfirmationDisplayType],
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplaycontenttype)
    MetadataStatement -> Maybe DOMString
tcDisplayContentType :: Maybe IDL.DOMString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplaypngcharacteristics)
    MetadataStatement
-> Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
tcDisplayPNGCharacteristics :: Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor),
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationrootcertificates)
    MetadataStatement -> [DOMString]
attestationRootCertificates :: [IDL.DOMString],
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-ecdaatrustanchors)
    MetadataStatement -> Maybe (NonEmpty EcdaaTrustAnchor)
ecdaaTrustAnchors :: Maybe (NonEmpty EcdaaTrustAnchor),
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-icon)
    MetadataStatement -> Maybe DOMString
icon :: Maybe IDL.DOMString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-supportedextensions)
    MetadataStatement -> Maybe (NonEmpty ExtensionDescriptor)
supportedExtensions :: Maybe (NonEmpty ExtensionDescriptor),
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticatorgetinfo)
    MetadataStatement -> Maybe AuthenticatorGetInfo
authenticatorGetInfo :: Maybe AuthenticatorGetInfo
  }
  deriving (Int -> MetadataStatement -> ShowS
[MetadataStatement] -> ShowS
MetadataStatement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetadataStatement] -> ShowS
$cshowList :: [MetadataStatement] -> ShowS
show :: MetadataStatement -> String
$cshow :: MetadataStatement -> String
showsPrec :: Int -> MetadataStatement -> ShowS
$cshowsPrec :: Int -> MetadataStatement -> ShowS
Show, MetadataStatement -> MetadataStatement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetadataStatement -> MetadataStatement -> Bool
$c/= :: MetadataStatement -> MetadataStatement -> Bool
== :: MetadataStatement -> MetadataStatement -> Bool
$c== :: MetadataStatement -> MetadataStatement -> Bool
Eq, forall x. Rep MetadataStatement x -> MetadataStatement
forall x. MetadataStatement -> Rep MetadataStatement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetadataStatement x -> MetadataStatement
$cfrom :: forall x. MetadataStatement -> Rep MetadataStatement x
Generic)

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

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

-- | Possible FIDO protocol families for 'protocolFamily'
data ProtocolFamily
  = ProtocolFamilyUAF
  | ProtocolFamilyU2F
  | ProtocolFamilyFIDO2
  deriving (Int -> ProtocolFamily -> ShowS
[ProtocolFamily] -> ShowS
ProtocolFamily -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolFamily] -> ShowS
$cshowList :: [ProtocolFamily] -> ShowS
show :: ProtocolFamily -> String
$cshow :: ProtocolFamily -> String
showsPrec :: Int -> ProtocolFamily -> ShowS
$cshowsPrec :: Int -> ProtocolFamily -> ShowS
Show, ProtocolFamily -> ProtocolFamily -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolFamily -> ProtocolFamily -> Bool
$c/= :: ProtocolFamily -> ProtocolFamily -> Bool
== :: ProtocolFamily -> ProtocolFamily -> Bool
$c== :: ProtocolFamily -> ProtocolFamily -> Bool
Eq, forall x. Rep ProtocolFamily x -> ProtocolFamily
forall x. ProtocolFamily -> Rep ProtocolFamily x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProtocolFamily x -> ProtocolFamily
$cfrom :: forall x. ProtocolFamily -> Rep ProtocolFamily x
Generic)

instance Aeson.FromJSON ProtocolFamily where
  parseJSON :: Value -> Parser ProtocolFamily
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON forall a b. (a -> b) -> a -> b
$ String -> Options
enumJSONEncodingOptions String
"ProtocolFamily"

instance Aeson.ToJSON ProtocolFamily where
  toJSON :: ProtocolFamily -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON forall a b. (a -> b) -> a -> b
$ String -> Options
enumJSONEncodingOptions String
"ProtocolFamily"