{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# 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 (..),
    ProtocolVersion (..),
    WebauthnAttestationType (..),
  )
where

import qualified Crypto.WebAuthn.Metadata.FidoRegistry as Registry
import qualified Crypto.WebAuthn.Metadata.Statement.WebIDL as StatementIDL
import qualified Crypto.WebAuthn.Model as M
import Data.Aeson (ToJSON, 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 (p :: M.ProtocolKind) = MetadataStatement
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-legalheader)
    MetadataStatement p -> 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 p -> Text
msDescription :: Text,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-alternativedescriptions)
    MetadataStatement p -> Maybe AlternativeDescriptions
msAlternativeDescriptions :: Maybe StatementIDL.AlternativeDescriptions,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticatorversion)
    MetadataStatement p -> 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 p -> NonEmpty (ProtocolVersion p)
msUpv :: NonEmpty (ProtocolVersion p),
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticationalgorithms)
    MetadataStatement p -> NonEmpty AuthenticationAlgorithm
msAuthenticationAlgorithms :: NonEmpty Registry.AuthenticationAlgorithm,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-publickeyalgandencodings)
    MetadataStatement p -> NonEmpty PublicKeyRepresentationFormat
msPublicKeyAlgAndEncodings :: NonEmpty Registry.PublicKeyRepresentationFormat,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationtypes)
    MetadataStatement p -> NonEmpty WebauthnAttestationType
msAttestationTypes :: NonEmpty WebauthnAttestationType,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-userverificationdetails)
    MetadataStatement p -> NonEmpty VerificationMethodANDCombinations
msUserVerificationDetails :: NonEmpty StatementIDL.VerificationMethodANDCombinations,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-keyprotection)
    MetadataStatement p -> NonEmpty KeyProtectionType
msKeyProtection :: NonEmpty Registry.KeyProtectionType,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-iskeyrestricted)
    MetadataStatement p -> Maybe Bool
msIsKeyRestricted :: Maybe Bool,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-isfreshuserverificationrequired)
    MetadataStatement p -> Maybe Bool
msIsFreshUserVerificationRequired :: Maybe Bool,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-matcherprotection)
    MetadataStatement p -> NonEmpty MatcherProtectionType
msMatcherProtection :: NonEmpty Registry.MatcherProtectionType,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-cryptostrength)
    MetadataStatement p -> Maybe Word16
msCryptoStrength :: Maybe Word16,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attachmenthint)
    MetadataStatement p -> NonEmpty AuthenticatorAttachmentHint
msAttachmentHint :: NonEmpty Registry.AuthenticatorAttachmentHint,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplay)
    MetadataStatement p -> [TransactionConfirmationDisplayType]
msTcDisplay :: [Registry.TransactionConfirmationDisplayType],
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplaycontenttype)
    MetadataStatement p -> Maybe Text
msTcDisplayContentType :: Maybe Text,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplaypngcharacteristics)
    MetadataStatement p
-> 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 p -> 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 p -> Maybe ByteString
msIcon :: Maybe BS.ByteString,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-supportedextensions)
    MetadataStatement p -> 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 p -> Maybe AuthenticatorGetInfo
