-- | Stability: experimental
-- Types related to the FIDO UAF Protocol as defined in the relevant
-- [(spec)](https://fidoalliance.org/specs/fido-uaf-v1.2-ps-20201020/fido-uaf-protocol-v1.2-ps-20201020.html)
module Crypto.WebAuthn.Metadata.UAF
  ( AAID (..),
    KeyIdentifier (..),
    Version (..),
  )
where

import Crypto.WebAuthn.Internal.Utils (jsonEncodingOptions)
import qualified Crypto.WebAuthn.Metadata.WebIDL as IDL
import qualified Data.Aeson as Aeson
import Data.Text (Text)
import GHC.Generics (Generic)

-- | [(spec)](https://fidoalliance.org/specs/fido-uaf-v1.2-ps-20201020/fido-uaf-protocol-v1.2-ps-20201020.html#authenticator-attestation-id-aaid-typedef)
newtype AAID = AAID Text
  deriving (Int -> AAID -> ShowS
[AAID] -> ShowS
AAID -> String
(Int -> AAID -> ShowS)
-> (AAID -> String) -> ([AAID] -> ShowS) -> Show AAID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AAID -> ShowS
showsPrec :: Int -> AAID -> ShowS
$cshow :: AAID -> String
show :: AAID -> String
$cshowList :: [AAID] -> ShowS
showList :: [AAID] -> ShowS
Show, AAID -> AAID -> Bool
(AAID -> AAID -> Bool) -> (AAID -> AAID -> Bool) -> Eq AAID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AAID -> AAID -> Bool
== :: AAID -> AAID -> Bool
$c/= :: AAID -> AAID -> Bool
/= :: AAID -> AAID -> Bool
Eq)
  deriving newtype (Value -> Parser [AAID]
Value -> Parser AAID
(Value -> Parser AAID) -> (Value -> Parser [AAID]) -> FromJSON AAID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AAID
parseJSON :: Value -> Parser AAID
$cparseJSONList :: Value -> Parser [AAID]
parseJSONList :: Value -> Parser [AAID]
Aeson.FromJSON, [AAID] -> Value
[AAID] -> Encoding
AAID -> Value
AAID -> Encoding
(AAID -> Value)
-> (AAID -> Encoding)
-> ([AAID] -> Value)
-> ([AAID] -> Encoding)
-> ToJSON AAID
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AAID -> Value
toJSON :: AAID -> Value
$ctoEncoding :: AAID -> Encoding
toEncoding :: AAID -> Encoding
$ctoJSONList :: [AAID] -> Value
toJSONList :: [AAID] -> Value
$ctoEncodingList :: [AAID] -> Encoding
toEncodingList :: [AAID] -> Encoding
Aeson.ToJSON)

-- | Hex string, this value MUST be calculated according to method 1 for
-- computing the keyIdentifier as defined in
-- [RFC5280 section 4.2.1.2](https://datatracker.ietf.org/doc/html/rfc5280#section-4.2.1.2).
newtype KeyIdentifier = KeyIdentifier Text
  deriving (Int -> KeyIdentifier -> ShowS
[KeyIdentifier] -> ShowS
KeyIdentifier -> String
(Int -> KeyIdentifier -> ShowS)
-> (KeyIdentifier -> String)
-> ([KeyIdentifier] -> ShowS)
-> Show KeyIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyIdentifier -> ShowS
showsPrec :: Int -> KeyIdentifier -> ShowS
$cshow :: KeyIdentifier -> String
show :: KeyIdentifier -> String
$cshowList :: [KeyIdentifier] -> ShowS
showList :: [KeyIdentifier] -> ShowS
Show, KeyIdentifier -> KeyIdentifier -> Bool
(KeyIdentifier -> KeyIdentifier -> Bool)
-> (KeyIdentifier -> KeyIdentifier -> Bool) -> Eq KeyIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyIdentifier -> KeyIdentifier -> Bool
== :: KeyIdentifier -> KeyIdentifier -> Bool
$c/= :: KeyIdentifier -> KeyIdentifier -> Bool
/= :: KeyIdentifier -> KeyIdentifier -> Bool
Eq)
  deriving newtype (Value -> Parser [KeyIdentifier]
Value -> Parser KeyIdentifier
(Value -> Parser KeyIdentifier)
-> (Value -> Parser [KeyIdentifier]) -> FromJSON KeyIdentifier
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser KeyIdentifier
parseJSON :: Value -> Parser KeyIdentifier
$cparseJSONList :: Value -> Parser [KeyIdentifier]
parseJSONList :: Value -> Parser [KeyIdentifier]
Aeson.FromJSON, [KeyIdentifier] -> Value
[KeyIdentifier] -> Encoding
KeyIdentifier -> Value
KeyIdentifier -> Encoding
(KeyIdentifier -> Value)
-> (KeyIdentifier -> Encoding)
-> ([KeyIdentifier] -> Value)
-> ([KeyIdentifier] -> Encoding)
-> ToJSON KeyIdentifier
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: KeyIdentifier -> Value
toJSON :: KeyIdentifier -> Value
$ctoEncoding :: KeyIdentifier -> Encoding
toEncoding :: KeyIdentifier -> Encoding
$ctoJSONList :: [KeyIdentifier] -> Value
toJSONList :: [KeyIdentifier] -> Value
$ctoEncodingList :: [KeyIdentifier] -> Encoding
toEncodingList :: [KeyIdentifier] -> Encoding
Aeson.ToJSON)

-- | [(spec)](https://fidoalliance.org/specs/fido-uaf-v1.2-ps-20201020/fido-uaf-protocol-v1.2-ps-20201020.html#version-interface)
data Version = Version
  { -- | [(spec)](https://fidoalliance.org/specs/fido-uaf-v1.2-ps-20201020/fido-uaf-protocol-v1.2-ps-20201020.html#widl-Version-major)
    Version -> UnsignedShort
major :: IDL.UnsignedShort,
    -- | [(spec)](https://fidoalliance.org/specs/fido-uaf-v1.2-ps-20201020/fido-uaf-protocol-v1.2-ps-20201020.html#widl-Version-minor)
    Version -> UnsignedShort
minor :: IDL.UnsignedShort
  }
  deriving (Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> String
show :: Version -> String
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Version -> Rep Version x
from :: forall x. Version -> Rep Version x
$cto :: forall x. Rep Version x -> Version
to :: forall x. Rep Version x -> Version
Generic)

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

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