{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
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.UAF as UAF
import qualified Crypto.WebAuthn.Model as M
import Crypto.WebAuthn.Model.Identifier (AAGUID (AAGUID), AuthenticatorIdentifier (AuthenticatorIdentifierFido2, AuthenticatorIdentifierFidoU2F), SubjectKeyIdentifier (SubjectKeyIdentifier))
import qualified Crypto.WebAuthn.WebIDL as IDL
import Data.Bifunctor (first)
import qualified Data.ByteString as BS
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.Singletons (SingI, sing)
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
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
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 ByteString -> Maybe (Digest SHA1)
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
decodeCertificate :: IDL.DOMString -> Either Text X509.SignedCertificate
decodeCertificate :: Text -> Either Text SignedCertificate
decodeCertificate Text
text =
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
decodeMetadataStatement ::
forall p.
SingI p =>
StatementIDL.MetadataStatement ->
Either (Maybe Text) (StatementTypes.MetadataStatement p)
decodeMetadataStatement :: MetadataStatement -> Either (Maybe Text) (MetadataStatement p)
decodeMetadataStatement StatementIDL.MetadataStatement {[Text]
[TransactionConfirmationDisplayType]
Maybe Boolean
Maybe UnsignedShort
Maybe Text
Maybe (NonEmpty KeyIdentifier)
Maybe (NonEmpty ExtensionDescriptor)
Maybe (NonEmpty EcdaaTrustAnchor)
Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
Maybe AAID
Maybe AuthenticatorGetInfo
Maybe AlternativeDescriptions
Maybe AAGUID
UnsignedShort
UnsignedLong
Text
NonEmpty AuthenticatorAttestationType
NonEmpty PublicKeyRepresentationFormat
NonEmpty AuthenticationAlgorithm
NonEmpty AuthenticatorAttachmentHint
NonEmpty MatcherProtectionType
NonEmpty KeyProtectionType
NonEmpty Version
NonEmpty VerificationMethodANDCombinations
ProtocolFamily
$sel:authenticatorGetInfo:MetadataStatement :: MetadataStatement -> Maybe AuthenticatorGetInfo
$sel:supportedExtensions:MetadataStatement :: MetadataStatement -> Maybe (NonEmpty ExtensionDescriptor)
$sel:icon:MetadataStatement :: MetadataStatement -> Maybe Text
$sel:ecdaaTrustAnchors:MetadataStatement :: MetadataStatement -> Maybe (NonEmpty EcdaaTrustAnchor)
$sel:attestationRootCertificates:MetadataStatement :: MetadataStatement -> [Text]
$sel:tcDisplayPNGCharacteristics:MetadataStatement :: MetadataStatement
-> Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
$sel:tcDisplayContentType:MetadataStatement :: MetadataStatement -> Maybe Text
$sel:tcDisplay:MetadataStatement :: MetadataStatement -> [TransactionConfirmationDisplayType]
$sel:attachmentHint:MetadataStatement :: MetadataStatement -> NonEmpty AuthenticatorAttachmentHint
$sel:cryptoStrength:MetadataStatement :: MetadataStatement -> Maybe UnsignedShort
$sel:matcherProtection:MetadataStatement :: MetadataStatement -> NonEmpty MatcherProtectionType
$sel:isFreshUserVerificationRequired:MetadataStatement :: MetadataStatement -> Maybe Boolean
$sel:isKeyRestricted:MetadataStatement :: MetadataStatement -> Maybe Boolean
$sel:keyProtection:MetadataStatement :: MetadataStatement -> NonEmpty KeyProtectionType
$sel:userVerificationDetails:MetadataStatement :: MetadataStatement -> NonEmpty VerificationMethodANDCombinations
$sel:attestationTypes:MetadataStatement :: MetadataStatement -> NonEmpty AuthenticatorAttestationType
$sel:publicKeyAlgAndEncodings:MetadataStatement :: MetadataStatement -> NonEmpty PublicKeyRepresentationFormat
$sel:authenticationAlgorithms:MetadataStatement :: MetadataStatement -> NonEmpty AuthenticationAlgorithm
$sel:upv:MetadataStatement :: MetadataStatement -> NonEmpty Version
$sel:schema:MetadataStatement :: MetadataStatement -> UnsignedShort
$sel:protocolFamily:MetadataStatement :: MetadataStatement -> ProtocolFamily
$sel:authenticatorVersion:MetadataStatement :: MetadataStatement -> UnsignedLong
$sel:alternativeDescriptions:MetadataStatement :: MetadataStatement -> Maybe AlternativeDescriptions
$sel:description:MetadataStatement :: MetadataStatement -> Text
$sel:attestationCertificateKeyIdentifiers:MetadataStatement :: MetadataStatement -> Maybe (NonEmpty KeyIdentifier)
$sel:aaguid:MetadataStatement :: MetadataStatement -> Maybe AAGUID
$sel:aaid:MetadataStatement :: MetadataStatement -> Maybe AAID
$sel:legalHeader:MetadataStatement :: MetadataStatement -> Text
authenticatorGetInfo :: Maybe AuthenticatorGetInfo
supportedExtensions :: Maybe (NonEmpty ExtensionDescriptor)
icon :: Maybe Text
ecdaaTrustAnchors :: Maybe (NonEmpty EcdaaTrustAnchor)
attestationRootCertificates :: [Text]
tcDisplayPNGCharacteristics :: Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
tcDisplayContentType :: Maybe Text
tcDisplay :: [TransactionConfirmationDisplayType]
attachmentHint :: NonEmpty AuthenticatorAttachmentHint
cryptoStrength :: Maybe UnsignedShort
matcherProtection :: NonEmpty MatcherProtectionType
isFreshUserVerificationRequired :: Maybe Boolean
isKeyRestricted :: Maybe Boolean
keyProtection :: NonEmpty KeyProtectionType
userVerificationDetails :: NonEmpty VerificationMethodANDCombinations
attestationTypes :: NonEmpty AuthenticatorAttestationType
publicKeyAlgAndEncodings :: NonEmpty PublicKeyRepresentationFormat
authenticationAlgorithms :: NonEmpty AuthenticationAlgorithm
upv :: NonEmpty Version
schema :: UnsignedShort
protocolFamily :: ProtocolFamily
authenticatorVersion :: UnsignedLong
alternativeDescriptions :: Maybe AlternativeDescriptions
description :: Text
attestationCertificateKeyIdentifiers :: Maybe (NonEmpty KeyIdentifier)
aaguid :: Maybe AAGUID
aaid :: Maybe AAID
legalHeader :: Text
..} = 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)
NonEmpty (ProtocolVersion p)
msUpv <- case SingI p => Sing p
forall k (a :: k). SingI a => Sing a
sing @p of
Sing p
M.SFidoU2F -> (Text -> Maybe Text)
-> Either Text (NonEmpty (ProtocolVersion 'FidoU2F))
-> Either (Maybe Text) (NonEmpty (ProtocolVersion 'FidoU2F))
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 (ProtocolVersion 'FidoU2F))
-> Either (Maybe Text) (NonEmpty (ProtocolVersion 'FidoU2F)))
-> Either Text (NonEmpty (ProtocolVersion 'FidoU2F))
-> Either (Maybe Text) (NonEmpty (ProtocolVersion 'FidoU2F))
forall a b. (a -> b) -> a -> b
$ (Version -> Either Text (ProtocolVersion 'FidoU2F))
-> NonEmpty Version
-> Either Text (NonEmpty (ProtocolVersion 'FidoU2F))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Version -> Either Text (ProtocolVersion 'FidoU2F)
decodeUpvFidoU2F NonEmpty Version
upv
Sing p
M.SFido2 -> (Text -> Maybe Text)
-> Either Text (NonEmpty (ProtocolVersion 'Fido2))
-> Either (Maybe Text) (NonEmpty (ProtocolVersion 'Fido2))
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 (ProtocolVersion 'Fido2))
-> Either (Maybe Text) (NonEmpty (ProtocolVersion 'Fido2)))
-> Either Text (NonEmpty (ProtocolVersion 'Fido2))
-> Either (Maybe Text) (NonEmpty (ProtocolVersion 'Fido2))
forall a b. (a -> b) -> a -> b
$ (Version -> Either Text (ProtocolVersion 'Fido2))
-> NonEmpty Version
-> Either Text (NonEmpty (ProtocolVersion 'Fido2))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Version -> Either Text (ProtocolVersion 'Fido2)
decodeUpvFido2 NonEmpty Version
upv
let 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
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 (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)
traverse Text -> Either Text SignedCertificate
decodeCertificate NonEmpty Text
certs
Maybe ByteString
msIcon <- (Text -> Maybe Text)
-> Either Text (Maybe ByteString)
-> Either (Maybe Text) (Maybe ByteString)
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 ByteString)
-> Either (Maybe Text) (Maybe ByteString))
-> Either Text (Maybe ByteString)
-> Either (Maybe Text) (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (Text -> Either Text ByteString)
-> Maybe Text -> Either Text (Maybe ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Either Text ByteString
decodeIcon Maybe Text
icon
let msSupportedExtensions :: Maybe (NonEmpty ExtensionDescriptor)
msSupportedExtensions = Maybe (NonEmpty ExtensionDescriptor)
supportedExtensions
msAuthenticatorGetInfo :: Maybe AuthenticatorGetInfo
msAuthenticatorGetInfo = Maybe AuthenticatorGetInfo
authenticatorGetInfo
MetadataStatement p -> Either (Maybe Text) (MetadataStatement p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataStatement p -> Either (Maybe Text) (MetadataStatement p))
-> MetadataStatement p -> Either (Maybe Text) (MetadataStatement p)
forall a b. (a -> b) -> a -> b
$ MetadataStatement :: forall (p :: ProtocolKind).
Text
-> Text
-> Maybe AlternativeDescriptions
-> UnsignedLong
-> NonEmpty (ProtocolVersion p)
-> NonEmpty AuthenticationAlgorithm
-> NonEmpty PublicKeyRepresentationFormat
-> NonEmpty WebauthnAttestationType
-> NonEmpty VerificationMethodANDCombinations
-> NonEmpty KeyProtectionType
-> Maybe Boolean
-> Maybe Boolean
-> NonEmpty MatcherProtectionType
-> Maybe UnsignedShort
-> NonEmpty AuthenticatorAttachmentHint
-> [TransactionConfirmationDisplayType]
-> Maybe Text
-> Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
-> NonEmpty SignedCertificate
-> Maybe ByteString
-> Maybe (NonEmpty ExtensionDescriptor)
-> Maybe AuthenticatorGetInfo
-> MetadataStatement p
StatementTypes.MetadataStatement {[TransactionConfirmationDisplayType]
Maybe Boolean
Maybe UnsignedShort
Maybe ByteString
Maybe Text
Maybe (NonEmpty ExtensionDescriptor)
Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
Maybe AuthenticatorGetInfo
Maybe AlternativeDescriptions
UnsignedLong
Text
NonEmpty SignedCertificate
NonEmpty PublicKeyRepresentationFormat
NonEmpty AuthenticationAlgorithm
NonEmpty AuthenticatorAttachmentHint
NonEmpty MatcherProtectionType
NonEmpty KeyProtectionType
NonEmpty VerificationMethodANDCombinations
NonEmpty WebauthnAttestationType
NonEmpty (ProtocolVersion p)
msAuthenticatorGetInfo :: Maybe AuthenticatorGetInfo
msSupportedExtensions :: Maybe (NonEmpty ExtensionDescriptor)
msIcon :: Maybe ByteString
msAttestationRootCertificates :: NonEmpty SignedCertificate
msTcDisplayPNGCharacteristics :: Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
msTcDisplayContentType :: Maybe Text
msTcDisplay :: [TransactionConfirmationDisplayType]
msAttachmentHint :: NonEmpty AuthenticatorAttachmentHint
msCryptoStrength :: Maybe UnsignedShort
msMatcherProtection :: NonEmpty MatcherProtectionType
msIsFreshUserVerificationRequired :: Maybe Boolean
msIsKeyRestricted :: Maybe Boolean
msKeyProtection :: NonEmpty KeyProtectionType
msUserVerificationDetails :: NonEmpty VerificationMethodANDCombinations
msAttestationTypes :: NonEmpty WebauthnAttestationType
msPublicKeyAlgAndEncodings :: NonEmpty PublicKeyRepresentationFormat
msAuthenticationAlgorithms :: NonEmpty AuthenticationAlgorithm
msUpv :: NonEmpty (ProtocolVersion p)
msAuthenticatorVersion :: UnsignedLong
msAlternativeDescriptions :: Maybe AlternativeDescriptions
msDescription :: Text
msLegalHeader :: Text
msAuthenticatorGetInfo :: Maybe AuthenticatorGetInfo
msSupportedExtensions :: Maybe (NonEmpty ExtensionDescriptor)
msIcon :: Maybe ByteString
msAttestationRootCertificates :: NonEmpty SignedCertificate
msTcDisplayPNGCharacteristics :: Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor)
msTcDisplayContentType :: Maybe Text
msTcDisplay :: [TransactionConfirmationDisplayType]
msAttachmentHint :: NonEmpty AuthenticatorAttachmentHint
msCryptoStrength :: Maybe UnsignedShort
msMatcherProtection :: NonEmpty MatcherProtectionType
msIsFreshUserVerificationRequired :: Maybe Boolean
msIsKeyRestricted :: Maybe Boolean
msKeyProtection :: NonEmpty KeyProtectionType
msUserVerificationDetails :: NonEmpty VerificationMethodANDCombinations
msAttestationTypes :: NonEmpty WebauthnAttestationType
msPublicKeyAlgAndEncodings :: NonEmpty PublicKeyRepresentationFormat
msAuthenticationAlgorithms :: NonEmpty AuthenticationAlgorithm
msUpv :: NonEmpty (ProtocolVersion p)
msAuthenticatorVersion :: UnsignedLong
msAlternativeDescriptions :: Maybe AlternativeDescriptions
msDescription :: Text
msLegalHeader :: Text
..}
where
decodeUpvFidoU2F :: UAF.Version -> Either Text (StatementTypes.ProtocolVersion 'M.FidoU2F)
decodeUpvFidoU2F :: Version -> Either Text (ProtocolVersion 'FidoU2F)
decodeUpvFidoU2F UAF.Version {major :: Version -> UnsignedShort
UAF.major = UnsignedShort
1, minor :: Version -> UnsignedShort
UAF.minor = UnsignedShort
0} = ProtocolVersion 'FidoU2F -> Either Text (ProtocolVersion 'FidoU2F)
forall a b. b -> Either a b
Right ProtocolVersion 'FidoU2F
StatementTypes.U2F1_0
decodeUpvFidoU2F UAF.Version {major :: Version -> UnsignedShort
UAF.major = UnsignedShort
1, minor :: Version -> UnsignedShort
UAF.minor = UnsignedShort
1} = ProtocolVersion 'FidoU2F -> Either Text (ProtocolVersion 'FidoU2F)
forall a b. b -> Either a b
Right ProtocolVersion 'FidoU2F
StatementTypes.U2F1_1
decodeUpvFidoU2F UAF.Version {major :: Version -> UnsignedShort
UAF.major = UnsignedShort
1, minor :: Version -> UnsignedShort
UAF.minor = UnsignedShort
2} = ProtocolVersion 'FidoU2F -> Either Text (ProtocolVersion 'FidoU2F)
forall a b. b -> Either a b
Right ProtocolVersion 'FidoU2F
StatementTypes.U2F1_2
decodeUpvFidoU2F Version
version = Text -> Either Text (ProtocolVersion 'FidoU2F)
forall a b. a -> Either a b
Left (Text -> Either Text (ProtocolVersion 'FidoU2F))
-> Text -> Either Text (ProtocolVersion 'FidoU2F)
forall a b. (a -> b) -> a -> b
$ Text
"Unknown FIDO U2F UPV version: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Version -> String
forall a. Show a => a -> String
show Version
version)
decodeUpvFido2 :: UAF.Version -> Either Text (StatementTypes.ProtocolVersion 'M.Fido2)
decodeUpvFido2 :: Version -> Either Text (ProtocolVersion 'Fido2)
decodeUpvFido2 UAF.Version {major :: Version -> UnsignedShort
UAF.major = UnsignedShort
1, minor :: Version -> UnsignedShort
UAF.minor = UnsignedShort
0} = ProtocolVersion 'Fido2 -> Either Text (ProtocolVersion 'Fido2)
forall a b. b -> Either a b
Right ProtocolVersion 'Fido2
StatementTypes.CTAP2_0
decodeUpvFido2 UAF.Version {major :: Version -> UnsignedShort
UAF.major = UnsignedShort
1, minor :: Version -> UnsignedShort
UAF.minor = UnsignedShort
1} = ProtocolVersion 'Fido2 -> Either Text (ProtocolVersion 'Fido2)
forall a b. b -> Either a b
Right ProtocolVersion 'Fido2
StatementTypes.CTAP2_1
decodeUpvFido2 Version
version = Text -> Either Text (ProtocolVersion 'Fido2)
forall a b. a -> Either a b
Left (Text -> Either Text (ProtocolVersion 'Fido2))
-> Text -> Either Text (ProtocolVersion 'Fido2)
forall a b. (a -> b) -> a -> b
$ Text
"Unknown FIDO2 UPV version: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Version -> String
forall a. Show a => a -> String
show Version
version)
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
decodeIcon :: IDL.DOMString -> Either Text BS.ByteString
decodeIcon :: Text -> Either Text ByteString
decodeIcon Text
dataUrl = case Text -> Text -> Maybe Text
Text.stripPrefix Text
"data:image/png;base64," Text
dataUrl of
Maybe Text
Nothing -> Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
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 ->
ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right (ByteString -> Either Text ByteString)
-> ByteString -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base64.decodeLenient (Text -> ByteString
encodeUtf8 Text
suffix)