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 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)
metadataBlobToRegistry ::
BS.ByteString ->
HG.DateTime ->
Either Text (These (NE.NonEmpty Text) Service.MetadataServiceRegistry)
metadataBlobToRegistry :: ByteString
-> DateTime
-> Either Text (These (NonEmpty Text) MetadataServiceRegistry)
metadataBlobToRegistry ByteString
bytes DateTime
now = do
HashMap Text Value
json <- (ProcessingError -> Text)
-> Either ProcessingError (HashMap Text Value)
-> Either Text (HashMap Text Value)
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 (HashMap Text Value)
Service.jwtToJson ByteString
bytes RootCertificate
Service.fidoAllianceRootCertificate DateTime
now)
let payload :: These (NonEmpty Text) MetadataPayload
payload = HashMap Text Value -> These (NonEmpty Text) MetadataPayload
Service.jsonToPayload HashMap Text Value
json
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