{-# LANGUAGE DataKinds #-}

-- | Stability: experimental
-- [Fido Registry of Predefined Values](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#authenticator-attestation-types)
-- FIDO Alliance Proposed Standard 17 December 2019
module Crypto.WebAuthn.Metadata.FidoRegistry
  ( UserVerificationMethod (..),
    KeyProtectionType (..),
    MatcherProtectionType (..),
    AuthenticatorAttachmentHint (..),
    TransactionConfirmationDisplayType (..),
    AuthenticationAlgorithm (..),
    PublicKeyRepresentationFormat (..),
    AuthenticatorAttestationType (..),
  )
where

import Crypto.WebAuthn.Internal.Utils (enumJSONEncodingOptions)
import qualified Data.Aeson as Aeson
import GHC.Generics (Generic)

-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#user-verification-methods)
data UserVerificationMethod
  = USER_VERIFY_PRESENCE_INTERNAL
  | USER_VERIFY_FINGERPRINT_INTERNAL
  | USER_VERIFY_PASSCODE_INTERNAL
  | USER_VERIFY_VOICEPRINT_INTERNAL
  | USER_VERIFY_FACEPRINT_INTERNAL
  | USER_VERIFY_LOCATION_INTERNAL
  | USER_VERIFY_EYEPRINT_INTERNAL
  | USER_VERIFY_PATTERN_INTERNAL
  | USER_VERIFY_HANDPRINT_INTERNAL
  | USER_VERIFY_PASSCODE_EXTERNAL
  | USER_VERIFY_PATTERN_EXTERNAL
  | USER_VERIFY_NONE
  | USER_VERIFY_ALL
  deriving (Int -> UserVerificationMethod -> ShowS
[UserVerificationMethod] -> ShowS
UserVerificationMethod -> String
(Int -> UserVerificationMethod -> ShowS)
-> (UserVerificationMethod -> String)
-> ([UserVerificationMethod] -> ShowS)
-> Show UserVerificationMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserVerificationMethod] -> ShowS
$cshowList :: [UserVerificationMethod] -> ShowS
show :: UserVerificationMethod -> String
$cshow :: UserVerificationMethod -> String
showsPrec :: Int -> UserVerificationMethod -> ShowS
$cshowsPrec :: Int -> UserVerificationMethod -> ShowS
Show, UserVerificationMethod -> UserVerificationMethod -> Bool
(UserVerificationMethod -> UserVerificationMethod -> Bool)
-> (UserVerificationMethod -> UserVerificationMethod -> Bool)
-> Eq UserVerificationMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserVerificationMethod -> UserVerificationMethod -> Bool
$c/= :: UserVerificationMethod -> UserVerificationMethod -> Bool
== :: UserVerificationMethod -> UserVerificationMethod -> Bool
$c== :: UserVerificationMethod -> UserVerificationMethod -> Bool
Eq, (forall x. UserVerificationMethod -> Rep UserVerificationMethod x)
-> (forall x.
    Rep UserVerificationMethod x -> UserVerificationMethod)
-> Generic UserVerificationMethod
forall x. Rep UserVerificationMethod x -> UserVerificationMethod
forall x. UserVerificationMethod -> Rep UserVerificationMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserVerificationMethod x -> UserVerificationMethod
$cfrom :: forall x. UserVerificationMethod -> Rep UserVerificationMethod x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#key-protection-types)
data KeyProtectionType
  = KEY_PROTECTION_SOFTWARE
  | KEY_PROTECTION_HARDWARE
  | KEY_PROTECTION_TEE
  | KEY_PROTECTION_SECURE_ELEMENT
  | KEY_PROTECTION_REMOTE_HANDLE
  deriving (Int -> KeyProtectionType -> ShowS
[KeyProtectionType] -> ShowS
KeyProtectionType -> String
(Int -> KeyProtectionType -> ShowS)
-> (KeyProtectionType -> String)
-> ([KeyProtectionType] -> ShowS)
-> Show KeyProtectionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyProtectionType] -> ShowS
$cshowList :: [KeyProtectionType] -> ShowS
show :: KeyProtectionType -> String
$cshow :: KeyProtectionType -> String
showsPrec :: Int -> KeyProtectionType -> ShowS
$cshowsPrec :: Int -> KeyProtectionType -> ShowS
Show, KeyProtectionType -> KeyProtectionType -> Bool
(KeyProtectionType -> KeyProtectionType -> Bool)
-> (KeyProtectionType -> KeyProtectionType -> Bool)
-> Eq KeyProtectionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyProtectionType -> KeyProtectionType -> Bool
$c/= :: KeyProtectionType -> KeyProtectionType -> Bool
== :: KeyProtectionType -> KeyProtectionType -> Bool
$c== :: KeyProtectionType -> KeyProtectionType -> Bool
Eq, (forall x. KeyProtectionType -> Rep KeyProtectionType x)
-> (forall x. Rep KeyProtectionType x -> KeyProtectionType)
-> Generic KeyProtectionType
forall x. Rep KeyProtectionType x -> KeyProtectionType
forall x. KeyProtectionType -> Rep KeyProtectionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeyProtectionType x -> KeyProtectionType
$cfrom :: forall x. KeyProtectionType -> Rep KeyProtectionType x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#matcher-protection-types)
data MatcherProtectionType
  = MATCHER_PROTECTION_SOFTWARE
  | MATCHER_PROTECTION_TEE
  | MATCHER_PROTECTION_ON_CHIP
  deriving (Int -> MatcherProtectionType -> ShowS
[MatcherProtectionType] -> ShowS
MatcherProtectionType -> String
(Int -> MatcherProtectionType -> ShowS)
-> (MatcherProtectionType -> String)
-> ([MatcherProtectionType] -> ShowS)
-> Show MatcherProtectionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatcherProtectionType] -> ShowS
$cshowList :: [MatcherProtectionType] -> ShowS
show :: MatcherProtectionType -> String
$cshow :: MatcherProtectionType -> String
showsPrec :: Int -> MatcherProtectionType -> ShowS
$cshowsPrec :: Int -> MatcherProtectionType -> ShowS
Show, MatcherProtectionType -> MatcherProtectionType -> Bool
(MatcherProtectionType -> MatcherProtectionType -> Bool)
-> (MatcherProtectionType -> MatcherProtectionType -> Bool)
-> Eq MatcherProtectionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatcherProtectionType -> MatcherProtectionType -> Bool
$c/= :: MatcherProtectionType -> MatcherProtectionType -> Bool
== :: MatcherProtectionType -> MatcherProtectionType -> Bool
$c== :: MatcherProtectionType -> MatcherProtectionType -> Bool
Eq, (forall x. MatcherProtectionType -> Rep MatcherProtectionType x)
-> (forall x. Rep MatcherProtectionType x -> MatcherProtectionType)
-> Generic MatcherProtectionType
forall x. Rep MatcherProtectionType x -> MatcherProtectionType
forall x. MatcherProtectionType -> Rep MatcherProtectionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MatcherProtectionType x -> MatcherProtectionType
$cfrom :: forall x. MatcherProtectionType -> Rep MatcherProtectionType x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#authenticator-attachment-hints)
data AuthenticatorAttachmentHint
  = ATTACHMENT_HINT_INTERNAL
  | ATTACHMENT_HINT_EXTERNAL
  | ATTACHMENT_HINT_WIRED
  | ATTACHMENT_HINT_WIRELESS
  | ATTACHMENT_HINT_NFC
  | ATTACHMENT_HINT_BLUETOOTH
  | ATTACHMENT_HINT_NETWORK
  | ATTACHMENT_HINT_READY
  | ATTACHMENT_HINT_WIFI_DIRECT
  deriving (Int -> AuthenticatorAttachmentHint -> ShowS
[AuthenticatorAttachmentHint] -> ShowS
AuthenticatorAttachmentHint -> String
(Int -> AuthenticatorAttachmentHint -> ShowS)
-> (AuthenticatorAttachmentHint -> String)
-> ([AuthenticatorAttachmentHint] -> ShowS)
-> Show AuthenticatorAttachmentHint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatorAttachmentHint] -> ShowS
$cshowList :: [AuthenticatorAttachmentHint] -> ShowS
show :: AuthenticatorAttachmentHint -> String
$cshow :: AuthenticatorAttachmentHint -> String
showsPrec :: Int -> AuthenticatorAttachmentHint -> ShowS
$cshowsPrec :: Int -> AuthenticatorAttachmentHint -> ShowS
Show, AuthenticatorAttachmentHint -> AuthenticatorAttachmentHint -> Bool
(AuthenticatorAttachmentHint
 -> AuthenticatorAttachmentHint -> Bool)
-> (AuthenticatorAttachmentHint
    -> AuthenticatorAttachmentHint -> Bool)
-> Eq AuthenticatorAttachmentHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatorAttachmentHint -> AuthenticatorAttachmentHint -> Bool
$c/= :: AuthenticatorAttachmentHint -> AuthenticatorAttachmentHint -> Bool
== :: AuthenticatorAttachmentHint -> AuthenticatorAttachmentHint -> Bool
$c== :: AuthenticatorAttachmentHint -> AuthenticatorAttachmentHint -> Bool
Eq, (forall x.
 AuthenticatorAttachmentHint -> Rep AuthenticatorAttachmentHint x)
-> (forall x.
    Rep AuthenticatorAttachmentHint x -> AuthenticatorAttachmentHint)
-> Generic AuthenticatorAttachmentHint
forall x.
Rep AuthenticatorAttachmentHint x -> AuthenticatorAttachmentHint
forall x.
AuthenticatorAttachmentHint -> Rep AuthenticatorAttachmentHint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthenticatorAttachmentHint x -> AuthenticatorAttachmentHint
$cfrom :: forall x.
AuthenticatorAttachmentHint -> Rep AuthenticatorAttachmentHint x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#transaction-confirmation-display-types)
data TransactionConfirmationDisplayType
  = TRANSACTION_CONFIRMATION_DISPLAY_ANY
  | TRANSACTION_CONFIRMATION_DISPLAY_PRIVILEGED_SOFTWARE
  | TRANSACTION_CONFIRMATION_DISPLAY_TEE
  | TRANSACTION_CONFIRMATION_DISPLAY_HARDWARE
  | TRANSACTION_CONFIRMATION_DISPLAY_REMOTE
  deriving (Int -> TransactionConfirmationDisplayType -> ShowS
[TransactionConfirmationDisplayType] -> ShowS
TransactionConfirmationDisplayType -> String
(Int -> TransactionConfirmationDisplayType -> ShowS)
-> (TransactionConfirmationDisplayType -> String)
-> ([TransactionConfirmationDisplayType] -> ShowS)
-> Show TransactionConfirmationDisplayType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionConfirmationDisplayType] -> ShowS
$cshowList :: [TransactionConfirmationDisplayType] -> ShowS
show :: TransactionConfirmationDisplayType -> String
$cshow :: TransactionConfirmationDisplayType -> String
showsPrec :: Int -> TransactionConfirmationDisplayType -> ShowS
$cshowsPrec :: Int -> TransactionConfirmationDisplayType -> ShowS
Show, TransactionConfirmationDisplayType
-> TransactionConfirmationDisplayType -> Bool
(TransactionConfirmationDisplayType
 -> TransactionConfirmationDisplayType -> Bool)
-> (TransactionConfirmationDisplayType
    -> TransactionConfirmationDisplayType -> Bool)
-> Eq TransactionConfirmationDisplayType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionConfirmationDisplayType
-> TransactionConfirmationDisplayType -> Bool
$c/= :: TransactionConfirmationDisplayType
-> TransactionConfirmationDisplayType -> Bool
== :: TransactionConfirmationDisplayType
-> TransactionConfirmationDisplayType -> Bool
$c== :: TransactionConfirmationDisplayType
-> TransactionConfirmationDisplayType -> Bool
Eq, (forall x.
 TransactionConfirmationDisplayType
 -> Rep TransactionConfirmationDisplayType x)
-> (forall x.
    Rep TransactionConfirmationDisplayType x
    -> TransactionConfirmationDisplayType)
-> Generic TransactionConfirmationDisplayType
forall x.
Rep TransactionConfirmationDisplayType x
-> TransactionConfirmationDisplayType
forall x.
TransactionConfirmationDisplayType
-> Rep TransactionConfirmationDisplayType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TransactionConfirmationDisplayType x
-> TransactionConfirmationDisplayType
$cfrom :: forall x.
TransactionConfirmationDisplayType
-> Rep TransactionConfirmationDisplayType x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#authentication-algorithms)
data AuthenticationAlgorithm
  = ALG_SIGN_SECP256R1_ECDSA_SHA256_RAW
  | ALG_SIGN_SECP256R1_ECDSA_SHA256_DER
  | ALG_SIGN_RSASSA_PSS_SHA256_RAW
  | ALG_SIGN_RSASSA_PSS_SHA256_DER
  | ALG_SIGN_SECP256K1_ECDSA_SHA256_RAW
  | ALG_SIGN_SECP256K1_ECDSA_SHA256_DER
  | ALG_SIGN_SM2_SM3_RAW
  | ALG_SIGN_RSA_EMSA_PKCS1_SHA256_RAW
  | ALG_SIGN_RSA_EMSA_PKCS1_SHA256_DER
  | ALG_SIGN_RSASSA_PSS_SHA384_RAW
  | ALG_SIGN_RSASSA_PSS_SHA512_RAW
  | ALG_SIGN_RSASSA_PKCSV15_SHA256_RAW
  | ALG_SIGN_RSASSA_PKCSV15_SHA384_RAW
  | ALG_SIGN_RSASSA_PKCSV15_SHA512_RAW
  | ALG_SIGN_RSASSA_PKCSV15_SHA1_RAW
  | ALG_SIGN_SECP384R1_ECDSA_SHA384_RAW
  | ALG_SIGN_SECP512R1_ECDSA_SHA512_RAW
  | ALG_SIGN_ED25519_EDDSA_SHA512_RAW
  deriving (Int -> AuthenticationAlgorithm -> ShowS
[AuthenticationAlgorithm] -> ShowS
AuthenticationAlgorithm -> String
(Int -> AuthenticationAlgorithm -> ShowS)
-> (AuthenticationAlgorithm -> String)
-> ([AuthenticationAlgorithm] -> ShowS)
-> Show AuthenticationAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationAlgorithm] -> ShowS
$cshowList :: [AuthenticationAlgorithm] -> ShowS
show :: AuthenticationAlgorithm -> String
$cshow :: AuthenticationAlgorithm -> String
showsPrec :: Int -> AuthenticationAlgorithm -> ShowS
$cshowsPrec :: Int -> AuthenticationAlgorithm -> ShowS
Show, AuthenticationAlgorithm -> AuthenticationAlgorithm -> Bool
(AuthenticationAlgorithm -> AuthenticationAlgorithm -> Bool)
-> (AuthenticationAlgorithm -> AuthenticationAlgorithm -> Bool)
-> Eq AuthenticationAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticationAlgorithm -> AuthenticationAlgorithm -> Bool
$c/= :: AuthenticationAlgorithm -> AuthenticationAlgorithm -> Bool
== :: AuthenticationAlgorithm -> AuthenticationAlgorithm -> Bool
$c== :: AuthenticationAlgorithm -> AuthenticationAlgorithm -> Bool
Eq, (forall x.
 AuthenticationAlgorithm -> Rep AuthenticationAlgorithm x)
-> (forall x.
    Rep AuthenticationAlgorithm x -> AuthenticationAlgorithm)
-> Generic AuthenticationAlgorithm
forall x. Rep AuthenticationAlgorithm x -> AuthenticationAlgorithm
forall x. AuthenticationAlgorithm -> Rep AuthenticationAlgorithm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthenticationAlgorithm x -> AuthenticationAlgorithm
$cfrom :: forall x. AuthenticationAlgorithm -> Rep AuthenticationAlgorithm x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#public-key-representation-formats)
data PublicKeyRepresentationFormat
  = ALG_KEY_ECC_X962_RAW
  | ALG_KEY_ECC_X962_DER
  | ALG_KEY_RSA_2048_RAW
  | ALG_KEY_RSA_2048_DER
  | ALG_KEY_COSE
  deriving (Int -> PublicKeyRepresentationFormat -> ShowS
[PublicKeyRepresentationFormat] -> ShowS
PublicKeyRepresentationFormat -> String
(Int -> PublicKeyRepresentationFormat -> ShowS)
-> (PublicKeyRepresentationFormat -> String)
-> ([PublicKeyRepresentationFormat] -> ShowS)
-> Show PublicKeyRepresentationFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKeyRepresentationFormat] -> ShowS
$cshowList :: [PublicKeyRepresentationFormat] -> ShowS
show :: PublicKeyRepresentationFormat -> String
$cshow :: PublicKeyRepresentationFormat -> String
showsPrec :: Int -> PublicKeyRepresentationFormat -> ShowS
$cshowsPrec :: Int -> PublicKeyRepresentationFormat -> ShowS
Show, PublicKeyRepresentationFormat
-> PublicKeyRepresentationFormat -> Bool
(PublicKeyRepresentationFormat
 -> PublicKeyRepresentationFormat -> Bool)
-> (PublicKeyRepresentationFormat
    -> PublicKeyRepresentationFormat -> Bool)
-> Eq PublicKeyRepresentationFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKeyRepresentationFormat
-> PublicKeyRepresentationFormat -> Bool
$c/= :: PublicKeyRepresentationFormat
-> PublicKeyRepresentationFormat -> Bool
== :: PublicKeyRepresentationFormat
-> PublicKeyRepresentationFormat -> Bool
$c== :: PublicKeyRepresentationFormat
-> PublicKeyRepresentationFormat -> Bool
Eq, (forall x.
 PublicKeyRepresentationFormat
 -> Rep PublicKeyRepresentationFormat x)
-> (forall x.
    Rep PublicKeyRepresentationFormat x
    -> PublicKeyRepresentationFormat)
-> Generic PublicKeyRepresentationFormat
forall x.
Rep PublicKeyRepresentationFormat x
-> PublicKeyRepresentationFormat
forall x.
PublicKeyRepresentationFormat
-> Rep PublicKeyRepresentationFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PublicKeyRepresentationFormat x
-> PublicKeyRepresentationFormat
$cfrom :: forall x.
PublicKeyRepresentationFormat
-> Rep PublicKeyRepresentationFormat x
Generic)

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

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

-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#authenticator-attestation-types)
data AuthenticatorAttestationType
  = ATTESTATION_BASIC_FULL
  | ATTESTATION_BASIC_SURROGATE
  | ATTESTATION_ECDAA
  | ATTESTATION_ATTCA
  deriving (Int -> AuthenticatorAttestationType -> ShowS
[AuthenticatorAttestationType] -> ShowS
AuthenticatorAttestationType -> String
(Int -> AuthenticatorAttestationType -> ShowS)
-> (AuthenticatorAttestationType -> String)
-> ([AuthenticatorAttestationType] -> ShowS)
-> Show AuthenticatorAttestationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatorAttestationType] -> ShowS
$cshowList :: [AuthenticatorAttestationType] -> ShowS
show :: AuthenticatorAttestationType -> String
$cshow :: AuthenticatorAttestationType -> String
showsPrec :: Int -> AuthenticatorAttestationType -> ShowS
$cshowsPrec :: Int -> AuthenticatorAttestationType -> ShowS
Show, AuthenticatorAttestationType
-> AuthenticatorAttestationType -> Bool
(AuthenticatorAttestationType
 -> AuthenticatorAttestationType -> Bool)
-> (AuthenticatorAttestationType
    -> AuthenticatorAttestationType -> Bool)
-> Eq AuthenticatorAttestationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatorAttestationType
-> AuthenticatorAttestationType -> Bool
$c/= :: AuthenticatorAttestationType
-> AuthenticatorAttestationType -> Bool
== :: AuthenticatorAttestationType
-> AuthenticatorAttestationType -> Bool
$c== :: AuthenticatorAttestationType
-> AuthenticatorAttestationType -> Bool
Eq, (forall x.
 AuthenticatorAttestationType -> Rep AuthenticatorAttestationType x)
-> (forall x.
    Rep AuthenticatorAttestationType x -> AuthenticatorAttestationType)
-> Generic AuthenticatorAttestationType
forall x.
Rep AuthenticatorAttestationType x -> AuthenticatorAttestationType
forall x.
AuthenticatorAttestationType -> Rep AuthenticatorAttestationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthenticatorAttestationType x -> AuthenticatorAttestationType
$cfrom :: forall x.
AuthenticatorAttestationType -> Rep AuthenticatorAttestationType x
Generic)

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

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