{-# 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
(Int -> AAGUID -> ShowS)
-> (AAGUID -> String) -> ([AAGUID] -> ShowS) -> Show AAGUID
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
(AAGUID -> AAGUID -> Bool)
-> (AAGUID -> AAGUID -> Bool) -> Eq AAGUID
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
(Value -> Parser AAGUID)
-> (Value -> Parser [AAGUID]) -> FromJSON 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
(AAGUID -> Value)
-> (AAGUID -> Encoding)
-> ([AAGUID] -> Value)
-> ([AAGUID] -> Encoding)
-> ToJSON AAGUID
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
(Int -> CodeAccuracyDescriptor -> ShowS)
-> (CodeAccuracyDescriptor -> String)
-> ([CodeAccuracyDescriptor] -> ShowS)
-> Show CodeAccuracyDescriptor
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
(CodeAccuracyDescriptor -> CodeAccuracyDescriptor -> Bool)
-> (CodeAccuracyDescriptor -> CodeAccuracyDescriptor -> Bool)
-> Eq CodeAccuracyDescriptor
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. CodeAccuracyDescriptor -> Rep CodeAccuracyDescriptor x)
-> (forall x.
    Rep CodeAccuracyDescriptor x -> CodeAccuracyDescriptor)
-> Generic CodeAccuracyDescriptor
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 = Options -> Value -> Parser CodeAccuracyDescriptor
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 = Options -> CodeAccuracyDescriptor -> Value
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
(Int -> BiometricAccuracyDescriptor -> ShowS)
-> (BiometricAccuracyDescriptor -> String)
-> ([BiometricAccuracyDescriptor] -> ShowS)
-> Show BiometricAccuracyDescriptor
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
(BiometricAccuracyDescriptor
 -> BiometricAccuracyDescriptor -> Bool)
-> (BiometricAccuracyDescriptor
    -> BiometricAccuracyDescriptor -> Bool)
-> Eq BiometricAccuracyDescriptor
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.
 BiometricAccuracyDescriptor -> Rep BiometricAccuracyDescriptor x)
-> (forall x.
    Rep BiometricAccuracyDescriptor x -> BiometricAccuracyDescriptor)
-> Generic BiometricAccuracyDescriptor
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 = Options -> Value -> Parser BiometricAccuracyDescriptor
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 = Options -> BiometricAccuracyDescriptor -> Value
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
(Int -> PatternAccuracyDescriptor -> ShowS)
-> (PatternAccuracyDescriptor -> String)
-> ([PatternAccuracyDescriptor] -> ShowS)
-> Show PatternAccuracyDescriptor
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
(PatternAccuracyDescriptor -> PatternAccuracyDescriptor -> Bool)
-> (PatternAccuracyDescriptor -> PatternAccuracyDescriptor -> Bool)
-> Eq PatternAccuracyDescriptor
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.
 PatternAccuracyDescriptor -> Rep PatternAccuracyDescriptor x)
-> (forall x.
    Rep PatternAccuracyDescriptor x -> PatternAccuracyDescriptor)
-> Generic PatternAccuracyDescriptor
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 = Options -> Value -> Parser PatternAccuracyDescriptor
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 = Options -> PatternAccuracyDescriptor -> Value
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
(Int -> VerificationMethodDescriptor -> ShowS)
-> (VerificationMethodDescriptor -> String)
-> ([VerificationMethodDescriptor] -> ShowS)
-> Show VerificationMethodDescriptor
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
(VerificationMethodDescriptor
 -> VerificationMethodDescriptor -> Bool)
-> (VerificationMethodDescriptor
    -> VerificationMethodDescriptor -> Bool)
-> Eq VerificationMethodDescriptor
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.
 VerificationMethodDescriptor -> Rep VerificationMethodDescriptor x)
-> (forall x.
    Rep VerificationMethodDescriptor x -> VerificationMethodDescriptor)
-> Generic VerificationMethodDescriptor
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 = Options -> Value -> Parser VerificationMethodDescriptor
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 = Options -> VerificationMethodDescriptor -> Value
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
(Int -> VerificationMethodANDCombinations -> ShowS)
-> (VerificationMethodANDCombinations -> String)
-> ([VerificationMethodANDCombinations] -> ShowS)
-> Show VerificationMethodANDCombinations
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
(VerificationMethodANDCombinations
 -> VerificationMethodANDCombinations -> Bool)
-> (VerificationMethodANDCombinations
    -> VerificationMethodANDCombinations -> Bool)
-> Eq VerificationMethodANDCombinations
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
(Value -> Parser VerificationMethodANDCombinations)
-> (Value -> Parser [VerificationMethodANDCombinations])
-> FromJSON 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
(VerificationMethodANDCombinations -> Value)
-> (VerificationMethodANDCombinations -> Encoding)
-> ([VerificationMethodANDCombinations] -> Value)
-> ([VerificationMethodANDCombinations] -> Encoding)
-> ToJSON VerificationMethodANDCombinations
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
(Int -> RgbPaletteEntry -> ShowS)
-> (RgbPaletteEntry -> String)
-> ([RgbPaletteEntry] -> ShowS)
-> Show RgbPaletteEntry
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
(RgbPaletteEntry -> RgbPaletteEntry -> Bool)
-> (RgbPaletteEntry -> RgbPaletteEntry -> Bool)
-> Eq RgbPaletteEntry
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. RgbPaletteEntry -> Rep RgbPaletteEntry x)
-> (forall x. Rep RgbPaletteEntry x -> RgbPaletteEntry)
-> Generic RgbPaletteEntry
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 = Options -> Value -> Parser RgbPaletteEntry
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 = Options -> RgbPaletteEntry -> Value
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
(Int -> DisplayPNGCharacteristicsDescriptor -> ShowS)
-> (DisplayPNGCharacteristicsDescriptor -> String)
-> ([DisplayPNGCharacteristicsDescriptor] -> ShowS)
-> Show DisplayPNGCharacteristicsDescriptor
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
(DisplayPNGCharacteristicsDescriptor
 -> DisplayPNGCharacteristicsDescriptor -> Bool)
