-- | 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 the authenticator
-- 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.Processing as Service
import qualified Crypto.WebAuthn.Metadata.Service.Types as Service
import qualified Data.ByteString as BS
import qualified Data.Hourglass as HG
import Data.Text (Text)
import qualified Data.Text as Text

-- | 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 an error on a registry of metadata entries
  Either Text Service.MetadataServiceRegistry
metadataBlobToRegistry :: ByteString -> DateTime -> Either Text MetadataServiceRegistry
metadataBlobToRegistry ByteString
bytes DateTime
now = do
  HashMap Text Value
json <- case ByteString
-> RootCertificate
-> DateTime
-> Either ProcessingError (HashMap Text Value)
Service.jwtToJson ByteString
bytes RootCertificate
Service.fidoAllianceRootCertificate DateTime
now of
    Left ProcessingError
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ProcessingError
err
    Right HashMap Text Value
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Value
res
  MetadataPayload
payload <- HashMap Text Value -> Either Text MetadataPayload
Service.jsonToPayload HashMap Text Value
json
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [SomeMetadataEntry] -> MetadataServiceRegistry
Service.createMetadataRegistry forall a b. (a -> b) -> a -> b
$ MetadataPayload -> [SomeMetadataEntry]
Service.mpEntries MetadataPayload
payload