{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}

-- | Stability: experimental
-- This module contains additional Haskell-specific type definitions for the
-- [FIDO Metadata Service](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html)
-- specification
module Crypto.WebAuthn.Metadata.Service.Types
  ( MetadataServiceRegistry (..),
    MetadataPayload (..),
    MetadataEntry (..),
    SomeMetadataEntry (..),
    StatusReport (..),
  )
where

import qualified Crypto.WebAuthn.Metadata.Service.WebIDL as ServiceIDL
import Crypto.WebAuthn.Metadata.Statement.Types (MetadataStatement)
import qualified Crypto.WebAuthn.Model as M
import Crypto.WebAuthn.Model.Identifier (AAGUID, AuthenticatorIdentifier, SubjectKeyIdentifier)
import Data.Aeson (ToJSON)
import Data.HashMap.Strict (HashMap)
import Data.Hourglass (Date)
import Data.List.NonEmpty (NonEmpty)
import Data.Singletons (SingI)
import Data.Text (Text)
import Data.Word (Word32)
import qualified Data.X509 as X509
import GHC.Generics (Generic)

-- | A registry of 'MetadataEntry's, allowing fast lookup using 'M.AAGUID's or
-- 'SubjectKeyIdentifier's. This is used by 'Crypto.WebAuthn.Operation.Registration.verifyRegistrationResponse'
-- as a way to look up root certificates of authenticators and return meta information.
-- Using 'Crypto.WebAuthn.Metadata.Service.Processing.createMetadataRegistry'
-- it's also possible to create additional custom entries, which can be merged
-- with '<>'. Meanwhile 'mempty' can be used if no metadata is needed.
data MetadataServiceRegistry = MetadataServiceRegistry
  { MetadataServiceRegistry -> HashMap AAGUID (MetadataEntry 'Fido2)
fido2Entries :: HashMap AAGUID (MetadataEntry 'M.Fido2),
    MetadataServiceRegistry
-> HashMap SubjectKeyIdentifier (MetadataEntry 'FidoU2F)
fidoU2FEntries :: HashMap SubjectKeyIdentifier (MetadataEntry 'M.FidoU2F)
  }

instance Semigroup MetadataServiceRegistry where
  MetadataServiceRegistry HashMap AAGUID (MetadataEntry 'Fido2)
l2 HashMap SubjectKeyIdentifier (MetadataEntry 'FidoU2F)
lu2f <> :: MetadataServiceRegistry
-> MetadataServiceRegistry -> MetadataServiceRegistry
<> MetadataServiceRegistry HashMap AAGUID (MetadataEntry 'Fido2)
r2 HashMap SubjectKeyIdentifier (MetadataEntry 'FidoU2F)
ru2f =
    HashMap AAGUID (MetadataEntry 'Fido2)
-> HashMap SubjectKeyIdentifier (MetadataEntry 'FidoU2F)
-> MetadataServiceRegistry
MetadataServiceRegistry (HashMap AAGUID (MetadataEntry 'Fido2)
l2 HashMap AAGUID (MetadataEntry 'Fido2)
-> HashMap AAGUID (MetadataEntry 'Fido2)
-> HashMap AAGUID (MetadataEntry 'Fido2)
forall a. Semigroup a => a -> a -> a
<> HashMap AAGUID (MetadataEntry 'Fido2)
r2) (HashMap SubjectKeyIdentifier (MetadataEntry 'FidoU2F)
lu2f HashMap SubjectKeyIdentifier (MetadataEntry 'FidoU2F)
-> HashMap SubjectKeyIdentifier (MetadataEntry 'FidoU2F)
-> HashMap SubjectKeyIdentifier (MetadataEntry 'FidoU2F)
forall a. Semigroup a => a -> a -> a
<> HashMap SubjectKeyIdentifier (MetadataEntry 'FidoU2F)
ru2f)

instance Monoid MetadataServiceRegistry where
  mempty :: MetadataServiceRegistry
mempty = HashMap AAGUID (MetadataEntry 'Fido2)
-> HashMap SubjectKeyIdentifier (MetadataEntry 'FidoU2F)
-> MetadataServiceRegistry
MetadataServiceRegistry HashMap AAGUID (MetadataEntry 'Fido2)
forall a. Monoid a => a
mempty HashMap SubjectKeyIdentifier (MetadataEntry 'FidoU2F)
forall a. Monoid a => a
mempty

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#metadata-blob-payload-dictionary)
-- Same as 'StatementIDL.MetadataBLOBPayload', but fully decoded. However all
-- 'StatementIDL.entries' not relevant for webauthn are discarded
data MetadataPayload = MetadataPayload
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-legalheader)
    -- The legalHeader, which MUST be in each BLOB, is an indication of the
    -- acceptance of the relevant legal agreement for using the MDS.
    MetadataPayload -> Maybe Text
mpLegalHeader :: Maybe Text,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-no)
    -- The serial number of this UAF Metadata BLOB Payload. Serial numbers MUST
    -- be consecutive and strictly monotonic, i.e. the successor BLOB will have
    -- a no value exactly incremented by one.
    MetadataPayload -> Int
mpNo :: Int,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-nextupdate)
    -- Date when the next update will be provided at latest.
    MetadataPayload -> Date
mpNextUpdate :: Date,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-entries)
    -- List of zero or more entries. This can be passed to
    -- 'Crypto.WebAuthn.Metadata.Service.Processing.createMetadataRegistry'
    MetadataPayload -> [SomeMetadataEntry]
mpEntries :: [SomeMetadataEntry]
  }

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#metadata-blob-payload-entry-dictionary)
-- Same as 'StatementIDL.MetadataBLOBPayloadEntry', but fully decoded. This type
-- is parametrized over the 'StatementIDL.ProtocolFamily' this metadata entry is for
data MetadataEntry (p :: M.ProtocolKind) = MetadataEntry
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-aaguid) or [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-attestationcertificatekeyidentifiers)
    forall (p :: ProtocolKind).
MetadataEntry p -> AuthenticatorIdentifier p
meIdentifier :: AuthenticatorIdentifier p,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-metadatastatement)
    forall (p :: ProtocolKind).
MetadataEntry p -> Maybe MetadataStatement
meMetadataStatement :: Maybe MetadataStatement,
    -- TODO: Implement this, currently not used in the blob however
    -- meBiometricStatusReports :: Maybe (NonEmpty BiometricStatusReport),

    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-statusreports)
    forall (p :: ProtocolKind).
MetadataEntry p -> NonEmpty StatusReport
meStatusReports :: NonEmpty StatusReport,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-timeoflaststatuschange)
    forall (p :: ProtocolKind). MetadataEntry p -> Date
meTimeOfLastStatusChange :: Date
    -- rogueListURL, rogueListHash. TODO, but not currently used in the
    -- BLOB and difficult to implement since it involves JWT
  }
  deriving (MetadataEntry p -> MetadataEntry p -> Bool
(MetadataEntry p -> MetadataEntry p -> Bool)
-> (MetadataEntry p -> MetadataEntry p -> Bool)
-> Eq (MetadataEntry p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (p :: ProtocolKind).
MetadataEntry p -> MetadataEntry p -> Bool
/= :: MetadataEntry p -> MetadataEntry p -> Bool
$c/= :: forall (p :: ProtocolKind).
MetadataEntry p -> MetadataEntry p -> Bool
== :: MetadataEntry p -> MetadataEntry p -> Bool
$c== :: forall (p :: ProtocolKind).
MetadataEntry p -> MetadataEntry p -> Bool
Eq, Int -> MetadataEntry p -> ShowS
[MetadataEntry p] -> ShowS
MetadataEntry p -> String
(Int -> MetadataEntry p -> ShowS)
-> (MetadataEntry p -> String)
-> ([MetadataEntry p] -> ShowS)
-> Show (MetadataEntry p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: ProtocolKind). Int -> MetadataEntry p -> ShowS
forall (p :: ProtocolKind). [MetadataEntry p] -> ShowS
forall (p :: ProtocolKind). MetadataEntry p -> String
showList :: [MetadataEntry p] -> ShowS
$cshowList :: forall (p :: ProtocolKind). [MetadataEntry p] -> ShowS
show :: MetadataEntry p -> String
$cshow :: forall (p :: ProtocolKind). MetadataEntry p -> String
showsPrec :: Int -> MetadataEntry p -> ShowS
$cshowsPrec :: forall (p :: ProtocolKind). Int -> MetadataEntry p -> ShowS
Show, (forall x. MetadataEntry p -> Rep (MetadataEntry p) x)
-> (forall x. Rep (MetadataEntry p) x -> MetadataEntry p)
-> Generic (MetadataEntry p)
forall x. Rep (MetadataEntry p) x -> MetadataEntry p
forall x. MetadataEntry p -> Rep (MetadataEntry p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (p :: ProtocolKind) x.
Rep (MetadataEntry p) x -> MetadataEntry p
forall (p :: ProtocolKind) x.
MetadataEntry p -> Rep (MetadataEntry p) x
$cto :: forall (p :: ProtocolKind) x.
Rep (MetadataEntry p) x -> MetadataEntry p
$cfrom :: forall (p :: ProtocolKind) x.
MetadataEntry p -> Rep (MetadataEntry p) x
Generic, [MetadataEntry p] -> Encoding
[MetadataEntry p] -> Value
MetadataEntry p -> Encoding
MetadataEntry p -> Value
(MetadataEntry p -> Value)
-> (MetadataEntry p -> Encoding)
-> ([MetadataEntry p] -> Value)
-> ([MetadataEntry p] -> Encoding)
-> ToJSON (MetadataEntry p)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (p :: ProtocolKind). [MetadataEntry p] -> Encoding
forall (p :: ProtocolKind). [MetadataEntry p] -> Value
forall (p :: ProtocolKind). MetadataEntry p -> Encoding
forall (p :: ProtocolKind). MetadataEntry p -> Value
toEncodingList :: [MetadataEntry p] -> Encoding
$ctoEncodingList :: forall (p :: ProtocolKind). [MetadataEntry p] -> Encoding
toJSONList :: [MetadataEntry p] -> Value
$ctoJSONList :: forall (p :: ProtocolKind). [MetadataEntry p] -> Value
toEncoding :: MetadataEntry p -> Encoding
$ctoEncoding :: forall (p :: ProtocolKind). MetadataEntry p -> Encoding
toJSON :: MetadataEntry p -> Value
$ctoJSON :: forall (p :: ProtocolKind). MetadataEntry p -> Value
ToJSON)

-- | Same as 'MetadataEntry', but with its type parameter erased
data SomeMetadataEntry = forall p. SingI p => SomeMetadataEntry (MetadataEntry p)

-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#statusreport-dictionary)
-- Same as 'StatementIDL.StatusReport', but fully decoded.
data StatusReport = StatusReport
  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-status)
    StatusReport -> AuthenticatorStatus
srStatus :: ServiceIDL.AuthenticatorStatus,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-effectivedate)
    StatusReport -> Maybe Date
srEffectiveDate :: Maybe Date,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-authenticatorversion)
    StatusReport -> Maybe Word32
srAuthenticatorVersion :: Maybe Word32,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificate)
    StatusReport -> Maybe SignedCertificate
srCertificate :: Maybe X509.SignedCertificate,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-url)
    StatusReport -> Maybe Text
srUrl :: Maybe Text,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificationdescriptor)
    StatusReport -> Maybe Text
srCertificationDescriptor :: Maybe Text,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificatenumber)
    StatusReport -> Maybe Text
srCertificateNumber :: Maybe Text,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificationpolicyversion)
    StatusReport -> Maybe Text
srCertificationPolicyVersion :: Maybe Text,
    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificationrequirementsversion)
    StatusReport -> Maybe Text
srCertificationRequirementsVersion :: Maybe Text
  }
  deriving (StatusReport -> StatusReport -> Bool
(StatusReport -> StatusReport -> Bool)
-> (StatusReport -> StatusReport -> Bool) -> Eq StatusReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusReport -> StatusReport -> Bool
$c/= :: StatusReport -> StatusReport -> Bool
== :: StatusReport -> StatusReport -> Bool
$c== :: StatusReport -> StatusReport -> Bool
Eq, Int -> StatusReport -> ShowS
[StatusReport] -> ShowS
StatusReport -> String
(Int -> StatusReport -> ShowS)
-> (StatusReport -> String)
-> ([StatusReport] -> ShowS)
-> Show StatusReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusReport] -> ShowS
$cshowList :: [StatusReport] -> ShowS
show :: StatusReport -> String
$cshow :: StatusReport -> String
showsPrec :: Int -> StatusReport -> ShowS
$cshowsPrec :: Int -> StatusReport -> ShowS
Show, (forall x. StatusReport -> Rep StatusReport x)
-> (forall x. Rep StatusReport x -> StatusReport)
-> Generic StatusReport
forall x. Rep StatusReport x -> StatusReport
forall x. StatusReport -> Rep StatusReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StatusReport x -> StatusReport
$cfrom :: forall x. StatusReport -> Rep StatusReport x
Generic, [StatusReport] -> Encoding
[StatusReport] -> Value
StatusReport -> Encoding
StatusReport -> Value
(StatusReport -> Value)
-> (StatusReport -> Encoding)
-> ([StatusReport] -> Value)
-> ([StatusReport] -> Encoding)
-> ToJSON StatusReport
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StatusReport] -> Encoding
$ctoEncodingList :: [StatusReport] -> Encoding
toJSONList :: [StatusReport] -> Value
$ctoJSONList :: [StatusReport] -> Value
toEncoding :: StatusReport -> Encoding
$ctoEncoding :: StatusReport -> Encoding
toJSON :: StatusReport -> Value
$ctoJSON :: StatusReport -> Value
ToJSON)