{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}

-- | Stability: experimental
-- This module contains functions to further decode
-- [FIDO Metadata Statement](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html)
-- IDL types defined in 'Crypto.WebAuthn.Metadata.Statement.IDL' into the Haskell-specific types defined in 'Crypto.WebAuthn.Metadata.Statement.Types'
module Crypto.WebAuthn.Metadata.Statement.Decode
  ( decodeMetadataStatement,
    decodeAAGUID,
    decodeSubjectKeyIdentifier,
    decodeCertificate,
  )
where

import Control.Monad (unless)
import Crypto.Hash (SHA1, digestFromByteString)
import qualified Crypto.WebAuthn.Metadata.FidoRegistry as Registry
import Crypto.WebAuthn.Metadata.Statement.Types (WebauthnAttestationType (WebauthnAttestationAttCA, WebauthnAttestationBasic))
import qualified Crypto.WebAuthn.Metadata.Statement.Types as StatementTypes
import qualified Crypto.WebAuthn.Metadata.Statement.WebIDL as StatementIDL
import qualified Crypto.WebAuthn.Metadata.WebIDL as IDL
import qualified Crypto.WebAuthn.Model as M
import Crypto.WebAuthn.Model.Identifier (AAGUID (AAGUID), AuthenticatorIdentifier (AuthenticatorIdentifierFido2, AuthenticatorIdentifierFidoU2F), SubjectKeyIdentifier (SubjectKeyIdentifier))
import Data.Bifunctor (first)
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Base64 as Base64
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
import qualified Data.UUID as UUID
import qualified Data.X509 as X509

