{-# LANGUAGE StandaloneDeriving #-}

-- | Stability: experimental
-- This module contains additional Haskell-specific type definitions for the
-- [FIDO Metadata Statement](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html)
-- specification
module Crypto.WebAuthn.Metadata.Statement.Types
  ( MetadataStatement (..),
    PNGBytes (..),
    WebauthnAttestationType (..),
  )
where

import Crypto.WebAuthn.Internal.ToJSONOrphans (PrettyHexByteString (PrettyHexByteString))
import qualified Crypto.WebAuthn.Metadata.FidoRegistry as Registry
import qualified Crypto.WebAuthn.Metadata.Statement.WebIDL as StatementIDL
import qualified Crypto.WebAuthn.Metadata.UAF as UAF
import Data.Aeson (ToJSON)
import qualified Data.ByteString as BS
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Data.Word (Word32)
import qualified Data.X509 as X509
import GHC.Generics (Generic)
import GHC.Word (Word16)

-- | [(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 -> Text
msLegalHeader :: Text,
    -- msAaid, msAaguid, attestationCertificateKeyIdentifiers: These fields are the key of the hashmaps in MetadataServiceRegistry

    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-description)
    MetadataStatement -> Text
msDescription :: Text,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-alternativedescriptions)
    MetadataStatement -> Maybe AlternativeDescriptions
msAlternativeDescriptions :: Maybe StatementIDL.AlternativeDescriptions,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticatorversion)
    MetadataStatement -> Word32
msAuthenticatorVersion :: Word32,
    -- protocolFamily, encoded as the type-level p
    -- msSchema, this is always schema version 3

    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-upv)
    MetadataStatement -> NonEmpty Version
msUpv :: NonEmpty UAF.Version,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticationalgorithms)
    MetadataStatement -> NonEmpty AuthenticationAlgorithm
msAuthenticationAlgorithms :: NonEmpty Registry.AuthenticationAlgorithm,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-publickeyalgandencodings)
    MetadataStatement -> NonEmpty PublicKeyRepresentationFormat
msPublicKeyAlgAndEncodings :: NonEmpty Registry.PublicKeyRepresentationFormat,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationtypes)
    MetadataStatement -> NonEmpty WebauthnAttestationType
msAttestationTypes :: NonEmpty WebauthnAttestationType,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-userverificationdetails)
    MetadataStatement -> NonEmpty VerificationMethodANDCombinations
msUserVerificationDetails :: NonEmpty StatementIDL.VerificationMethodANDCombinations,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-keyprotection)
    MetadataStatement -> NonEmpty KeyProtectionType
msKeyProtection :: NonEmpty Registry.KeyProtectionType,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-iskeyrestricted)
    MetadataStatement -> Maybe Bool
msIsKeyRestricted :: Maybe Bool,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-isfreshuserverificationrequired)
    MetadataStatement -> Maybe Bool
msIsFreshUserVerificationRequired :: Maybe Bool,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-matcherprotection)
    MetadataStatement -> NonEmpty MatcherProtectionType
msMatcherProtection :: NonEmpty Registry.MatcherProtectionType,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-cryptostrength)
    MetadataStatement -> Maybe Word16
msCryptoStrength :: Maybe Word16,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attachmenthint)
    MetadataStatement -> NonEmpty AuthenticatorAttachmentHint
msAttachmentHint :: NonEmpty Registry.AuthenticatorAttachmentHint,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplay)
    MetadataStatement -> [TransactionConfirmationDisplayType]
msTcDisplay :: [Registry.TransactionConfirmationDisplayType],
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplaycontenttype)
    MetadataStatement -> Maybe Text
msTcDisplayContentType :: Maybe Text,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplaypngcharacteristics)
    MetadataStatement
-> Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
msTcDisplayPNGCharacteristics :: Maybe (NonEmpty StatementIDL.DisplayPNGCharacteristicsDescriptor),
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationrootcertificates)
    MetadataStatement -> NonEmpty SignedCertificate