-> (DisplayPNGCharacteristicsDescriptor
    -> DisplayPNGCharacteristicsDescriptor -> Bool)
-> Eq DisplayPNGCharacteristicsDescriptor
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.
 DisplayPNGCharacteristicsDescriptor
 -> Rep DisplayPNGCharacteristicsDescriptor x)
-> (forall x.
    Rep DisplayPNGCharacteristicsDescriptor x
    -> DisplayPNGCharacteristicsDescriptor)
-> Generic DisplayPNGCharacteristicsDescriptor
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 = Options -> Value -> Parser DisplayPNGCharacteristicsDescriptor
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 = Options -> DisplayPNGCharacteristicsDescriptor -> Value
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
(Int -> EcdaaTrustAnchor -> ShowS)
-> (EcdaaTrustAnchor -> String)
-> ([EcdaaTrustAnchor] -> ShowS)
-> Show EcdaaTrustAnchor
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
(EcdaaTrustAnchor -> EcdaaTrustAnchor -> Bool)
-> (EcdaaTrustAnchor -> EcdaaTrustAnchor -> Bool)
-> Eq EcdaaTrustAnchor
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. EcdaaTrustAnchor -> Rep EcdaaTrustAnchor x)
-> (forall x. Rep EcdaaTrustAnchor x -> EcdaaTrustAnchor)
-> Generic EcdaaTrustAnchor
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 = Options -> Value -> Parser EcdaaTrustAnchor
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 = Options -> EcdaaTrustAnchor -> Value
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
(Int -> ExtensionDescriptor -> ShowS)
-> (ExtensionDescriptor -> String)
-> ([ExtensionDescriptor] -> ShowS)
-> Show ExtensionDescriptor
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
(ExtensionDescriptor -> ExtensionDescriptor -> Bool)
-> (ExtensionDescriptor -> ExtensionDescriptor -> Bool)
-> Eq ExtensionDescriptor
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. ExtensionDescriptor -> Rep ExtensionDescriptor x)
-> (forall x. Rep ExtensionDescriptor x -> ExtensionDescriptor)
-> Generic ExtensionDescriptor
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 = Options -> Value -> Parser ExtensionDescriptor
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 = Options -> ExtensionDescriptor -> Value
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
(Int -> AlternativeDescriptions -> ShowS)
-> (AlternativeDescriptions -> String)
-> ([AlternativeDescriptions] -> ShowS)
-> Show AlternativeDescriptions
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
(AlternativeDescriptions -> AlternativeDescriptions -> Bool)
-> (AlternativeDescriptions -> AlternativeDescriptions -> Bool)
-> Eq AlternativeDescriptions
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
(Value -> Parser AlternativeDescriptions)
-> (Value -> Parser [AlternativeDescriptions])
-> FromJSON 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
(AlternativeDescriptions -> Value)
-> (AlternativeDescriptions -> Encoding)
-> ([AlternativeDescriptions] -> Value)
-> ([AlternativeDescriptions] -> Encoding)
-> ToJSON AlternativeDescriptions
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
(Int -> AuthenticatorGetInfo -> ShowS)
-> (AuthenticatorGetInfo -> String)
-> ([AuthenticatorGetInfo] -> ShowS)
-> Show AuthenticatorGetInfo
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
(AuthenticatorGetInfo -> AuthenticatorGetInfo -> Bool)
-> (AuthenticatorGetInfo -> AuthenticatorGetInfo -> Bool)
-> Eq AuthenticatorGetInfo
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
(Value -> Parser AuthenticatorGetInfo)
-> (Value -> Parser [AuthenticatorGetInfo])
-> FromJSON 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
(AuthenticatorGetInfo -> Value)
-> (AuthenticatorGetInfo -> Encoding)
-> ([AuthenticatorGetInfo] -> Value)
-> ([AuthenticatorGetInfo] -> Encoding)
-> ToJSON AuthenticatorGetInfo
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
(Int -> MetadataStatement -> ShowS)
-> (MetadataStatement -> String)
-> ([MetadataStatement] -> ShowS)
-> Show MetadataStatement
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
(MetadataStatement -> MetadataStatement -> Bool)
-> (MetadataStatement -> MetadataStatement -> Bool)
-> Eq MetadataStatement
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. MetadataStatement -> Rep MetadataStatement x)
-> (forall x. Rep MetadataStatement x -> MetadataStatement)
-> Generic MetadataStatement
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 = Options -> Value -> Parser MetadataStatement
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 = Options -> MetadataStatement -> Value
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
(Int -> ProtocolFamily -> ShowS)
-> (ProtocolFamily -> String)
-> ([ProtocolFamily] -> ShowS)
-> Show ProtocolFamily
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
(ProtocolFamily -> ProtocolFamily -> Bool)
-> (ProtocolFamily -> ProtocolFamily -> Bool) -> Eq ProtocolFamily
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. ProtocolFamily -> Rep ProtocolFamily x)
-> (forall x. Rep ProtocolFamily x -> ProtocolFamily)
-> Generic ProtocolFamily
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 = Options -> Value -> Parser ProtocolFamily
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON (Options -> Value -> Parser ProtocolFamily)
-> Options -> Value -> Parser ProtocolFamily
forall a b. (a -> b) -> a -> b
$ String -> Options
enumJSONEncodingOptions String
"ProtocolFamily"

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