-- | 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AAID] -> ShowS
$cshowList :: [AAID] -> ShowS
show :: AAID -> String
$cshow :: AAID -> String
showsPrec :: Int -> AAID -> ShowS
$cshowsPrec :: Int -> AAID -> ShowS
Show, AAID -> AAID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AAID -> AAID -> Bool
$c/= :: AAID -> AAID -> Bool
== :: AAID -> AAID -> Bool
$c== :: AAID -> AAID -> Bool
Eq)
  deriving newtype (Value -> Parser [AAID]
Value -> Parser AAID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AAID]
$cparseJSONList :: Value -> Parser [AAID]
parseJSON :: Value -> Parser AAID
$cparseJSON :: Value -> Parser AAID
Aeson.FromJSON, [AAID] -> Encoding
[AAID] -> Value
AAID -> Encoding
AAID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AAID] -> Encoding
$ctoEncodingList :: [AAID] -> Encoding
toJSONList :: [AAID] -> Value
$ctoJSONList :: [AAID] -> Value
toEncoding :: AAID -> Encoding
$ctoEncoding :: AAID -> Encoding
toJSON :: AAID -> Value
$ctoJSON :: AAID -> Value
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyIdentifier] -> ShowS
$cshowList :: [KeyIdentifier] -> ShowS
show :: KeyIdentifier -> String
$cshow :: KeyIdentifier -> String
showsPrec :: Int -> KeyIdentifier -> ShowS
$cshowsPrec :: Int -> KeyIdentifier -> ShowS
Show, KeyIdentifier -> KeyIdentifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyIdentifier -> KeyIdentifier -> Bool
$c/= :: KeyIdentifier -> KeyIdentifier -> Bool
== :: KeyIdentifier -> KeyIdentifier -> Bool
$c== :: KeyIdentifier -> KeyIdentifier -> Bool
Eq)
  deriving newtype (Value -> Parser [KeyIdentifier]
Value -> Parser KeyIdentifier
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [KeyIdentifier]
$cparseJSONList :: Value -> Parser [KeyIdentifier]
parseJSON :: Value -> Parser KeyIdentifier
$cparseJSON :: Value -> Parser KeyIdentifier
Aeson.FromJSON, [KeyIdentifier] -> Encoding
[KeyIdentifier] -> Value
KeyIdentifier -> Encoding
KeyIdentifier -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [KeyIdentifier] -> Encoding
$ctoEncodingList :: [KeyIdentifier] -> Encoding
toJSONList :: [KeyIdentifier] -> Value
$ctoJSONList :: [KeyIdentifier] -> Value
toEncoding :: KeyIdentifier -> Encoding
$ctoEncoding :: KeyIdentifier -> Encoding
toJSON :: KeyIdentifier -> Value
$ctoJSON :: KeyIdentifier -> Value
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, Version -> Version -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, 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
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic)

instance Aeson.FromJSON Version where
  parseJSON :: Value -> Parser Version
parseJSON = 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 = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
jsonEncodingOptions