-- | Decodes an 'M.AAGUID' from an [aaguid](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-aaguid) field of a metadata statement or an [aaguid](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-aaguid) field of a metadata service payload entry field
decodeAAGUID :: StatementIDL.AAGUID -> Either Text (AuthenticatorIdentifier 'M.Fido2)
decodeAAGUID :: AAGUID -> Either Text (AuthenticatorIdentifier 'Fido2)
decodeAAGUID (StatementIDL.AAGUID Text
aaguidText) = case Text -> Maybe UUID
UUID.fromText Text
aaguidText of
  Maybe UUID
Nothing -> Text -> Either Text (AuthenticatorIdentifier 'Fido2)
forall a b. a -> Either a b
Left (Text -> Either Text (AuthenticatorIdentifier 'Fido2))
-> Text -> Either Text (AuthenticatorIdentifier 'Fido2)
forall a b. (a -> b) -> a -> b
$ Text
"Could not decode metadata aaguid: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aaguidText
  Just UUID
aaguid -> AuthenticatorIdentifier 'Fido2
-> Either Text (AuthenticatorIdentifier 'Fido2)
forall a b. b -> Either a b
Right (AuthenticatorIdentifier 'Fido2
 -> Either Text (AuthenticatorIdentifier 'Fido2))
-> AuthenticatorIdentifier 'Fido2
-> Either Text (AuthenticatorIdentifier 'Fido2)
forall a b. (a -> b) -> a -> b
$ AAGUID -> AuthenticatorIdentifier 'Fido2
AuthenticatorIdentifierFido2 (AAGUID -> AuthenticatorIdentifier 'Fido2)
-> AAGUID -> AuthenticatorIdentifier 'Fido2
forall a b. (a -> b) -> a -> b
$ UUID -> AAGUID
AAGUID UUID
aaguid

-- | Decodes a 'M.SubjectKeyIdentifier' from an [attestationCertificateKeyIdentifiers](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationcertificatekeyidentifiers) field of a metadata statement or an [attestationCertificateKeyIdentifiers](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-attestationcertificatekeyidentifiers) field of a metadata service payload entry
decodeSubjectKeyIdentifier :: IDL.DOMString -> Either Text (AuthenticatorIdentifier 'M.FidoU2F)
decodeSubjectKeyIdentifier :: Text -> Either Text (AuthenticatorIdentifier 'FidoU2F)
decodeSubjectKeyIdentifier Text
subjectKeyIdentifierText = case ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
encodeUtf8 Text
subjectKeyIdentifierText) of
  Left String
err -> Text -> Either Text (AuthenticatorIdentifier 'FidoU2F)
forall a b. a -> Either a b
Left (Text -> Either Text (AuthenticatorIdentifier 'FidoU2F))
-> Text -> Either Text (AuthenticatorIdentifier 'FidoU2F)
forall a b. (a -> b) -> a -> b
$ Text
"A attestationCertificateKeyIdentifier failed to parse because it's not a valid base-16 encoding: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
subjectKeyIdentifierText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
err
  Right ByteString
bytes -> case forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA1 ByteString
bytes of
    Maybe (Digest SHA1)
Nothing -> Text -> Either Text (AuthenticatorIdentifier 'FidoU2F)
forall a b. a -> Either a b
Left (Text -> Either Text (AuthenticatorIdentifier 'FidoU2F))
-> Text -> Either Text (AuthenticatorIdentifier 'FidoU2F)
forall a b. (a -> b) -> a -> b
$ Text
"A attestationCertificateKeyIdentifier failed to parse because it has the wrong length for a SHA1 hash: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
subjectKeyIdentifierText
    Just Digest SHA1
hash -> AuthenticatorIdentifier 'FidoU2F
-> Either Text (AuthenticatorIdentifier 'FidoU2F)
forall a b. b -> Either a b
Right (AuthenticatorIdentifier 'FidoU2F
 -> Either Text (AuthenticatorIdentifier 'FidoU2F))
-> AuthenticatorIdentifier 'FidoU2F
-> Either Text (AuthenticatorIdentifier 'FidoU2F)
forall a b. (a -> b) -> a -> b
$ SubjectKeyIdentifier -> AuthenticatorIdentifier 'FidoU2F
AuthenticatorIdentifierFidoU2F (SubjectKeyIdentifier -> AuthenticatorIdentifier 'FidoU2F)
-> SubjectKeyIdentifier -> AuthenticatorIdentifier 'FidoU2F
forall a b. (a -> b) -> a -> b
$ Digest SHA1 -> SubjectKeyIdentifier
SubjectKeyIdentifier Digest SHA1
hash

-- | Decodes a 'X509.SignedCertificate' from an [attestationRootCertificates](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationrootcertificates) field of a metadata statement or the [certificate](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificate) field of a metadata service status report
decodeCertificate :: IDL.DOMString -> Either Text X509.SignedCertificate
decodeCertificate :: Text -> Either Text SignedCertificate
decodeCertificate Text
text =
  -- TODO: Remove Text.strip, it's only needed because of a spec violation, see
  -- <https://github.com/tweag/haskell-fido2/issues/68>
  -- TODO: Don't use decodeLenient, it's only needed because of a spec
  -- violation, see TODO above
  let bytes :: ByteString
bytes = ByteString -> ByteString
Base64.decodeLenient (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.strip Text
text)
   in case ByteString -> Either String SignedCertificate
X509.decodeSignedCertificate ByteString
bytes of
        Left String
err -> Text -> Either Text SignedCertificate
forall a b. a -> Either a b
Left (Text -> Either Text SignedCertificate)
-> Text -> Either Text SignedCertificate
forall a b. (a -> b) -> a -> b
$ Text
"A certificate failed to parse because it's not a valid encoding: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
err
        Right SignedCertificate
certificate -> SignedCertificate -> Either Text SignedCertificate
forall a b. b -> Either a b
Right SignedCertificate
certificate

-- | Fully decodes a [MetadataStatement](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#metadata-keys).
-- The @p@ type parameter is the 'StatementIDL.ProtocolFamily' that this metadata statement is for.
decodeMetadataStatement ::
  -- | The raw metadata statement, directly parsed from JSON
  StatementIDL.MetadataStatement ->
  -- | Either an early exit with 'Left', where @Left Nothing@ signals that
  -- this entry can be skipped because it's not relevant for Webauthn, and
  -- @Left . Just@ signals that an error happened during decoding
  -- Otherwise a successful result with 'Right'
  Either (Maybe Text) StatementTypes.MetadataStatement
decodeMetadataStatement :: MetadataStatement -> Either (Maybe Text) MetadataStatement
decodeMetadataStatement StatementIDL.MetadataStatement {[Text]
[TransactionConfirmationDisplayType]
Maybe Boolean
Maybe UnsignedShort
Maybe (NonEmpty KeyIdentifier)
Maybe (NonEmpty ExtensionDescriptor)
Maybe (NonEmpty EcdaaTrustAnchor)
Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
Maybe Text
Maybe AAID
Maybe AuthenticatorGetInfo
Maybe AlternativeDescriptions
Maybe AAGUID
UnsignedShort
UnsignedLong
NonEmpty Version
NonEmpty AuthenticatorAttestationType
NonEmpty PublicKeyRepresentationFormat
NonEmpty AuthenticationAlgorithm
NonEmpty AuthenticatorAttachmentHint
NonEmpty MatcherProtectionType
NonEmpty KeyProtectionType
NonEmpty VerificationMethodANDCombinations
Text
ProtocolFamily
legalHeader :: Text
aaid :: Maybe AAID
aaguid :: Maybe AAGUID
attestationCertificateKeyIdentifiers :: Maybe (NonEmpty KeyIdentifier)
description :: Text
alternativeDescriptions :: Maybe AlternativeDescriptions
authenticatorVersion :: UnsignedLong
protocolFamily :: ProtocolFamily
schema :: UnsignedShort
upv :: NonEmpty Version
authenticationAlgorithms :: NonEmpty AuthenticationAlgorithm
publicKeyAlgAndEncodings :: NonEmpty PublicKeyRepresentationFormat
attestationTypes :: NonEmpty AuthenticatorAttestationType
userVerificationDetails :: NonEmpty VerificationMethodANDCombinations
keyProtection :: NonEmpty KeyProtectionType
isKeyRestricted :: Maybe Boolean
isFreshUserVerificationRequired :: Maybe Boolean
matcherProtection :: NonEmpty MatcherProtectionType
cryptoStrength :: Maybe UnsignedShort
attachmentHint :: NonEmpty AuthenticatorAttachmentHint
tcDisplay :: [TransactionConfirmationDisplayType]
tcDisplayContentType :: Maybe Text
tcDisplayPNGCharacteristics :: Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
attestationRootCertificates :: [Text]
ecdaaTrustAnchors :: Maybe (NonEmpty EcdaaTrustAnchor)
icon :: Maybe Text
supportedExtensions :: Maybe (NonEmpty ExtensionDescriptor)
authenticatorGetInfo :: Maybe AuthenticatorGetInfo
$sel:legalHeader:MetadataStatement :: MetadataStatement -> Text
$sel:aaid:MetadataStatement :: MetadataStatement -> Maybe AAID
$sel:aaguid:MetadataStatement :: MetadataStatement -> Maybe AAGUID
$sel:attestationCertificateKeyIdentifiers:MetadataStatement :: MetadataStatement -> Maybe (NonEmpty KeyIdentifier)
$sel:description:MetadataStatement :: MetadataStatement -> Text
$sel:alternativeDescriptions:MetadataStatement :: MetadataStatement -> Maybe AlternativeDescriptions
$sel:authenticatorVersion:MetadataStatement :: MetadataStatement -> UnsignedLong
$sel:protocolFamily:MetadataStatement :: MetadataStatement -> ProtocolFamily
$sel:schema:MetadataStatement :: MetadataStatement -> UnsignedShort
$sel:upv:MetadataStatement :: MetadataStatement -> NonEmpty Version
$sel:authenticationAlgorithms:MetadataStatement :: MetadataStatement -> NonEmpty AuthenticationAlgorithm
$sel:publicKeyAlgAndEncodings:MetadataStatement :: MetadataStatement -> NonEmpty PublicKeyRepresentationFormat
$sel:attestationTypes:MetadataStatement :: MetadataStatement -> NonEmpty AuthenticatorAttestationType
$sel:userVerificationDetails:MetadataStatement :: MetadataStatement -> NonEmpty VerificationMethodANDCombinations
$sel:keyProtection:MetadataStatement :: MetadataStatement -> NonEmpty KeyProtectionType
$sel:isKeyRestricted:MetadataStatement :: MetadataStatement -> Maybe Boolean
$sel:isFreshUserVerificationRequired:MetadataStatement :: MetadataStatement -> Maybe Boolean
$sel:matcherProtection:MetadataStatement :: MetadataStatement -> NonEmpty MatcherProtectionType
$sel:cryptoStrength:MetadataStatement :: MetadataStatement -> Maybe UnsignedShort
$sel:attachmentHint:MetadataStatement :: MetadataStatement -> NonEmpty AuthenticatorAttachmentHint
$sel:tcDisplay:MetadataStatement :: MetadataStatement -> [TransactionConfirmationDisplayType]
$sel:tcDisplayContentType:MetadataStatement :: MetadataStatement -> Maybe Text
$sel:tcDisplayPNGCharacteristics:MetadataStatement :: MetadataStatement
-> Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
$sel:attestationRootCertificates:MetadataStatement :: MetadataStatement -> [Text]
$sel:ecdaaTrustAnchors:MetadataStatement :: MetadataStatement -> Maybe (NonEmpty EcdaaTrustAnchor)
$sel:icon:MetadataStatement :: MetadataStatement -> Maybe Text
$sel:supportedExtensions:MetadataStatement :: MetadataStatement -> Maybe (NonEmpty ExtensionDescriptor)
$sel:authenticatorGetInfo:MetadataStatement :: MetadataStatement -> Maybe AuthenticatorGetInfo
..} = do
  let msLegalHeader :: Text
msLegalHeader = Text
legalHeader
      msDescription :: Text
msDescription = Text
description
      msAlternativeDescriptions :: Maybe AlternativeDescriptions
msAlternativeDescriptions = Maybe AlternativeDescriptions
alternativeDescriptions
      msAuthenticatorVersion :: UnsignedLong
msAuthenticatorVersion = UnsignedLong
authenticatorVersion
  Boolean -> Either (Maybe Text) () -> Either (Maybe Text) ()
forall (f :: * -> *). Applicative f => Boolean -> f () -> f ()
unless (UnsignedShort
schema UnsignedShort -> UnsignedShort -> Boolean
forall a. Eq a => a -> a -> Boolean
== UnsignedShort
3) (Either (Maybe Text) () -> Either (Maybe Text) ())
-> Either (Maybe Text) () -> Either (Maybe Text) ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Either (Maybe Text) ()
forall a b. a -> Either a b
Left (Maybe Text -> Either (Maybe Text) ())
-> Maybe Text -> Either (Maybe Text) ()
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"Schema version is not 3 but " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (UnsignedShort -> String
forall a. Show a => a -> String
show UnsignedShort
schema)
  let msUpv :: NonEmpty Version
msUpv = NonEmpty Version
upv
      msAuthenticationAlgorithms :: NonEmpty AuthenticationAlgorithm
msAuthenticationAlgorithms = NonEmpty AuthenticationAlgorithm
authenticationAlgorithms
      msPublicKeyAlgAndEncodings :: NonEmpty PublicKeyRepresentationFormat
msPublicKeyAlgAndEncodings = NonEmpty PublicKeyRepresentationFormat
publicKeyAlgAndEncodings
  NonEmpty WebauthnAttestationType
msAttestationTypes <- NonEmpty AuthenticatorAttestationType
-> Either (Maybe Text) (NonEmpty WebauthnAttestationType)
decodeAttestationTypes NonEmpty AuthenticatorAttestationType
attestationTypes
  let msUserVerificationDetails :: NonEmpty VerificationMethodANDCombinations
msUserVerificationDetails = NonEmpty VerificationMethodANDCombinations
userVerificationDetails
      msKeyProtection :: NonEmpty KeyProtectionType
msKeyProtection = NonEmpty KeyProtectionType
keyProtection
      msIsKeyRestricted :: Maybe Boolean
msIsKeyRestricted = Maybe Boolean
isKeyRestricted
      msIsFreshUserVerificationRequired :: Maybe Boolean
msIsFreshUserVerificationRequired = Maybe Boolean
isFreshUserVerificationRequired
      msMatcherProtection :: NonEmpty MatcherProtectionType
msMatcherProtection = NonEmpty MatcherProtectionType
matcherProtection
      msCryptoStrength :: Maybe UnsignedShort
msCryptoStrength = Maybe UnsignedShort
cryptoStrength
      msAttachmentHint :: NonEmpty AuthenticatorAttachmentHint
msAttachmentHint = NonEmpty AuthenticatorAttachmentHint
attachmentHint
      msTcDisplay :: [TransactionConfirmationDisplayType]
msTcDisplay = [TransactionConfirmationDisplayType]
tcDisplay
      msTcDisplayContentType :: Maybe Text
msTcDisplayContentType = Maybe Text
tcDisplayContentType
      msTcDisplayPNGCharacteristics :: Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
msTcDisplayPNGCharacteristics = Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
tcDisplayPNGCharacteristics
  NonEmpty SignedCertificate
msAttestationRootCertificates <- case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Text]
attestationRootCertificates of
    -- > When supporting surrogate basic attestation only, no attestation trust anchor is required/used. So this array MUST be empty in that case.
    -- This will never be the case, because if only surrogate basic attestation is used, then decodeAttestationTypes above will have returned (Left Nothing) already
    Maybe (NonEmpty Text)
Nothing -> Maybe Text -> Either (Maybe Text) (NonEmpty SignedCertificate)
forall a b. a -> Either a b
Left (Maybe Text -> Either (Maybe Text) (NonEmpty SignedCertificate))
-> Maybe Text -> Either (Maybe Text) (NonEmpty SignedCertificate)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"attestationRootCertificates should not be empty"
    Just NonEmpty Text
certs -> (Text -> Maybe Text)
-> Either Text (NonEmpty SignedCertificate)
-> Either (Maybe Text) (NonEmpty SignedCertificate)
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 Text -> Maybe Text
forall a. a -> Maybe a
Just (Either Text (NonEmpty SignedCertificate)
 -> Either (Maybe Text) (NonEmpty SignedCertificate))
-> Either Text (NonEmpty SignedCertificate)
-> Either (Maybe Text) (NonEmpty SignedCertificate)
forall a b. (a -> b) -> a -> b
$ (Text -> Either Text SignedCertificate)
-> NonEmpty Text -> Either Text (NonEmpty SignedCertificate)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse Text -> Either Text SignedCertificate
decodeCertificate NonEmpty Text
certs
  Maybe PNGBytes
msIcon <- (Text -> Maybe Text)
-> Either Text (Maybe PNGBytes)
-> Either (Maybe Text) (Maybe PNGBytes)
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 Text -> Maybe Text
forall a. a -> Maybe a
Just (Either Text (Maybe PNGBytes)
 -> Either (Maybe Text) (Maybe PNGBytes))
-> Either Text (Maybe PNGBytes)
-> Either (Maybe Text) (Maybe PNGBytes)
forall a b. (a -> b) -> a -> b
$ (Text -> Either Text PNGBytes)
-> Maybe Text -> Either Text (Maybe PNGBytes)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Text -> Either Text PNGBytes
decodeIcon Maybe Text
icon
  let msSupportedExtensions :: Maybe (NonEmpty ExtensionDescriptor)
msSupportedExtensions = Maybe (NonEmpty ExtensionDescriptor)
supportedExtensions
      msAuthenticatorGetInfo :: Maybe AuthenticatorGetInfo
msAuthenticatorGetInfo = Maybe AuthenticatorGetInfo
authenticatorGetInfo
  MetadataStatement -> Either (Maybe Text) MetadataStatement
forall a. a -> Either (Maybe Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataStatement -> Either (Maybe Text) MetadataStatement)
-> MetadataStatement -> Either (Maybe Text) MetadataStatement
forall a b. (a -> b) -> a -> b
$ StatementTypes.MetadataStatement {[TransactionConfirmationDisplayType]
Maybe Boolean
Maybe UnsignedShort
Maybe (NonEmpty ExtensionDescriptor)
Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
Maybe Text
Maybe AuthenticatorGetInfo
Maybe AlternativeDescriptions
Maybe PNGBytes
UnsignedLong
NonEmpty SignedCertificate
NonEmpty Version
NonEmpty PublicKeyRepresentationFormat
NonEmpty AuthenticationAlgorithm
NonEmpty AuthenticatorAttachmentHint
NonEmpty MatcherProtectionType
NonEmpty KeyProtectionType
NonEmpty VerificationMethodANDCombinations
NonEmpty WebauthnAttestationType
Text
msLegalHeader :: Text
msDescription :: Text
msAlternativeDescriptions :: Maybe AlternativeDescriptions
msAuthenticatorVersion :: UnsignedLong
msUpv :: NonEmpty Version
msAuthenticationAlgorithms :: NonEmpty AuthenticationAlgorithm
msPublicKeyAlgAndEncodings :: NonEmpty PublicKeyRepresentationFormat
msAttestationTypes :: NonEmpty WebauthnAttestationType
msUserVerificationDetails :: NonEmpty VerificationMethodANDCombinations
msKeyProtection :: NonEmpty KeyProtectionType
msIsKeyRestricted :: Maybe Boolean
msIsFreshUserVerificationRequired :: Maybe Boolean
msMatcherProtection :: NonEmpty MatcherProtectionType
msCryptoStrength :: Maybe UnsignedShort
msAttachmentHint :: NonEmpty AuthenticatorAttachmentHint
msTcDisplay :: [TransactionConfirmationDisplayType]
msTcDisplayContentType :: Maybe Text
msTcDisplayPNGCharacteristics :: Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
msAttestationRootCertificates :: NonEmpty SignedCertificate
msIcon :: Maybe PNGBytes
msSupportedExtensions :: Maybe (NonEmpty ExtensionDescriptor)
msAuthenticatorGetInfo :: Maybe AuthenticatorGetInfo
msLegalHeader :: Text
msDescription :: Text
msAlternativeDescriptions :: Maybe AlternativeDescriptions
msAuthenticatorVersion :: UnsignedLong
msUpv :: NonEmpty Version
msAuthenticationAlgorithms :: NonEmpty AuthenticationAlgorithm
msPublicKeyAlgAndEncodings :: NonEmpty PublicKeyRepresentationFormat
msAttestationTypes :: NonEmpty WebauthnAttestationType
msUserVerificationDetails :: NonEmpty VerificationMethodANDCombinations
msKeyProtection :: NonEmpty KeyProtectionType
msIsKeyRestricted :: Maybe Boolean
msIsFreshUserVerificationRequired :: Maybe Boolean
msMatcherProtection :: NonEmpty MatcherProtectionType
msCryptoStrength :: Maybe UnsignedShort
msAttachmentHint :: NonEmpty AuthenticatorAttachmentHint
msTcDisplay :: [TransactionConfirmationDisplayType]
msTcDisplayContentType :: Maybe Text
msTcDisplayPNGCharacteristics :: Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
msAttestationRootCertificates :: NonEmpty SignedCertificate
msIcon :: Maybe PNGBytes
msSupportedExtensions :: Maybe (NonEmpty ExtensionDescriptor)
msAuthenticatorGetInfo :: Maybe AuthenticatorGetInfo
..}
  where
    -- Turns a non-empty list of 'Registry.AuthenticatorAttestationType' into a non-empty list of 'WebauthnAttestationType'.
    -- If the authenticator doesn't support any webauthn attestation types,
    -- `Left Nothing` is returned, indicating that this authenticator should be ignored
    decodeAttestationTypes ::
      NonEmpty Registry.AuthenticatorAttestationType ->
      Either (Maybe Text) (NonEmpty WebauthnAttestationType)
    decodeAttestationTypes :: NonEmpty AuthenticatorAttestationType
-> Either (Maybe Text) (NonEmpty WebauthnAttestationType)
decodeAttestationTypes NonEmpty AuthenticatorAttestationType
types = case [WebauthnAttestationType]
-> Maybe (NonEmpty WebauthnAttestationType)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([WebauthnAttestationType]
 -> Maybe (NonEmpty WebauthnAttestationType))
-> [WebauthnAttestationType]
-> Maybe (NonEmpty WebauthnAttestationType)
forall a b. (a -> b) -> a -> b
$ (AuthenticatorAttestationType -> Maybe WebauthnAttestationType)
-> [AuthenticatorAttestationType] -> [WebauthnAttestationType]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AuthenticatorAttestationType -> Maybe WebauthnAttestationType
transform ([AuthenticatorAttestationType] -> [WebauthnAttestationType])
-> [AuthenticatorAttestationType] -> [WebauthnAttestationType]
forall a b. (a -> b) -> a -> b
$ NonEmpty AuthenticatorAttestationType
-> [AuthenticatorAttestationType]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty AuthenticatorAttestationType
types of
      Maybe (NonEmpty WebauthnAttestationType)
Nothing -> Maybe Text
-> Either (Maybe Text) (NonEmpty WebauthnAttestationType)
forall a b. a -> Either a b
Left Maybe Text
forall a. Maybe a
Nothing
      Just NonEmpty WebauthnAttestationType
result -> NonEmpty WebauthnAttestationType
-> Either (Maybe Text) (NonEmpty WebauthnAttestationType)
forall a b. b -> Either a b
Right NonEmpty WebauthnAttestationType
result
      where
        transform :: Registry.AuthenticatorAttestationType -> Maybe WebauthnAttestationType
        transform :: AuthenticatorAttestationType -> Maybe WebauthnAttestationType
transform AuthenticatorAttestationType
Registry.ATTESTATION_BASIC_FULL = WebauthnAttestationType -> Maybe WebauthnAttestationType
forall a. a -> Maybe a
Just WebauthnAttestationType
WebauthnAttestationBasic
        transform AuthenticatorAttestationType
Registry.ATTESTATION_ATTCA = WebauthnAttestationType -> Maybe WebauthnAttestationType
forall a. a -> Maybe a
Just WebauthnAttestationType
WebauthnAttestationAttCA
        transform AuthenticatorAttestationType
_ = Maybe WebauthnAttestationType
forall a. Maybe a
Nothing

    -- Decodes the PNG bytes of an [icon](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-icon) field of a metadata statement
    decodeIcon :: IDL.DOMString -> Either Text StatementTypes.PNGBytes
    decodeIcon :: Text -> Either Text PNGBytes
decodeIcon Text
dataUrl = case Text -> Text -> Maybe Text
Text.stripPrefix Text
"data:image/png;base64," Text
dataUrl of
      Maybe Text
Nothing -> Text -> Either Text PNGBytes
forall a b. a -> Either a b
Left (Text -> Either Text PNGBytes) -> Text -> Either Text PNGBytes
forall a b. (a -> b) -> a -> b
$ Text
"Icon decoding failed because there is no \"data:image/png;base64,\" prefix: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dataUrl
      Just Text
suffix ->
        -- TODO: Use non-lenient decoding, it's only needed because of a spec violation,
        -- see <https://github.com/tweag/haskell-fido2/issues/68>
        PNGBytes -> Either Text PNGBytes
forall a b. b -> Either a b
Right (PNGBytes -> Either Text PNGBytes)
-> PNGBytes -> Either Text PNGBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> PNGBytes
StatementTypes.PNGBytes (ByteString -> PNGBytes) -> ByteString -> PNGBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base64.decodeLenient (Text -> ByteString
encodeUtf8 Text
suffix)