msAuthenticatorGetInfo :: Maybe StatementIDL.AuthenticatorGetInfo
  }
  deriving (MetadataStatement p -> MetadataStatement p -> Bool
(MetadataStatement p -> MetadataStatement p -> Bool)
-> (MetadataStatement p -> MetadataStatement p -> Bool)
-> Eq (MetadataStatement p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (p :: ProtocolKind).
MetadataStatement p -> MetadataStatement p -> Bool
/= :: MetadataStatement p -> MetadataStatement p -> Bool
$c/= :: forall (p :: ProtocolKind).
MetadataStatement p -> MetadataStatement p -> Bool
== :: MetadataStatement p -> MetadataStatement p -> Bool
$c== :: forall (p :: ProtocolKind).
MetadataStatement p -> MetadataStatement p -> Bool
Eq, Int -> MetadataStatement p -> ShowS
[MetadataStatement p] -> ShowS
MetadataStatement p -> String
(Int -> MetadataStatement p -> ShowS)
-> (MetadataStatement p -> String)
-> ([MetadataStatement p] -> ShowS)
-> Show (MetadataStatement p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: ProtocolKind). Int -> MetadataStatement p -> ShowS
forall (p :: ProtocolKind). [MetadataStatement p] -> ShowS
forall (p :: ProtocolKind). MetadataStatement p -> String
showList :: [MetadataStatement p] -> ShowS
$cshowList :: forall (p :: ProtocolKind). [MetadataStatement p] -> ShowS
show :: MetadataStatement p -> String
$cshow :: forall (p :: ProtocolKind). MetadataStatement p -> String
showsPrec :: Int -> MetadataStatement p -> ShowS
$cshowsPrec :: forall (p :: ProtocolKind). Int -> MetadataStatement p -> ShowS
Show, (forall x. MetadataStatement p -> Rep (MetadataStatement p) x)
-> (forall x. Rep (MetadataStatement p) x -> MetadataStatement p)
-> Generic (MetadataStatement p)
forall x. Rep (MetadataStatement p) x -> MetadataStatement p
forall x. MetadataStatement p -> Rep (MetadataStatement p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (p :: ProtocolKind) x.
Rep (MetadataStatement p) x -> MetadataStatement p
forall (p :: ProtocolKind) x.
MetadataStatement p -> Rep (MetadataStatement p) x
$cto :: forall (p :: ProtocolKind) x.
Rep (MetadataStatement p) x -> MetadataStatement p
$cfrom :: forall (p :: ProtocolKind) x.
MetadataStatement p -> Rep (MetadataStatement p) x
Generic, [MetadataStatement p] -> Encoding
[MetadataStatement p] -> Value
MetadataStatement p -> Encoding
MetadataStatement p -> Value
(MetadataStatement p -> Value)
-> (MetadataStatement p -> Encoding)
-> ([MetadataStatement p] -> Value)
-> ([MetadataStatement p] -> Encoding)
-> ToJSON (MetadataStatement p)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (p :: ProtocolKind). [MetadataStatement p] -> Encoding
forall (p :: ProtocolKind). [MetadataStatement p] -> Value
forall (p :: ProtocolKind). MetadataStatement p -> Encoding
forall (p :: ProtocolKind). MetadataStatement p -> Value
toEncodingList :: [MetadataStatement p] -> Encoding
$ctoEncodingList :: forall (p :: ProtocolKind). [MetadataStatement p] -> Encoding
toJSONList :: [MetadataStatement p] -> Value
$ctoJSONList :: forall (p :: ProtocolKind). [MetadataStatement p] -> Value
toEncoding :: MetadataStatement p -> Encoding
$ctoEncoding :: forall (p :: ProtocolKind). MetadataStatement p -> Encoding
toJSON :: MetadataStatement p -> Value
$ctoJSON :: forall (p :: ProtocolKind). MetadataStatement p -> Value
ToJSON)

-- | FIDO protocol versions, parametrized by the protocol family
data ProtocolVersion (p :: M.ProtocolKind) where
  -- | FIDO U2F 1.0
  U2F1_0 :: ProtocolVersion 'M.FidoU2F
  -- | FIDO U2F 1.1
  U2F1_1 :: ProtocolVersion 'M.FidoU2F
  -- | FIDO U2F 1.2
  U2F1_2 :: ProtocolVersion 'M.FidoU2F
  -- | FIDO 2, CTAP 2.0
  CTAP2_0 :: ProtocolVersion 'M.Fido2
  -- | FIDO 2, CTAP 2.1
  CTAP2_1 :: ProtocolVersion 'M.Fido2

deriving instance Eq (ProtocolVersion p)

deriving instance Show (ProtocolVersion p)

instance ToJSON (ProtocolVersion p) where
  toJSON :: ProtocolVersion p -> Value
toJSON ProtocolVersion p
U2F1_0 = Value
"U2F 1.0"
  toJSON ProtocolVersion p
U2F1_1 = Value
"U2F 1.1"
  toJSON ProtocolVersion p
U2F1_2 = Value
"U2F 1.2"
  toJSON ProtocolVersion p
CTAP2_0 = Value
"CTAP 2.0"
  toJSON ProtocolVersion p
CTAP2_1 = Value
"CTAP 2.1"

-- | 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
(WebauthnAttestationType -> WebauthnAttestationType -> Bool)
-> (WebauthnAttestationType -> WebauthnAttestationType -> Bool)
-> Eq WebauthnAttestationType
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
(Int -> WebauthnAttestationType -> ShowS)
-> (WebauthnAttestationType -> String)
-> ([WebauthnAttestationType] -> ShowS)
-> Show WebauthnAttestationType
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.
 WebauthnAttestationType -> Rep WebauthnAttestationType x)
-> (forall x.
    Rep WebauthnAttestationType x -> WebauthnAttestationType)
-> Generic WebauthnAttestationType
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, [WebauthnAttestationType] -> Encoding
[WebauthnAttestationType] -> Value
WebauthnAttestationType -> Encoding
WebauthnAttestationType -> Value
(WebauthnAttestationType -> Value)
-> (WebauthnAttestationType -> Encoding)
-> ([WebauthnAttestationType] -> Value)
-> ([WebauthnAttestationType] -> Encoding)
-> ToJSON WebauthnAttestationType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WebauthnAttestationType] -> Encoding
$ctoEncodingList :: [WebauthnAttestationType] -> Encoding
toJSONList :: [WebauthnAttestationType] -> Value
$ctoJSONList :: [WebauthnAttestationType] -> Value
toEncoding :: WebauthnAttestationType -> Encoding
$ctoEncoding :: WebauthnAttestationType -> Encoding
toJSON :: WebauthnAttestationType -> Value
$ctoJSON :: WebauthnAttestationType -> Value
ToJSON)