-- | Stability: experimental
-- A function for decoding a [FIDO Alliance Metadata Service](https://fidoalliance.org/metadata/).
-- BLOB in order to be able to enforce a set of requirements on he uthenticator
-- used, e.g. to only allow authenticators that have been
-- [FIDO certified](https://fidoalliance.org/certification/functional-certification/).
module Crypto.WebAuthn.Metadata
  ( metadataBlobToRegistry,
    Service.MetadataServiceRegistry,
  )
where

import qualified Crypto.WebAuthn.Metadata.Service.Decode as Service
import qualified Crypto.WebAuthn.Metadata.Service.Processing as Service
import qualified Crypto.WebAuthn.Metadata.Service.Types as Service
import Data.Bifunctor (Bifunctor (second), first)
import qualified Data.ByteString as BS
import qualified Data.Hourglass as HG
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as Text
import Data.These (These)

-- | Verifies, decodes and extracts a 'Service.MetadataServiceRegistry' from a
-- [FIDO Alliance Metadata Service](https://fidoalliance.org/metadata/) BLOB.
-- The result can be passed to 'Crypto.WebAuthn.Operation.Registration.verifyRegistrationResponse'.
metadataBlobToRegistry ::
  -- | A Metadata BLOB fetched from <https://mds.fidoalliance.org>
  BS.ByteString ->
  -- | The time at which it was fetched
  HG.DateTime ->
  -- | Either a certifcate error or a list of errors, a registry of metadata entries or both where the MDS has bad entries
  Either Text (These (NE.NonEmpty Text) Service.MetadataServiceRegistry)
metadataBlobToRegistry :: ByteString
-> DateTime
-> Either Text (These (NonEmpty Text) MetadataServiceRegistry)
metadataBlobToRegistry ByteString
bytes DateTime
now = do
  MetadataBLOBPayload
metadataPayload <- (ProcessingError -> Text)
-> Either ProcessingError MetadataBLOBPayload
-> Either Text MetadataBLOBPayload
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
Text.pack (String -> Text)
-> (ProcessingError -> String) -> ProcessingError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessingError -> String
forall a. Show a => a -> String
show) (ByteString
-> RootCertificate
-> DateTime
-> Either ProcessingError MetadataBLOBPayload
forall addData.
FromJSON addData =>
ByteString
-> RootCertificate -> DateTime -> Either ProcessingError addData
Service.jwtToAdditionalData ByteString
bytes RootCertificate
Service.fidoAllianceRootCertificate DateTime
now)
  let payload :: These (NonEmpty Text) MetadataPayload
payload = MetadataBLOBPayload -> These (NonEmpty Text) MetadataPayload
Service.decodeMetadataPayload MetadataBLOBPayload
metadataPayload
  These (NonEmpty Text) MetadataServiceRegistry
-> Either Text (These (NonEmpty Text) MetadataServiceRegistry)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These (NonEmpty Text) MetadataServiceRegistry
 -> Either Text (These (NonEmpty Text) MetadataServiceRegistry))
-> These (NonEmpty Text) MetadataServiceRegistry
-> Either Text (These (NonEmpty Text) MetadataServiceRegistry)
forall a b. (a -> b) -> a -> b
$ (MetadataPayload -> MetadataServiceRegistry)
-> These (NonEmpty Text) MetadataPayload
-> These (NonEmpty Text) MetadataServiceRegistry
forall b c a. (b -> c) -> These a b -> These a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([SomeMetadataEntry] -> MetadataServiceRegistry
Service.createMetadataRegistry ([SomeMetadataEntry] -> MetadataServiceRegistry)
-> (MetadataPayload -> [SomeMetadataEntry])
-> MetadataPayload
-> MetadataServiceRegistry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataPayload -> [SomeMetadataEntry]
Service.mpEntries) These (NonEmpty Text) MetadataPayload
payload