msAttestationRootCertificates :: NonEmpty X509.SignedCertificate,
    -- msEcdaaTrustAnchors, not needed for the subset we implement, FIDO 2 and FIDO U2F

    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-icon)
    MetadataStatement -> Maybe PNGBytes
msIcon :: Maybe PNGBytes,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-supportedextensions)
    MetadataStatement -> Maybe (NonEmpty ExtensionDescriptor)
msSupportedExtensions :: Maybe (NonEmpty StatementIDL.ExtensionDescriptor),
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticatorgetinfo)
    MetadataStatement -> Maybe AuthenticatorGetInfo
msAuthenticatorGetInfo :: Maybe StatementIDL.AuthenticatorGetInfo
  }
  deriving (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, 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, 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)

-- | An arbitrary and potentially unstable JSON encoding, only intended for
-- logging purposes. To actually encode and decode structures, use the
-- "Crypto.WebAuthn.Encoding" modules
deriving instance ToJSON MetadataStatement

-- | A wrapper for the bytes of a PNG images.
newtype PNGBytes = PNGBytes {PNGBytes -> ByteString
unPNGBytes :: BS.ByteString}
  deriving newtype (PNGBytes -> PNGBytes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PNGBytes -> PNGBytes -> Bool
$c/= :: PNGBytes -> PNGBytes -> Bool
== :: PNGBytes -> PNGBytes -> Bool
$c== :: PNGBytes -> PNGBytes -> Bool
Eq)
  deriving (Int -> PNGBytes -> ShowS
[PNGBytes] -> ShowS
PNGBytes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PNGBytes] -> ShowS
$cshowList :: [PNGBytes] -> ShowS
show :: PNGBytes -> String
$cshow :: PNGBytes -> String
showsPrec :: Int -> PNGBytes -> ShowS
$cshowsPrec :: Int -> PNGBytes -> ShowS
Show, [PNGBytes] -> Encoding
[PNGBytes] -> Value
PNGBytes -> Encoding
PNGBytes -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PNGBytes] -> Encoding
$ctoEncodingList :: [PNGBytes] -> Encoding
toJSONList :: [PNGBytes] -> Value
$ctoJSONList :: [PNGBytes] -> Value
toEncoding :: PNGBytes -> Encoding
$ctoEncoding :: PNGBytes -> Encoding
toJSON :: PNGBytes -> Value
$ctoJSON :: PNGBytes -> Value
ToJSON) via PrettyHexByteString

-- | Values of 'Registry.AuthenticatorAttestationType' but limited to the ones possible with Webauthn, see https://www.w3.org/TR/webauthn-2/#sctn-attestation-types
data WebauthnAttestationType
  = WebauthnAttestationBasic
  | WebauthnAttestationAttCA
  deriving (WebauthnAttestationType -> WebauthnAttestationType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebauthnAttestationType -> WebauthnAttestationType -> Bool
$c/= :: WebauthnAttestationType -> WebauthnAttestationType -> Bool
== :: WebauthnAttestationType -> WebauthnAttestationType -> Bool
$c== :: WebauthnAttestationType -> WebauthnAttestationType -> Bool
Eq, Int -> WebauthnAttestationType -> ShowS
[WebauthnAttestationType] -> ShowS
WebauthnAttestationType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebauthnAttestationType] -> ShowS
$cshowList :: [WebauthnAttestationType] -> ShowS
show :: WebauthnAttestationType -> String
$cshow :: WebauthnAttestationType -> String
showsPrec :: Int -> WebauthnAttestationType -> ShowS
$cshowsPrec :: Int -> WebauthnAttestationType -> ShowS
Show, forall x. Rep WebauthnAttestationType x -> WebauthnAttestationType
forall x. WebauthnAttestationType -> Rep WebauthnAttestationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WebauthnAttestationType x -> WebauthnAttestationType
$cfrom :: forall x. WebauthnAttestationType -> Rep WebauthnAttestationType x
Generic)

-- | An arbitrary and potentially unstable JSON encoding, only intended for
-- logging purposes. To actually encode and decode structures, use the
-- "Crypto.WebAuthn.Encoding" modules
deriving instance ToJSON WebauthnAttestationType