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 <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([SomeMetadataEntry] -> MetadataServiceRegistry
Service.createMetadataRegistry forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataPayload -> [SomeMetadataEntry]
Service.mpEntries) These (NonEmpty Text) MetadataPayload
payload