diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,38 @@ +### 0.4.0.0 + +* [#129](https://github.com/tweag/webauthn/pull/129) Rename and expand + documentation for authentication/registration errors. +* [#136](https://github.com/tweag/webauthn/pull/136) Improve the safety and + remove duplication of the public key interface. More checks are being done + now, preventing invalid public keys from being constructed. +* [#140](https://github.com/tweag/webauthn/pull/140) Introduction of new + serialization-related modules, all reexported via `Crypto.WebAuthn`: + - `Crypto.WebAuthn.Model.Defaults` for defaults of optional fields + - `Crypto.WebAuthn.Encoding.Strings` for string serializations of enumerations + - `Crypto.WebAuthn.Encoding.Binary` for binary serializations +* [#140](https://github.com/tweag/webauthn/pull/140) Backwards-incompatible + changes/fixes regarding serialization: + - Fix unknown `AuthenticatorTransport` values being ignored. This breaks + backwards compatibility when the received `AuthenticatorTransport`s are + inspected and stored in the database. Users are encouraged to serialize + individual `AuthenticatorTransport`s to strings using the new + `encodeAuthenticatorTransport`. The [example + server](https://github.com/tweag/webauthn/tree/master/server) has been + updated to store all encoded `AuthenticatorTransport`s as a CBOR-encoded + bytestring in the database, but other schemes to store multiple transports + can also be employed. + - Rename webauthn-json decoding/encoding functions to have a "wj" prefix like + `wjEncodeCredentialOptionsRegistration`. The types they interact with have + changed their prefix from `IDL` to `WJ` as well + - Introduce `wjDecodeCredentialRegistration'` (with a tick) to take a + `SupportedAttestationStatementFormats` argument, while the unticked version + doesn't take such an argument anymore. In the future only the unticked + version is expected to stay backwards-compatible. + - `ccdCrossOrigin`s type was corrected from `Bool` to `Maybe Bool`, where + `Nothing` has the same semantics as `Just False`. This is necessary for + compatibility with WebAuthn Level 1 clients, which don't set this field + + ### 0.3.0.0 * [#125](https://github.com/tweag/webauthn/pull/125) Some small metadata type diff --git a/src/Crypto/WebAuthn.hs b/src/Crypto/WebAuthn.hs --- a/src/Crypto/WebAuthn.hs +++ b/src/Crypto/WebAuthn.hs @@ -100,18 +100,24 @@ -- | A set of types representing credential options ('CredentialOptions') -- and their resulting credentials responses ('Credential'), used in -- [step 2](#step-2) and [step 4](#step-4#) respectively. - -- - -- Also includes a set of functions for indirectly encoding credential - -- options to JSON ('encodeCredentialOptionsRegistration', - -- 'encodeCredentialOptionsAuthentication') and indirectly decoding - -- credential responses from JSON ('decodeCredentialRegistration', - -- 'decodeCredentialAuthentication'), using the same encoding as - -- [webauthn-json](https://github.com/github/webauthn-json) which can be - -- used on the JavaScript side. This is needed to construct the response - -- for [step 2](#step-2) and to deconstruct the request in - -- [step 4](#step-4) respectively. module Crypto.WebAuthn.Model, + -- * WebAuthn Encoding + + -- | Includes everything needed to encode\/decode WebAuthn types between + -- serializations and Haskell types defined in "Crypto.WebAuthn.Model". + -- Most notably this includes encoding and decoding functions for messages + -- exchanged with the + -- [webauthn-json](https://github.com/github/webauthn-json) JavaScript + -- library: Encoding 'CredentialOptions' to intermediate JSON-serializable + -- types using 'wjEncodeCredentialOptionsRegistration' and + -- 'wjEncodeCredentialOptionsAuthentication', which can be used for [step + -- 2](#step-2). Also decoding 'Credential's from intermediate + -- JSON-deserializable types using 'wjDecodeCredentialRegistration' and + -- 'wjDecodeCredentialAuthentication', which can be used for [step + -- 4](#step-4). + module Crypto.WebAuthn.Encoding, + -- * Attestation Statement Formats -- | In case of a [registration ceremony](https://www.w3.org/TR/webauthn-2/#registration), @@ -122,8 +128,9 @@ -- -- This module contains the 'allSupportedFormats' value, which contains -- implementations of all standard attestation statement formats supported - -- by this library. It can be passed to the 'decodeCredentialRegistration' - -- to enable all these formats. + -- by this library. It can be manually passed to the + -- 'wjDecodeCredentialRegistration'' to enable only specific formats or add + -- support for additional ones. module Crypto.WebAuthn.AttestationStatementFormat, -- * Operations @@ -159,6 +166,7 @@ where import Crypto.WebAuthn.AttestationStatementFormat +import Crypto.WebAuthn.Encoding import Crypto.WebAuthn.Metadata import Crypto.WebAuthn.Model import Crypto.WebAuthn.Operation diff --git a/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidKey.hs b/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidKey.hs --- a/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidKey.hs +++ b/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidKey.hs @@ -18,8 +18,10 @@ import Control.Exception (Exception) import Control.Monad (forM, unless, void, when) import Crypto.Hash (Digest, SHA256, digestFromByteString) -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose +import qualified Crypto.WebAuthn.Cose.PublicKey as Cose +import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose import Crypto.WebAuthn.Internal.Utils (failure) import qualified Crypto.WebAuthn.Model.Types as M import Data.ASN1.Parse (ParseASN1, getNext, getNextContainerMaybe, hasNext, onNextContainer, onNextContainerMaybe, runParseASN1) @@ -155,10 +157,11 @@ data Statement = Statement { sig :: ByteString, x5c :: NonEmpty X509.SignedCertificate, - alg :: Cose.CoseSignAlg, - -- | Holds the parsed attestation extension of the above X509 certificate - -- Not part of the spec, but prevents parsing in the AndroidKey.verify function - pubKey :: Cose.PublicKey, + -- | Holds both the "alg" from the statement and the public key from the + -- X.509 certificate + pubKeyAndAlg :: Cose.PublicKeyWithSignAlg, + -- | Holds the parsed attestation extension of the above X509 certificate, + -- prevents having to parse it in the AndroidKey.verify function attExt :: ExtAttestation } deriving (Eq, Show) @@ -166,7 +169,7 @@ instance ToJSON Statement where toJSON Statement {..} = object - [ "alg" .= alg, + [ "alg" .= Cose.signAlg pubKeyAndAlg, "sig" .= sig, "x5c" .= x5c ] @@ -250,13 +253,15 @@ pubKey <- Cose.fromX509 $ X509.certPubKey cert + pubKeyAndAlg <- Cose.makePublicKeyWithSignAlg pubKey alg + pure Statement {..} _ -> Left $ "CBOR map didn't have expected value types (alg: int, sig: bytes, x5c: nonempty list): " <> Text.pack (show xs) asfEncode _ Statement {..} = CBOR.TMap [ (CBOR.TString "sig", CBOR.TBytes sig), - (CBOR.TString "alg", CBOR.TInt $ Cose.fromCoseSignAlg alg), + (CBOR.TString "alg", CBOR.TInt $ Cose.fromCoseSignAlg $ Cose.signAlg pubKeyAndAlg), ( CBOR.TString "x5c", CBOR.TList $ map (CBOR.TBytes . X509.encodeSignedObject) $ toList x5c @@ -273,13 +278,14 @@ -- 2. Verify that sig is a valid signature over the concatenation of authenticatorData and clientDataHash using the -- public key in the first certificate in x5c with the algorithm specified in alg. let signedData = rawData <> convert (M.unClientDataHash clientDataHash) - case Cose.verify alg pubKey signedData sig of + case Cose.verify pubKeyAndAlg signedData sig of Right () -> pure () Left err -> failure $ VerificationFailure err -- 3. Verify that the public key in the first certificate in x5c matches the credentialPublicKey in the -- attestedCredentialData in authenticatorData. - let credentialPublicKey = Cose.fromCose (M.acdCredentialPublicKey adAttestedCredentialData) + let credentialPublicKey = Cose.publicKey (M.acdCredentialPublicKey adAttestedCredentialData) + pubKey = Cose.publicKey pubKeyAndAlg unless (credentialPublicKey == pubKey) . failure $ PublicKeyMismatch credentialPublicKey pubKey -- 4. Verify that the attestationChallenge field in the attestation certificate extension data is identical to diff --git a/src/Crypto/WebAuthn/AttestationStatementFormat/Apple.hs b/src/Crypto/WebAuthn/AttestationStatementFormat/Apple.hs --- a/src/Crypto/WebAuthn/AttestationStatementFormat/Apple.hs +++ b/src/Crypto/WebAuthn/AttestationStatementFormat/Apple.hs @@ -22,6 +22,8 @@ import Control.Monad.Cont (unless) import Crypto.Hash (Digest, SHA256, digestFromByteString, hash) import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose +import qualified Crypto.WebAuthn.Cose.PublicKey as Cose +import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose import Crypto.WebAuthn.Internal.Utils (failure) import qualified Crypto.WebAuthn.Model.Types as M import qualified Data.ASN1.Parse as ASN1 @@ -161,7 +163,7 @@ -- 5. Verify that the credential public key equals the Subject Public Key -- of credCert. - let credentialPublicKey = Cose.fromCose $ M.acdCredentialPublicKey credData + let credentialPublicKey = Cose.publicKey $ M.acdCredentialPublicKey credData unless (credentialPublicKey == pubKey) . failure $ PublicKeyMismatch credentialPublicKey pubKey -- 6. If successful, return implementation-specific values representing diff --git a/src/Crypto/WebAuthn/AttestationStatementFormat/FidoU2F.hs b/src/Crypto/WebAuthn/AttestationStatementFormat/FidoU2F.hs --- a/src/Crypto/WebAuthn/AttestationStatementFormat/FidoU2F.hs +++ b/src/Crypto/WebAuthn/AttestationStatementFormat/FidoU2F.hs @@ -12,17 +12,19 @@ ) where +import qualified Codec.CBOR.Read as CBOR import qualified Codec.CBOR.Term as CBOR import Control.Exception (Exception) import Control.Monad (unless) import Crypto.PubKey.ECC.Types (CurveName (SEC_p256r1)) -import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose +import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose import Crypto.WebAuthn.Internal.Utils (failure) import qualified Crypto.WebAuthn.Model.Types as M import Data.Aeson (ToJSON, object, toJSON, (.=)) import Data.Bifunctor (first) import qualified Data.ByteArray as BA import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS import Data.HashMap.Strict ((!?)) import qualified Data.Text as Text import qualified Data.X509 as X509 @@ -40,9 +42,9 @@ data VerificationError = -- | The public key in the certificate was not an EC Key or the curve was not the p256 curve CertificatePublicKeyInvalid X509.PubKey - | -- | The credential public key is not an ECDSA key - CredentialPublicKeyNotECDSA Cose.PublicKey - | -- | The x and/or y coordinates of the credential public key don't have a length of 32 bytes + | -- | The COSE encoding of the credential public key does not have key type EC2 + CredentialPublicKeyNotCoseEC2 Cose.CosePublicKey + | -- | The x and/or y coordinates of the credential public key are longer than 32 bytes CoordinateSizeInvalid { -- | Actual length in bytes of the x coordinate xLength :: Int, @@ -129,12 +131,12 @@ -- If size differs or "-3" key is not found, terminate this algorithm and -- return an appropriate error. -- NOTE: Already done during decoding of the COSE public key - case Cose.fromCose acdCredentialPublicKey of - Cose.PublicKeyECDSA {ecdsaX = xb, ecdsaY = yb} -> do - let xlen = BS.length xb - ylen = BS.length yb - unless (xlen == 32 && ylen == 32) $ failure $ CoordinateSizeInvalid xlen ylen - + case extractPublicKey . M.unRaw $ acdCredentialPublicKeyBytes of + Nothing -> failure $ CredentialPublicKeyNotCoseEC2 acdCredentialPublicKey + Just (xb, yb) -> do + -- We decode the x and y values in an earlier stage of the process. In order to construct the publicKeyU2F, we have to reencode the value. + unless (BS.length xb == 32 && BS.length yb == 32) $ + failure $ CoordinateSizeInvalid (BS.length xb) (BS.length yb) -- 4.c Let publicKeyU2F be the concatenation 0x04 || x || y. let publicKeyU2F = BS.singleton 0x04 <> xb <> yb @@ -155,7 +157,6 @@ X509.SignaturePass -> pure () X509.SignatureFailed e -> failure $ SignatureInvalid e pure () - key -> failure $ CredentialPublicKeyNotECDSA key -- 7. Optionally, inspect x5c and consult externally provided knowledge to -- determine whether attStmt conveys a Basic or AttCA attestation. @@ -172,3 +173,21 @@ -- SomeAttestationStatementFormat type. format :: M.SomeAttestationStatementFormat format = M.SomeAttestationStatementFormat Format + +-- [(spec)](https://www.iana.org/assignments/cose/cose.xhtml) +-- This function assumes the provided key is an ECC key, which is a valid +-- assumption as we have already verified that in step 2.b +-- Any non ECC key would result in another error here, which is fine. +extractPublicKey :: BS.ByteString -> Maybe (BS.ByteString, BS.ByteString) +extractPublicKey keyBS = do + (rest, result) <- either (const Nothing) pure $ CBOR.deserialiseFromBytes CBOR.decodeTerm $ LBS.fromStrict keyBS + unless (LBS.null rest) Nothing + pairs <- case result of + CBOR.TMap pairs -> return pairs + _ -> Nothing + let xKey = -2 + let yKey = -3 + case (CBOR.TInt xKey `lookup` pairs, CBOR.TInt yKey `lookup` pairs) of + (Just (CBOR.TBytes x), Just (CBOR.TBytes y)) -> do + pure (x, y) + _ -> Nothing diff --git a/src/Crypto/WebAuthn/AttestationStatementFormat/Packed.hs b/src/Crypto/WebAuthn/AttestationStatementFormat/Packed.hs --- a/src/Crypto/WebAuthn/AttestationStatementFormat/Packed.hs +++ b/src/Crypto/WebAuthn/AttestationStatementFormat/Packed.hs @@ -15,9 +15,9 @@ import qualified Codec.CBOR.Term as CBOR import Control.Exception (Exception) import Control.Monad (forM, unless, when) -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose -import qualified Crypto.WebAuthn.Cose.Key as Cose +import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose import Crypto.WebAuthn.Internal.Utils (IdFidoGenCeAAGUID (IdFidoGenCeAAGUID), failure) import Crypto.WebAuthn.Model (AAGUID) import qualified Crypto.WebAuthn.Model.Types as M @@ -141,12 +141,12 @@ Nothing -> do -- Validate that alg matches the algorithm of the credentialPublicKey in authenticatorData. let key = M.acdCredentialPublicKey credData - signAlg = Cose.keySignAlg key + signAlg = Cose.signAlg key when (stmtAlg /= signAlg) . failure $ AlgorithmMismatch stmtAlg signAlg -- Verify that sig is a valid signature over the concatenation of -- authenticatorData and clientDataHash using the credential public key with alg. - case Cose.verify signAlg (Cose.fromCose key) signedData stmtSig of + case Cose.verify key signedData stmtSig of Right () -> pure () Left err -> failure $ InvalidSignature err diff --git a/src/Crypto/WebAuthn/AttestationStatementFormat/TPM.hs b/src/Crypto/WebAuthn/AttestationStatementFormat/TPM.hs --- a/src/Crypto/WebAuthn/AttestationStatementFormat/TPM.hs +++ b/src/Crypto/WebAuthn/AttestationStatementFormat/TPM.hs @@ -22,9 +22,10 @@ import Crypto.Hash (SHA1 (SHA1), SHA256 (SHA256), hashWith) import qualified Crypto.Hash as Hash import Crypto.Number.Serialize (os2ip) -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose -import qualified Crypto.WebAuthn.Cose.Key as Cose +import qualified Crypto.WebAuthn.Cose.PublicKey as Cose +import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose import Crypto.WebAuthn.Internal.Utils (IdFidoGenCeAAGUID (IdFidoGenCeAAGUID), failure) import Crypto.WebAuthn.Model.Identifier (AAGUID) import qualified Crypto.WebAuthn.Model.Types as M @@ -205,9 +206,10 @@ -- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-tpm-attestation) data Statement = Statement - { alg :: Cose.CoseSignAlg, - x5c :: NE.NonEmpty X509.SignedCertificate, - aikCert :: X509.SignedCertificate, + { x5c :: NE.NonEmpty X509.SignedCertificate, + aikCert :: X509.Certificate, + -- Combined aikCert public key and the "alg" statement key + aikPubKeyAndAlg :: Cose.PublicKeyWithSignAlg, subjectAlternativeName :: SubjectAlternativeName, aaguidExt :: Maybe IdFidoGenCeAAGUID, extendedKeyUsage :: [X509.ExtKeyUsagePurpose], @@ -225,7 +227,7 @@ toJSON Statement {..} = object [ "ver" .= String "2.0", - "alg" .= alg, + "alg" .= Cose.signAlg aikPubKeyAndAlg, "x5c" .= x5c, "sig" .= sig, "certInfo" .= certInfo, @@ -357,7 +359,7 @@ case (xs !? "ver", xs !? "alg", xs !? "x5c", xs !? "sig", xs !? "certInfo", xs !? "pubArea") of (Just (CBOR.TString "2.0"), Just (CBOR.TInt algId), Just (CBOR.TList (NE.nonEmpty -> Just x5cRaw)), Just (CBOR.TBytes sig), Just (CBOR.TBytes certInfoRaw), Just (CBOR.TBytes pubAreaRaw)) -> do - x5c@(aikCert :| _) <- forM x5cRaw $ \case + x5c@(signedAikCert :| _) <- forM x5cRaw $ \case CBOR.TBytes certBytes -> first (("Failed to decode signed certificate: " <>) . Text.pack) (X509.decodeSignedCertificate certBytes) cert -> @@ -374,21 +376,24 @@ Right (_, _, res) -> pure res pubAreaKey <- extractPublicKey pubArea - let cert = X509.getCertificate aikCert + let aikCert = X509.getCertificate signedAikCert - subjectAlternativeName <- case X509.extensionGetE (X509.certExtensions cert) of + aikCertPubKey <- Cose.fromX509 $ X509.certPubKey aikCert + aikPubKeyAndAlg <- Cose.makePublicKeyWithSignAlg aikCertPubKey alg + + subjectAlternativeName <- case X509.extensionGetE (X509.certExtensions aikCert) of Just (Right ext) -> pure ext Just (Left err) -> Left $ "Failed to decode certificate subject alternative name extension: " <> Text.pack err Nothing -> Left "Certificate subject alternative name extension is missing" - aaguidExt <- case X509.extensionGetE (X509.certExtensions cert) of + aaguidExt <- case X509.extensionGetE (X509.certExtensions aikCert) of Just (Right ext) -> pure $ Just ext Just (Left err) -> Left $ "Failed to decode certificate aaguid extension: " <> Text.pack err Nothing -> pure Nothing - X509.ExtExtendedKeyUsage extendedKeyUsage <- case X509.extensionGetE (X509.certExtensions cert) of + X509.ExtExtendedKeyUsage extendedKeyUsage <- case X509.extensionGetE (X509.certExtensions aikCert) of Just (Right ext) -> pure ext Just (Left err) -> Left $ "Failed to decode certificate extended key usage extension: " <> Text.pack err Nothing -> Left "Certificate extended key usage extension is missing" - X509.ExtBasicConstraints basicConstraintsCA _ <- case X509.extensionGetE (X509.certExtensions cert) of + X509.ExtBasicConstraints basicConstraintsCA _ <- case X509.extensionGetE (X509.certExtensions aikCert) of Just (Right ext) -> pure ext Just (Left err) -> Left $ "Failed to decode certificate basic constraints extension: " <> Text.pack err Nothing -> Left "Certificate basic constraints extension is missing" @@ -476,7 +481,7 @@ tpmtpParameters = TPMSRSAParms {..}, tpmtpUnique = TPM2BPublicKeyRSA nb } = - pure + Cose.checkPublicKey Cose.PublicKeyRSA { rsaN = os2ip nb, rsaE = toInteger tpmsrpExponent @@ -487,18 +492,18 @@ tpmtpParameters = TPMSECCParms {..}, tpmtpUnique = TPMSECCPoint {..} } = - pure + Cose.checkPublicKey Cose.PublicKeyECDSA { ecdsaCurve = tpmsepCurveId, - ecdsaX = tpmseX, - ecdsaY = tpmseY + ecdsaX = os2ip tpmseX, + ecdsaY = os2ip tpmseY } extractPublicKey key = Left $ "Unsupported TPM public key: " <> Text.pack (show key) asfEncode _ Statement {..} = CBOR.TMap [ (CBOR.TString "ver", CBOR.TString "2.0"), - (CBOR.TString "alg", CBOR.TInt $ Cose.fromCoseSignAlg alg), + (CBOR.TString "alg", CBOR.TInt $ Cose.fromCoseSignAlg $ Cose.signAlg aikPubKeyAndAlg), ( CBOR.TString "x5c", CBOR.TList $ map (CBOR.TBytes . X509.encodeSignedObject) $ NE.toList x5c ), @@ -522,7 +527,7 @@ -- 2. Verify that the public key specified by the parameters and unique -- fields of pubArea is identical to the credentialPublicKey in the -- attestedCredentialData in authenticatorData. - let pubKey = Cose.fromCose $ M.acdCredentialPublicKey adAttestedCredentialData + let pubKey = Cose.publicKey $ M.acdCredentialPublicKey adAttestedCredentialData unless (pubAreaKey == pubKey) . failure $ PublicKeyMismatch pubAreaKey pubKey -- 3. Concatenate authenticatorData and clientDataHash to form attToBeSigned. @@ -539,7 +544,7 @@ -- 4.3 Verify that extraData is set to the hash of attToBeSigned using -- the hash algorithm employed in "alg". - case hashWithCorrectAlgorithm alg attToBeSigned of + case hashWithCorrectAlgorithm (Cose.signAlg aikPubKeyAndAlg) attToBeSigned of Just attHash -> do let extraData = tpmsaExtraData certInfo unless (attHash == extraData) . failure $ HashMismatch attHash extraData @@ -580,22 +585,19 @@ -- 4.8 Verify the sig is a valid signature over certInfo using the -- attestation public key in aikCert with the algorithm specified in alg. - let unsignedAikCert = X509.getCertificate aikCert - case Cose.fromX509 $ X509.certPubKey unsignedAikCert of - Right certPubKey -> case Cose.verify alg certPubKey certInfoRaw sig of - Right () -> pure () - Left err -> failure $ VerificationFailure err - Left err -> failure $ PublicKeyInvalid err + case Cose.verify aikPubKeyAndAlg certInfoRaw sig of + Right () -> pure () + Left err -> failure $ VerificationFailure err -- 4.9 Verify that aikCert meets the requirements in § 8.3.1 TPM Attestation -- Statement Certificate Requirements. -- 4.9.1 Version MUST be set to 3. -- Version ::= INTEGER { v1(0), v2(1), v3(2) }, see https://datatracker.ietf.org/doc/html/rfc5280.html#section-4.1 - let version = X509.certVersion unsignedAikCert + let version = X509.certVersion aikCert unless (version == 2) . failure $ CertificateVersionInvalid version -- 4.9.2. Subject field MUST be set to empty. - let subject = X509.getDistinguishedElements $ X509.certSubjectDN unsignedAikCert + let subject = X509.getDistinguishedElements $ X509.certSubjectDN aikCert unless (null subject) . failure $ SubjectFieldNotEmpty subject -- 4.9.3 The Subject Alternative Name extension MUST be set as defined in -- [TPMv2-EK-Profile] section 3.2.9. diff --git a/src/Crypto/WebAuthn/Cose/Algorithm.hs b/src/Crypto/WebAuthn/Cose/Algorithm.hs deleted file mode 100644 --- a/src/Crypto/WebAuthn/Cose/Algorithm.hs +++ /dev/null @@ -1,240 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} - --- | Stability: experimental --- This module contains definitions for [COSE registry](https://www.iana.org/assignments/cose/cose.xhtml) --- entries that are relevant for Webauthn COSE public keys. All the types in --- this module implement the 'Serialise' class, mapping them to the respective --- CBOR values/labels. --- --- This modules sometimes uses this --- [CBOR Grammar](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-13#section-1.4) --- to describe CBOR value types corresponding to CBOR parameters -module Crypto.WebAuthn.Cose.Algorithm - ( -- * COSE Algorithms - CoseSignAlg - ( .., - CoseAlgorithmEdDSA, - CoseAlgorithmES256, - CoseAlgorithmES384, - CoseAlgorithmES512, - CoseAlgorithmRS256, - CoseAlgorithmRS384, - CoseAlgorithmRS512, - CoseAlgorithmRS1 - ), - fromCoseSignAlg, - toCoseSignAlg, - - -- * Hash Algorithms - CoseHashAlgECDSA (..), - CoseHashAlgRSA (..), - ) -where - -import Codec.CBOR.Decoding (decodeIntCanonical) -import Codec.CBOR.Encoding (encodeInt) -import Codec.Serialise (Serialise) -import Codec.Serialise.Class (decode, encode) -import Data.Aeson (ToJSON) -import Data.Text (Text) -import qualified Data.Text as Text -import GHC.Generics (Generic) - --- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- All the entries from the [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- limited to the ones that are currently needed for Webauthn. Notably we only --- care about asymmetric signature algorithms -data CoseSignAlg - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2) - -- EdDSA - -- - -- [RFC8032](https://datatracker.ietf.org/doc/html/rfc8032) describes the elliptic curve signature scheme Edwards-curve - -- Digital Signature Algorithm (EdDSA). In that document, the signature - -- algorithm is instantiated using parameters for edwards25519 and - -- edwards448 curves. The document additionally describes two variants - -- of the EdDSA algorithm: Pure EdDSA, where no hash function is applied - -- to the content before signing, and HashEdDSA, where a hash function - -- is applied to the content before signing and the result of that hash - -- function is signed. For EdDSA, the content to be signed (either the - -- message or the pre-hash value) is processed twice inside of the - -- signature algorithm. For use with COSE, only the pure EdDSA version - -- is used. - -- - -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2.1) - CoseSignAlgEdDSA - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) - -- ECDSA - -- - -- ECDSA [DSS] defines a signature algorithm using ECC. Implementations - -- SHOULD use a deterministic version of ECDSA such as the one defined - -- in [RFC6979]. - -- - -- The ECDSA signature algorithm is parameterized with a hash function - -- (h). In the event that the length of the hash function output is - -- greater than the group of the key, the leftmost bytes of the hash - -- output are used. - -- ECDSA w/ SHA-256 - -- - -- This document defines ECDSA to work only with the curves P-256, - -- P-384, and P-521. Future documents may define it to work with other - -- curves and points in the future. - -- - -- In order to promote interoperability, it is suggested that SHA-256 be - -- used only with curve P-256, SHA-384 be used only with curve P-384, - -- and SHA-512 be used with curve P-521. This is aligned with the - -- recommendation in [Section 4 of RFC5480](https://datatracker.ietf.org/doc/html/rfc5480#section-4) - -- - -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1.1) - CoseSignAlgECDSA CoseHashAlgECDSA - | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) - -- The RSASSA-PKCS1-v1_5 signature algorithm is defined in - -- [RFC8017](https://www.rfc-editor.org/rfc/rfc8812.html#RFC8017). - -- The RSASSA-PKCS1-v1_5 signature algorithm is parameterized with a hash function (h). - -- - -- A key of size 2048 bits or larger MUST be used with these algorithms. - -- - -- Security considerations are [here](https://www.rfc-editor.org/rfc/rfc8812.html#section-5) - CoseSignAlgRSA CoseHashAlgRSA - deriving (Eq, Show, Ord, Generic, ToJSON) - --- | Hash algorithms that can be used with the ECDSA signature algorithm -data CoseHashAlgECDSA - = -- | SHA-256 - CoseHashAlgECDSASHA256 - | -- | SHA-384 - CoseHashAlgECDSASHA384 - | -- | SHA-512 - CoseHashAlgECDSASHA512 - deriving (Eq, Show, Ord, Enum, Bounded, Generic, ToJSON) - --- | Hash algorithms that can be used with the RSA signature algorithm -data CoseHashAlgRSA - = -- | SHA-1 (deprecated) - CoseHashAlgRSASHA1 - | -- | SHA-256 - CoseHashAlgRSASHA256 - | -- | SHA-384 - CoseHashAlgRSASHA384 - | -- | SHA-512 - CoseHashAlgRSASHA512 - deriving (Eq, Show, Ord, Enum, Bounded, Generic, ToJSON) - --- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @EdDSA@. Alias for 'CoseSignAlgEdDSA' --- --- * Name: EdDSA --- * Description: EdDSA --- * Recommended: Yes -pattern CoseAlgorithmEdDSA :: CoseSignAlg -pattern CoseAlgorithmEdDSA = CoseSignAlgEdDSA - --- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @ES256@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA256'@ --- --- * Name: ES256 --- * Description: ECDSA w/ SHA-256 --- * Recommended: Yes -pattern CoseAlgorithmES256 :: CoseSignAlg -pattern CoseAlgorithmES256 = CoseSignAlgECDSA CoseHashAlgECDSASHA256 - --- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @ES384@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA384'@ --- --- * Name: ES384 --- * Description: ECDSA w/ SHA-384 --- * Recommended: Yes -pattern CoseAlgorithmES384 :: CoseSignAlg -pattern CoseAlgorithmES384 = CoseSignAlgECDSA CoseHashAlgECDSASHA384 - --- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @ES512@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA512'@ --- --- * Name: ES512 --- * Description: ECDSA w/ SHA-512 --- * Recommended: Yes -pattern CoseAlgorithmES512 :: CoseSignAlg -pattern CoseAlgorithmES512 = CoseSignAlgECDSA CoseHashAlgECDSASHA512 - --- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @RS256@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA256'@ --- --- * Name: RS256 --- * Description: RSASSA-PKCS1-v1_5 using SHA-256 --- * Recommended: No -pattern CoseAlgorithmRS256 :: CoseSignAlg -pattern CoseAlgorithmRS256 = CoseSignAlgRSA CoseHashAlgRSASHA256 - --- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @RS384@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA384'@ --- --- * Name: RS384 --- * Description: RSASSA-PKCS1-v1_5 using SHA-384 --- * Recommended: No -pattern CoseAlgorithmRS384 :: CoseSignAlg -pattern CoseAlgorithmRS384 = CoseSignAlgRSA CoseHashAlgRSASHA384 - --- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @RS512@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA512'@ --- --- * Name: RS512 --- * Description: RSASSA-PKCS1-v1_5 using SHA-512 --- * Recommended: No -pattern CoseAlgorithmRS512 :: CoseSignAlg -pattern CoseAlgorithmRS512 = CoseSignAlgRSA CoseHashAlgRSASHA512 - --- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @RS1@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA1'@ --- --- * Name: RS1 --- * Description: RSASSA-PKCS1-v1_5 using SHA-1 --- * Recommended: Deprecated -pattern CoseAlgorithmRS1 :: CoseSignAlg -pattern CoseAlgorithmRS1 = CoseSignAlgRSA CoseHashAlgRSASHA1 - --- | Serialises COSE Algorithms using the @Value@ column from the --- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms). --- This uses the 'fromCoseSignAlg' and 'toCoseSignAlg' functions to do the --- encoding and decoding respectively. -instance Serialise CoseSignAlg where - encode = encodeInt . fromCoseSignAlg - decode = do - int <- decodeIntCanonical - case toCoseSignAlg int of - Right res -> pure res - Left err -> fail $ Text.unpack err - --- | Converts a 'CoseSignAlg' to the corresponding integer value from the --- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms). --- The inverse operation is 'toCoseSignAlg' -fromCoseSignAlg :: Num p => CoseSignAlg -> p -fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA1) = -65535 -fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA512) = -259 -fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA384) = -258 -fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA256) = -257 -fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA512) = -36 -fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA384) = -35 -fromCoseSignAlg CoseSignAlgEdDSA = -8 -fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA256) = -7 - --- | Converts an integer value to the corresponding 'CoseSignAlg' from the --- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms). --- Returns an error if the integer doesn't represent a known algorithm. --- The inverse operation is 'fromCoseSignAlg' -toCoseSignAlg :: (Eq a, Num a, Show a) => a -> Either Text CoseSignAlg -toCoseSignAlg (-65535) = pure (CoseSignAlgRSA CoseHashAlgRSASHA1) -toCoseSignAlg (-259) = pure (CoseSignAlgRSA CoseHashAlgRSASHA512) -toCoseSignAlg (-258) = pure (CoseSignAlgRSA CoseHashAlgRSASHA384) -toCoseSignAlg (-257) = pure (CoseSignAlgRSA CoseHashAlgRSASHA256) -toCoseSignAlg (-36) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA512) -toCoseSignAlg (-35) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA384) -toCoseSignAlg (-8) = pure CoseSignAlgEdDSA -toCoseSignAlg (-7) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA256) -toCoseSignAlg value = Left $ "Unknown COSE algorithm value " <> Text.pack (show value) diff --git a/src/Crypto/WebAuthn/Cose/Internal/Verify.hs b/src/Crypto/WebAuthn/Cose/Internal/Verify.hs --- a/src/Crypto/WebAuthn/Cose/Internal/Verify.hs +++ b/src/Crypto/WebAuthn/Cose/Internal/Verify.hs @@ -11,19 +11,17 @@ -- * 'Cose.CosePublicKey', which is a combination of a 'Cose.CoseSignAlg' along with -- a public key that can be used with it. This is what the COSE_Key -- CBOR structure decodes to --- * 'PublicKey', only the public key part of 'Cose.CosePublicKey' +-- * 'Cose.PublicKey', only the public key part of 'Cose.CosePublicKey' -- -- The following main operations are supported for these types: -- -- * 'Cose.CosePublicKey' can be totally decomposed into a 'Cose.CoseSignAlg' --- with 'Cose.keySignAlg' and a 'PublicKey' with 'fromCose' --- * A 'PublicKey' can be created from an X.509 public key with 'fromX509' --- * A 'Cose.CoseSignAlg' and a 'PublicKey' can be used to verify a signature +-- with 'Cose.signAlg' and a 'Cose.PublicKey' with 'Cose.publicKey' +-- * A 'Cose.PublicKey' can be created from an X.509 public key with 'fromX509' +-- * A 'Cose.CoseSignAlg' and a 'Cose.PublicKey' can be used to verify a signature -- with 'verify' module Crypto.WebAuthn.Cose.Internal.Verify ( -- * Public Key - PublicKey (..), - fromCose, fromX509, -- * Signature verification @@ -34,205 +32,147 @@ toCryptHashECDSA, SomeHashAlgorithmASN1 (..), toCryptHashRSA, - - -- * Conversions from/to cryptonite elliptic curves - toCryptCurveECDSA, - fromCryptCurveECDSA, ) where import Crypto.Error (CryptoFailable (CryptoFailed, CryptoPassed)) import qualified Crypto.Hash as Hash -import Crypto.Number.Serialize (i2osp, i2ospOf, os2ip) +import Crypto.Number.Serialize (i2osp) import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.RSA.PKCS15 as RSA -import qualified Crypto.WebAuthn.Cose.Algorithm as A -import qualified Crypto.WebAuthn.Cose.Key as Cose +import qualified Crypto.WebAuthn.Cose.PublicKey as Cose +import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose import Crypto.WebAuthn.Internal.ToJSONOrphans () import qualified Data.ASN1.BinaryEncoding as ASN1 import qualified Data.ASN1.Encoding as ASN1 import qualified Data.ASN1.Types as ASN1 -import Data.Aeson (ToJSON) import Data.ByteArray (convert) import qualified Data.ByteString as BS import Data.Text (Text) import qualified Data.Text as Text import qualified Data.X509 as X509 import qualified Data.X509.EC as X509 -import GHC.Generics (Generic) --- | Same as 'Cose.CosePublicKey', but without signature algorithm parameters, i.e. --- hash algorithms. -data PublicKey - = -- | See 'Cose.CosePublicKeyEdDSA' - PublicKeyEdDSA - { -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) - -- The elliptic curve to use - eddsaCurve :: Cose.CoseCurveEdDSA, - -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) - -- This contains the public key bytes - eddsaX :: BS.ByteString - } - | -- | See 'Cose.CosePublicKeyECDSA' - PublicKeyECDSA - { -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- The elliptic curve to use - ecdsaCurve :: Cose.CoseCurveECDSA, - -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- This contains the x-coordinate for the EC point. The integer is - -- converted to a byte string as defined in [SEC1]. Leading zero - -- octets MUST be preserved. - ecdsaX :: BS.ByteString, - -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- This contains the value of the - -- y-coordinate for the EC point. When encoding the value y, the - -- integer is converted to an byte string (as defined in - -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1)) - -- and encoded as a CBOR bstr. Leading zero octets MUST be - -- preserved. - ecdsaY :: BS.ByteString - } - | -- | See 'Cose.CosePublicKeyRSA' - PublicKeyRSA - { -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) - -- The RSA modulus n is a product of u distinct odd primes - -- r_i, i = 1, 2, ..., u, where u >= 2 - rsaN :: Integer, - -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) - -- The RSA public exponent e is an integer between 3 and n - 1 satisfying - -- GCD(e,\\lambda(n)) = 1, where \\lambda(n) = LCM(r_1 - 1, ..., r_u - 1) - rsaE :: Integer - } - deriving (Eq, Show, Generic, ToJSON) - --- | Turns a 'Cose.CosePublicKey' into a 'PublicKey' by removing the hash functions -fromCose :: Cose.CosePublicKey -> PublicKey -fromCose Cose.CosePublicKeyEdDSA {..} = PublicKeyEdDSA {..} -fromCose Cose.CosePublicKeyECDSA {..} = PublicKeyECDSA {..} -fromCose Cose.CosePublicKeyRSA {..} = PublicKeyRSA {..} - --- | Turns a X.509 certificates 'X509.PubKey' into a 'PublicKey' -fromX509 :: X509.PubKey -> Either Text PublicKey +-- | Turns a X.509 certificates 'X509.PubKey' into a 'Cose.PublicKey' +fromX509 :: X509.PubKey -> Either Text Cose.PublicKey fromX509 (X509.PubKeyEd25519 key) = - Right $ - PublicKeyEdDSA + Cose.checkPublicKey + Cose.PublicKeyEdDSA { eddsaCurve = Cose.CoseCurveEd25519, eddsaX = convert key } fromX509 (X509.PubKeyEC X509.PubKeyEC_Named {..}) = do let curve = ECC.getCurveByName pubkeyEC_name - ecdsaCurve <- fromCryptCurveECDSA pubkeyEC_name + ecdsaCurve <- Cose.fromCryptCurveECDSA pubkeyEC_name point <- case X509.unserializePoint curve pubkeyEC_pub of Nothing -> Left "Failed to unserialize ECDSA point in X509 certificate" Just res -> pure res - -- Round up to a full byte - let byteSize = (ECC.curveSizeBits curve + 7) `div` 8 - case point of - ECC.Point x y -> do - ecdsaX <- case i2ospOf byteSize x of - Nothing -> Left $ "Failed to convert ECDSA x coordinate integer " <> Text.pack (show x) <> " to bytes of size " <> Text.pack (show byteSize) - Just res -> pure res - ecdsaY <- case i2ospOf byteSize y of - Nothing -> Left $ "Failed to convert ECDSA y coordinate integer " <> Text.pack (show y) <> " to bytes of size " <> Text.pack (show byteSize) - Just res -> pure res - Right $ PublicKeyECDSA {..} + unchecked <- case point of + ECC.Point ecdsaX ecdsaY -> Right $ Cose.PublicKeyECDSA {..} ECC.PointO -> Left "The infinity point is not supported" + Cose.checkPublicKey unchecked fromX509 (X509.PubKeyRSA RSA.PublicKey {..}) = - Right - PublicKeyRSA + Cose.checkPublicKey + Cose.PublicKeyRSA { rsaN = public_n, rsaE = public_e } fromX509 key = Left $ "X509 public key algorithm is not supported: " <> Text.pack (show (X509.pubkeyToAlg key)) --- | Verifies an asymmetric signature for a message using a 'Cose.CoseSignAlg' --- and a 'PublicKey'. Returns an error if the signature algorithm doesn't --- match. Also returns an error if the signature wasn't valid or for other --- errors. -verify :: A.CoseSignAlg -> PublicKey -> BS.ByteString -> BS.ByteString -> Either Text () -verify A.CoseSignAlgEdDSA PublicKeyEdDSA {eddsaCurve = Cose.CoseCurveEd25519, ..} msg sig = do - key <- case Ed25519.publicKey eddsaX of - CryptoFailed err -> Left $ "Failed to create Ed25519 public key: " <> Text.pack (show err) - CryptoPassed res -> pure res - sig <- case Ed25519.signature sig of - CryptoFailed err -> Left $ "Failed to create Ed25519 signature: " <> Text.pack (show err) - CryptoPassed res -> pure res - if Ed25519.verify key msg sig - then Right () - else Left "EdDSA Signature invalid" -verify (A.CoseSignAlgECDSA (toCryptHashECDSA -> SomeHashAlgorithm hash)) PublicKeyECDSA {..} msg sig = do - let key = - ECDSA.PublicKey - { public_curve = ECC.getCurveByName $ toCryptCurveECDSA ecdsaCurve, - public_q = ECC.Point (os2ip ecdsaX) (os2ip ecdsaY) - } +-- | Verifies an asymmetric signature for a message using a +-- 'Cose.PublicKeyWithSignAlg' Returns an error if the signature algorithm +-- doesn't match. Also returns an error if the signature wasn't valid or for +-- other errors. +verify :: Cose.PublicKeyWithSignAlg -> BS.ByteString -> BS.ByteString -> Either Text () +verify + Cose.PublicKeyWithSignAlg + { publicKey = Cose.PublicKey Cose.PublicKeyEdDSA {eddsaCurve = Cose.CoseCurveEd25519, ..}, + signAlg = Cose.CoseSignAlgEdDSA + } + msg + sig = do + key <- case Ed25519.publicKey eddsaX of + CryptoFailed err -> Left $ "Failed to create Ed25519 public key: " <> Text.pack (show err) + CryptoPassed res -> pure res + sig <- case Ed25519.signature sig of + CryptoFailed err -> Left $ "Failed to create Ed25519 signature: " <> Text.pack (show err) + CryptoPassed res -> pure res + if Ed25519.verify key msg sig + then Right () + else Left "EdDSA Signature invalid" +verify + Cose.PublicKeyWithSignAlg + { publicKey = Cose.PublicKey Cose.PublicKeyECDSA {..}, + signAlg = Cose.CoseSignAlgECDSA (toCryptHashECDSA -> SomeHashAlgorithm hash) + } + msg + sig = do + let curveName = Cose.toCryptCurveECDSA ecdsaCurve + public_curve = ECC.getCurveByName curveName + public_q = ECC.Point ecdsaX ecdsaY - -- https://www.w3.org/TR/webauthn-2/#sctn-signature-attestation-types - -- > For COSEAlgorithmIdentifier -7 (ES256), and other ECDSA-based algorithms, - -- the `sig` value MUST be encoded as an ASN.1 DER Ecdsa-Sig-Value, as defined - -- in [RFC3279](https://www.w3.org/TR/webauthn-2/#biblio-rfc3279) section 2.2.3. - sig <- case ASN1.decodeASN1' ASN1.DER sig of - Left err -> Left $ "Failed to decode ECDSA DER value: " <> Text.pack (show err) - -- Ecdsa-Sig-Value in https://datatracker.ietf.org/doc/html/rfc3279#section-2.2.3 - Right [ASN1.Start ASN1.Sequence, ASN1.IntVal r, ASN1.IntVal s, ASN1.End ASN1.Sequence] -> - pure $ ECDSA.Signature r s - Right asns -> Left $ "Unexpected ECDSA ASN.1 structure: " <> Text.pack (show asns) + -- This check is already done in checkPublicKey + --unless (ECC.isPointValid public_curve public_q) $ + -- Left $ "ECDSA point is not valid for curve " <> Text.pack (show curveName) <> ": " <> Text.pack (show public_q) + let key = ECDSA.PublicKey {..} - if ECDSA.verify hash key sig msg - then Right () - else Left "ECDSA Signature invalid" -verify (A.CoseSignAlgRSA (toCryptHashRSA -> SomeHashAlgorithmASN1 hash)) PublicKeyRSA {..} msg sig = do - let key = - RSA.PublicKey - { -- https://www.rfc-editor.org/rfc/rfc8017#section-8.2.2 - -- > k is the length in octets of the RSA modulus n - -- - -- > Length checking: If the length of the signature S is not k - -- > octets, output "invalid signature" and stop. - -- This is done by the RSA.verify call - public_size = BS.length (i2osp rsaN), - public_n = rsaN, - public_e = rsaE - } - if RSA.verify (Just hash) key msg sig - then Right () - else Left "RSA Signature invalid" -verify sigAlg pubKey _ _ = - Left $ "Unsupported combination of signature algorithm " <> Text.pack (show sigAlg) <> " and public key " <> Text.pack (show pubKey) + -- https://www.w3.org/TR/webauthn-2/#sctn-signature-attestation-types + -- > For COSEAlgorithmIdentifier -7 (ES256), and other ECDSA-based algorithms, + -- the `sig` value MUST be encoded as an ASN.1 DER Ecdsa-Sig-Value, as defined + -- in [RFC3279](https://www.w3.org/TR/webauthn-2/#biblio-rfc3279) section 2.2.3. + sig <- case ASN1.decodeASN1' ASN1.DER sig of + Left err -> Left $ "Failed to decode ECDSA DER value: " <> Text.pack (show err) + -- Ecdsa-Sig-Value in https://datatracker.ietf.org/doc/html/rfc3279#section-2.2.3 + Right [ASN1.Start ASN1.Sequence, ASN1.IntVal r, ASN1.IntVal s, ASN1.End ASN1.Sequence] -> + pure $ ECDSA.Signature r s + Right asns -> Left $ "Unexpected ECDSA ASN.1 structure: " <> Text.pack (show asns) + if ECDSA.verify hash key sig msg + then Right () + else Left "ECDSA Signature invalid" +verify + Cose.PublicKeyWithSignAlg + { publicKey = Cose.PublicKey Cose.PublicKeyRSA {..}, + signAlg = Cose.CoseSignAlgRSA (toCryptHashRSA -> SomeHashAlgorithmASN1 hash) + } + msg + sig = do + let key = + RSA.PublicKey + { -- https://www.rfc-editor.org/rfc/rfc8017#section-8.2.2 + -- > k is the length in octets of the RSA modulus n + -- + -- > Length checking: If the length of the signature S is not k + -- > octets, output "invalid signature" and stop. + -- This is done by the RSA.verify call + public_size = BS.length (i2osp rsaN), + public_n = rsaN, + public_e = rsaE + } + if RSA.verify (Just hash) key msg sig + then Right () + else Left "RSA Signature invalid" +verify key _ _ = error $ "PublicKeyWithSignAlg invariant violated for public key " <> show key <> ". This should not occur unless the PublicKeyWithSignAlg module has a bug" + -- | Some cryptonite 'Hash.HashAlgorithm' type, used as a return value of 'toCryptHashECDSA' data SomeHashAlgorithm = forall a. Hash.HashAlgorithm a => SomeHashAlgorithm a -- | Returns the cryptonite 'SomeHashAlgorithm' corresponding to this hash algorithm -toCryptHashECDSA :: A.CoseHashAlgECDSA -> SomeHashAlgorithm -toCryptHashECDSA A.CoseHashAlgECDSASHA256 = SomeHashAlgorithm Hash.SHA256 -toCryptHashECDSA A.CoseHashAlgECDSASHA384 = SomeHashAlgorithm Hash.SHA384 -toCryptHashECDSA A.CoseHashAlgECDSASHA512 = SomeHashAlgorithm Hash.SHA512 +toCryptHashECDSA :: Cose.CoseHashAlgECDSA -> SomeHashAlgorithm +toCryptHashECDSA Cose.CoseHashAlgECDSASHA256 = SomeHashAlgorithm Hash.SHA256 +toCryptHashECDSA Cose.CoseHashAlgECDSASHA384 = SomeHashAlgorithm Hash.SHA384 +toCryptHashECDSA Cose.CoseHashAlgECDSASHA512 = SomeHashAlgorithm Hash.SHA512 -- | Some cryptonite 'RSA.HashAlgorithmASN1' type, used as a return value of 'toCryptHashRSA' data SomeHashAlgorithmASN1 = forall a. RSA.HashAlgorithmASN1 a => SomeHashAlgorithmASN1 a -- | Returns the cryptonite 'SomeHashAlgorithmASN1' corresponding to this hash algorithm -toCryptHashRSA :: A.CoseHashAlgRSA -> SomeHashAlgorithmASN1 -toCryptHashRSA A.CoseHashAlgRSASHA1 = SomeHashAlgorithmASN1 Hash.SHA1 -toCryptHashRSA A.CoseHashAlgRSASHA256 = SomeHashAlgorithmASN1 Hash.SHA256 -toCryptHashRSA A.CoseHashAlgRSASHA384 = SomeHashAlgorithmASN1 Hash.SHA384 -toCryptHashRSA A.CoseHashAlgRSASHA512 = SomeHashAlgorithmASN1 Hash.SHA512 - --- | Converts a 'Cose.CoseCurveECDSA' to an 'ECC.CurveName'. The inverse --- function is 'fromCryptCurveECDSA' -toCryptCurveECDSA :: Cose.CoseCurveECDSA -> ECC.CurveName -toCryptCurveECDSA Cose.CoseCurveP256 = ECC.SEC_p256r1 -toCryptCurveECDSA Cose.CoseCurveP384 = ECC.SEC_p384r1 -toCryptCurveECDSA Cose.CoseCurveP521 = ECC.SEC_p521r1 - --- | Tries to converts a 'ECC.CurveName' to an 'Cose.CoseCurveECDSA'. The inverse --- function is 'toCryptCurveECDSA' -fromCryptCurveECDSA :: ECC.CurveName -> Either Text Cose.CoseCurveECDSA -fromCryptCurveECDSA ECC.SEC_p256r1 = Right Cose.CoseCurveP256 -fromCryptCurveECDSA ECC.SEC_p384r1 = Right Cose.CoseCurveP384 -fromCryptCurveECDSA ECC.SEC_p521r1 = Right Cose.CoseCurveP521 -fromCryptCurveECDSA curve = Left $ "Curve " <> Text.pack (show curve) <> " is not a supported COSE ECDSA public key curve" +toCryptHashRSA :: Cose.CoseHashAlgRSA -> SomeHashAlgorithmASN1 +toCryptHashRSA Cose.CoseHashAlgRSASHA1 = SomeHashAlgorithmASN1 Hash.SHA1 +toCryptHashRSA Cose.CoseHashAlgRSASHA256 = SomeHashAlgorithmASN1 Hash.SHA256 +toCryptHashRSA Cose.CoseHashAlgRSASHA384 = SomeHashAlgorithmASN1 Hash.SHA384 +toCryptHashRSA Cose.CoseHashAlgRSASHA512 = SomeHashAlgorithmASN1 Hash.SHA512 diff --git a/src/Crypto/WebAuthn/Cose/Key.hs b/src/Crypto/WebAuthn/Cose/Key.hs deleted file mode 100644 --- a/src/Crypto/WebAuthn/Cose/Key.hs +++ /dev/null @@ -1,297 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - --- | Stability: experimental --- This module contains a partial implementation of the --- [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7) format, --- limited to what is needed for Webauthn, and in a structured way. -module Crypto.WebAuthn.Cose.Key - ( -- * COSE public Key - CosePublicKey (..), - keySignAlg, - - -- * COSE Elliptic Curves - CoseCurveEdDSA (..), - CoseCurveECDSA (..), - ) -where - -import Codec.CBOR.Decoding (Decoder, TokenType (TypeBool, TypeBytes), decodeBytesCanonical, decodeMapLenCanonical, peekTokenType) -import Codec.CBOR.Encoding (Encoding, encodeBytes, encodeMapLen) -import Codec.Serialise (Serialise (decode, encode)) -import Control.Monad (unless) -import Crypto.Number.Serialize (i2osp, os2ip) -import qualified Crypto.WebAuthn.Cose.Algorithm as A -import qualified Crypto.WebAuthn.Cose.Internal.Registry as R -import Crypto.WebAuthn.Internal.ToJSONOrphans () -import Data.Aeson (ToJSON) -import qualified Data.ByteString as BS -import GHC.Generics (Generic) - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialpublickey) --- A structured representation of a [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7) --- limited to what is know to be necessary for Webauthn public keys for the --- [credentialPublicKey](https://www.w3.org/TR/webauthn-2/#credentialpublickey) field. --- Constructors represent signature algorithms. -data CosePublicKey - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2) - -- EdDSA Signature Algorithm - -- - -- [RFC8032](https://datatracker.ietf.org/doc/html/rfc8032) describes the - -- elliptic curve signature scheme Edwards-curve - -- Digital Signature Algorithm (EdDSA). In that document, the signature - -- algorithm is instantiated using parameters for edwards25519 and - -- edwards448 curves. The document additionally describes two variants - -- of the EdDSA algorithm: Pure EdDSA, where no hash function is applied - -- to the content before signing, and HashEdDSA, where a hash function - -- is applied to the content before signing and the result of that hash - -- function is signed. For EdDSA, the content to be signed (either the - -- message or the pre-hash value) is processed twice inside of the - -- signature algorithm. For use with COSE, only the pure EdDSA version - -- is used. - -- - -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2.1) - CosePublicKeyEdDSA - { -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) - -- The elliptic curve to use - eddsaCurve :: CoseCurveEdDSA, - -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) - -- This contains the public key bytes - eddsaX :: BS.ByteString - } - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) - -- ECDSA Signature Algorithm - -- - -- This document defines ECDSA to work only with the curves P-256, - -- P-384, and P-521. Future documents may define it to work with other - -- curves and points in the future. - -- - -- In order to promote interoperability, it is suggested that SHA-256 be - -- used only with curve P-256, SHA-384 be used only with curve P-384, - -- and SHA-512 be used with curve P-521. This is aligned with the recommendation in - -- [Section 4 of RFC5480](https://datatracker.ietf.org/doc/html/rfc5480#section-4). - -- - -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1.1) - CosePublicKeyECDSA - { -- | The hash function to use - ecdsaHash :: A.CoseHashAlgECDSA, - -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- The elliptic curve to use - ecdsaCurve :: CoseCurveECDSA, - -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- This contains the x-coordinate for the EC point. The integer is - -- converted to a byte string as defined in [SEC1]. Leading zero - -- octets MUST be preserved. - ecdsaX :: BS.ByteString, - -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- This contains the value of the - -- y-coordinate for the EC point. When encoding the value y, the - -- integer is converted to an byte string (as defined in - -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1)) - -- and encoded as a CBOR bstr. Leading zero octets MUST be - -- preserved. - ecdsaY :: BS.ByteString - } - | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) - -- [RSASSA-PKCS1-v1_5](https://www.rfc-editor.org/rfc/rfc8017#section-8.2) Signature Algorithm - -- - -- A key of size 2048 bits or larger MUST be used with these algorithms. - -- Security considerations are [here](https://www.rfc-editor.org/rfc/rfc8812.html#section-5) - CosePublicKeyRSA - { -- | The hash function to use - rsaHash :: A.CoseHashAlgRSA, - -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) - -- The RSA modulus n is a product of u distinct odd primes - -- r_i, i = 1, 2, ..., u, where u >= 2 - rsaN :: Integer, - -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) - -- The RSA public exponent e is an integer between 3 and n - 1 satisfying - -- GCD(e,\\lambda(n)) = 1, where \\lambda(n) = LCM(r_1 - 1, ..., r_u - 1) - rsaE :: Integer - } - deriving (Eq, Show, Generic, ToJSON) - --- | CBOR encoding as a [COSE_Key](https://tools.ietf.org/html/rfc8152#section-7) --- using the [CTAP2 canonical CBOR encoding form](https://fidoalliance.org/specs/fido-v2.0-ps-20190130/fido-client-to-authenticator-protocol-v2.0-ps-20190130.html#ctap2-canonical-cbor-encoding-form) -instance Serialise CosePublicKey where - encode key = case key of - CosePublicKeyEdDSA {..} -> - common R.CoseKeyTypeOKP - <> encode R.CoseKeyTypeParameterOKPCrv - <> encode (fromCurveEdDSA eddsaCurve) - <> encode R.CoseKeyTypeParameterOKPX - <> encodeBytes eddsaX - CosePublicKeyECDSA {..} -> - common R.CoseKeyTypeEC2 - <> encode R.CoseKeyTypeParameterEC2Crv - <> encode (fromCurveECDSA ecdsaCurve) - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1 - -- > Leading zero octets MUST be preserved. - <> encode R.CoseKeyTypeParameterEC2X - <> encodeBytes ecdsaX - <> encode R.CoseKeyTypeParameterEC2Y - <> encodeBytes ecdsaY - CosePublicKeyRSA {..} -> - common R.CoseKeyTypeRSA - -- https://www.rfc-editor.org/rfc/rfc8230.html#section-4 - -- > The octet sequence MUST utilize the minimum - -- number of octets needed to represent the value. - <> encode R.CoseKeyTypeParameterRSAN - <> encodeBytes (i2osp rsaN) - <> encode R.CoseKeyTypeParameterRSAE - <> encodeBytes (i2osp rsaE) - where - alg = keySignAlg key - common :: R.CoseKeyType -> Encoding - common kty = - encodeMapLen (R.parameterCount kty) - <> encode R.CoseKeyCommonParameterKty - <> encode kty - <> encode R.CoseKeyCommonParameterAlg - <> encode alg - - -- NOTE: CBOR itself doesn't give an ordering of map keys, but the CTAP2 canonical CBOR encoding form does: - -- > The keys in every map must be sorted lowest value to highest. The sorting rules are: - -- > - -- > * If the major types are different, the one with the lower value in numerical order sorts earlier. - -- > * If two keys have different lengths, the shorter one sorts earlier; - -- > * If two keys have the same length, the one with the lower value in (byte-wise) lexical order sorts earlier. - -- - -- This has the effect that numeric keys are sorted like 1, 2, 3, ..., -1, -2, -3, ... - -- Which aligns very nicely with the fact that common parameters use positive - -- values and can therefore be decoded first, while key type specific - -- parameters use negative values - decode = do - n <- fromIntegral <$> decodeMapLenCanonical - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1 - -- This parameter MUST be present in a key object. - decodeExpected R.CoseKeyCommonParameterKty - kty <- decode - -- https://www.w3.org/TR/webauthn-2/#credentialpublickey - -- The COSE_Key-encoded credential public key MUST contain the "alg" - -- parameter and MUST NOT contain any other OPTIONAL parameters. - decodeExpected R.CoseKeyCommonParameterAlg - alg <- decode - - decodeKey n kty alg - where - decodeKey :: Word -> R.CoseKeyType -> A.CoseSignAlg -> Decoder s CosePublicKey - decodeKey n kty alg = case alg of - A.CoseSignAlgEdDSA -> decodeEdDSAKey - A.CoseSignAlgECDSA hash -> decodeECDSAKey hash - A.CoseSignAlgRSA hash -> decodeRSAKey hash - where - -- [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1) - -- Implementations MUST verify that the key type is appropriate for - -- the algorithm being processed. - checkKty :: R.CoseKeyType -> Decoder s () - checkKty expectedKty = do - unless (expectedKty == kty) $ - fail $ - "Expected COSE key type " - <> show expectedKty - <> " for COSE algorithm " - <> show alg - <> " but got COSE key type " - <> show kty - <> " instead" - unless (R.parameterCount kty == n) $ - fail $ - "Expected CBOR map to contain " - <> show (R.parameterCount kty) - <> " parameters for COSE key type " - <> show kty - <> " but got " - <> show n - <> " parameters instead" - - decodeEdDSAKey :: Decoder s CosePublicKey - decodeEdDSAKey = do - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2 - -- > The 'kty' field MUST be present, and it MUST be 'OKP' (Octet Key Pair). - checkKty R.CoseKeyTypeOKP - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2 - decodeExpected R.CoseKeyTypeParameterOKPCrv - eddsaCurve <- toCurveEdDSA <$> decode - decodeExpected R.CoseKeyTypeParameterOKPX - eddsaX <- decodeBytesCanonical - pure $ CosePublicKeyEdDSA {..} - - decodeECDSAKey :: A.CoseHashAlgECDSA -> Decoder s CosePublicKey - decodeECDSAKey ecdsaHash = do - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1 - -- > The 'kty' field MUST be present, and it MUST be 'EC2'. - checkKty R.CoseKeyTypeEC2 - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1 - decodeExpected R.CoseKeyTypeParameterEC2Crv - ecdsaCurve <- toCurveECDSA <$> decode - decodeExpected R.CoseKeyTypeParameterEC2X - ecdsaX <- decodeBytesCanonical - decodeExpected R.CoseKeyTypeParameterEC2Y - ecdsaY <- - peekTokenType >>= \case - TypeBytes -> decodeBytesCanonical - -- TODO: Implement this - TypeBool -> fail "Compressed EC2 y coordinate not yet supported" - typ -> fail $ "Unexpected type in EC2 y parameter: " <> show typ - pure $ CosePublicKeyECDSA {..} - - decodeRSAKey :: A.CoseHashAlgRSA -> Decoder s CosePublicKey - decodeRSAKey rsaHash = do - -- https://www.rfc-editor.org/rfc/rfc8812.html#section-2 - -- > Implementations need to check that the key type is 'RSA' when creating or verifying a signature. - checkKty R.CoseKeyTypeRSA - -- https://www.rfc-editor.org/rfc/rfc8230.html#section-4 - decodeExpected R.CoseKeyTypeParameterRSAN - rsaN <- os2ip <$> decodeBytesCanonical - decodeExpected R.CoseKeyTypeParameterRSAE - rsaE <- os2ip <$> decodeBytesCanonical - pure $ CosePublicKeyRSA {..} - --- | Decode a value and ensure it's the same as the value that was given -decodeExpected :: (Show a, Eq a, Serialise a) => a -> Decoder s () -decodeExpected expected = do - actual <- decode - unless (expected == actual) $ - fail $ "Expected " <> show expected <> " but got " <> show actual - --- | The COSE signing algorithm corresponding to a COSE public key -keySignAlg :: CosePublicKey -> A.CoseSignAlg -keySignAlg CosePublicKeyEdDSA {} = A.CoseSignAlgEdDSA -keySignAlg CosePublicKeyECDSA {..} = A.CoseSignAlgECDSA ecdsaHash -keySignAlg CosePublicKeyRSA {..} = A.CoseSignAlgRSA rsaHash - --- | COSE elliptic curves that can be used with EdDSA -data CoseCurveEdDSA - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- Ed25519 for use w/ EdDSA only - CoseCurveEd25519 - deriving (Eq, Show, Enum, Bounded, Generic, ToJSON) - -fromCurveEdDSA :: CoseCurveEdDSA -> R.CoseEllipticCurveOKP -fromCurveEdDSA CoseCurveEd25519 = R.CoseEllipticCurveEd25519 - -toCurveEdDSA :: R.CoseEllipticCurveOKP -> CoseCurveEdDSA -toCurveEdDSA R.CoseEllipticCurveEd25519 = CoseCurveEd25519 - --- | COSE elliptic curves that can be used with ECDSA -data CoseCurveECDSA - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- NIST P-256 also known as secp256r1 - CoseCurveP256 - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- NIST P-384 also known as secp384r1 - CoseCurveP384 - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- NIST P-521 also known as secp521r1 - CoseCurveP521 - deriving (Eq, Show, Enum, Bounded, Generic, ToJSON) - -fromCurveECDSA :: CoseCurveECDSA -> R.CoseEllipticCurveEC2 -fromCurveECDSA CoseCurveP256 = R.CoseEllipticCurveEC2P256 -fromCurveECDSA CoseCurveP384 = R.CoseEllipticCurveEC2P384 -fromCurveECDSA CoseCurveP521 = R.CoseEllipticCurveEC2P521 - -toCurveECDSA :: R.CoseEllipticCurveEC2 -> CoseCurveECDSA -toCurveECDSA R.CoseEllipticCurveEC2P256 = CoseCurveP256 -toCurveECDSA R.CoseEllipticCurveEC2P384 = CoseCurveP384 -toCurveECDSA R.CoseEllipticCurveEC2P521 = CoseCurveP521 diff --git a/src/Crypto/WebAuthn/Cose/PublicKey.hs b/src/Crypto/WebAuthn/Cose/PublicKey.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/WebAuthn/Cose/PublicKey.hs @@ -0,0 +1,207 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} + +-- | Stability: experimental +-- This module contains a partial implementation of the +-- [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7) format, +-- limited to what is needed for Webauthn, and in a structured way. +module Crypto.WebAuthn.Cose.PublicKey + ( -- * Public key + UncheckedPublicKey (..), + checkPublicKey, + PublicKey (PublicKey), + + -- * COSE Elliptic Curves + CoseCurveEdDSA (..), + coordinateSizeEdDSA, + CoseCurveECDSA (..), + toCryptCurveECDSA, + fromCryptCurveECDSA, + coordinateSizeECDSA, + ) +where + +import qualified Crypto.PubKey.ECC.Prim as ECC +import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import Crypto.WebAuthn.Internal.ToJSONOrphans () +import Data.Aeson (ToJSON) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as Base16 +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import GHC.Generics (Generic) + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialpublickey) +-- A structured representation of a [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7) +-- limited to what is know to be necessary for Webauthn public keys for the +-- [credentialPublicKey](https://www.w3.org/TR/webauthn-2/#credentialpublickey) field, +-- and without any signing algorithm parameters like hashes. Due to the raw +-- nature of parameters, this type is labeled as unchecked. Parameters are +-- checked by using the 'checkPublicKey' function, returning a t'PublicKey' +-- type. +data UncheckedPublicKey + = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2) + -- EdDSA Signature Algorithm + -- + -- [RFC8032](https://datatracker.ietf.org/doc/html/rfc8032) describes the + -- elliptic curve signature scheme Edwards-curve + -- Digital Signature Algorithm (EdDSA). In that document, the signature + -- algorithm is instantiated using parameters for edwards25519 and + -- edwards448 curves. The document additionally describes two variants + -- of the EdDSA algorithm: Pure EdDSA, where no hash function is applied + -- to the content before signing, and HashEdDSA, where a hash function + -- is applied to the content before signing and the result of that hash + -- function is signed. For EdDSA, the content to be signed (either the + -- message or the pre-hash value) is processed twice inside of the + -- signature algorithm. For use with COSE, only the pure EdDSA version + -- is used. + -- + -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2.1) + PublicKeyEdDSA + { -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) + -- The elliptic curve to use + eddsaCurve :: CoseCurveEdDSA, + -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) + -- This contains the public key bytes. + eddsaX :: BS.ByteString + } + | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) + -- ECDSA Signature Algorithm + -- + -- This document defines ECDSA to work only with the curves P-256, + -- P-384, and P-521. Future documents may define it to work with other + -- curves and points in the future. + -- + -- In order to promote interoperability, it is suggested that SHA-256 be + -- used only with curve P-256, SHA-384 be used only with curve P-384, + -- and SHA-512 be used with curve P-521. This is aligned with the recommendation in + -- [Section 4 of RFC5480](https://datatracker.ietf.org/doc/html/rfc5480#section-4). + -- + -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1.1) + PublicKeyECDSA + { -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) + -- The elliptic curve to use + ecdsaCurve :: CoseCurveECDSA, + -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) + -- This contains the x-coordinate for the EC point. The integer is + -- converted to a byte string as defined in [SEC1]. Leading zero + -- octets MUST be preserved. + ecdsaX :: Integer, + -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) + -- This contains the value of the + -- y-coordinate for the EC point. When encoding the value y, the + -- integer is converted to an byte string (as defined in + -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1)) + -- and encoded as a CBOR bstr. Leading zero octets MUST be + -- preserved. + ecdsaY :: Integer + } + | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) + -- [RSASSA-PKCS1-v1_5](https://www.rfc-editor.org/rfc/rfc8017#section-8.2) Signature Algorithm + -- + -- A key of size 2048 bits or larger MUST be used with these algorithms. + -- Security considerations are [here](https://www.rfc-editor.org/rfc/rfc8812.html#section-5) + PublicKeyRSA + { -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) + -- The RSA modulus n is a product of u distinct odd primes + -- r_i, i = 1, 2, ..., u, where u >= 2 + rsaN :: Integer, + -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) + -- The RSA public exponent e is an integer between 3 and n - 1 satisfying + -- GCD(e,\\lambda(n)) = 1, where \\lambda(n) = LCM(r_1 - 1, ..., r_u - 1) + rsaE :: Integer + } + deriving (Eq, Show, Generic, ToJSON) + +-- | Same as 'UncheckedPublicKey', but checked to be valid using +-- 'checkPublicKey'. +newtype PublicKey = CheckedPublicKey UncheckedPublicKey + deriving newtype (Eq, Show, ToJSON) + +-- | Returns the 'UncheckedPublicKey' for a t'PublicKey' +pattern PublicKey :: UncheckedPublicKey -> PublicKey +pattern PublicKey k <- CheckedPublicKey k + +{-# COMPLETE PublicKey #-} + +-- | Checks whether an 'UncheckedPublicKey' is valid. This is the only way to construct a t'PublicKey' +checkPublicKey :: UncheckedPublicKey -> Either Text PublicKey +checkPublicKey key@PublicKeyEdDSA {..} + | actualSize == expectedSize = Right $ CheckedPublicKey key + | otherwise = + Left $ + "EdDSA public key for curve " + <> Text.pack (show eddsaCurve) + <> " didn't have the expected size of " + <> Text.pack (show expectedSize) + <> " bytes, it has " + <> Text.pack (show actualSize) + <> " bytes instead: " + <> Text.decodeUtf8 (Base16.encode eddsaX) + where + actualSize = BS.length eddsaX + expectedSize = coordinateSizeEdDSA eddsaCurve +checkPublicKey key@PublicKeyECDSA {..} + | ECC.isPointValid curve point = Right $ CheckedPublicKey key + | otherwise = + Left $ + "ECDSA public key point is not valid for curve " + <> Text.pack (show ecdsaCurve) + <> ": " + <> Text.pack (show point) + where + curve = ECC.getCurveByName (toCryptCurveECDSA ecdsaCurve) + point = ECC.Point ecdsaX ecdsaY +checkPublicKey key = Right $ CheckedPublicKey key + +-- | COSE elliptic curves that can be used with EdDSA +data CoseCurveEdDSA + = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) + -- Ed25519 for use w/ EdDSA only + CoseCurveEd25519 + deriving (Eq, Show, Enum, Bounded, Generic, ToJSON) + +-- | Returns the size of a coordinate point for a specific EdDSA curve in bytes. +coordinateSizeEdDSA :: CoseCurveEdDSA -> Int +coordinateSizeEdDSA CoseCurveEd25519 = Ed25519.publicKeySize + +-- | COSE elliptic curves that can be used with ECDSA +data CoseCurveECDSA + = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) + -- NIST P-256 also known as secp256r1 + CoseCurveP256 + | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) + -- NIST P-384 also known as secp384r1 + CoseCurveP384 + | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) + -- NIST P-521 also known as secp521r1 + CoseCurveP521 + deriving (Eq, Show, Enum, Bounded, Generic, ToJSON) + +-- | Converts a 'Cose.CoseCurveECDSA' to an 'ECC.CurveName'. The inverse +-- function is 'fromCryptCurveECDSA' +toCryptCurveECDSA :: CoseCurveECDSA -> ECC.CurveName +toCryptCurveECDSA CoseCurveP256 = ECC.SEC_p256r1 +toCryptCurveECDSA CoseCurveP384 = ECC.SEC_p384r1 +toCryptCurveECDSA CoseCurveP521 = ECC.SEC_p521r1 + +-- | Tries to converts a 'ECC.CurveName' to an 'Cose.CoseCurveECDSA'. The inverse +-- function is 'toCryptCurveECDSA' +fromCryptCurveECDSA :: ECC.CurveName -> Either Text CoseCurveECDSA +fromCryptCurveECDSA ECC.SEC_p256r1 = Right CoseCurveP256 +fromCryptCurveECDSA ECC.SEC_p384r1 = Right CoseCurveP384 +fromCryptCurveECDSA ECC.SEC_p521r1 = Right CoseCurveP521 +fromCryptCurveECDSA curve = + Left $ + "Curve " + <> Text.pack (show curve) + <> " is not a supported COSE ECDSA public key curve" + +-- | Returns the size of a coordinate point for a specific ECDSA curve in bytes. +coordinateSizeECDSA :: CoseCurveECDSA -> Int +coordinateSizeECDSA curve = byteSize + where + bitSize = ECC.curveSizeBits (ECC.getCurveByName (toCryptCurveECDSA curve)) + byteSize = (bitSize + 7) `div` 8 diff --git a/src/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs b/src/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs @@ -0,0 +1,281 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeSynonymInstances #-} + +-- | Stability: experimental +-- This module contains a partial implementation of the +-- [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7) format, +-- limited to what is needed for Webauthn, and in a structured way. +module Crypto.WebAuthn.Cose.PublicKeyWithSignAlg + ( -- * COSE public Key + PublicKeyWithSignAlg (PublicKeyWithSignAlg, Crypto.WebAuthn.Cose.PublicKeyWithSignAlg.publicKey, signAlg), + CosePublicKey, + makePublicKeyWithSignAlg, + ) +where + +import Codec.CBOR.Decoding (Decoder, TokenType (TypeBool, TypeBytes), decodeBytesCanonical, decodeMapLenCanonical, peekTokenType) +import Codec.CBOR.Encoding (Encoding, encodeBytes, encodeMapLen) +import Codec.Serialise (Serialise (decode, encode)) +import Control.Monad (unless) +import Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip) +import qualified Crypto.WebAuthn.Cose.Internal.Registry as R +import qualified Crypto.WebAuthn.Cose.PublicKey as P +import qualified Crypto.WebAuthn.Cose.SignAlg as A +import Crypto.WebAuthn.Internal.ToJSONOrphans () +import qualified Data.Aeson as Aeson +import qualified Data.ByteString as BS +import Data.Functor (($>)) +import Data.Text (Text) +import qualified Data.Text as Text +import GHC.Generics (Generic) + +-- | A combination of a t'P.PublicKey' holding the public key data and a +-- 'A.CoseSignAlg' holding the exact signature algorithm that should be used. +-- This type can only be constructed with 'makePublicKeyWithSignAlg', which +-- ensures that the signature scheme matches between 'P.PublicKey' and +-- 'A.CoseSignAlg'. This type is equivalent to a COSE public key, which holds +-- the same information, see 'CosePublicKey' +data PublicKeyWithSignAlg = PublicKeyWithSignAlgInternal + { publicKeyInternal :: P.PublicKey, + signAlgInternal :: A.CoseSignAlg + -- TODO: Consider adding a RawField here to replace + -- acdCredentialPublicKeyBytes. This would then require parametrizing + -- 'PublicKeyWithSignAlg' with 'raw :: Bool' + } + deriving (Eq, Show, Generic, Aeson.ToJSON) + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialpublickey) +-- A structured and checked representation of a +-- [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7), limited +-- to what is know to be necessary for Webauthn public keys for the +-- [credentialPublicKey](https://www.w3.org/TR/webauthn-2/#credentialpublickey) +-- field. +type CosePublicKey = PublicKeyWithSignAlg + +-- | Deconstructs a 'makePublicKeyWithSignAlg' into its t'P.PublicKey' and +-- 'A.CoseSignAlg'. Since 'makePublicKeyWithSignAlg' can only be constructed +-- using 'makePublicKeyWithSignAlg', we can be sure that the signature scheme +-- of t'P.PublicKey' and 'A.CoseSignAlg' matches. +pattern PublicKeyWithSignAlg :: P.PublicKey -> A.CoseSignAlg -> PublicKeyWithSignAlg +pattern PublicKeyWithSignAlg {publicKey, signAlg} <- PublicKeyWithSignAlgInternal {publicKeyInternal = publicKey, signAlgInternal = signAlg} + +{-# COMPLETE PublicKeyWithSignAlg #-} + +-- | Constructs a t'PublicKeyWithSignAlg' from a t'P.PublicKey' and +-- 'A.CoseSignAlg', returning an error if the signature schemes between these +-- two types don't match. +makePublicKeyWithSignAlg :: P.PublicKey -> A.CoseSignAlg -> Either Text PublicKeyWithSignAlg +makePublicKeyWithSignAlg key@(P.PublicKey k) alg = + verifyValid k alg + $> PublicKeyWithSignAlgInternal + { publicKeyInternal = key, + signAlgInternal = alg + } + where + verifyValid :: P.UncheckedPublicKey -> A.CoseSignAlg -> Either Text () + verifyValid P.PublicKeyEdDSA {} A.CoseSignAlgEdDSA = pure () + verifyValid P.PublicKeyEdDSA {} alg = Left $ "EdDSA public key cannot be used with signing algorithm " <> Text.pack (show alg) + verifyValid P.PublicKeyECDSA {} A.CoseSignAlgECDSA {} = pure () + verifyValid P.PublicKeyECDSA {} alg = Left $ "ECDSA public key cannot be used with signing algorithm " <> Text.pack (show alg) + verifyValid P.PublicKeyRSA {} A.CoseSignAlgRSA {} = pure () + verifyValid P.PublicKeyRSA {} alg = Left $ "RSA public key cannot be used with signing algorithm " <> Text.pack (show alg) + +-- | CBOR encoding as a [COSE_Key](https://tools.ietf.org/html/rfc8152#section-7) +-- using the [CTAP2 canonical CBOR encoding form](https://fidoalliance.org/specs/fido-v2.0-ps-20190130/fido-client-to-authenticator-protocol-v2.0-ps-20190130.html#ctap2-canonical-cbor-encoding-form) +instance Serialise CosePublicKey where + encode PublicKeyWithSignAlg {..} = case publicKey of + P.PublicKey P.PublicKeyEdDSA {..} -> + common R.CoseKeyTypeOKP + <> encode R.CoseKeyTypeParameterOKPCrv + <> encode (fromCurveEdDSA eddsaCurve) + <> encode R.CoseKeyTypeParameterOKPX + <> encodeBytes eddsaX + P.PublicKey P.PublicKeyECDSA {..} -> + common R.CoseKeyTypeEC2 + <> encode R.CoseKeyTypeParameterEC2Crv + <> encode (fromCurveECDSA ecdsaCurve) + -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1 + -- > Leading zero octets MUST be preserved. + <> encode R.CoseKeyTypeParameterEC2X + -- This version of i2ospOf_ throws if the bytestring is larger than + -- size, but this can't happen due to the PublicKey invariants + <> encodeBytes (i2ospOf_ size ecdsaX) + <> encode R.CoseKeyTypeParameterEC2Y + <> encodeBytes (i2ospOf_ size ecdsaY) + where + size = P.coordinateSizeECDSA ecdsaCurve + P.PublicKey P.PublicKeyRSA {..} -> + common R.CoseKeyTypeRSA + -- https://www.rfc-editor.org/rfc/rfc8230.html#section-4 + -- > The octet sequence MUST utilize the minimum + -- number of octets needed to represent the value. + <> encode R.CoseKeyTypeParameterRSAN + <> encodeBytes (i2osp rsaN) + <> encode R.CoseKeyTypeParameterRSAE + <> encodeBytes (i2osp rsaE) + where + common :: R.CoseKeyType -> Encoding + common kty = + encodeMapLen (R.parameterCount kty) + <> encode R.CoseKeyCommonParameterKty + <> encode kty + <> encode R.CoseKeyCommonParameterAlg + <> encode signAlg + + -- NOTE: CBOR itself doesn't give an ordering of map keys, but the CTAP2 canonical CBOR encoding form does: + -- > The keys in every map must be sorted lowest value to highest. The sorting rules are: + -- > + -- > * If the major types are different, the one with the lower value in numerical order sorts earlier. + -- > * If two keys have different lengths, the shorter one sorts earlier; + -- > * If two keys have the same length, the one with the lower value in (byte-wise) lexical order sorts earlier. + -- + -- This has the effect that numeric keys are sorted like 1, 2, 3, ..., -1, -2, -3, ... + -- Which aligns very nicely with the fact that common parameters use positive + -- values and can therefore be decoded first, while key type specific + -- parameters use negative values + decode = do + n <- fromIntegral <$> decodeMapLenCanonical + -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1 + -- This parameter MUST be present in a key object. + decodeExpected R.CoseKeyCommonParameterKty + kty <- decode + -- https://www.w3.org/TR/webauthn-2/#credentialpublickey + -- The COSE_Key-encoded credential public key MUST contain the "alg" + -- parameter and MUST NOT contain any other OPTIONAL parameters. + decodeExpected R.CoseKeyCommonParameterAlg + alg <- decode + + uncheckedKey <- decodeKey n kty alg + case P.checkPublicKey uncheckedKey of + Left err -> fail $ "Key check failed: " <> Text.unpack err + Right result -> + pure $ + PublicKeyWithSignAlgInternal + { publicKeyInternal = result, + signAlgInternal = alg + } + where + decodeKey :: Word -> R.CoseKeyType -> A.CoseSignAlg -> Decoder s P.UncheckedPublicKey + decodeKey n kty alg = case alg of + A.CoseSignAlgEdDSA -> decodeEdDSAKey + A.CoseSignAlgECDSA _ -> decodeECDSAKey + A.CoseSignAlgRSA _ -> decodeRSAKey + where + -- [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1) + -- Implementations MUST verify that the key type is appropriate for + -- the algorithm being processed. + checkKty :: R.CoseKeyType -> Decoder s () + checkKty expectedKty = do + unless (expectedKty == kty) $ + fail $ + "Expected COSE key type " + <> show expectedKty + <> " for COSE algorithm " + <> show alg + <> " but got COSE key type " + <> show kty + <> " instead" + unless (R.parameterCount kty == n) $ + fail $ + "Expected CBOR map to contain " + <> show (R.parameterCount kty) + <> " parameters for COSE key type " + <> show kty + <> " but got " + <> show n + <> " parameters instead" + + decodeEdDSAKey :: Decoder s P.UncheckedPublicKey + decodeEdDSAKey = do + -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2 + -- > The 'kty' field MUST be present, and it MUST be 'OKP' (Octet Key Pair). + checkKty R.CoseKeyTypeOKP + -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2 + decodeExpected R.CoseKeyTypeParameterOKPCrv + eddsaCurve <- toCurveEdDSA <$> decode + decodeExpected R.CoseKeyTypeParameterOKPX + eddsaX <- decodeBytesCanonical + pure P.PublicKeyEdDSA {..} + + decodeECDSAKey :: Decoder s P.UncheckedPublicKey + decodeECDSAKey = do + -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1 + -- > The 'kty' field MUST be present, and it MUST be 'EC2'. + checkKty R.CoseKeyTypeEC2 + -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1 + decodeExpected R.CoseKeyTypeParameterEC2Crv + ecdsaCurve <- toCurveECDSA <$> decode + let size = P.coordinateSizeECDSA ecdsaCurve + decodeExpected R.CoseKeyTypeParameterEC2X + ecdsaX <- os2ipWithSize size =<< decodeBytesCanonical + + decodeExpected R.CoseKeyTypeParameterEC2Y + ecdsaY <- + peekTokenType >>= \case + TypeBytes -> os2ipWithSize size =<< decodeBytesCanonical + TypeBool -> fail "Compressed EC2 y coordinate not yet supported" + typ -> fail $ "Unexpected type in EC2 y parameter: " <> show typ + + pure P.PublicKeyECDSA {..} + + decodeRSAKey :: Decoder s P.UncheckedPublicKey + decodeRSAKey = do + -- https://www.rfc-editor.org/rfc/rfc8812.html#section-2 + -- > Implementations need to check that the key type is 'RSA' when creating or verifying a signature. + checkKty R.CoseKeyTypeRSA + -- https://www.rfc-editor.org/rfc/rfc8230.html#section-4 + decodeExpected R.CoseKeyTypeParameterRSAN + -- > The octet sequence MUST utilize the minimum number of octets needed to represent the value. + rsaN <- os2ipNoLeading =<< decodeBytesCanonical + decodeExpected R.CoseKeyTypeParameterRSAE + rsaE <- os2ipNoLeading =<< decodeBytesCanonical + pure P.PublicKeyRSA {..} + +-- | Same as 'os2ip', but throws an error if there are not exactly as many bytes as expected. Thus any successful result of this function will give the same 'BS.ByteString' back if encoded with @'i2ospOf_' size@. +os2ipWithSize :: MonadFail m => Int -> BS.ByteString -> m Integer +os2ipWithSize size bytes + | BS.length bytes == size = pure $ os2ip bytes + | otherwise = + fail $ + "bytes have length " <> show (BS.length bytes) + <> " when length " + <> show size + <> " was expected" + +-- | Same as 'os2ip', but throws an error if there are leading zero bytes. Thus any successful result of this function will give the same 'BS.ByteString' back if encoded with 'i2osp'. +os2ipNoLeading :: MonadFail m => BS.ByteString -> m Integer +os2ipNoLeading bytes + | leadingZeroCount == 0 = pure $ os2ip bytes + | otherwise = + fail $ + "bytes of length " + <> show (BS.length bytes) + <> " has " + <> show leadingZeroCount + <> " leading zero bytes when none were expected" + where + leadingZeroCount = BS.length (BS.takeWhile (== 0) bytes) + +-- | Decode a value and ensure it's the same as the value that was given +decodeExpected :: (Show a, Eq a, Serialise a) => a -> Decoder s () +decodeExpected expected = do + actual <- decode + unless (expected == actual) $ + fail $ "Expected " <> show expected <> " but got " <> show actual + +fromCurveEdDSA :: P.CoseCurveEdDSA -> R.CoseEllipticCurveOKP +fromCurveEdDSA P.CoseCurveEd25519 = R.CoseEllipticCurveEd25519 + +toCurveEdDSA :: R.CoseEllipticCurveOKP -> P.CoseCurveEdDSA +toCurveEdDSA R.CoseEllipticCurveEd25519 = P.CoseCurveEd25519 + +fromCurveECDSA :: P.CoseCurveECDSA -> R.CoseEllipticCurveEC2 +fromCurveECDSA P.CoseCurveP256 = R.CoseEllipticCurveEC2P256 +fromCurveECDSA P.CoseCurveP384 = R.CoseEllipticCurveEC2P384 +fromCurveECDSA P.CoseCurveP521 = R.CoseEllipticCurveEC2P521 + +toCurveECDSA :: R.CoseEllipticCurveEC2 -> P.CoseCurveECDSA +toCurveECDSA R.CoseEllipticCurveEC2P256 = P.CoseCurveP256 +toCurveECDSA R.CoseEllipticCurveEC2P384 = P.CoseCurveP384 +toCurveECDSA R.CoseEllipticCurveEC2P521 = P.CoseCurveP521 diff --git a/src/Crypto/WebAuthn/Cose/SignAlg.hs b/src/Crypto/WebAuthn/Cose/SignAlg.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/WebAuthn/Cose/SignAlg.hs @@ -0,0 +1,240 @@ +{-# LANGUAGE PatternSynonyms #-} + +-- | Stability: experimental +-- This module contains definitions for [COSE registry](https://www.iana.org/assignments/cose/cose.xhtml) +-- entries that are relevant for Webauthn COSE public keys. All the types in +-- this module implement the 'Serialise' class, mapping them to the respective +-- CBOR values/labels. +-- +-- This modules sometimes uses this +-- [CBOR Grammar](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-13#section-1.4) +-- to describe CBOR value types corresponding to CBOR parameters +module Crypto.WebAuthn.Cose.SignAlg + ( -- * COSE Algorithms + CoseSignAlg + ( .., + CoseAlgorithmEdDSA, + CoseAlgorithmES256, + CoseAlgorithmES384, + CoseAlgorithmES512, + CoseAlgorithmRS256, + CoseAlgorithmRS384, + CoseAlgorithmRS512, + CoseAlgorithmRS1 + ), + fromCoseSignAlg, + toCoseSignAlg, + + -- * Hash Algorithms + CoseHashAlgECDSA (..), + CoseHashAlgRSA (..), + ) +where + +import Codec.CBOR.Decoding (decodeIntCanonical) +import Codec.CBOR.Encoding (encodeInt) +import Codec.Serialise (Serialise) +import Codec.Serialise.Class (decode, encode) +import Data.Aeson (ToJSON) +import Data.Text (Text) +import qualified Data.Text as Text +import GHC.Generics (Generic) + +-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) +-- All the entries from the [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) +-- limited to the ones that are currently needed for Webauthn. Notably we only +-- care about asymmetric signature algorithms +data CoseSignAlg + = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2) + -- EdDSA + -- + -- [RFC8032](https://datatracker.ietf.org/doc/html/rfc8032) describes the elliptic curve signature scheme Edwards-curve + -- Digital Signature Algorithm (EdDSA). In that document, the signature + -- algorithm is instantiated using parameters for edwards25519 and + -- edwards448 curves. The document additionally describes two variants + -- of the EdDSA algorithm: Pure EdDSA, where no hash function is applied + -- to the content before signing, and HashEdDSA, where a hash function + -- is applied to the content before signing and the result of that hash + -- function is signed. For EdDSA, the content to be signed (either the + -- message or the pre-hash value) is processed twice inside of the + -- signature algorithm. For use with COSE, only the pure EdDSA version + -- is used. + -- + -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2.1) + CoseSignAlgEdDSA + | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) + -- ECDSA + -- + -- ECDSA [DSS] defines a signature algorithm using ECC. Implementations + -- SHOULD use a deterministic version of ECDSA such as the one defined + -- in [RFC6979]. + -- + -- The ECDSA signature algorithm is parameterized with a hash function + -- (h). In the event that the length of the hash function output is + -- greater than the group of the key, the leftmost bytes of the hash + -- output are used. + -- ECDSA w/ SHA-256 + -- + -- This document defines ECDSA to work only with the curves P-256, + -- P-384, and P-521. Future documents may define it to work with other + -- curves and points in the future. + -- + -- In order to promote interoperability, it is suggested that SHA-256 be + -- used only with curve P-256, SHA-384 be used only with curve P-384, + -- and SHA-512 be used with curve P-521. This is aligned with the + -- recommendation in [Section 4 of RFC5480](https://datatracker.ietf.org/doc/html/rfc5480#section-4) + -- + -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1.1) + CoseSignAlgECDSA CoseHashAlgECDSA + | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) + -- The RSASSA-PKCS1-v1_5 signature algorithm is defined in + -- [RFC8017](https://www.rfc-editor.org/rfc/rfc8812.html#RFC8017). + -- The RSASSA-PKCS1-v1_5 signature algorithm is parameterized with a hash function (h). + -- + -- A key of size 2048 bits or larger MUST be used with these algorithms. + -- + -- Security considerations are [here](https://www.rfc-editor.org/rfc/rfc8812.html#section-5) + CoseSignAlgRSA CoseHashAlgRSA + deriving (Eq, Show, Ord, Generic, ToJSON) + +-- | Hash algorithms that can be used with the ECDSA signature algorithm +data CoseHashAlgECDSA + = -- | SHA-256 + CoseHashAlgECDSASHA256 + | -- | SHA-384 + CoseHashAlgECDSASHA384 + | -- | SHA-512 + CoseHashAlgECDSASHA512 + deriving (Eq, Show, Ord, Enum, Bounded, Generic, ToJSON) + +-- | Hash algorithms that can be used with the RSA signature algorithm +data CoseHashAlgRSA + = -- | SHA-1 (deprecated) + CoseHashAlgRSASHA1 + | -- | SHA-256 + CoseHashAlgRSASHA256 + | -- | SHA-384 + CoseHashAlgRSASHA384 + | -- | SHA-512 + CoseHashAlgRSASHA512 + deriving (Eq, Show, Ord, Enum, Bounded, Generic, ToJSON) + +-- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2) +-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) +-- entry @EdDSA@. Alias for 'CoseSignAlgEdDSA' +-- +-- * Name: EdDSA +-- * Description: EdDSA +-- * Recommended: Yes +pattern CoseAlgorithmEdDSA :: CoseSignAlg +pattern CoseAlgorithmEdDSA = CoseSignAlgEdDSA + +-- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) +-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) +-- entry @ES256@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA256'@ +-- +-- * Name: ES256 +-- * Description: ECDSA w/ SHA-256 +-- * Recommended: Yes +pattern CoseAlgorithmES256 :: CoseSignAlg +pattern CoseAlgorithmES256 = CoseSignAlgECDSA CoseHashAlgECDSASHA256 + +-- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) +-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) +-- entry @ES384@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA384'@ +-- +-- * Name: ES384 +-- * Description: ECDSA w/ SHA-384 +-- * Recommended: Yes +pattern CoseAlgorithmES384 :: CoseSignAlg +pattern CoseAlgorithmES384 = CoseSignAlgECDSA CoseHashAlgECDSASHA384 + +-- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) +-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) +-- entry @ES512@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA512'@ +-- +-- * Name: ES512 +-- * Description: ECDSA w/ SHA-512 +-- * Recommended: Yes +pattern CoseAlgorithmES512 :: CoseSignAlg +pattern CoseAlgorithmES512 = CoseSignAlgECDSA CoseHashAlgECDSASHA512 + +-- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) +-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) +-- entry @RS256@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA256'@ +-- +-- * Name: RS256 +-- * Description: RSASSA-PKCS1-v1_5 using SHA-256 +-- * Recommended: No +pattern CoseAlgorithmRS256 :: CoseSignAlg +pattern CoseAlgorithmRS256 = CoseSignAlgRSA CoseHashAlgRSASHA256 + +-- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) +-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) +-- entry @RS384@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA384'@ +-- +-- * Name: RS384 +-- * Description: RSASSA-PKCS1-v1_5 using SHA-384 +-- * Recommended: No +pattern CoseAlgorithmRS384 :: CoseSignAlg +pattern CoseAlgorithmRS384 = CoseSignAlgRSA CoseHashAlgRSASHA384 + +-- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) +-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) +-- entry @RS512@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA512'@ +-- +-- * Name: RS512 +-- * Description: RSASSA-PKCS1-v1_5 using SHA-512 +-- * Recommended: No +pattern CoseAlgorithmRS512 :: CoseSignAlg +pattern CoseAlgorithmRS512 = CoseSignAlgRSA CoseHashAlgRSASHA512 + +-- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) +-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) +-- entry @RS1@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA1'@ +-- +-- * Name: RS1 +-- * Description: RSASSA-PKCS1-v1_5 using SHA-1 +-- * Recommended: Deprecated +pattern CoseAlgorithmRS1 :: CoseSignAlg +pattern CoseAlgorithmRS1 = CoseSignAlgRSA CoseHashAlgRSASHA1 + +-- | Serialises COSE Algorithms using the @Value@ column from the +-- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms). +-- This uses the 'fromCoseSignAlg' and 'toCoseSignAlg' functions to do the +-- encoding and decoding respectively. +instance Serialise CoseSignAlg where + encode = encodeInt . fromCoseSignAlg + decode = do + int <- decodeIntCanonical + case toCoseSignAlg int of + Right res -> pure res + Left err -> fail $ Text.unpack err + +-- | Converts a 'CoseSignAlg' to the corresponding integer value from the +-- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms). +-- The inverse operation is 'toCoseSignAlg' +fromCoseSignAlg :: Num p => CoseSignAlg -> p +fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA1) = -65535 +fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA512) = -259 +fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA384) = -258 +fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA256) = -257 +fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA512) = -36 +fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA384) = -35 +fromCoseSignAlg CoseSignAlgEdDSA = -8 +fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA256) = -7 + +-- | Converts an integer value to the corresponding 'CoseSignAlg' from the +-- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms). +-- Returns an error if the integer doesn't represent a known algorithm. +-- The inverse operation is 'fromCoseSignAlg' +toCoseSignAlg :: (Eq a, Num a, Show a) => a -> Either Text CoseSignAlg +toCoseSignAlg (-65535) = pure (CoseSignAlgRSA CoseHashAlgRSASHA1) +toCoseSignAlg (-259) = pure (CoseSignAlgRSA CoseHashAlgRSASHA512) +toCoseSignAlg (-258) = pure (CoseSignAlgRSA CoseHashAlgRSASHA384) +toCoseSignAlg (-257) = pure (CoseSignAlgRSA CoseHashAlgRSASHA256) +toCoseSignAlg (-36) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA512) +toCoseSignAlg (-35) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA384) +toCoseSignAlg (-8) = pure CoseSignAlgEdDSA +toCoseSignAlg (-7) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA256) +toCoseSignAlg value = Left $ "Unknown COSE algorithm value " <> Text.pack (show value) diff --git a/src/Crypto/WebAuthn/Encoding.hs b/src/Crypto/WebAuthn/Encoding.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/WebAuthn/Encoding.hs @@ -0,0 +1,39 @@ +{-# OPTIONS_GHC -Wno-missing-import-lists #-} + +-- | Stability: experimental +-- This module ncludes everything needed to encode\/decode WebAuthn types +-- between serializations and Haskell types defined in "Crypto.WebAuthn.Model". +module Crypto.WebAuthn.Encoding + ( -- * webauthn-json serialization + + -- This module includes encoding and decoding functions for messages + -- exchanged with the + -- [webauthn-json](https://github.com/github/webauthn-json) JavaScript + -- library. + module Crypto.WebAuthn.Encoding.WebAuthnJson, + + -- * Binary fields + + -- WebAuthn defines several structures that employ a binary serialization, + -- such as + -- [clientDataJSON](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson) + -- or [authenticator + -- data](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-authenticatordata). + -- This module exposes functions for encoding/decoding such fields, using + -- types from "Crypto.WebAuthn.Model". This is useful for defining + -- serializations alternative to the webauthn-json one. + module Crypto.WebAuthn.Encoding.Binary, + + -- * Enum strings + + -- WebAuthn also defines several enumerations, which can be translated + -- to\/from their respective Haskell types in "Crypto.WebAuthn.Model" using + -- this module. This is useful for defining serializations alternative to + -- the webauthn-json one. + module Crypto.WebAuthn.Encoding.Strings, + ) +where + +import Crypto.WebAuthn.Encoding.Binary +import Crypto.WebAuthn.Encoding.Strings +import Crypto.WebAuthn.Encoding.WebAuthnJson diff --git a/src/Crypto/WebAuthn/Encoding/Binary.hs b/src/Crypto/WebAuthn/Encoding/Binary.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/WebAuthn/Encoding/Binary.hs @@ -0,0 +1,660 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Stability: experimental +-- Certain parts of the specification require that data is decoded\/encoded +-- from\/to a binary form. This module holds such functions. +module Crypto.WebAuthn.Encoding.Binary + ( -- * 'M.CollectedClientData' + encodeRawCollectedClientData, + stripRawCollectedClientData, + decodeCollectedClientData, + + -- * 'M.AttestedCredentialData' + encodeRawAttestedCredentialData, + stripRawAttestedCredentialData, + + -- * 'M.AuthenticatorData' + encodeRawAuthenticatorData, + stripRawAuthenticatorData, + decodeAuthenticatorData, + + -- * 'M.AttestationObject' + encodeRawAttestationObject, + stripRawAttestationObject, + encodeAttestationObject, + decodeAttestationObject, + + -- * 'M.AuthenticatorResponse' + encodeRawAuthenticatorResponse, + stripRawAuthenticatorResponse, + + -- * 'M.Credential' + encodeRawCredential, + stripRawCredential, + ) +where + +import qualified Codec.CBOR.Decoding as CBOR +import qualified Codec.CBOR.Read as CBOR +import qualified Codec.CBOR.Term as CBOR +import qualified Codec.CBOR.Write as CBOR +import Codec.Serialise (Serialise (decode), encode) +import Control.Monad (unless) +import Control.Monad.Except (throwError) +import Control.Monad.State (MonadState (get, put), StateT (runStateT)) +import qualified Crypto.Hash as Hash +import Crypto.WebAuthn.Internal.Utils (jsonEncodingOptions) +import Crypto.WebAuthn.Model.Identifier (AAGUID (AAGUID), unAAGUID) +import qualified Crypto.WebAuthn.Model.Kinds as K +import qualified Crypto.WebAuthn.Model.Types as M +import qualified Data.Aeson as Aeson +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary +import Data.Bits ((.|.)) +import qualified Data.Bits as Bits +import Data.ByteArray (convert) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as Base64 +import qualified Data.ByteString.Base64.URL as Base64Url +import Data.ByteString.Builder (Builder, stringUtf8, toLazyByteString) +import qualified Data.ByteString.Lazy as LBS +import qualified Data.HashMap.Strict as HashMap +import Data.Maybe (fromJust, fromMaybe) +import Data.Singletons (SingI (sing)) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import qualified Data.UUID as UUID +import Data.Word (Word16, Word8) +import GHC.Generics (Generic) + +{- +The functions in this module are grouped and named according to the +following conventions: + +* If the type is parametrized by @raw@, there should be @stripRaw@ and + @encodeRaw@ functions +* If the type is serializable there should be a @decode@ + * In addition, if the type has a raw field for its own encoding (implying + that it's parametrized by @raw@), no other function needs to be provided + * Alternatively, there should be an @encode@ that encodes the type, using + any nested raw fields if available + +If the type is parametrized by @raw@, this module should guarantee these +invariants for any @value :: TheType (raw ~ False)@: + +* @stripRaw@ doesn't change any fields: @stripRaw value = value@ +* @encodeRaw@ doesn't change any fields: @stripRaw (encodeRaw value) = value@ +* If the type is also serializable: + * If the type has a raw field, @decode@ inverses @encodeRaw@ and + @getEncoded@: @stripRaw (decode (getEncoded (encodeRaw value))) = value@ + * Alternatively, @decode@ inverses @encodeRaw@ and @encode@: + @stripRaw (decode (encode (encodeRaw value))) = value@ + +If the type is only serializable then this invariant should hold for any +@value :: TheType@ + +* @decode@ inverses @encode@: @decode (encode value) = value@ + +If any such functions are expected to be used only internally, they may not be +exported +-} + +-- | Webauthn contains a mixture of binary formats. For one it's CBOR and for +-- another it's a custom format. For CBOR we wish to use the +-- [cborg](https://hackage.haskell.org/package/cborg) library and for the +-- custom binary format the +-- [binary](https://hackage.haskell.org/package/binary) library. However these +-- two libraries don't interact nicely with each other. Because of this we are +-- specifying decoders that don't consume all input as a 'PartialBinaryDecoder +-- DecodingError', which is just a function that can partially consume a +-- 'LBS.ByteString'. Using this we can somewhat easily flip between the two +-- libraries while decoding without too much nastiness. +type PartialBinaryDecoder a = StateT LBS.ByteString (Either Text) a + +-- | Runs a 'PartialBinaryDecoder' using a strict bytestring. Afterwards it +-- makes sure that no bytes are left, otherwise returns an error. +runPartialBinaryDecoder :: + BS.ByteString -> + PartialBinaryDecoder a -> + Either Text a +runPartialBinaryDecoder bytes decoder = + case runStateT decoder . LBS.fromStrict $ bytes of + Left err -> Left err + Right (result, rest) + | LBS.null rest -> return result + | otherwise -> + Left $ + "Not all binary input used, rest in base64 format is: " + <> decodeUtf8 (Base64.encode $ LBS.toStrict rest) + +-- | A 'PartialBinaryDecoder' for a binary encoding specified using +-- 'Binary.Get'. +runBinary :: + Binary.Get a -> + PartialBinaryDecoder a +runBinary decoder = do + bytes <- get + case Binary.runGetOrFail decoder bytes of + Left (_rest, _offset, err) -> + throwError $ "Binary decoding error: " <> Text.pack err + Right (rest, _offset, result) -> do + put rest + pure result + +-- | A 'PartialBinaryDecoder' for a CBOR encoding specified using the given +-- 'CBOR.Decoder'. +runCBOR :: + (forall s. CBOR.Decoder s a) -> + PartialBinaryDecoder (LBS.ByteString, a) +runCBOR decoder = do + bytes <- get + case CBOR.deserialiseFromBytesWithSize decoder bytes of + Left err -> + throwError $ "CBOR decoding error: " <> Text.pack (show err) + Right (rest, consumed, a) -> do + put rest + pure (LBS.take (fromIntegral consumed) bytes, a) + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#authdataextensions) Encodes +-- [authenticator extension +-- outputs](https://www.w3.org/TR/webauthn-2/#authenticator-extension-output) +-- as a CBOR map. +encodeExtensions :: + M.AuthenticatorExtensionOutputs -> + Builder +encodeExtensions M.AuthenticatorExtensionOutputs {} = + -- TODO: Extensions are not implemented by this library, see the TODO in the + -- module documentation of `Crypto.WebAuthn.Model` for more information. + CBOR.toBuilder $ CBOR.encodeTerm (CBOR.TMap []) + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#authdataextensions) Decodes a +-- CBOR map as [authenticator extension +-- outputs](https://www.w3.org/TR/webauthn-2/#authenticator-extension-output). +decodeExtensions :: + PartialBinaryDecoder M.AuthenticatorExtensionOutputs +decodeExtensions = do + -- TODO: Extensions are not implemented by this library, see the TODO in the + -- module documentation of `Crypto.WebAuthn.Model` for more information. + (_, _extensions :: CBOR.Term) <- runCBOR CBOR.decodeTerm + pure M.AuthenticatorExtensionOutputs {} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-client-data) +-- Intermediate type used to extract the JSON structure stored in the +-- CBOR-encoded +-- [clientDataJSON](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson). +data ClientDataJSON = ClientDataJSON + { littype :: Text, + challenge :: Text, + origin :: Text, + crossOrigin :: Maybe Bool + -- TODO: We do not implement TokenBinding, see the documentation of + -- `CollectedClientData` for more information. + -- tokenBinding :: Maybe TokenBinding + } + deriving (Generic) + +-- Note: Encoding should NOT be derived via aeson, use +-- 'encodeRawCollectedClientData' instead +instance Aeson.FromJSON ClientDataJSON where + parseJSON = Aeson.genericParseJSON jsonEncodingOptions + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-client-data) Encodes +-- all raw fields of a 'M.CollectedClientData' into 'M.ccdRawData' using the +-- [JSON-compatible serialization of client +-- data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-json-compatible-serialization-of-client-data) +-- This function is useful for testing. +encodeRawCollectedClientData :: + forall (c :: K.CeremonyKind) raw. + SingI c => + M.CollectedClientData c raw -> + M.CollectedClientData c 'True +encodeRawCollectedClientData M.CollectedClientData {..} = + M.CollectedClientData {ccdRawData = M.WithRaw bytes, ..} + where + bytes = LBS.toStrict $ toLazyByteString builder + + -- https://www.w3.org/TR/webauthn-2/#clientdatajson-serialization + builder :: Builder + builder = + stringUtf8 "{\"type\":" + <> jsonBuilder typeValue + <> stringUtf8 ",\"challenge\":" + <> jsonBuilder challengeValue + <> stringUtf8 ",\"origin\":" + <> jsonBuilder originValue + <> stringUtf8 ",\"crossOrigin\":" + <> jsonBuilder crossOriginValue + <> stringUtf8 "}" + + typeValue :: Text + typeValue = case sing @c of + K.SRegistration -> "webauthn.create" + K.SAuthentication -> "webauthn.get" + + challengeValue :: Text + challengeValue = decodeUtf8 (Base64Url.encode (M.unChallenge ccdChallenge)) + + originValue :: Text + originValue = M.unOrigin ccdOrigin + + crossOriginValue :: Bool + -- > If crossOrigin is not present, or is false: + -- > Append 0x66616c7365 (false) to result. + crossOriginValue = fromMaybe False ccdCrossOrigin + + jsonBuilder :: Aeson.ToJSON a => a -> Builder + jsonBuilder = Aeson.fromEncoding . Aeson.toEncoding + +-- | Removes all raw fields of a 'M.CollectedClientData'. +stripRawCollectedClientData :: + M.CollectedClientData c raw -> + M.CollectedClientData c 'False +stripRawCollectedClientData M.CollectedClientData {..} = + M.CollectedClientData {ccdRawData = M.NoRaw, ..} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-client-data) Decodes +-- a 'M.CollectedClientData' from a 'BS.ByteString'. This is needed to parse +-- the +-- [clientDataJSON](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson) +-- field in the +-- [AuthenticatorResponse](https://www.w3.org/TR/webauthn-2/#iface-authenticatorresponse) +-- structure, which is used for both attestation and assertion. +decodeCollectedClientData :: + forall (c :: K.CeremonyKind). + SingI c => + BS.ByteString -> + Either Text (M.CollectedClientData c 'True) +decodeCollectedClientData bytes = do + -- + ClientDataJSON {..} <- case Aeson.eitherDecodeStrict bytes of + Left err -> + Left $ + "Collected client data JSON decoding error: " + <> Text.pack err + Right res -> pure res + + -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-challenge) + -- This member contains the base64url encoding of the challenge provided by + -- the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party). See + -- the [§ 13.4.3 Cryptographic + -- Challenges](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges) + -- security consideration. + challenge <- case Base64Url.decode (encodeUtf8 challenge) of + Left err -> + Left $ + "Failed to base64url-decode challenge " + <> challenge + <> ": " + <> Text.pack err + Right res -> pure res + + -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-type) + -- This member contains the string "webauthn.create" when creating new + -- credentials, and "webauthn.get" when getting an assertion from an existing + -- credential. The purpose of this member is to prevent certain types of + -- signature confusion attacks (where an attacker substitutes one legitimate + -- signature for another). + let expectedType = case sing @c of + K.SRegistration -> "webauthn.create" + K.SAuthentication -> "webauthn.get" + unless (littype == expectedType) $ + Left $ + "Expected collected client data to have webauthn type " + <> expectedType + <> " but it is " + <> littype + pure + M.CollectedClientData + { ccdChallenge = M.Challenge challenge, + ccdOrigin = M.Origin origin, + ccdCrossOrigin = crossOrigin, + ccdRawData = M.WithRaw bytes + } + +-- | Encodes all raw fields of a 'M.AttestedCredentialData', particularly +-- encodes 'M.acdCredentialPublicKey' using its 'Serialise' instance into +-- 'M.acdCredentialPublicKeyBytes', see +-- [@credentialPublicKey@](https://www.w3.org/TR/webauthn-2/#credentialpublickey). +encodeRawAttestedCredentialData :: + M.AttestedCredentialData c raw -> + M.AttestedCredentialData c 'True +encodeRawAttestedCredentialData M.AttestedCredentialData {..} = + M.AttestedCredentialData + { acdCredentialPublicKeyBytes = M.WithRaw $ LBS.toStrict bytes, + .. + } + where + bytes = CBOR.toLazyByteString $ encode acdCredentialPublicKey +encodeRawAttestedCredentialData M.NoAttestedCredentialData = + M.NoAttestedCredentialData + +-- | Removes all raw fields of a 'M.AttestedCredentialData'. +stripRawAttestedCredentialData :: + M.AttestedCredentialData c raw -> + M.AttestedCredentialData c 'False +stripRawAttestedCredentialData M.AttestedCredentialData {..} = + M.AttestedCredentialData {acdCredentialPublicKeyBytes = M.NoRaw, ..} +stripRawAttestedCredentialData M.NoAttestedCredentialData = + M.NoAttestedCredentialData + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-attested-credential-data) +-- Encodes attested credential data into bytes, used by +-- 'encodeRawAuthenticatorData'. +encodeAttestedCredentialData :: + M.AttestedCredentialData 'K.Registration 'True -> + Builder +encodeAttestedCredentialData M.AttestedCredentialData {..} = + Binary.execPut (Binary.putLazyByteString $ UUID.toByteString $ unAAGUID acdAaguid) + <> Binary.execPut (Binary.putWord16be credentialLength) + <> Binary.execPut (Binary.putByteString $ M.unCredentialId acdCredentialId) + <> Binary.execPut (Binary.putByteString $ M.unRaw acdCredentialPublicKeyBytes) + where + credentialLength :: Word16 + credentialLength = fromIntegral $ BS.length $ M.unCredentialId acdCredentialId + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-attested-credential-data) +-- Decodes attested credential data from bytes, used by +-- 'decodeAuthenticatorData'. +decodeAttestedCredentialData :: + PartialBinaryDecoder (M.AttestedCredentialData 'K.Registration 'True) +decodeAttestedCredentialData = do + -- https://www.w3.org/TR/webauthn-2/#aaguid + acdAaguid <- + -- Note: fromJust is safe because UUID.fromByteString only returns + -- nothing if there's not exactly 16 bytes + AAGUID . fromJust . UUID.fromByteString + <$> runBinary (Binary.getLazyByteString 16) + + -- https://www.w3.org/TR/webauthn-2/#credentialidlength + credentialLength <- + runBinary Binary.getWord16be + + -- https://www.w3.org/TR/webauthn-2/#credentialid + acdCredentialId <- + M.CredentialId + <$> runBinary (Binary.getByteString (fromIntegral credentialLength)) + + -- https://www.w3.org/TR/webauthn-2/#credentialpublickey + (usedBytes, acdCredentialPublicKey) <- runCBOR decode + let acdCredentialPublicKeyBytes = M.WithRaw $ LBS.toStrict usedBytes + + pure M.AttestedCredentialData {..} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#authenticator-data) +-- Encodes all raw-containing fields of a 'M.AuthenticatorData', particularly +-- 'M.adAttestedCredentialData', and the 'M.AuthenticatorData' itself into +-- 'M.adRawData'. This function is needed for an authenticator implementation. +encodeRawAuthenticatorData :: + forall (c :: K.CeremonyKind) raw. + SingI c => + M.AuthenticatorData c raw -> + M.AuthenticatorData c 'True +encodeRawAuthenticatorData M.AuthenticatorData {..} = + M.AuthenticatorData + { adRawData = M.WithRaw bytes, + adAttestedCredentialData = rawAttestedCredentialData, + .. + } + where + rawAttestedCredentialData = + encodeRawAttestedCredentialData adAttestedCredentialData + + bytes :: BS.ByteString + bytes = LBS.toStrict $ toLazyByteString builder + + -- https://www.w3.org/TR/webauthn-2/#flags + flags :: Word8 + flags = + userPresentFlag + .|. userVerifiedFlag + .|. attestedCredentialDataPresentFlag + .|. extensionsPresentFlag + where + userPresentFlag = if M.adfUserPresent adFlags then Bits.bit 0 else 0 + userVerifiedFlag = if M.adfUserVerified adFlags then Bits.bit 2 else 0 + attestedCredentialDataPresentFlag = case sing @c of + K.SRegistration -> Bits.bit 6 + K.SAuthentication -> 0 + extensionsPresentFlag = case adExtensions of + Just _ -> Bits.bit 7 + Nothing -> 0 + + -- https://www.w3.org/TR/webauthn-2/#sctn-authenticator-data + builder :: Builder + builder = + Binary.execPut (Binary.putByteString $ convert $ M.unRpIdHash adRpIdHash) + <> Binary.execPut (Binary.putWord8 flags) + <> Binary.execPut (Binary.putWord32be $ M.unSignatureCounter adSignCount) + <> ( case sing @c of + K.SRegistration -> + encodeAttestedCredentialData rawAttestedCredentialData + K.SAuthentication -> + mempty + ) + <> maybe mempty encodeExtensions adExtensions + +-- | Removes all raw fields from a 'M.AuthenticatorData'. +stripRawAuthenticatorData :: + M.AuthenticatorData c raw -> + M.AuthenticatorData c 'False +stripRawAuthenticatorData M.AuthenticatorData {..} = + M.AuthenticatorData + { adRawData = M.NoRaw, + adAttestedCredentialData = + stripRawAttestedCredentialData adAttestedCredentialData, + .. + } + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#authenticator-data) Decodes a +-- 'M.AuthenticatorData' from a 'BS.ByteString'. This is needed to parse a +-- webauthn clients +-- [authenticatorData](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-authenticatordata) +-- field in the +-- [AuthenticatorAssertionResponse](https://www.w3.org/TR/webauthn-2/#iface-authenticatorassertionresponse) +-- structure. +decodeAuthenticatorData :: + forall (c :: K.CeremonyKind). + SingI c => + BS.ByteString -> + Either Text (M.AuthenticatorData c 'True) +decodeAuthenticatorData strictBytes = runPartialBinaryDecoder strictBytes $ do + -- https://www.w3.org/TR/webauthn-2/#authenticator-data + let adRawData = M.WithRaw strictBytes + + -- https://www.w3.org/TR/webauthn-2/#rpidhash + adRpIdHash <- + M.RpIdHash . fromJust . Hash.digestFromByteString + <$> runBinary (Binary.getByteString 32) + + -- https://www.w3.org/TR/webauthn-2/#flags + bitFlags <- runBinary Binary.getWord8 + let adFlags = + M.AuthenticatorDataFlags + { M.adfUserPresent = Bits.testBit bitFlags 0, + M.adfUserVerified = Bits.testBit bitFlags 2 + } + + -- https://www.w3.org/TR/webauthn-2/#signcount + adSignCount <- M.SignatureCounter <$> runBinary Binary.getWord32be + + -- https://www.w3.org/TR/webauthn-2/#attestedcredentialdata + adAttestedCredentialData <- case (sing @c, Bits.testBit bitFlags 6) of + -- For [attestation + -- signatures](https://www.w3.org/TR/webauthn-2/#attestation-signature), + -- the authenticator MUST set the AT + -- [flag](https://www.w3.org/TR/webauthn-2/#flags) and include the + -- `[attestedCredentialData](https://www.w3.org/TR/webauthn-2/#attestedcredentialdata)`. + (K.SRegistration, True) -> + decodeAttestedCredentialData + (K.SRegistration, False) -> + throwError "Expected attested credential data, but there is none" + -- For [assertion + -- signatures](https://www.w3.org/TR/webauthn-2/#assertion-signature), the + -- AT [flag](https://www.w3.org/TR/webauthn-2/#flags) MUST NOT be set and + -- the + -- `[attestedCredentialData](https://www.w3.org/TR/webauthn-2/#attestedcredentialdata)` + -- MUST NOT be included. + (K.SAuthentication, False) -> + pure M.NoAttestedCredentialData + (K.SAuthentication, True) -> + throwError "Expected no attested credential data, but there is" + + -- https://www.w3.org/TR/webauthn-2/#authdataextensions + adExtensions <- + if Bits.testBit bitFlags 7 + then Just <$> decodeExtensions + else pure Nothing + + pure M.AuthenticatorData {..} + +-- | Encodes all raw fields of an 'M.AttestationObject'. +encodeRawAttestationObject :: + M.AttestationObject raw -> + M.AttestationObject 'True +encodeRawAttestationObject M.AttestationObject {..} = + M.AttestationObject + { aoAuthData = encodeRawAuthenticatorData aoAuthData, + .. + } + +-- | Removes all raw fields of an 'M.AttestationObject'. +stripRawAttestationObject :: + M.AttestationObject raw -> + M.AttestationObject 'False +stripRawAttestationObject M.AttestationObject {..} = + M.AttestationObject + { aoAuthData = stripRawAuthenticatorData aoAuthData, + .. + } + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object) +-- Encodes an 'M.AttestationObject' as a 'BS.ByteString'. This is needed by +-- the client side to generate a valid JSON response. +encodeAttestationObject :: + M.AttestationObject 'True -> + BS.ByteString +encodeAttestationObject M.AttestationObject {..} = + CBOR.toStrictByteString $ CBOR.encodeTerm term + where + -- https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object + term :: CBOR.Term + term = + CBOR.TMap + [ (CBOR.TString "authData", CBOR.TBytes $ M.unRaw $ M.adRawData aoAuthData), + (CBOR.TString "fmt", CBOR.TString $ M.asfIdentifier aoFmt), + (CBOR.TString "attStmt", M.asfEncode aoFmt aoAttStmt) + ] + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object) +-- Decodes a 'M.AttestationObject' from a 'BS.ByteString'. This is needed to +-- parse a webauthn clients +-- [attestationObject](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-attestationobject) +-- field in the +-- [AuthenticatorAttestationResponse](https://www.w3.org/TR/webauthn-2/#iface-authenticatorattestationresponse) +-- structure This function takes a 'M.SupportedAttestationStatementFormats' +-- argument to indicate which attestation statement formats are supported. +-- structure. +decodeAttestationObject :: + M.SupportedAttestationStatementFormats -> + BS.ByteString -> + Either Text (M.AttestationObject 'True) +decodeAttestationObject supportedFormats bytes = do + (_consumed, result) <- + runPartialBinaryDecoder bytes (runCBOR CBOR.decodeTerm) + pairs <- case result of + CBOR.TMap pairs -> return pairs + _ -> + Left $ + "The attestation object should be a CBOR map, but it's not: " + <> Text.pack (show result) + + -- https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object + case ( CBOR.TString "authData" `lookup` pairs, + CBOR.TString "fmt" `lookup` pairs, + CBOR.TString "attStmt" `lookup` pairs + ) of + ( Just (CBOR.TBytes authDataBytes), + Just (CBOR.TString fmt), + Just (CBOR.TMap attStmtPairs) + ) -> do + aoAuthData <- decodeAuthenticatorData authDataBytes + + case M.lookupAttestationStatementFormat fmt supportedFormats of + Nothing -> Left $ "Unknown attestation statement format: " <> fmt + Just (M.SomeAttestationStatementFormat aoFmt) -> do + attStmtMap <- + HashMap.fromList + <$> traverse textKeyPairs attStmtPairs + aoAttStmt <- M.asfDecode aoFmt attStmtMap + pure M.AttestationObject {..} + _ -> + Left $ + "The attestation object doesn't have the expected structure of " + <> "(authData: bytes, fmt: string, attStmt: map): " + <> Text.pack (show result) + where + textKeyPairs (CBOR.TString text, term) = pure (text, term) + textKeyPairs (nonString, _) = + Left $ + "Unexpected non-string attestation statement key: " + <> Text.pack (show nonString) + +-- | Encode all raw fields of an 'M.AuthenticatorResponse'. +encodeRawAuthenticatorResponse :: + M.AuthenticatorResponse c raw -> + M.AuthenticatorResponse c 'True +encodeRawAuthenticatorResponse M.AuthenticatorResponseRegistration {..} = + M.AuthenticatorResponseRegistration + { arrClientData = encodeRawCollectedClientData arrClientData, + arrAttestationObject = encodeRawAttestationObject arrAttestationObject, + .. + } +encodeRawAuthenticatorResponse M.AuthenticatorResponseAuthentication {..} = + M.AuthenticatorResponseAuthentication + { araClientData = encodeRawCollectedClientData araClientData, + araAuthenticatorData = encodeRawAuthenticatorData araAuthenticatorData, + .. + } + +-- | Removes all raw fields of an 'M.AuthenticatorResponse'. +stripRawAuthenticatorResponse :: + M.AuthenticatorResponse c raw -> + M.AuthenticatorResponse c 'False +stripRawAuthenticatorResponse M.AuthenticatorResponseRegistration {..} = + M.AuthenticatorResponseRegistration + { arrClientData = stripRawCollectedClientData arrClientData, + arrAttestationObject = stripRawAttestationObject arrAttestationObject, + .. + } +stripRawAuthenticatorResponse M.AuthenticatorResponseAuthentication {..} = + M.AuthenticatorResponseAuthentication + { araClientData = stripRawCollectedClientData araClientData, + araAuthenticatorData = stripRawAuthenticatorData araAuthenticatorData, + .. + } + +-- | Encodes all raw fields of an 'M.Credential'. +encodeRawCredential :: + M.Credential c raw -> + M.Credential c 'True +encodeRawCredential M.Credential {..} = + M.Credential + { cResponse = encodeRawAuthenticatorResponse cResponse, + .. + } + +-- | Removes all raw fields of an 'M.Credential'. +stripRawCredential :: + M.Credential c raw -> + M.Credential c 'False +stripRawCredential M.Credential {..} = + M.Credential + { cResponse = stripRawAuthenticatorResponse cResponse, + .. + } diff --git a/src/Crypto/WebAuthn/Encoding/Internal/WebAuthnJson.hs b/src/Crypto/WebAuthn/Encoding/Internal/WebAuthnJson.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/WebAuthn/Encoding/Internal/WebAuthnJson.hs @@ -0,0 +1,666 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +-- | Stability: internal +-- This module implements decoding\/encoding from\/to +-- [webauthn-json](https://github.com/github/webauthn-json) JSON values to the +-- Haskell types defined in "Crypto.WebAuthn.Model.Types". +module Crypto.WebAuthn.Encoding.Internal.WebAuthnJson + ( -- * Top-level types + PublicKeyCredentialCreationOptions (..), + PublicKeyCredentialRequestOptions (..), + PublicKeyCredential (..), + + -- * Nested types + AuthenticatorAttestationResponse (..), + AuthenticatorAssertionResponse (..), + PublicKeyCredentialRpEntity (..), + PublicKeyCredentialUserEntity (..), + PublicKeyCredentialParameters (..), + COSEAlgorithmIdentifier, + PublicKeyCredentialDescriptor (..), + AuthenticatorSelectionCriteria (..), + Base64UrlString (..), + + -- * Type classes + Encode (..), + Decode (..), + ) +where + +import Control.Monad.Except (MonadError, liftEither) +import Control.Monad.Reader (MonadReader (ask)) +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose +import qualified Crypto.WebAuthn.Encoding.Binary as B +import qualified Crypto.WebAuthn.Encoding.Strings as S +import Crypto.WebAuthn.Internal.Utils (jsonEncodingOptions) +import qualified Crypto.WebAuthn.Model.Defaults as D +import qualified Crypto.WebAuthn.Model.Kinds as K +import qualified Crypto.WebAuthn.Model.Types as T +import qualified Data.Aeson as Aeson +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64.URL as Base64Url +import Data.Coerce (Coercible, coerce) +import Data.Int (Int32) +import Data.Kind (Type) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Singletons (SingI) +import Data.Text (Text) +import qualified Data.Text.Encoding as Text +import Data.Word (Word32) +import GHC.Generics (Generic) + +-- | A type class to indicate that some Haskell type @a@ can be encoded to a +-- corresponding JSON-serializable webauthn-json type @'JSON' a@ using 'encode' +class Encode a where + type JSON a :: Type + + -- | Encodes a value to its webauthn-json equivalent + encode :: a -> JSON a + default encode :: Coercible a (JSON a) => a -> JSON a + encode = coerce + +-- | An extension of 'Encode' to decoding. This typeclass is parametrized by a +-- 'Monad' @m@ since decoding certain structures requires additional +-- information to succeed, specifically +-- 'M.SupportedAttestationStatementFormats', which can be provided with a +-- 'MonadReader' constraint +class Encode a => Decode m a where + -- | Decodes a webauthn-json type, potentially throwing a 'Text' error + decode :: MonadError Text m => JSON a -> m a + default decode :: (MonadError Text m, Coercible (JSON a) a) => JSON a -> m a + decode = pure . coerce + +-- | Decodes an optional value with a default +decodeWithDefault :: (MonadError Text m, Decode m a) => a -> Maybe (JSON a) -> m a +decodeWithDefault def Nothing = pure def +decodeWithDefault _ (Just value) = decode value + +instance (Functor f, Encode a) => Encode (f a) where + type JSON (f a) = f (JSON a) + encode = fmap encode + +instance (Traversable f, Decode m a) => Decode m (f a) where + decode = traverse decode + +-- | A base64url encoded string. Its 'Aeson.FromJSON'\/'Aeson.ToJSON' instances +-- do the conversion +newtype Base64UrlString = Base64UrlString {unBase64UrlString :: BS.ByteString} + deriving (Show, Eq) + +-- | Decodes a base64url encoded JSON string into the bytes it represents +instance Aeson.FromJSON Base64UrlString where + parseJSON = Aeson.withText "base64url" $ \t -> + either fail (pure . Base64UrlString) (Base64Url.decode $ Text.encodeUtf8 t) + +-- | Encodes bytes using base64url to a JSON string +instance Aeson.ToJSON Base64UrlString where + toJSON = Aeson.String . Text.decodeUtf8 . Base64Url.encodeUnpadded . unBase64UrlString + +instance Encode T.Timeout where + type JSON T.Timeout = Word32 + +instance Decode m T.Timeout + +instance Encode T.RpId where + type JSON T.RpId = Text + +instance Decode m T.RpId + +instance Encode T.RelyingPartyName where + type JSON T.RelyingPartyName = Text + +instance Decode m T.RelyingPartyName + +instance Encode T.UserHandle where + type JSON T.UserHandle = Base64UrlString + +instance Decode m T.UserHandle + +instance Encode T.UserAccountDisplayName where + type JSON T.UserAccountDisplayName = Text + +instance Decode m T.UserAccountDisplayName + +instance Encode T.UserAccountName where + type JSON T.UserAccountName = Text + +instance Decode m T.UserAccountName + +instance Encode T.Challenge where + type JSON T.Challenge = Base64UrlString + +instance Decode m T.Challenge + +instance Encode T.CredentialId where + type JSON T.CredentialId = Base64UrlString + +instance Decode m T.CredentialId + +instance Encode T.AssertionSignature where + type JSON T.AssertionSignature = Base64UrlString + +instance Decode m T.AssertionSignature + +{- +Note: The spec often mentions that _client platforms_ must ignore unknown +values, but since we implement a RP, we don't need to concern ourselves with +that. + +The only place where we do need to concern ourselves with it is the +[transports](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-transports-slot) +field returned from the client, which in Level 2 of the spec mentions: + +> The values SHOULD be members of +> `[AuthenticatorTransport](https://www.w3.org/TR/webauthn-2/#enumdef-authenticatortransport)` +> but [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) MUST +> ignore unknown values. + +However that doesn't say what should happen in case of unknown values. This has +been fixed in a more recent version of the spec, see +https://github.com/w3c/webauthn/issues/1587. It will say this in the future: + +> The values SHOULD be members of AuthenticatorTransport but Relying Parties +> SHOULD accept and store unknown values. +-} + +instance Encode T.CredentialType where + type JSON T.CredentialType = Text + encode = S.encodeCredentialType + +instance Decode m T.CredentialType where + decode = liftEither . S.decodeCredentialType + +instance Encode T.UserVerificationRequirement where + type JSON T.UserVerificationRequirement = Text + encode = S.encodeUserVerificationRequirement + +instance Decode m T.UserVerificationRequirement where + decode = liftEither . S.decodeUserVerificationRequirement + +instance Encode T.AuthenticatorAttachment where + type JSON T.AuthenticatorAttachment = Text + encode = S.encodeAuthenticatorAttachment + +instance Decode m T.AuthenticatorAttachment where + decode = liftEither . S.decodeAuthenticatorAttachment + +instance Encode T.ResidentKeyRequirement where + type JSON T.ResidentKeyRequirement = Text + encode = S.encodeResidentKeyRequirement + +instance Decode m T.ResidentKeyRequirement where + decode = liftEither . S.decodeResidentKeyRequirement + +instance Encode T.AttestationConveyancePreference where + type JSON T.AttestationConveyancePreference = Text + encode = S.encodeAttestationConveyancePreference + +instance Decode m T.AttestationConveyancePreference where + decode = liftEither . S.decodeAttestationConveyancePreference + +instance Encode T.AuthenticatorTransport where + type JSON T.AuthenticatorTransport = Text + encode = S.encodeAuthenticatorTransport + +instance Decode m T.AuthenticatorTransport where + decode = pure . S.decodeAuthenticatorTransport + +instance Encode Cose.CoseSignAlg where + type JSON Cose.CoseSignAlg = Int32 + encode = Cose.fromCoseSignAlg + +instance Decode m Cose.CoseSignAlg where + decode = liftEither . Cose.toCoseSignAlg + +instance Encode T.AuthenticationExtensionsClientInputs where + type JSON T.AuthenticationExtensionsClientInputs = Map Text Aeson.Value + + -- TODO: Extensions are not implemented by this library, see the TODO in the + -- module documentation of `Crypto.WebAuthn.Model` for more information. + encode T.AuthenticationExtensionsClientInputs {} = Map.empty + +instance Decode m T.AuthenticationExtensionsClientInputs where + -- TODO: Extensions are not implemented by this library, see the TODO in the + -- module documentation of `Crypto.WebAuthn.Model` for more information. + decode _ = pure T.AuthenticationExtensionsClientInputs {} + +instance Encode T.AuthenticationExtensionsClientOutputs where + type JSON T.AuthenticationExtensionsClientOutputs = Map Text Aeson.Value + + -- TODO: Extensions are not implemented by this library, see the TODO in the + -- module documentation of `Crypto.WebAuthn.Model` for more information. + encode T.AuthenticationExtensionsClientOutputs {} = Map.empty + +instance Decode m T.AuthenticationExtensionsClientOutputs where + -- TODO: Extensions are not implemented by this library, see the TODO in the + -- module documentation of `Crypto.WebAuthn.Model` for more information. + decode _ = pure T.AuthenticationExtensionsClientOutputs {} + +instance SingI c => Encode (T.CollectedClientData (c :: K.CeremonyKind) 'True) where + type JSON (T.CollectedClientData c 'True) = Base64UrlString + encode = Base64UrlString . T.unRaw . T.ccdRawData + +instance SingI c => Decode m (T.CollectedClientData (c :: K.CeremonyKind) 'True) where + decode = liftEither . B.decodeCollectedClientData . unBase64UrlString + +instance Encode (T.AttestationObject 'True) where + type JSON (T.AttestationObject 'True) = Base64UrlString + encode = Base64UrlString . B.encodeAttestationObject + +instance + MonadReader T.SupportedAttestationStatementFormats m => + Decode m (T.AttestationObject 'True) + where + decode (Base64UrlString bytes) = do + supportedFormats <- ask + liftEither $ B.decodeAttestationObject supportedFormats bytes + +instance Encode (T.AuthenticatorData 'K.Authentication 'True) where + type JSON (T.AuthenticatorData 'K.Authentication 'True) = Base64UrlString + encode = Base64UrlString . T.unRaw . T.adRawData + +instance Decode m (T.AuthenticatorData 'K.Authentication 'True) where + decode = liftEither . B.decodeAuthenticatorData . unBase64UrlString + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-makecredentialoptions) +data PublicKeyCredentialCreationOptions = PublicKeyCredentialCreationOptions + { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-rp) + rp :: PublicKeyCredentialRpEntity, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-user) + user :: PublicKeyCredentialUserEntity, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-challenge) + challenge :: Base64UrlString, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-pubkeycredparams) + pubKeyCredParams :: [PublicKeyCredentialParameters], + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-timeout) + timeout :: Maybe Word32, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-excludecredentials) + excludeCredentials :: Maybe [PublicKeyCredentialDescriptor], + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-authenticatorselection) + authenticatorSelection :: Maybe AuthenticatorSelectionCriteria, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-attestation) + attestation :: Maybe Text, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-extensions) + extensions :: Maybe (Map Text Aeson.Value) + } + deriving (Eq, Show, Generic) + +instance Aeson.FromJSON PublicKeyCredentialCreationOptions where + parseJSON = Aeson.genericParseJSON jsonEncodingOptions + +instance Aeson.ToJSON PublicKeyCredentialCreationOptions where + toJSON = Aeson.genericToJSON jsonEncodingOptions + +instance Encode (T.CredentialOptions 'K.Registration) where + type JSON (T.CredentialOptions 'K.Registration) = PublicKeyCredentialCreationOptions + encode T.CredentialOptionsRegistration {..} = + PublicKeyCredentialCreationOptions + { rp = encode corRp, + user = encode corUser, + challenge = encode corChallenge, + pubKeyCredParams = encode corPubKeyCredParams, + timeout = encode corTimeout, + excludeCredentials = Just $ encode corExcludeCredentials, + authenticatorSelection = encode corAuthenticatorSelection, + attestation = Just $ encode corAttestation, + extensions = encode corExtensions + } + +instance Decode m (T.CredentialOptions 'K.Registration) where + decode PublicKeyCredentialCreationOptions {..} = do + corRp <- decode rp + corUser <- decode user + corChallenge <- decode challenge + corPubKeyCredParams <- decode pubKeyCredParams + corTimeout <- decode timeout + corExcludeCredentials <- decodeWithDefault D.corExcludeCredentialsDefault excludeCredentials + corAuthenticatorSelection <- decode authenticatorSelection + corAttestation <- decodeWithDefault D.corAttestationDefault attestation + corExtensions <- decode extensions + pure $ T.CredentialOptionsRegistration {..} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-assertion-options) +data PublicKeyCredentialRequestOptions = PublicKeyCredentialRequestOptions + { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-challenge) + challenge :: Base64UrlString, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-timeout) + timeout :: Maybe Word32, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-rpid) + rpId :: Maybe Text, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-allowcredentials) + allowCredentials :: Maybe [PublicKeyCredentialDescriptor], + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-userverification) + userVerification :: Maybe Text, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-extensions) + extensions :: Maybe (Map Text Aeson.Value) + } + deriving (Eq, Show, Generic) + +instance Aeson.FromJSON PublicKeyCredentialRequestOptions where + parseJSON = Aeson.genericParseJSON jsonEncodingOptions + +instance Aeson.ToJSON PublicKeyCredentialRequestOptions where + toJSON = Aeson.genericToJSON jsonEncodingOptions + +instance Encode (T.CredentialOptions 'K.Authentication) where + type JSON (T.CredentialOptions 'K.Authentication) = PublicKeyCredentialRequestOptions + encode T.CredentialOptionsAuthentication {..} = + PublicKeyCredentialRequestOptions + { challenge = encode coaChallenge, + timeout = encode coaTimeout, + rpId = encode coaRpId, + allowCredentials = Just $ encode coaAllowCredentials, + userVerification = Just $ encode coaUserVerification, + extensions = encode coaExtensions + } + +instance Decode m (T.CredentialOptions 'K.Authentication) where + decode PublicKeyCredentialRequestOptions {..} = do + coaChallenge <- decode challenge + coaTimeout <- decode timeout + coaRpId <- decode rpId + coaAllowCredentials <- decodeWithDefault D.coaAllowCredentialsDefault allowCredentials + coaUserVerification <- decodeWithDefault D.coaUserVerificationDefault userVerification + coaExtensions <- decode extensions + pure $ T.CredentialOptionsAuthentication {..} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-rp-credential-params) +data PublicKeyCredentialRpEntity = PublicKeyCredentialRpEntity + { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrpentity-id) + id :: Maybe Text, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name) + name :: Text + } + deriving (Eq, Show, Generic) + +instance Aeson.FromJSON PublicKeyCredentialRpEntity where + parseJSON = Aeson.genericParseJSON jsonEncodingOptions + +instance Aeson.ToJSON PublicKeyCredentialRpEntity where + toJSON = Aeson.genericToJSON jsonEncodingOptions + +instance Encode T.CredentialRpEntity where + type JSON T.CredentialRpEntity = PublicKeyCredentialRpEntity + encode T.CredentialRpEntity {..} = + PublicKeyCredentialRpEntity + { id = encode creId, + name = encode creName + } + +instance Decode m T.CredentialRpEntity where + decode PublicKeyCredentialRpEntity {..} = do + creId <- decode id + creName <- decode name + pure $ T.CredentialRpEntity {..} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-user-credential-params) +data PublicKeyCredentialUserEntity = PublicKeyCredentialUserEntity + { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-id) + id :: Base64UrlString, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-displayname) + displayName :: Text, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name) + name :: Text + } + deriving (Eq, Show, Generic) + +instance Aeson.FromJSON PublicKeyCredentialUserEntity where + parseJSON = Aeson.genericParseJSON jsonEncodingOptions + +instance Aeson.ToJSON PublicKeyCredentialUserEntity where + toJSON = Aeson.genericToJSON jsonEncodingOptions + +instance Encode T.CredentialUserEntity where + type JSON T.CredentialUserEntity = PublicKeyCredentialUserEntity + encode T.CredentialUserEntity {..} = + PublicKeyCredentialUserEntity + { id = encode cueId, + displayName = encode cueDisplayName, + name = encode cueName + } + +instance Decode m T.CredentialUserEntity where + decode PublicKeyCredentialUserEntity {..} = do + cueId <- decode id + cueDisplayName <- decode displayName + cueName <- decode name + pure $ T.CredentialUserEntity {..} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-credential-params) +data PublicKeyCredentialParameters = PublicKeyCredentialParameters + { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialparameters-type) + littype :: Text, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialparameters-alg) + alg :: COSEAlgorithmIdentifier + } + deriving (Eq, Show, Generic) + +instance Aeson.FromJSON PublicKeyCredentialParameters where + parseJSON = Aeson.genericParseJSON jsonEncodingOptions + +instance Aeson.ToJSON PublicKeyCredentialParameters where + toJSON = Aeson.genericToJSON jsonEncodingOptions + +instance Encode T.CredentialParameters where + type JSON T.CredentialParameters = PublicKeyCredentialParameters + encode T.CredentialParameters {..} = + PublicKeyCredentialParameters + { littype = encode cpTyp, + alg = encode cpAlg + } + +instance Decode m T.CredentialParameters where + decode PublicKeyCredentialParameters {..} = do + cpTyp <- decode littype + cpAlg <- decode alg + pure T.CredentialParameters {..} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-alg-identifier) +type COSEAlgorithmIdentifier = Int32 + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialdescriptor) +data PublicKeyCredentialDescriptor = PublicKeyCredentialDescriptor + { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-type) + littype :: Text, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-id) + id :: Base64UrlString, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-transports) + transports :: Maybe [Text] + } + deriving (Eq, Show, Generic) + +instance Aeson.FromJSON PublicKeyCredentialDescriptor where + parseJSON = Aeson.genericParseJSON jsonEncodingOptions + +instance Aeson.ToJSON PublicKeyCredentialDescriptor where + toJSON = Aeson.genericToJSON jsonEncodingOptions + +instance Encode T.CredentialDescriptor where + type JSON T.CredentialDescriptor = PublicKeyCredentialDescriptor + encode T.CredentialDescriptor {..} = + PublicKeyCredentialDescriptor + { littype = encode cdTyp, + id = encode cdId, + transports = encode cdTransports + } + +instance Decode m T.CredentialDescriptor where + decode PublicKeyCredentialDescriptor {..} = do + cdTyp <- decode littype + cdId <- decode id + cdTransports <- decode transports + pure T.CredentialDescriptor {..} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-authenticatorselectioncriteria) +data AuthenticatorSelectionCriteria = AuthenticatorSelectionCriteria + { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-authenticatorattachment) + authenticatorAttachment :: Maybe Text, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-residentkey) + residentKey :: Maybe Text, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-requireresidentkey) + requireResidentKey :: Maybe Bool, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-userverification) + userVerification :: Maybe Text + } + deriving (Eq, Show, Generic) + +instance Aeson.FromJSON AuthenticatorSelectionCriteria where + parseJSON = Aeson.genericParseJSON jsonEncodingOptions + +instance Aeson.ToJSON AuthenticatorSelectionCriteria where + toJSON = Aeson.genericToJSON jsonEncodingOptions + +instance Encode T.AuthenticatorSelectionCriteria where + type JSON T.AuthenticatorSelectionCriteria = AuthenticatorSelectionCriteria + encode T.AuthenticatorSelectionCriteria {..} = + AuthenticatorSelectionCriteria + { authenticatorAttachment = encode ascAuthenticatorAttachment, + residentKey = Just $ encode ascResidentKey, + -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-requireresidentkey) + -- Relying Parties SHOULD set it to true if, and only if, residentKey is set to required. + requireResidentKey = Just (ascResidentKey == T.ResidentKeyRequirementRequired), + userVerification = Just $ encode ascUserVerification + } + +instance Decode m T.AuthenticatorSelectionCriteria where + decode AuthenticatorSelectionCriteria {..} = do + ascAuthenticatorAttachment <- decode authenticatorAttachment + ascResidentKey <- decodeWithDefault (D.ascResidentKeyDefault requireResidentKey) residentKey + ascUserVerification <- decodeWithDefault D.ascUserVerificationDefault userVerification + pure $ T.AuthenticatorSelectionCriteria {..} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-pkcredential) +data PublicKeyCredential response = PublicKeyCredential + { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-identifier-slot) + rawId :: Base64UrlString, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-response) + response :: response, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-getclientextensionresults) + clientExtensionResults :: Map Text Aeson.Value + } + deriving (Eq, Show, Generic) + +instance Aeson.FromJSON response => Aeson.FromJSON (PublicKeyCredential response) where + parseJSON = Aeson.genericParseJSON jsonEncodingOptions + +instance Aeson.ToJSON response => Aeson.ToJSON (PublicKeyCredential response) where + toJSON = Aeson.genericToJSON jsonEncodingOptions + +instance Encode (T.Credential 'K.Registration 'True) where + type JSON (T.Credential 'K.Registration 'True) = PublicKeyCredential AuthenticatorAttestationResponse + encode T.Credential {..} = + PublicKeyCredential + { rawId = encode cIdentifier, + response = encode cResponse, + clientExtensionResults = encode cClientExtensionResults + } + +instance + MonadReader T.SupportedAttestationStatementFormats m => + Decode m (T.Credential 'K.Registration 'True) + where + decode PublicKeyCredential {..} = do + cIdentifier <- decode rawId + cResponse <- decode response + cClientExtensionResults <- decode clientExtensionResults + pure $ T.Credential {..} + +instance Encode (T.Credential 'K.Authentication 'True) where + type JSON (T.Credential 'K.Authentication 'True) = PublicKeyCredential AuthenticatorAssertionResponse + encode T.Credential {..} = + PublicKeyCredential + { rawId = encode cIdentifier, + response = encode cResponse, + clientExtensionResults = encode cClientExtensionResults + } + +instance Decode m (T.Credential 'K.Authentication 'True) where + decode PublicKeyCredential {..} = do + cIdentifier <- decode rawId + cResponse <- decode response + cClientExtensionResults <- decode clientExtensionResults + pure $ T.Credential {..} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authenticatorattestationresponse) +data AuthenticatorAttestationResponse = AuthenticatorAttestationResponse + { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson) + clientDataJSON :: Base64UrlString, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-attestationobject) + attestationObject :: Base64UrlString, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-transports-slot) + -- This field is only being propagated by webauthn-json [since recently](https://github.com/github/webauthn-json/pull/44), + -- which is why we allow absence of this value + transports :: Maybe [Text] + } + deriving (Eq, Show, Generic) + +instance Aeson.FromJSON AuthenticatorAttestationResponse where + parseJSON = Aeson.genericParseJSON jsonEncodingOptions + +instance Aeson.ToJSON AuthenticatorAttestationResponse where + toJSON = Aeson.genericToJSON jsonEncodingOptions + +instance Encode (T.AuthenticatorResponse 'K.Registration 'True) where + type JSON (T.AuthenticatorResponse 'K.Registration 'True) = AuthenticatorAttestationResponse + encode T.AuthenticatorResponseRegistration {..} = + AuthenticatorAttestationResponse + { clientDataJSON = encode arrClientData, + attestationObject = encode arrAttestationObject, + transports = Just $ encode arrTransports + } + +instance + MonadReader T.SupportedAttestationStatementFormats m => + Decode m (T.AuthenticatorResponse 'K.Registration 'True) + where + decode AuthenticatorAttestationResponse {..} = do + arrClientData <- decode clientDataJSON + arrAttestationObject <- decode attestationObject + -- Older webauthn-json versions don't add that field + arrTransports <- decodeWithDefault [] transports + pure $ T.AuthenticatorResponseRegistration {..} + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authenticatorassertionresponse) +data AuthenticatorAssertionResponse = AuthenticatorAssertionResponse + { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson) + clientDataJSON :: Base64UrlString, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-authenticatordata) + authenticatorData :: Base64UrlString, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-signature) + signature :: Base64UrlString, + -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-userhandle) + userHandle :: Maybe Base64UrlString + } + deriving (Eq, Show, Generic) + +instance Aeson.FromJSON AuthenticatorAssertionResponse where + parseJSON = Aeson.genericParseJSON jsonEncodingOptions + +instance Aeson.ToJSON AuthenticatorAssertionResponse where + toJSON = Aeson.genericToJSON jsonEncodingOptions + +instance Encode (T.AuthenticatorResponse 'K.Authentication 'True) where + type JSON (T.AuthenticatorResponse 'K.Authentication 'True) = AuthenticatorAssertionResponse + encode T.AuthenticatorResponseAuthentication {..} = + AuthenticatorAssertionResponse + { clientDataJSON = encode araClientData, + authenticatorData = encode araAuthenticatorData, + signature = encode araSignature, + userHandle = encode araUserHandle + } + +instance Decode m (T.AuthenticatorResponse 'K.Authentication 'True) where + decode AuthenticatorAssertionResponse {..} = do + araClientData <- decode clientDataJSON + araAuthenticatorData <- decode authenticatorData + araSignature <- decode signature + araUserHandle <- decode userHandle + pure $ T.AuthenticatorResponseAuthentication {..} diff --git a/src/Crypto/WebAuthn/Encoding/Strings.hs b/src/Crypto/WebAuthn/Encoding/Strings.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/WebAuthn/Encoding/Strings.hs @@ -0,0 +1,133 @@ +-- | Stability: experimental +-- This module provides functions for encoding and decoding WebAuthn enum types +-- between their Haskell types defined in "Crypto.WebAuthn.Model.Types" and +-- their string forms. +module Crypto.WebAuthn.Encoding.Strings + ( encodeCredentialType, + decodeCredentialType, + encodeUserVerificationRequirement, + decodeUserVerificationRequirement, + encodeAuthenticatorAttachment, + decodeAuthenticatorAttachment, + encodeResidentKeyRequirement, + decodeResidentKeyRequirement, + encodeAttestationConveyancePreference, + decodeAttestationConveyancePreference, + encodeAuthenticatorTransport, + decodeAuthenticatorTransport, + ) +where + +import qualified Crypto.WebAuthn.Model.Types as T +import Data.Text (Text) + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-publickeycredentialtype) +-- Encodes a 'T.CredentialType' to a string. +encodeCredentialType :: T.CredentialType -> Text +encodeCredentialType T.CredentialTypePublicKey = "public-key" + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-publickeycredentialtype) +-- Decodes a string into a 'T.CredentialType', returning 'Left' when the string +-- isn't known to be an enum value. +decodeCredentialType :: Text -> Either Text T.CredentialType +decodeCredentialType "public-key" = pure T.CredentialTypePublicKey +decodeCredentialType str = Left $ "Unknown PublicKeyCredentialType string: " <> str + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-userVerificationRequirement) +-- Encodes a 'T.UserVerificationRequirement' to a string. +encodeUserVerificationRequirement :: T.UserVerificationRequirement -> Text +encodeUserVerificationRequirement T.UserVerificationRequirementRequired = "required" +encodeUserVerificationRequirement T.UserVerificationRequirementPreferred = "preferred" +encodeUserVerificationRequirement T.UserVerificationRequirementDiscouraged = "discouraged" + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-userVerificationRequirement) +-- Decodes a string into a 'T.UserVerificationRequirement', returning 'Left' when +-- the string isn't known to be an enum value. +decodeUserVerificationRequirement :: Text -> Either Text T.UserVerificationRequirement +decodeUserVerificationRequirement "discouraged" = pure T.UserVerificationRequirementDiscouraged +decodeUserVerificationRequirement "preferred" = pure T.UserVerificationRequirementPreferred +decodeUserVerificationRequirement "required" = pure T.UserVerificationRequirementRequired +decodeUserVerificationRequirement str = Left $ "Unknown UserVerificationRequirement string: " <> str + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-authenticatorattachment) +-- Encodes a 'T.AuthenticatorAttachment' to a string. +encodeAuthenticatorAttachment :: T.AuthenticatorAttachment -> Text +encodeAuthenticatorAttachment T.AuthenticatorAttachmentPlatform = "platform" +encodeAuthenticatorAttachment T.AuthenticatorAttachmentCrossPlatform = "cross-platform" + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-authenticatorattachment) +-- Decodes a string into a 'T.AuthenticatorAttachment', returning 'Left' when +-- the string isn't known to be an enum value. +decodeAuthenticatorAttachment :: Text -> Either Text T.AuthenticatorAttachment +decodeAuthenticatorAttachment "platform" = pure T.AuthenticatorAttachmentPlatform +decodeAuthenticatorAttachment "cross-platform" = pure T.AuthenticatorAttachmentCrossPlatform +decodeAuthenticatorAttachment str = Left $ "Unknown AuthenticatorAttachment string: " <> str + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-residentKeyRequirement) +-- Encodes a 'T.ResidentKeyRequirement' to a string. +encodeResidentKeyRequirement :: T.ResidentKeyRequirement -> Text +encodeResidentKeyRequirement T.ResidentKeyRequirementDiscouraged = "discouraged" +encodeResidentKeyRequirement T.ResidentKeyRequirementPreferred = "preferred" +encodeResidentKeyRequirement T.ResidentKeyRequirementRequired = "required" + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-residentKeyRequirement) +-- Decodes a string into a 'T.ResidentKeyRequirement', returning 'Left' when +-- the string isn't known to be an enum value. +decodeResidentKeyRequirement :: Text -> Either Text T.ResidentKeyRequirement +decodeResidentKeyRequirement "discouraged" = pure T.ResidentKeyRequirementDiscouraged +decodeResidentKeyRequirement "preferred" = pure T.ResidentKeyRequirementPreferred +decodeResidentKeyRequirement "required" = pure T.ResidentKeyRequirementRequired +decodeResidentKeyRequirement str = Left $ "Unknown ResidentKeyRequirement string: " <> str + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-attestation-convey) +-- Encodes a 'T.AttestationConveyancePreference' to a string. +encodeAttestationConveyancePreference :: T.AttestationConveyancePreference -> Text +encodeAttestationConveyancePreference T.AttestationConveyancePreferenceNone = "none" +encodeAttestationConveyancePreference T.AttestationConveyancePreferenceIndirect = "indirect" +encodeAttestationConveyancePreference T.AttestationConveyancePreferenceDirect = "direct" +encodeAttestationConveyancePreference T.AttestationConveyancePreferenceEnterprise = "enterprise" + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-attestation-convey) +-- Decodes a string into a 'T.AttestationConveyancePreference', returning 'Left' when +-- the string isn't known to be an enum value. +decodeAttestationConveyancePreference :: Text -> Either Text T.AttestationConveyancePreference +decodeAttestationConveyancePreference "none" = pure T.AttestationConveyancePreferenceNone +decodeAttestationConveyancePreference "indirect" = pure T.AttestationConveyancePreferenceIndirect +decodeAttestationConveyancePreference "direct" = pure T.AttestationConveyancePreferenceDirect +decodeAttestationConveyancePreference "enterprise" = pure T.AttestationConveyancePreferenceEnterprise +decodeAttestationConveyancePreference str = Left $ "Unknown AttestationConveyancePreference string: " <> str + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-authenticatortransport) +-- Encodes a 'T.AuthenticatorTransport' to a string. +encodeAuthenticatorTransport :: T.AuthenticatorTransport -> Text +encodeAuthenticatorTransport T.AuthenticatorTransportUSB = "usb" +encodeAuthenticatorTransport T.AuthenticatorTransportNFC = "nfc" +encodeAuthenticatorTransport T.AuthenticatorTransportBLE = "ble" +encodeAuthenticatorTransport T.AuthenticatorTransportInternal = "internal" +encodeAuthenticatorTransport (T.AuthenticatorTransportUnknown str) = str + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-authenticatortransport) +-- Decodes a string into a 'T.AuthenticatorTransport', returning +-- 'T.AuthenticatorTransportUnknown' when the string isn't known to be an enum +-- value. This is required so that relying parties can still store unknown +-- values, see +-- [transports](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-transports-slot) +-- and the clarification to that section +-- [here](https://github.com/w3c/webauthn/pull/1654) +decodeAuthenticatorTransport :: Text -> T.AuthenticatorTransport +decodeAuthenticatorTransport "usb" = T.AuthenticatorTransportUSB +decodeAuthenticatorTransport "nfc" = T.AuthenticatorTransportNFC +decodeAuthenticatorTransport "ble" = T.AuthenticatorTransportBLE +decodeAuthenticatorTransport "internal" = T.AuthenticatorTransportInternal +-- +-- mentions: +-- +-- > The values SHOULD be members of AuthenticatorTransport but Relying Parties +-- > MUST ignore unknown values. +-- +-- This is a small bug in the standard however, see +-- https://github.com/w3c/webauthn/pull/1654 which changes it to +-- +-- > The values SHOULD be members of AuthenticatorTransport but Relying +-- > Parties SHOULD accept and store unknown values. +decodeAuthenticatorTransport str = T.AuthenticatorTransportUnknown str diff --git a/src/Crypto/WebAuthn/Encoding/WebAuthnJson.hs b/src/Crypto/WebAuthn/Encoding/WebAuthnJson.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/WebAuthn/Encoding/WebAuthnJson.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE DataKinds #-} + +-- | Stability: experimental +-- This module contains functions and types for encoding 'T.CredentialOptions' +-- and decoding 'T.Credential's, based on intermediate types that implement the +-- 'ToJSON' and 'FromJSON' types respectively, matching the serialization used +-- by [webauthn-json](https://github.com/github/webauthn-json). +module Crypto.WebAuthn.Encoding.WebAuthnJson + ( -- * Registration + wjEncodeCredentialOptionsRegistration, + WJCredentialOptionsRegistration, + WJCredentialRegistration, + wjDecodeCredentialRegistration', + wjDecodeCredentialRegistration, + + -- * Authentication + wjEncodeCredentialOptionsAuthentication, + WJCredentialOptionsAuthentication, + WJCredentialAuthentication, + wjDecodeCredentialAuthentication, + ) +where + +import Control.Monad.Except (runExceptT) +import Control.Monad.Identity (runIdentity) +import Control.Monad.Reader (runReaderT) +import Crypto.WebAuthn.AttestationStatementFormat (allSupportedFormats) +import qualified Crypto.WebAuthn.Encoding.Internal.WebAuthnJson as WJ +import qualified Crypto.WebAuthn.Model.Kinds as K +import qualified Crypto.WebAuthn.Model.Types as T +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) + +-- | Encodes a @'T.CredentialOptions' 'K.Registration'@, which is needed for the +-- [registration ceremony](https://www.w3.org/TR/webauthn-2/#registration). The +-- resulting type from this function can be encoded using 'Data.Aeson.toJSON', +-- sent as a response, received by the Relying Party script, passed directly as the [@publicKey@](https://www.w3.org/TR/webauthn-2/#dom-credentialcreationoptions-publickey) +-- field in the argument to [webauthn-json](https://github.com/github/webauthn-json)'s [@create()@](https://github.com/github/webauthn-json#api) (or equivalent) function. The result of that function can then be decoded using 'wjDecodeCredentialRegistration'. +wjEncodeCredentialOptionsRegistration :: + T.CredentialOptions 'K.Registration -> + WJCredentialOptionsRegistration +wjEncodeCredentialOptionsRegistration = WJCredentialOptionsRegistration <$> WJ.encode + +-- | The intermediate type returned by 'wjEncodeCredentialOptionsRegistration', +-- equivalent to the [@PublicKeyCredentialCreationOptions@](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialcreationoptions) dictionary +newtype WJCredentialOptionsRegistration = WJCredentialOptionsRegistration + { _unWJCredentialOptionsRegistration :: WJ.PublicKeyCredentialCreationOptions + } + deriving newtype (Show, Eq, ToJSON) + +-- | The intermediate type as an input to 'wjDecodeCredentialRegistration', +-- equivalent to the [PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#iface-pkcredential) +-- interface with the response being an +-- [AuthenticatorAttestationResponse](https://www.w3.org/TR/webauthn-2/#authenticatorattestationresponse). +newtype WJCredentialRegistration = WJCredentialRegistration + { unWJCredentialRegistration :: WJ.PublicKeyCredential WJ.AuthenticatorAttestationResponse + } + deriving newtype (Show, Eq, FromJSON, ToJSON) + +-- | Decodes the intermediate 'WJCredentialRegistration' type which can be +-- parsed with 'Data.Aeson.fromJSON' from the result of +-- [webauthn-json](https://github.com/github/webauthn-json)'s +-- [@create()@](https://github.com/github/webauthn-json#api) (or equivalent) +-- function, to a @'T.Credential' 'K.Registration'@. This is the continuation +-- of 'wjEncodeCredentialOptionsRegistration'. +wjDecodeCredentialRegistration' :: + -- | The [attestation statement formats](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats) + -- that should be supported. The value of 'Crypto.WebAuthn.allSupportedFormats' + -- can be passed here, but additional or custom formats may also be used if needed + T.SupportedAttestationStatementFormats -> + WJCredentialRegistration -> + Either Text (T.Credential 'K.Registration 'True) +wjDecodeCredentialRegistration' supportedFormats = + runIdentity . (`runReaderT` supportedFormats) . runExceptT . WJ.decode . unWJCredentialRegistration + +-- | A version of 'wjDecodeCredentialRegistration'' with 'allSupportedFormats' passed as the supported formats +wjDecodeCredentialRegistration :: + WJCredentialRegistration -> + Either Text (T.Credential 'K.Registration 'True) +wjDecodeCredentialRegistration = wjDecodeCredentialRegistration' allSupportedFormats + +-- | Encodes a @'T.CredentialOptions' 'K.Authentication'@, which is needed for the +-- [authentication ceremony](https://www.w3.org/TR/webauthn-2/#authentication). The +-- resulting type from this function can be encoded using 'Data.Aeson.toJSON', +-- sent as a response, received by the Relying Party script, parsed as JSON, +-- and passed directly as the [@publicKey@](https://www.w3.org/TR/webauthn-2/#dom-credentialrequestoptions-publickey) +-- field in the argument to the [@navigator.credentials.get()@](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) +-- function. +wjEncodeCredentialOptionsAuthentication :: + T.CredentialOptions 'K.Authentication -> + WJCredentialOptionsAuthentication +wjEncodeCredentialOptionsAuthentication = WJCredentialOptionsAuthentication <$> WJ.encode + +-- | The intermediate type returned by 'wjEncodeCredentialOptionsAuthentication', +-- equivalent to the [@PublicKeyCredentialRequestOptions@](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialrequestoptions) dictionary +newtype WJCredentialOptionsAuthentication = WJCredentialOptionsAuthentication + { _unWJCredentialOptionsAuthentication :: WJ.PublicKeyCredentialRequestOptions + } + deriving newtype (Show, Eq, ToJSON) + +-- | The intermediate type as an input to 'wjDecodeCredentialAuthentication', +-- equivalent to the [PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#iface-pkcredential) +-- interface with the response being an +-- [AuthenticatorAssertionResponse](https://www.w3.org/TR/webauthn-2/#authenticatorassertionresponse). +newtype WJCredentialAuthentication = WJCredentialAuthentication + { unWJCredentialAuthentication :: WJ.PublicKeyCredential WJ.AuthenticatorAssertionResponse + } + deriving newtype (Show, Eq, FromJSON, ToJSON) + +-- | Decodes a 'WJ.RequestedPublicKeyCredential' result, corresponding to the +-- [@PublicKeyCredential@ interface](https://www.w3.org/TR/webauthn-2/#iface-pkcredential) +-- as returned by the [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) +-- method while [Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion) +-- +-- | Decodes the intermediate 'WJCredentialAuthentication' type which can be +-- parsed with 'Data.Aeson.fromJSON' from the result of +-- [webauthn-json](https://github.com/github/webauthn-json)'s +-- [@get()@](https://github.com/github/webauthn-json#api) (or equivalent) +-- function, to a @'T.Credential' 'K.Authentication' True@. This is the continuation +-- of 'wjEncodeCredentialOptionsAuthentication' +wjDecodeCredentialAuthentication :: + WJCredentialAuthentication -> + Either Text (T.Credential 'K.Authentication 'True) +wjDecodeCredentialAuthentication = + runIdentity . runExceptT . WJ.decode . unWJCredentialAuthentication diff --git a/src/Crypto/WebAuthn/Metadata/Service/Decode.hs b/src/Crypto/WebAuthn/Metadata/Service/Decode.hs --- a/src/Crypto/WebAuthn/Metadata/Service/Decode.hs +++ b/src/Crypto/WebAuthn/Metadata/Service/Decode.hs @@ -13,7 +13,7 @@ import qualified Crypto.WebAuthn.Metadata.Service.Types as ServiceTypes import qualified Crypto.WebAuthn.Metadata.Service.WebIDL as ServiceIDL import Crypto.WebAuthn.Metadata.Statement.Decode (decodeAAGUID, decodeCertificate, decodeMetadataStatement, decodeSubjectKeyIdentifier) -import qualified Crypto.WebAuthn.WebIDL as IDL +import qualified Crypto.WebAuthn.Metadata.WebIDL as IDL import Data.Bifunctor (first) import Data.Hourglass (Date, DateTime (dtDate), ISO8601_Date (ISO8601_Date), timeParse) import Data.List.NonEmpty (NonEmpty) diff --git a/src/Crypto/WebAuthn/Metadata/Service/WebIDL.hs b/src/Crypto/WebAuthn/Metadata/Service/WebIDL.hs --- a/src/Crypto/WebAuthn/Metadata/Service/WebIDL.hs +++ b/src/Crypto/WebAuthn/Metadata/Service/WebIDL.hs @@ -20,7 +20,7 @@ import Crypto.WebAuthn.Internal.Utils (jsonEncodingOptions) import Crypto.WebAuthn.Metadata.Statement.WebIDL (AAGUID, MetadataStatement) import qualified Crypto.WebAuthn.Metadata.UAF as UAF -import qualified Crypto.WebAuthn.WebIDL as IDL +import qualified Crypto.WebAuthn.Metadata.WebIDL as IDL import qualified Data.Aeson as Aeson import Data.List.NonEmpty (NonEmpty) import GHC.Generics (Generic) diff --git a/src/Crypto/WebAuthn/Metadata/Statement/Decode.hs b/src/Crypto/WebAuthn/Metadata/Statement/Decode.hs --- a/src/Crypto/WebAuthn/Metadata/Statement/Decode.hs +++ b/src/Crypto/WebAuthn/Metadata/Statement/Decode.hs @@ -19,9 +19,9 @@ 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 qualified Crypto.WebAuthn.WebIDL as IDL import Data.Bifunctor (first) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 diff --git a/src/Crypto/WebAuthn/Metadata/Statement/WebIDL.hs b/src/Crypto/WebAuthn/Metadata/Statement/WebIDL.hs --- a/src/Crypto/WebAuthn/Metadata/Statement/WebIDL.hs +++ b/src/Crypto/WebAuthn/Metadata/Statement/WebIDL.hs @@ -28,7 +28,7 @@ import Crypto.WebAuthn.Internal.Utils (enumJSONEncodingOptions, jsonEncodingOptions) import qualified Crypto.WebAuthn.Metadata.FidoRegistry as Registry import qualified Crypto.WebAuthn.Metadata.UAF as UAF -import qualified Crypto.WebAuthn.WebIDL as IDL +import qualified Crypto.WebAuthn.Metadata.WebIDL as IDL import qualified Data.Aeson as Aeson import Data.List.NonEmpty (NonEmpty) import Data.Map (Map) diff --git a/src/Crypto/WebAuthn/Metadata/UAF.hs b/src/Crypto/WebAuthn/Metadata/UAF.hs --- a/src/Crypto/WebAuthn/Metadata/UAF.hs +++ b/src/Crypto/WebAuthn/Metadata/UAF.hs @@ -9,7 +9,7 @@ where import Crypto.WebAuthn.Internal.Utils (jsonEncodingOptions) -import qualified Crypto.WebAuthn.WebIDL as IDL +import qualified Crypto.WebAuthn.Metadata.WebIDL as IDL import qualified Data.Aeson as Aeson import Data.Text (Text) import GHC.Generics (Generic) diff --git a/src/Crypto/WebAuthn/Metadata/WebIDL.hs b/src/Crypto/WebAuthn/Metadata/WebIDL.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/WebAuthn/Metadata/WebIDL.hs @@ -0,0 +1,59 @@ +-- | Stability: experimental +-- | This module defines some types from the [Web IDL](https://webidl.spec.whatwg.org/) specification +module Crypto.WebAuthn.Metadata.WebIDL + ( DOMString, + USVString, + UnsignedLongLong, + UnsignedLong, + Long, + UnsignedShort, + Octet, + Boolean, + Crypto.WebAuthn.Metadata.WebIDL.Double, + ) +where + +import Data.Int (Int32) +import Data.Text (Text) +import Data.Word (Word16, Word32, Word64, Word8) + +-- | [(spec)](https://webidl.spec.whatwg.org/#idl-DOMString) +-- The `[DOMString](https://webidl.spec.whatwg.org/#idl-DOMString)` type +-- corresponds to the set of all possible sequences of +-- [code units](https://webidl.spec.whatwg.org/#dfn-code-unit). Such sequences +-- are commonly interpreted as UTF-16 encoded strings +-- [RFC2781](https://webidl.spec.whatwg.org/#biblio-rfc2781) although this is not required. +-- TODO: This implementation doesn't allow invalid UTF-16 codepoints, which +-- probably makes it not work regarding +-- Write a test case that doesn't work and find a better representation. +type DOMString = Text + +-- | [(spec)](https://webidl.spec.whatwg.org/#idl-USVString) +-- The `[USVString](https://webidl.spec.whatwg.org/#idl-USVString)` type +-- corresponds to the set of all possible sequences of +-- [Unicode scalar values](http://www.unicode.org/glossary/#unicode_scalar_value), +-- which are all of the Unicode code points apart from the surrogate code points. +-- TODO: This implementation allows for surrogate code points. Figure out if +-- this can violate the spec in any way. +type USVString = Text + +-- | [(spec)](https://webidl.spec.whatwg.org/#idl-unsigned-long) +type UnsignedLong = Word32 + +-- | [(spec)](https://webidl.spec.whatwg.org/#idl-unsigned-long) +type UnsignedLongLong = Word64 + +-- | [(spec)](https://webidl.spec.whatwg.org/#idl-long) +type Long = Int32 + +-- | [(spec)](https://webidl.spec.whatwg.org/#idl-unsigned-short) +type UnsignedShort = Word16 + +-- | [(spec)](https://webidl.spec.whatwg.org/#idl-octet) +type Octet = Word8 + +-- | [(spec)](https://webidl.spec.whatwg.org/#idl-boolean) +type Boolean = Bool + +-- | [(spec)](https://webidl.spec.whatwg.org/#idl-double) +type Double = Prelude.Double diff --git a/src/Crypto/WebAuthn/Model.hs b/src/Crypto/WebAuthn/Model.hs --- a/src/Crypto/WebAuthn/Model.hs +++ b/src/Crypto/WebAuthn/Model.hs @@ -4,34 +4,23 @@ -- A set of types representing credential options ('CredentialOptions') -- and their resulting credentials responses ('Credential'). -- --- Also includes a set of functions for indirectly encoding credential --- options to JSON ('encodeCredentialOptionsRegistration', --- 'encodeCredentialOptionsAuthentication') and indirectly decoding --- credential responses from JSON ('decodeCredentialRegistration', --- 'decodeCredentialAuthentication'), using the same encoding as --- [webauthn-json](https://github.com/github/webauthn-json) which can be --- used on the JavaScript side. --- --- The types in this module form one way the library represents the WebAuthn --- types, another are the internal WebIDL modules, which is a lower-level, more --- one-to-one mapping. As a user of the library, you will most likely use the --- representation in this module over the one in the WebIDL modules. --- -- This module is reexported by the "Crypto.WebAuthn" module, which is the -- preferred way of using it. module Crypto.WebAuthn.Model - ( module Crypto.WebAuthn.Model.Identifier, + ( module Crypto.WebAuthn.Model.Defaults, + module Crypto.WebAuthn.Model.Identifier, module Crypto.WebAuthn.Model.Kinds, module Crypto.WebAuthn.Model.Types, - module Crypto.WebAuthn.Model.WebIDL, - module Crypto.WebAuthn.Cose.Algorithm, - module Crypto.WebAuthn.Cose.Key, + module Crypto.WebAuthn.Cose.SignAlg, + module Crypto.WebAuthn.Cose.PublicKeyWithSignAlg, + module Crypto.WebAuthn.Cose.PublicKey, ) where -import Crypto.WebAuthn.Cose.Algorithm -import Crypto.WebAuthn.Cose.Key +import Crypto.WebAuthn.Cose.PublicKey +import Crypto.WebAuthn.Cose.PublicKeyWithSignAlg +import Crypto.WebAuthn.Cose.SignAlg +import Crypto.WebAuthn.Model.Defaults import Crypto.WebAuthn.Model.Identifier import Crypto.WebAuthn.Model.Kinds import Crypto.WebAuthn.Model.Types -import Crypto.WebAuthn.Model.WebIDL diff --git a/src/Crypto/WebAuthn/Model/Defaults.hs b/src/Crypto/WebAuthn/Model/Defaults.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/WebAuthn/Model/Defaults.hs @@ -0,0 +1,54 @@ +-- | Stability: experimental +-- This module defines default values for fields of webauthn structures that +-- are optional but have a default specified. The identifiers here all have the +-- pattern of @Default@ indicating that this is the default value for +-- field @@ defined in 'Crypto.WebAuthn.Model.Types' +-- +-- These default values are used when the respective fields are missing during +-- decoding. They may also be used by relying parties that don't want to set +-- the respective fields to their default. This is needed because defaults for +-- such fields can't be easily mapped to Haskell's records, see +-- "Crypto.WebAuthn.Model.Types#defaultFields" +module Crypto.WebAuthn.Model.Defaults + ( ascUserVerificationDefault, + ascResidentKeyDefault, + corAttestationDefault, + corExcludeCredentialsDefault, + coaUserVerificationDefault, + coaAllowCredentialsDefault, + ) +where + +import qualified Crypto.WebAuthn.Model.Types as M + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-userverification) +-- Returns the default of the field 'M.ascUserVerification' +ascUserVerificationDefault :: M.UserVerificationRequirement +ascUserVerificationDefault = M.UserVerificationRequirementPreferred + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-residentkey) +-- Returns the default of the field 'M.ascResidentKey' based on the +-- value of [@requireResidentKey@](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-requireresidentkey) +ascResidentKeyDefault :: Maybe Bool -> M.ResidentKeyRequirement +ascResidentKeyDefault (Just True) = M.ResidentKeyRequirementRequired +ascResidentKeyDefault _ = M.ResidentKeyRequirementDiscouraged + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-attestation) +-- Returns the default of the field 'M.corAttestation' +corAttestationDefault :: M.AttestationConveyancePreference +corAttestationDefault = M.AttestationConveyancePreferenceNone + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-excludecredentials) +-- Returns the default of the field 'M.corExcludeCredentials' +corExcludeCredentialsDefault :: [M.CredentialDescriptor] +corExcludeCredentialsDefault = [] + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-userverification) +-- Returns the default of the field 'M.coaUserVerification' +coaUserVerificationDefault :: M.UserVerificationRequirement +coaUserVerificationDefault = M.UserVerificationRequirementPreferred + +-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-allowcredentials) +-- Returns the default of the field 'M.coaAllowCredentials' +coaAllowCredentialsDefault :: [M.CredentialDescriptor] +coaAllowCredentialsDefault = [] diff --git a/src/Crypto/WebAuthn/Model/Types.hs b/src/Crypto/WebAuthn/Model/Types.hs --- a/src/Crypto/WebAuthn/Model/Types.hs +++ b/src/Crypto/WebAuthn/Model/Types.hs @@ -7,12 +7,43 @@ {-# LANGUAGE TypeFamilies #-} -- | Stability: experimental --- This module contains the same top-level definitions as 'Crypto.WebAuthn.Client.JavaScript', --- but with the types containing a more Haskell-friendly structure. -- --- Note: The 'ToJSON' instances of these types are for pretty-printing purposes --- only. +-- This module contains Haskell-friendly types for structures used in WebAuthn +-- that are used throughout this library. These types are modelled according to +-- the following conventions: -- +-- * If a structure has the same semantics for both the +-- [registration](https://www.w3.org/TR/webauthn-2/#registration) and +-- [authentication](https://www.w3.org/TR/webauthn-2/#authentication) WebAuthn +-- [ceremonies](https://www.w3.org/TR/webauthn-2/#ceremony), then its type is +-- parametrized by a @c@ parameter of kind 'CeremonyKind'. If such types have +-- differing fields, +-- [GADTs](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/gadt.html) +-- are used to distinguish between them, where the constructor name is the +-- type name with a @...Registration@ or @...Authentication@ suffix +-- * If the raw bytes are needed for verification purposes of a structure, then +-- its type is parametrized by a @raw@ parameter of kind 'Bool'. Only if @raw +-- ~ 'True'@, the raw bytes of the necessary structures has to be present in +-- the type. The type 'RawField' is used as a helper type for this. +-- * In order to avoid duplicate record fields, all fields are prefixed with +-- the initials of the constructor name. +-- * Every type should have a 'ToJSON' instance for pretty-printing purposes. +-- This JSON encoding doesn't correspond to any encoding used for +-- sending/receiving these structures, it's only used for pretty-printing, +-- which is why it doesn't need to be standardized. For encoding these +-- structures from/to JSON for sending/receiving, see the +-- 'Crypto.WebAuthn.Model.WebIDL' module +-- #defaultFields# +-- * Fields of the WebAuthn standard that are optional (for writing) but have +-- defaults (making them non-optional for reading) are encoded as +-- non-optional fields, while the defaults are exposed in the +-- 'Crypto.WebAuthn.Model.Defaults' module. The alternative of making these +-- fields optional would allow RP not having to specify them, which seems +-- like a less safer option, since the defaults might not be what is really +-- needed, and they might change. The root cause why this decision had to be +-- made is that such assymetrical reading/writing fields don't map nicely to +-- Haskell's records. +-- -- #extensions# -- TODO: -- [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-extensions) This library @@ -86,7 +117,6 @@ -- * Top-level types CredentialOptions (..), Credential (..), - stripRawCredential, ) where @@ -95,15 +125,14 @@ import Crypto.Hash (Digest) import Crypto.Hash.Algorithms (SHA256) import Crypto.Random (MonadRandom, getRandomBytes) -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose -import qualified Crypto.WebAuthn.Cose.Key as Cose +import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose import Crypto.WebAuthn.Internal.ToJSONOrphans () import Crypto.WebAuthn.Model.Identifier (AAGUID) import Crypto.WebAuthn.Model.Kinds ( AttestationKind (Unverifiable, Verifiable), CeremonyKind (Authentication, Registration), ProtocolKind (Fido2, FidoU2F), - SCeremonyKind (SAuthentication, SRegistration), ) import Data.Aeson (ToJSON, Value (Null, String), object, (.=)) import Data.Aeson.Types (toJSON) @@ -141,6 +170,9 @@ -- values can be added to it in the future, as more credential types are defined. -- The values of this enumeration are used for versioning the Authentication Assertion -- and attestation structures according to the type of the authenticator. +-- +-- To decode\/encode this type from\/to its standard string, use +-- 'Crypto.WebAuthn.Encoding.Strings.decodeCredentialType'/'Crypto.WebAuthn.Encoding.Strings.encodeCredentialType'. data CredentialType = CredentialTypePublicKey deriving (Eq, Show, Bounded, Enum, Ord, Generic) @@ -157,6 +189,9 @@ -- best belief as to how an authenticator may be reached. A [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) -- will typically learn of the supported transports for a [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) -- via [getTransports()](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-gettransports). +-- +-- To decode\/encode this type from\/to its standard string, use +-- 'Crypto.WebAuthn.Encoding.Strings.decodeAuthenticatorTransport'/'Crypto.WebAuthn.Encoding.Strings.encodeAuthenticatorTransport'. data AuthenticatorTransport = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatortransport-usb) -- Indicates the respective [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) @@ -176,7 +211,15 @@ -- transport, i.e., it is a [platform authenticator](https://www.w3.org/TR/webauthn-2/#platform-authenticators). -- These authenticators are not removable from the [client device](https://www.w3.org/TR/webauthn-2/#client-device). AuthenticatorTransportInternal - deriving (Eq, Show, Bounded, Enum, Ord, Generic, ToJSON) + | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-transports) + -- An unknown authenticator transport. Note that according to the current + -- version 2 of the WebAuthn standard, unknown fields [must be + -- ignored](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-transports-slot), + -- which is a bit misleading because such unknown values still need to be + -- stored. Draft version 3 of the standard [fixes + -- this](https://github.com/w3c/webauthn/pull/1654). + AuthenticatorTransportUnknown Text + deriving (Eq, Show, Ord, Generic, ToJSON) -- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-authenticatorattachment) -- This enumeration’s values describe [authenticators](https://www.w3.org/TR/webauthn-2/#authenticator)' @@ -185,6 +228,9 @@ -- express a preferred [authenticator attachment modality](https://www.w3.org/TR/webauthn-2/#authenticator-attachment-modality) -- when calling [@navigator.credentials.create()@](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) -- to [create a credential](https://www.w3.org/TR/webauthn-2/#sctn-createCredential). +-- +-- To decode\/encode this type from\/to its standard string, use +-- 'Crypto.WebAuthn.Encoding.Strings.decodeAuthenticatorAttachment'/'Crypto.WebAuthn.Encoding.Strings.encodeAuthenticatorAttachment'. data AuthenticatorAttachment = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattachment-platform) -- This value indicates [platform attachment](https://www.w3.org/TR/webauthn-2/#platform-attachment). @@ -199,6 +245,9 @@ -- requirements for [client-side discoverable credentials](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential) -- (formerly known as [resident credentials](https://www.w3.org/TR/webauthn-2/#resident-credential) -- or [resident keys](https://www.w3.org/TR/webauthn-2/#resident-key)): +-- +-- To decode\/encode this type from\/to its standard string, use +-- 'Crypto.WebAuthn.Encoding.Strings.decodeResidentKeyRequirement'/'Crypto.WebAuthn.Encoding.Strings.encodeResidentKeyRequirement'. data ResidentKeyRequirement = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-residentkeyrequirement-discouraged) -- This value indicates the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) @@ -225,6 +274,9 @@ -- A [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party) may -- require [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) for some -- of its operations but not for others, and may use this type to express its needs. +-- +-- To decode\/encode this type from\/to its standard string, use +-- 'Crypto.WebAuthn.Encoding.Strings.decodeUserVerificationRequirement'/'Crypto.WebAuthn.Encoding.Strings.encodeUserVerificationRequirement'. data UserVerificationRequirement = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-userverificationrequirement-required) -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) @@ -250,6 +302,9 @@ -- [AttestationConveyancePreference](https://www.w3.org/TR/webauthn-2/#enumdef-attestationconveyancepreference) -- to specify their preference regarding -- [attestation conveyance](https://www.w3.org/TR/webauthn-2/#attestation-conveyance) during credential generation. +-- +-- To decode\/encode this type from\/to its standard string, use +-- 'Crypto.WebAuthn.Encoding.Strings.decodeAttestationConveyancePreference'/'Crypto.WebAuthn.Encoding.Strings.encodeAttestationConveyancePreference'. data AttestationConveyancePreference = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-attestationconveyancepreference-none) -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) @@ -604,7 +659,7 @@ -- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authentication-extensions-client-inputs) -- This is a dictionary containing the [client extension input](https://www.w3.org/TR/webauthn-2/#client-extension-input) -- values for zero or more [WebAuthn Extensions](https://www.w3.org/TR/webauthn-2/#webauthn-extensions). --- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model#extensions". +-- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model.Types#extensions". data AuthenticationExtensionsClientInputs = AuthenticationExtensionsClientInputs { } @@ -616,7 +671,7 @@ -- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authentication-extensions-client-outputs) -- This is a dictionary containing the [client extension output](https://www.w3.org/TR/webauthn-2/#client-extension-output) -- values for zero or more [WebAuthn Extensions](https://www.w3.org/TR/webauthn-2/#webauthn-extensions). --- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model#extensions". +-- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model.Types#extensions". data AuthenticationExtensionsClientOutputs = AuthenticationExtensionsClientOutputs { } @@ -710,7 +765,6 @@ -- This OPTIONAL member contains a hint as to how the [client](https://www.w3.org/TR/webauthn-2/#client) -- might communicate with the [managing authenticator](https://www.w3.org/TR/webauthn-2/#public-key-credential-source-managing-authenticator) -- of the [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) the caller is referring to. - -- The values SHOULD be members of 'AuthenticatorTransport' but [client platforms](https://www.w3.org/TR/webauthn-2/#client-platform) MUST ignore unknown values. cdTransports :: Maybe [AuthenticatorTransport] } deriving (Eq, Show, Generic, ToJSON) @@ -729,15 +783,14 @@ -- Specifies the extent to which the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) -- desires to create a [client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential). -- For historical reasons the naming retains the deprecated “resident” terminology. + -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.ascResidentKeyDefault'. ascResidentKey :: ResidentKeyRequirement, -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-userverification) -- This member describes the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)'s -- requirements regarding [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) -- for the [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) -- operation. Eligible authenticators are filtered to only those capable of satisfying this requirement. - -- The value SHOULD be a member of 'UserVerificationRequirement' but - -- [client platforms](https://www.w3.org/TR/webauthn-2/#client-platform) MUST ignore unknown values, - -- treating an unknown value as if the [member does not exist](https://infra.spec.whatwg.org/#map-exists). + -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.ascUserVerificationDefault'. ascUserVerification :: UserVerificationRequirement } deriving (Eq, Show, Generic, ToJSON) @@ -818,6 +871,7 @@ -- that wish to limit the creation of multiple credentials for the same account on a single authenticator. -- The [client](https://www.w3.org/TR/webauthn-2/#client) is requested to return an error if the new credential -- would be created on an authenticator that also contains one of the credentials enumerated in this parameter. + -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.corExcludeCredentials'. corExcludeCredentials :: [CredentialDescriptor], -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-authenticatorselection) -- This member is intended for use by [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) @@ -827,6 +881,7 @@ -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-attestation) -- This member is intended for use by [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) -- that wish to express their preference for [attestation conveyance](https://www.w3.org/TR/webauthn-2/#attestation-conveyance). + -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.corAttestationDefault'. corAttestation :: AttestationConveyancePreference, -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-extensions) -- This member contains additional parameters requesting additional processing by the client and authenticator. @@ -836,7 +891,7 @@ -- consult the IANA "WebAuthn Extension Identifiers" registry [IANA-WebAuthn-Registries](https://www.w3.org/TR/webauthn-2/#biblio-iana-webauthn-registries) -- established by [RFC8809](https://www.w3.org/TR/webauthn-2/#biblio-rfc8809) for an up-to-date -- list of registered [WebAuthn Extensions](https://www.w3.org/TR/webauthn-2/#webauthn-extensions). - -- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model#extensions". + -- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model.Types#extensions". corExtensions :: Maybe AuthenticationExtensionsClientInputs } -> CredentialOptions 'Registration @@ -864,16 +919,18 @@ -- This OPTIONAL member contains a list of 'CredentialDescriptor' -- objects representing [public key credentials](https://www.w3.org/TR/webauthn-2/#public-key-credential) acceptable to the caller, -- in descending order of the caller’s preference (the first item in the list is the most preferred credential, and so on down the list). + -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.coaAllowCredentialsDefault'. coaAllowCredentials :: [CredentialDescriptor], -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-userverification) -- This OPTIONAL member describes the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)'s requirements regarding -- [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) for the -- `[get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)` operation. + -- The default value of this field is 'Crypto.WebAuthn.Model.Defaults.coaUserVerificationDefault'. coaUserVerification :: UserVerificationRequirement, -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-extensions) -- This OPTIONAL member contains additional parameters requesting additional processing by the client and authenticator. -- For example, if transaction confirmation is sought from the user, then the prompt string might be included as an extension. - -- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model#extensions". + -- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model.Types#extensions". coaExtensions :: Maybe AuthenticationExtensionsClientInputs } -> CredentialOptions 'Authentication @@ -911,6 +968,23 @@ -- The client data represents the contextual bindings of both the -- [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party) -- and the [client](https://www.w3.org/TR/webauthn-2/#client). +-- +-- For binary serialization of thes type, see +-- "Crypto.WebAuthn.Encoding.Binary". If decoded with +-- 'Crypto.WebAuthn.Encoding.Binary.decodeCollectedClientData', the +-- 'ccdRawData' field is filled out with the raw bytes, while +-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawCollectedClientData' can be used +-- to fill out this field when constructing this value otherwise. Unchecked +-- invariant: If @raw ~ 'True'@, then +-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawCollectedClientData c = c', +-- ensuring that the 'ccdRawData' field should always correspond to its +-- encoding. This means that if @raw ~ 'True'@, it's not safe to modify +-- individual fields. To make changes, first use +-- 'Crypto.WebAuthn.Encoding.Binary.stripRawCollectedClientData', make the +-- changes on the result, then call +-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawCollectedClientData' on that. Note +-- however that any modifications also invalidate signatures over the binary +-- data, specifically 'araSignature' and 'aoAttStmt'. data CollectedClientData (c :: CeremonyKind) raw = CollectedClientData { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-challenge) -- This member contains the challenge provided by the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party). @@ -924,8 +998,8 @@ -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-crossorigin) -- This member contains the inverse of the @sameOriginWithAncestors@ araument value -- that was passed into the [internal method](https://tc39.github.io/ecma262/#sec-object-internal-methods-and-internal-slots). - ccdCrossOrigin :: Bool, - -- | Raw data of the client data, for verification purposes + ccdCrossOrigin :: Maybe Bool, + -- | Raw data of the client data, for verification purposes. ccdRawData :: RawField raw -- TODO: This library does not implement token binding, this is in -- anticipation of version 3 of the webauthn spec that likely removes this @@ -995,6 +1069,24 @@ -- the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) receives -- the [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data) -- in the same format, and uses its knowledge of the authenticator to make trust decisions. +-- +-- For the binary serialization of this type, see +-- "Crypto.WebAuthn.Encoding.Binary". If decoded with +-- 'Crypto.WebAuthn.Encoding.Binary.decodeAuthenticatorData', the 'adRawData' +-- field is filled out with the binary serialization, while +-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAuthenticatorData' can be used to +-- fill out this field when constructing this value otherwise. This also +-- applies to raw 'acdCredentialPublicKeyBytes' field in +-- 'adAttestedCredentialData'. Unchecked invariant: If @raw ~ 'True'@, then +-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAuthenticatorData d = d', ensuring +-- that the 'adRawData' and 'acdCredentialPublicKeyBytes' fields should always +-- correspond to their respective binary serializations. This means that if +-- @raw ~ 'True'@, it's not safe to modify individual fields. To make changes, +-- first use 'Crypto.WebAuthn.Encoding.Binary.stripRawAuthenticatorData', make +-- the changes on the result, then call +-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAuthenticatorData' on that. Note +-- however that any modifications also invalidate signatures over the binary +-- data, specifically 'araSignature' and 'aoAttStmt'. data AuthenticatorData (c :: CeremonyKind) raw = AuthenticatorData { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#rpidhash) -- SHA-256 hash of the [RP ID](https://www.w3.org/TR/webauthn-2/#rp-id) the @@ -1153,6 +1245,26 @@ lookupAttestationStatementFormat id (SupportedAttestationStatementFormats sasf) = sasf !? id -- | [(spec)](https://www.w3.org/TR/webauthn-2/#attestation-object) +-- +-- For the [binary +-- serialization](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object) +-- of this type, see "Crypto.WebAuthn.Encoding.Binary". If decoded with +-- 'Crypto.WebAuthn.Encoding.Binary.decodeAttestationObject', the 'aoAuthData' +-- field is filled out with the binary serialization of its fields, while +-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAttestationObject' can be used to +-- fill out this field when constructing this value otherwise. Unchecked +-- invariant: If @raw ~ 'True'@, then +-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAttestationObject o = o', ensuring +-- that the binary fields of the 'aoAuthData' field should always correspond to +-- their respective serializations. This means that if @raw ~ 'True'@, it's not +-- safe to modify individual fields. To make changes, first use +-- 'Crypto.WebAuthn.Encoding.Binary.stripRawAttestationObject', make the +-- changes on the result, then call +-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawAttestationObject' on that. Note +-- however that any modifications also invalidate signatures over the binary +-- data, specifically 'aoAttStmt'. The +-- 'Crypto.WebAuthn.Encoding.Binary.encodeAttestationObject' can be used to get +-- the binary encoding of this type when @raw ~ 'True'@. data AttestationObject raw = forall a. AttestationStatementFormat a => AttestationObject @@ -1171,8 +1283,38 @@ -- in the same format, and uses its knowledge of the authenticator to make trust decisions. aoAuthData :: AuthenticatorData 'Registration raw, -- | [(spec)](https://www.w3.org/TR/webauthn-2/#attestation-statement-format) + -- The attestation statement format is the manner in which the signature is + -- represented and the various contextual bindings are incorporated into + -- the attestation statement by the + -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator). In + -- other words, this defines the syntax of the statement. Various existing + -- components and OS platforms (such as TPMs and the Android OS) have + -- previously defined [attestation statement + -- formats](https://www.w3.org/TR/webauthn-2/#attestation-statement-format). + -- This specification supports a variety of such formats in an extensible + -- way, as defined in [§ 6.5.2 Attestation Statement + -- Formats](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats). + -- The formats themselves are identified by strings, as described in [§ 8.1 + -- Attestation Statement Format + -- Identifiers](https://www.w3.org/TR/webauthn-2/#sctn-attstn-fmt-ids). + -- + -- This value is of a type that's an instance of + -- 'AttestationStatementFormat', which encodes everything needed about the + -- attestation statement. aoFmt :: a, -- | [(spec)](https://www.w3.org/TR/webauthn-2/#attestation-statement) + -- The [(spec)](https://www.w3.org/TR/webauthn-2/#attestation-statement) is + -- a specific type of signed data object, containing statements about a + -- [public key + -- credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) + -- itself and the + -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) that + -- created it. It contains an [attestation + -- signature](https://www.w3.org/TR/webauthn-2/#attestation-signature) + -- created using the key of the attesting authority (except for the case of + -- [self attestation](https://www.w3.org/TR/webauthn-2/#self-attestation), + -- when it is created using the [credential private + -- key](https://www.w3.org/TR/webauthn-2/#credential-private-key)). aoAttStmt :: AttStmt a } @@ -1271,7 +1413,9 @@ -- returned by the authenticator. See [§ 6.1 Authenticator Data](https://www.w3.org/TR/webauthn-2/#sctn-authenticator-data). araAuthenticatorData :: AuthenticatorData 'Authentication raw, -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-signature) - -- This attribute contains the raw signature returned from the authenticator. + -- This attribute contains the raw [assertion + -- signature](https://www.w3.org/TR/webauthn-2/#assertion-signature) + -- returned from the authenticator. -- See [§ 6.3.3 The authenticatorGetAssertion Operation](https://www.w3.org/TR/webauthn-2/#sctn-op-get-assertion). araSignature :: AssertionSignature, -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-userhandle) @@ -1303,6 +1447,22 @@ -- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-pkcredential) -- The 'Credential' interface contains the attributes that are returned to the caller when a new credential is created, or a new assertion is requested. +-- +-- This type has nested fields which use a binary encoding that needs to be +-- preserved for verification purposes. The binary encoding of these fields can +-- be removed or recomputed using functions from +-- "Crypto.WebAuthn.Encoding.Binary". Specifically +-- 'Crypto.WebAuthn.Encoding.Binary.stripRawCredential' and +-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawCredential' respectively. +-- Unchecked invariant: If @raw ~ 'True'@, then +-- 'Crypto.WebAuthn.Encoding.Binary.encodeRawCredential c = c', ensuring that +-- the binary fields should always correspond to the values respective +-- serializations. This means that if @raw ~ 'True'@, it's not safe to modify +-- individual fields. To make changes, first use +-- 'Crypto.WebAuthn.Encoding.Binary.stripRawCredential', make the changes on +-- the result, then call 'Crypto.WebAuthn.Encoding.Binary.encodeRawCredential' +-- on that. Note however that any modifications also invalidate signatures over +-- the binary data, specifically 'araSignature' and 'aoAttStmt'. data Credential (c :: CeremonyKind) raw = Credential { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-identifier-slot) -- Contains the [credential ID](https://www.w3.org/TR/webauthn-2/#credential-id), @@ -1330,54 +1490,3 @@ cClientExtensionResults :: AuthenticationExtensionsClientOutputs } deriving (Eq, Show, Generic, ToJSON) - --- | Removes all raw fields from a 'Credential', useful for --- e.g. pretty-printing only the desired fields. This is the counterpart to --- 'Crypto.WebAuthn.Model.Binary.Encoding.encodeRawCredential' -stripRawCredential :: forall c raw. SingI c => Credential c raw -> Credential c 'False -stripRawCredential Credential {..} = - Credential - { cResponse = case sing @c of - SRegistration -> stripRawAuthenticatorResponseRegistration cResponse - SAuthentication -> stripRawAuthenticatorResponseAuthentication cResponse, - .. - } - where - stripRawAuthenticatorResponseAuthentication :: AuthenticatorResponse 'Authentication raw -> AuthenticatorResponse 'Authentication 'False - stripRawAuthenticatorResponseAuthentication AuthenticatorResponseAuthentication {..} = - AuthenticatorResponseAuthentication - { araClientData = stripRawCollectedClientData araClientData, - araAuthenticatorData = stripRawAuthenticatorData araAuthenticatorData, - .. - } - - stripRawAuthenticatorResponseRegistration :: AuthenticatorResponse 'Registration raw -> AuthenticatorResponse 'Registration 'False - stripRawAuthenticatorResponseRegistration AuthenticatorResponseRegistration {..} = - AuthenticatorResponseRegistration - { arrClientData = stripRawCollectedClientData arrClientData, - arrAttestationObject = stripRawAttestationObject arrAttestationObject, - .. - } - - stripRawAttestationObject :: AttestationObject raw -> AttestationObject 'False - stripRawAttestationObject AttestationObject {..} = - AttestationObject - { aoAuthData = stripRawAuthenticatorData aoAuthData, - .. - } - - stripRawAuthenticatorData :: forall c raw. SingI c => AuthenticatorData c raw -> AuthenticatorData c 'False - stripRawAuthenticatorData AuthenticatorData {..} = - AuthenticatorData - { adRawData = NoRaw, - adAttestedCredentialData = stripRawAttestedCredentialData adAttestedCredentialData, - .. - } - - stripRawAttestedCredentialData :: forall c raw. SingI c => AttestedCredentialData c raw -> AttestedCredentialData c 'False - stripRawAttestedCredentialData = case sing @c of - SRegistration -> \AttestedCredentialData {..} -> AttestedCredentialData {acdCredentialPublicKeyBytes = NoRaw, ..} - SAuthentication -> \NoAttestedCredentialData -> NoAttestedCredentialData - - stripRawCollectedClientData :: forall c raw. SingI c => CollectedClientData c raw -> CollectedClientData c 'False - stripRawCollectedClientData CollectedClientData {..} = CollectedClientData {ccdRawData = NoRaw, ..} diff --git a/src/Crypto/WebAuthn/Model/WebIDL.hs b/src/Crypto/WebAuthn/Model/WebIDL.hs deleted file mode 100644 --- a/src/Crypto/WebAuthn/Model/WebIDL.hs +++ /dev/null @@ -1,112 +0,0 @@ -{-# LANGUAGE DataKinds #-} - --- | Stability: experimental --- This module contains functions and types for encoding 'T.CredentialOptions' --- and decoding 'T.Credential's, based on intermediate types that implement the 'ToJSON' and 'FromJSON' types respectively, matching the serialization used by [webauthn-json](https://github.com/github/webauthn-json). -module Crypto.WebAuthn.Model.WebIDL - ( -- * Registration - encodeCredentialOptionsRegistration, - IDLCredentialOptionsRegistration, - IDLCredentialRegistration, - decodeCredentialRegistration, - - -- * Authentication - encodeCredentialOptionsAuthentication, - IDLCredentialOptionsAuthentication, - IDLCredentialAuthentication, - decodeCredentialAuthentication, - ) -where - -import qualified Crypto.WebAuthn.Model.Kinds as K -import qualified Crypto.WebAuthn.Model.Types as T -import Crypto.WebAuthn.Model.WebIDL.Internal.Decoding (Decode (decode), DecodeCreated (decodeCreated)) -import Crypto.WebAuthn.Model.WebIDL.Internal.Encoding (Encode (encode)) -import qualified Crypto.WebAuthn.Model.WebIDL.Types as IDL -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) - --- | Encodes a @'T.CredentialOptions' 'K.Registration'@, which is needed for the --- [registration ceremony](https://www.w3.org/TR/webauthn-2/#registration). The --- resulting type from this function can be encoded using 'Data.Aeson.toJSON', --- sent as a response, received by the Relying Party script, passed directly as the [@publicKey@](https://www.w3.org/TR/webauthn-2/#dom-credentialcreationoptions-publickey) --- field in the argument to [webauthn-json](https://github.com/github/webauthn-json)'s [@create()@](https://github.com/github/webauthn-json#api) (or equivalent) function. The result of that function can then be decoded using 'decodeCredentialRegistration'. -encodeCredentialOptionsRegistration :: - T.CredentialOptions 'K.Registration -> - IDLCredentialOptionsRegistration -encodeCredentialOptionsRegistration = IDLCredentialOptionsRegistration <$> encode - --- | The intermediate type returned by 'encodeCredentialOptionsRegistration', --- equivalent to the [@PublicKeyCredentialCreationOptions@](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialcreationoptions) dictionary -newtype IDLCredentialOptionsRegistration = IDLCredentialOptionsRegistration - { _unIDLCredentialOptionsRegistration :: IDL.PublicKeyCredentialCreationOptions - } - deriving newtype (Show, Eq, ToJSON) - --- | The intermediate type as an input to 'decodeCredentialRegistration', --- equivalent to the [PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#iface-pkcredential) --- interface with the response being an --- [AuthenticatorAttestationResponse](https://www.w3.org/TR/webauthn-2/#authenticatorattestationresponse). -newtype IDLCredentialRegistration = IDLCredentialRegistration - { unIDLCredentialRegistration :: IDL.PublicKeyCredential IDL.AuthenticatorAttestationResponse - } - deriving newtype (Show, Eq, FromJSON, ToJSON) - --- | Decodes the intermediate 'IDLCredentialRegistration' type which can be --- parsed with 'Data.Aeson.fromJSON' from the result of --- [webauthn-json](https://github.com/github/webauthn-json)'s --- [@create()@](https://github.com/github/webauthn-json#api) (or equivalent) --- function, to a @'T.Credential' 'K.Registration'@. This is the continuation --- of 'encodeCredentialOptionsRegistration'. -decodeCredentialRegistration :: - -- | The [attestation statement formats](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats) - -- that should be supported. The value of 'Crypto.WebAuthn.allSupportedFormats' - -- can be passed here, but additional or custom formats may also be used if needed - T.SupportedAttestationStatementFormats -> - IDLCredentialRegistration -> - Either Text (T.Credential 'K.Registration 'True) -decodeCredentialRegistration supportedFormats = decodeCreated supportedFormats . unIDLCredentialRegistration - --- | Encodes a @'T.CredentialOptions' 'K.Authentication'@, which is needed for the --- [authentication ceremony](https://www.w3.org/TR/webauthn-2/#authentication). The --- resulting type from this function can be encoded using 'Data.Aeson.toJSON', --- sent as a response, received by the Relying Party script, parsed as JSON, --- and passed directly as the [@publicKey@](https://www.w3.org/TR/webauthn-2/#dom-credentialrequestoptions-publickey) --- field in the argument to the [@navigator.credentials.get()@](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) --- function. -encodeCredentialOptionsAuthentication :: - T.CredentialOptions 'K.Authentication -> - IDLCredentialOptionsAuthentication -encodeCredentialOptionsAuthentication = IDLCredentialOptionsAuthentication <$> encode - --- | The intermediate type returned by 'encodeCredentialOptionsAuthentication', --- equivalent to the [@PublicKeyCredentialRequestOptions@](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialrequestoptions) dictionary -newtype IDLCredentialOptionsAuthentication = IDLCredentialOptionsAuthentication - { _unIDLCredentialOptionsAuthentication :: IDL.PublicKeyCredentialRequestOptions - } - deriving newtype (Show, Eq, ToJSON) - --- | The intermediate type as an input to 'decodeCredentialAuthentication', --- equivalent to the [PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#iface-pkcredential) --- interface with the response being an --- [AuthenticatorAssertionResponse](https://www.w3.org/TR/webauthn-2/#authenticatorassertionresponse). -newtype IDLCredentialAuthentication = IDLCredentialAuthentication - { unIDLCredentialAuthentication :: IDL.PublicKeyCredential IDL.AuthenticatorAssertionResponse - } - deriving newtype (Show, Eq, FromJSON, ToJSON) - --- | Decodes a 'IDL.RequestedPublicKeyCredential' result, corresponding to the --- [@PublicKeyCredential@ interface](https://www.w3.org/TR/webauthn-2/#iface-pkcredential) --- as returned by the [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) --- method while [Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion) --- --- | Decodes the intermediate 'IDLCredentialAuthentication' type which can be --- parsed with 'Data.Aeson.fromJSON' from the result of --- [webauthn-json](https://github.com/github/webauthn-json)'s --- [@get()@](https://github.com/github/webauthn-json#api) (or equivalent) --- function, to a @'T.Credential' 'K.Authentication' True@. This is the continuation --- of 'encodeCredentialOptionsAuthentication' -decodeCredentialAuthentication :: - IDLCredentialAuthentication -> - Either Text (T.Credential 'K.Authentication 'True) -decodeCredentialAuthentication = decode . unIDLCredentialAuthentication diff --git a/src/Crypto/WebAuthn/Model/WebIDL/Internal/Binary/Decoding.hs b/src/Crypto/WebAuthn/Model/WebIDL/Internal/Binary/Decoding.hs deleted file mode 100644 --- a/src/Crypto/WebAuthn/Model/WebIDL/Internal/Binary/Decoding.hs +++ /dev/null @@ -1,260 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} - --- | Stability: internal --- Certain parts of the specification require that data is decoded from a --- binary form. This module holds such functions. -module Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Decoding - ( -- * Decoding from bytes - decodeAuthenticatorData, - decodeAttestationObject, - decodeCollectedClientData, - ) -where - -import qualified Codec.CBOR.Decoding as CBOR -import qualified Codec.CBOR.Read as CBOR -import qualified Codec.CBOR.Term as CBOR -import Codec.Serialise (decode) -import Control.Monad (forM, unless) -import Control.Monad.Except (MonadError (throwError)) -import Control.Monad.State (MonadState (get, put), StateT (runStateT)) -import qualified Crypto.Hash as Hash -import Crypto.WebAuthn.Internal.Utils (jsonEncodingOptions) -import Crypto.WebAuthn.Model.Identifier (AAGUID (AAGUID)) -import qualified Crypto.WebAuthn.Model.Kinds as K -import qualified Crypto.WebAuthn.Model.Types as M -import qualified Crypto.WebAuthn.WebIDL as IDL -import qualified Data.Aeson as Aeson -import Data.Bifunctor (first) -import qualified Data.Binary.Get as Binary -import qualified Data.Bits as Bits -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base64 as Base64 -import qualified Data.ByteString.Base64.URL as Base64Url -import qualified Data.ByteString.Lazy as LBS -import qualified Data.HashMap.Strict as HashMap -import Data.Maybe (fromJust, fromMaybe) -import Data.Singletons (SingI, sing) -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import qualified Data.UUID as UUID -import GHC.Generics (Generic) - --- | Webauthn contains a mixture of binary formats. For one it's CBOR and --- for another it's a custom format. For CBOR we wish to use the --- [cborg](https://hackage.haskell.org/package/cborg) library --- and for the custom binary format the [binary](https://hackage.haskell.org/package/binary) --- library. However these two libraries don't interact nicely with each other. --- Because of this we are specifying the decoders as a 'PartialBinaryDecoder DecodingError', --- which is just a function that can partially consume a 'LBS.ByteString'. --- Using this we can somewhat easily flip between the two libraries while --- decoding without too much nastiness. -type PartialBinaryDecoder a = StateT LBS.ByteString (Either Text) a - --- | Runs a 'PartialBinaryDecoder' using a strict bytestring. Afterwards it --- makes sure that no bytes are left, otherwise returns an error -runPartialBinaryDecoder :: BS.ByteString -> PartialBinaryDecoder a -> Either Text a -runPartialBinaryDecoder bytes decoder = case runStateT decoder . LBS.fromStrict $ bytes of - Left err -> Left err - Right (result, rest) - | LBS.null rest -> return result - | otherwise -> Left $ "Not all binary input used, rest in base64 format is: " <> Text.decodeUtf8 (Base64.encode $ LBS.toStrict rest) - --- | A 'PartialBinaryDecoder DecodingError' for a binary encoding specified using 'Binary.Get' -runBinary :: Binary.Get a -> PartialBinaryDecoder a -runBinary decoder = do - bytes <- get - case Binary.runGetOrFail decoder bytes of - Left (_rest, _offset, err) -> - throwError $ "Binary decoding error: " <> Text.pack err - Right (rest, _offset, result) -> do - put rest - pure result - --- | A 'PartialBinaryDecoder DecodingError' for a CBOR encoding specified using the given Decoder -runCBOR :: (forall s. CBOR.Decoder s a) -> PartialBinaryDecoder (LBS.ByteString, a) -runCBOR decoder = do - bytes <- get - case CBOR.deserialiseFromBytesWithSize decoder bytes of - Left err -> - throwError $ "CBOR decoding error: " <> Text.pack (show err) - Right (rest, consumed, a) -> do - put rest - pure (LBS.take (fromIntegral consumed) bytes, a) - --- | Decodes a 'M.AuthenticatorData' from a 'BS.ByteString'. --- This is needed to parse a webauthn clients --- [authenticatorData](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-authenticatordata) --- field in the [AuthenticatorAssertionResponse](https://www.w3.org/TR/webauthn-2/#iface-authenticatorassertionresponse) --- structure -decodeAuthenticatorData :: - forall c. - SingI c => - BS.ByteString -> - Either Text (M.AuthenticatorData c 'True) -decodeAuthenticatorData strictBytes = runPartialBinaryDecoder strictBytes $ do - -- https://www.w3.org/TR/webauthn-2/#authenticator-data - let adRawData = M.WithRaw strictBytes - - -- https://www.w3.org/TR/webauthn-2/#rpidhash - adRpIdHash <- - M.RpIdHash . fromJust . Hash.digestFromByteString - <$> runBinary (Binary.getByteString 32) - - -- https://www.w3.org/TR/webauthn-2/#flags - bitFlags <- runBinary Binary.getWord8 - let adFlags = - M.AuthenticatorDataFlags - { M.adfUserPresent = Bits.testBit bitFlags 0, - M.adfUserVerified = Bits.testBit bitFlags 2 - } - - -- https://www.w3.org/TR/webauthn-2/#signcount - adSignCount <- M.SignatureCounter <$> runBinary Binary.getWord32be - - -- https://www.w3.org/TR/webauthn-2/#attestedcredentialdata - adAttestedCredentialData <- case (sing @c, Bits.testBit bitFlags 6) of - -- For [attestation signatures](https://www.w3.org/TR/webauthn-2/#attestation-signature), - -- the authenticator MUST set the AT [flag](https://www.w3.org/TR/webauthn-2/#flags) - -- and include the `[attestedCredentialData](https://www.w3.org/TR/webauthn-2/#attestedcredentialdata)`. - (K.SRegistration, True) -> decodeAttestedCredentialData - (K.SRegistration, False) -> throwError "Expected attested credential data, but there is none" - -- For [assertion signatures](https://www.w3.org/TR/webauthn-2/#assertion-signature), - -- the AT [flag](https://www.w3.org/TR/webauthn-2/#flags) MUST NOT be set and the - -- `[attestedCredentialData](https://www.w3.org/TR/webauthn-2/#attestedcredentialdata)` MUST NOT be included. - (K.SAuthentication, False) -> pure M.NoAttestedCredentialData - (K.SAuthentication, True) -> throwError "Expected no attested credential data, but there is" - - -- https://www.w3.org/TR/webauthn-2/#authdataextensions - adExtensions <- - if Bits.testBit bitFlags 7 - then Just <$> decodeExtensions - else pure Nothing - - pure M.AuthenticatorData {..} - where - decodeAttestedCredentialData :: PartialBinaryDecoder (M.AttestedCredentialData 'K.Registration 'True) - decodeAttestedCredentialData = do - -- https://www.w3.org/TR/webauthn-2/#aaguid - acdAaguid <- - -- Note: fromJust is safe because UUID.fromByteString only returns - -- nothing if there's not exactly 16 bytes - AAGUID . fromJust . UUID.fromByteString - <$> runBinary (Binary.getLazyByteString 16) - - -- https://www.w3.org/TR/webauthn-2/#credentialidlength - credentialLength <- - runBinary Binary.getWord16be - - -- https://www.w3.org/TR/webauthn-2/#credentialid - acdCredentialId <- - M.CredentialId - <$> runBinary (Binary.getByteString (fromIntegral credentialLength)) - - -- https://www.w3.org/TR/webauthn-2/#credentialpublickey - (usedBytes, acdCredentialPublicKey) <- runCBOR decode - let acdCredentialPublicKeyBytes = M.WithRaw $ LBS.toStrict usedBytes - - pure M.AttestedCredentialData {..} - - decodeExtensions :: PartialBinaryDecoder M.AuthenticatorExtensionOutputs - decodeExtensions = do - -- TODO: Extensions are not implemented by this library, see the TODO in the - -- module documentation of `Crypto.WebAuthn.Model` for more information. - (_, _extensions :: CBOR.Term) <- runCBOR CBOR.decodeTerm - pure M.AuthenticatorExtensionOutputs {} - --- | Decodes a 'M.AttestationObject' from a 'BS.ByteString'. --- This is needed to parse a webauthn clients --- [attestationObject](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-attestationobject) --- field in the [AuthenticatorAttestationResponse](https://www.w3.org/TR/webauthn-2/#iface-authenticatorattestationresponse) --- structure This function takes a 'M.SupportedAttestationStatementFormats' --- argument to indicate which attestation statement formats are supported. --- structure -decodeAttestationObject :: M.SupportedAttestationStatementFormats -> BS.ByteString -> Either Text (M.AttestationObject 'True) -decodeAttestationObject supportedFormats bytes = do - (_consumed, result) <- runPartialBinaryDecoder bytes (runCBOR CBOR.decodeTerm) - pairs <- case result of - CBOR.TMap pairs -> return pairs - _ -> Left $ "The attestation object should be a CBOR map, but it's not: " <> Text.pack (show result) - - -- https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object - case (CBOR.TString "authData" `lookup` pairs, CBOR.TString "fmt" `lookup` pairs, CBOR.TString "attStmt" `lookup` pairs) of - (Just (CBOR.TBytes authDataBytes), Just (CBOR.TString fmt), Just (CBOR.TMap attStmtPairs)) -> do - aoAuthData <- decodeAuthenticatorData authDataBytes - - case M.lookupAttestationStatementFormat fmt supportedFormats of - Nothing -> Left $ "Unknown attestation statement format: " <> fmt - Just (M.SomeAttestationStatementFormat aoFmt) -> do - attStmtMap <- - HashMap.fromList - <$> forM - attStmtPairs - ( \case - (CBOR.TString text, term) -> pure (text, term) - (nonString, _) -> Left $ "Unexpected non-string attestation statement key: " <> Text.pack (show nonString) - ) - aoAttStmt <- M.asfDecode aoFmt attStmtMap - pure M.AttestationObject {..} - _ -> Left $ "The attestation object doesn't have the expected structure of (authData: bytes, fmt: string, attStmt: map): " <> Text.pack (show result) - ---- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-client-data) ---- Intermediate type used to extract the JSON structure stored in the ---- CBOR-encoded [clientDataJSON](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson). -data ClientDataJSON = ClientDataJSON - { littype :: IDL.DOMString, - challenge :: IDL.DOMString, - origin :: IDL.DOMString, - crossOrigin :: Maybe IDL.Boolean - -- TODO: We do not implement TokenBinding, see the documentation of - -- `CollectedClientData` for more information. - -- tokenBinding :: Maybe TokenBinding - } - deriving (Generic) - --- Note: Encoding should NOT be derived via aeson. See the Encoding module instead -instance Aeson.FromJSON ClientDataJSON where - parseJSON = Aeson.genericParseJSON jsonEncodingOptions - --- | Decodes a 'M.CollectedClientData' from a 'BS.ByteString'. This is needed --- to parse the [clientDataJSON](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson) --- field in the [AuthenticatorResponse](https://www.w3.org/TR/webauthn-2/#iface-authenticatorresponse) --- structure, which is used for both attestation and assertion -decodeCollectedClientData :: forall (c :: K.CeremonyKind). SingI c => BS.ByteString -> Either Text (M.CollectedClientData c 'True) -decodeCollectedClientData bytes = do - -- https://www.w3.org/TR/webauthn-2/#collectedclientdata-json-compatible-serialization-of-client-data - ClientDataJSON {..} <- - first (("Collected client data JSON decoding error: " <>) . Text.pack) $ - Aeson.eitherDecodeStrict bytes - -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-challenge) - -- This member contains the base64url encoding of the challenge provided by the - -- [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party). See the - -- [§ 13.4.3 Cryptographic Challenges](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges) - -- security consideration. - challenge <- - first ((("Failed to base64url-decode challenge " <> challenge <> ": ") <>) . Text.pack) $ - Base64Url.decode (Text.encodeUtf8 challenge) - -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-type) - -- This member contains the string "webauthn.create" when creating new credentials, - -- and "webauthn.get" when getting an assertion from an existing credential. - -- The purpose of this member is to prevent certain types of signature confusion - -- attacks (where an attacker substitutes one legitimate signature for another). - let expectedType = case sing @c of - K.SRegistration -> "webauthn.create" - K.SAuthentication -> "webauthn.get" - unless (littype == expectedType) $ - Left $ - "Expected collected client data to have webauthn type " <> expectedType <> " but it is " <> littype - pure - M.CollectedClientData - { ccdChallenge = M.Challenge challenge, - ccdOrigin = M.Origin origin, - ccdCrossOrigin = fromMaybe False crossOrigin, - ccdRawData = M.WithRaw bytes - } diff --git a/src/Crypto/WebAuthn/Model/WebIDL/Internal/Binary/Encoding.hs b/src/Crypto/WebAuthn/Model/WebIDL/Internal/Binary/Encoding.hs deleted file mode 100644 --- a/src/Crypto/WebAuthn/Model/WebIDL/Internal/Binary/Encoding.hs +++ /dev/null @@ -1,200 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} - --- | Stability: internal --- Certain parts of the specification require that data is encoded to a --- binary form. This module holds such functions. -module Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Encoding - ( -- * Encoding raw fields - encodeRawCredential, - encodeRawAuthenticatorData, - encodeRawCollectedClientData, - - -- * Encoding structures to bytes - encodeAttestationObject, - encodeCollectedClientData, - ) -where - -import qualified Codec.CBOR.Term as CBOR -import qualified Codec.CBOR.Write as CBOR -import Codec.Serialise (Serialise (encode)) -import Crypto.WebAuthn.Model.Identifier (AAGUID (unAAGUID)) -import qualified Crypto.WebAuthn.Model.Kinds as K -import qualified Crypto.WebAuthn.Model.Types as M -import qualified Data.Aeson as Aeson -import qualified Data.Binary.Put as Binary -import Data.Bits ((.|.)) -import qualified Data.Bits as Bits -import Data.ByteArray (convert) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base64.URL as Base64Url -import Data.ByteString.Builder (Builder, stringUtf8, toLazyByteString) -import qualified Data.ByteString.Lazy as LBS -import Data.Singletons (SingI, sing) -import Data.Text (Text) -import Data.Text.Encoding (decodeUtf8) -import qualified Data.UUID as UUID -import Data.Word (Word16, Word8) - --- | Encodes all raw fields of a 'M.Credential'. This function is --- mainly useful for testing that the encoding/decoding functions are correct. --- The counterpart to this function is 'Crypto.WebAuthn.Model.Binary.Decoding.stripRawCredential' -encodeRawCredential :: forall (c :: K.CeremonyKind) raw. SingI c => M.Credential c raw -> M.Credential c 'True -encodeRawCredential M.Credential {..} = - M.Credential - { cResponse = case sing @c of - K.SRegistration -> encodeRawAuthenticatorResponseRegistration cResponse - K.SAuthentication -> encodeRawAuthenticatorResponseAuthentication cResponse, - .. - } - where - encodeRawAuthenticatorResponseAuthentication :: M.AuthenticatorResponse 'K.Authentication raw -> M.AuthenticatorResponse 'K.Authentication 'True - encodeRawAuthenticatorResponseAuthentication M.AuthenticatorResponseAuthentication {..} = - M.AuthenticatorResponseAuthentication - { araClientData = encodeRawCollectedClientData araClientData, - araAuthenticatorData = encodeRawAuthenticatorData araAuthenticatorData, - .. - } - - encodeRawAuthenticatorResponseRegistration :: M.AuthenticatorResponse 'K.Registration raw -> M.AuthenticatorResponse 'K.Registration 'True - encodeRawAuthenticatorResponseRegistration M.AuthenticatorResponseRegistration {..} = - M.AuthenticatorResponseRegistration - { arrClientData = encodeRawCollectedClientData arrClientData, - arrAttestationObject = encodeRawAttestationObject arrAttestationObject, - .. - } - - encodeRawAttestationObject :: M.AttestationObject raw -> M.AttestationObject 'True - encodeRawAttestationObject M.AttestationObject {..} = - M.AttestationObject - { aoAuthData = encodeRawAuthenticatorData aoAuthData, - .. - } - --- | Encodes all raw fields of a 'M.AuthenticatorData'. This function is needed --- for an authenticator implementation -encodeRawAuthenticatorData :: forall c raw. SingI c => M.AuthenticatorData c raw -> M.AuthenticatorData c 'True -encodeRawAuthenticatorData M.AuthenticatorData {..} = - M.AuthenticatorData - { adRawData = M.WithRaw bytes, - adAttestedCredentialData = rawAttestedCredentialData, - .. - } - where - rawAttestedCredentialData = encodeRawAttestedCredentialData adAttestedCredentialData - - bytes :: BS.ByteString - bytes = LBS.toStrict $ toLazyByteString builder - - -- https://www.w3.org/TR/webauthn-2/#flags - flags :: Word8 - flags = - userPresentFlag - .|. userVerifiedFlag - .|. attestedCredentialDataPresentFlag - .|. extensionsPresentFlag - where - userPresentFlag = if M.adfUserPresent adFlags then Bits.bit 0 else 0 - userVerifiedFlag = if M.adfUserVerified adFlags then Bits.bit 2 else 0 - attestedCredentialDataPresentFlag = case sing @c of - K.SRegistration -> Bits.bit 6 - K.SAuthentication -> 0 - extensionsPresentFlag = case adExtensions of - Just _ -> Bits.bit 7 - Nothing -> 0 - - -- https://www.w3.org/TR/webauthn-2/#sctn-authenticator-data - builder :: Builder - builder = - Binary.execPut (Binary.putByteString $ convert $ M.unRpIdHash adRpIdHash) - <> Binary.execPut (Binary.putWord8 flags) - <> Binary.execPut (Binary.putWord32be $ M.unSignatureCounter adSignCount) - <> ( case sing @c of - K.SRegistration -> encodeAttestedCredentialData rawAttestedCredentialData - K.SAuthentication -> mempty - ) - <> maybe mempty encodeExtensions adExtensions - - encodeExtensions :: M.AuthenticatorExtensionOutputs -> Builder - encodeExtensions M.AuthenticatorExtensionOutputs {} = CBOR.toBuilder $ CBOR.encodeTerm (CBOR.TMap []) - - -- https://www.w3.org/TR/webauthn-2/#sctn-attested-credential-data - encodeAttestedCredentialData :: M.AttestedCredentialData 'K.Registration 'True -> Builder - encodeAttestedCredentialData M.AttestedCredentialData {..} = - Binary.execPut (Binary.putLazyByteString $ UUID.toByteString $ unAAGUID acdAaguid) - <> Binary.execPut (Binary.putWord16be credentialLength) - <> Binary.execPut (Binary.putByteString $ M.unCredentialId acdCredentialId) - <> Binary.execPut (Binary.putByteString $ M.unRaw acdCredentialPublicKeyBytes) - where - credentialLength :: Word16 - credentialLength = fromIntegral $ BS.length $ M.unCredentialId acdCredentialId - - encodeRawAttestedCredentialData :: forall (c :: K.CeremonyKind) raw. SingI c => M.AttestedCredentialData c raw -> M.AttestedCredentialData c 'True - encodeRawAttestedCredentialData = case sing @c of - K.SRegistration -> \M.AttestedCredentialData {..} -> - M.AttestedCredentialData - { acdCredentialPublicKeyBytes = - M.WithRaw $ LBS.toStrict $ CBOR.toLazyByteString $ encode acdCredentialPublicKey, - .. - } - K.SAuthentication -> \M.NoAttestedCredentialData -> M.NoAttestedCredentialData - --- | Encodes all raw fields of a 'M.CollectedClientData'. This function is --- needed for a client implementation -encodeRawCollectedClientData :: forall c raw. SingI c => M.CollectedClientData c raw -> M.CollectedClientData c 'True -encodeRawCollectedClientData M.CollectedClientData {..} = M.CollectedClientData {..} - where - ccdRawData = M.WithRaw $ LBS.toStrict $ toLazyByteString builder - - -- https://www.w3.org/TR/webauthn-2/#clientdatajson-serialization - builder :: Builder - builder = - stringUtf8 "{\"type\":" - <> jsonBuilder typeValue - <> stringUtf8 ",\"challenge\":" - <> jsonBuilder challengeValue - <> stringUtf8 ",\"origin\":" - <> jsonBuilder originValue - <> stringUtf8 ",\"crossOrigin\":" - <> jsonBuilder crossOriginValue - <> stringUtf8 "}" - - typeValue :: Text - typeValue = case sing @c of - K.SRegistration -> "webauthn.create" - K.SAuthentication -> "webauthn.get" - - challengeValue :: Text - challengeValue = decodeUtf8 (Base64Url.encode (M.unChallenge ccdChallenge)) - - originValue :: Text - originValue = M.unOrigin ccdOrigin - - crossOriginValue :: Bool - crossOriginValue = ccdCrossOrigin - - jsonBuilder :: Aeson.ToJSON a => a -> Builder - jsonBuilder = Aeson.fromEncoding . Aeson.toEncoding - --- | Encodes an 'M.AttestationObject' as a 'BS.ByteString'. This is needed by --- the client side to generate a valid JSON response -encodeAttestationObject :: M.AttestationObject 'True -> BS.ByteString -encodeAttestationObject M.AttestationObject {..} = CBOR.toStrictByteString $ CBOR.encodeTerm term - where - -- https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object - term :: CBOR.Term - term = - CBOR.TMap - [ (CBOR.TString "authData", CBOR.TBytes $ M.unRaw $ M.adRawData aoAuthData), - (CBOR.TString "fmt", CBOR.TString $ M.asfIdentifier aoFmt), - (CBOR.TString "attStmt", M.asfEncode aoFmt aoAttStmt) - ] - --- | Encodes an 'M.CollectedClientData' as a 'BS.ByteString'. This is needed by --- the client side to generate a valid JSON response -encodeCollectedClientData :: forall (c :: K.CeremonyKind). SingI c => M.CollectedClientData c 'True -> BS.ByteString -encodeCollectedClientData M.CollectedClientData {..} = M.unRaw ccdRawData diff --git a/src/Crypto/WebAuthn/Model/WebIDL/Internal/Convert.hs b/src/Crypto/WebAuthn/Model/WebIDL/Internal/Convert.hs deleted file mode 100644 --- a/src/Crypto/WebAuthn/Model/WebIDL/Internal/Convert.hs +++ /dev/null @@ -1,129 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeFamilies #-} - --- | Stability: internal --- This module maps every Model type to a WebIDL type. As the name of the --- module and typclass suggest, this is used to perform the conversion between --- the WebIDL and Model representations. -module Crypto.WebAuthn.Model.WebIDL.Internal.Convert - ( Convert (..), - ) -where - -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose -import qualified Crypto.WebAuthn.Model.Kinds as K -import qualified Crypto.WebAuthn.Model.Types as M -import qualified Crypto.WebAuthn.Model.WebIDL.Types as IDL -import qualified Crypto.WebAuthn.WebIDL as IDL -import qualified Data.Aeson as Aeson -import Data.Kind (Type) -import Data.Map (Map) -import Data.Text (Text) - --- | @'Convert' hs@ indicates that the Haskell-specific type @hs@ has a more --- general JavaScript-specific type associated with it, which can be accessed with 'IDL'. -class Convert hs where - type IDL hs :: Type - -instance Convert hs => Convert (Maybe hs) where - type IDL (Maybe hs) = Maybe (IDL hs) - -instance Convert M.RpId where - type IDL M.RpId = IDL.DOMString - -instance Convert M.RelyingPartyName where - type IDL M.RelyingPartyName = IDL.DOMString - -instance Convert M.CredentialRpEntity where - type IDL M.CredentialRpEntity = IDL.PublicKeyCredentialRpEntity - -instance Convert M.UserHandle where - type IDL M.UserHandle = IDL.BufferSource - -instance Convert M.UserAccountDisplayName where - type IDL M.UserAccountDisplayName = IDL.DOMString - -instance Convert M.UserAccountName where - type IDL M.UserAccountName = IDL.DOMString - -instance Convert M.CredentialUserEntity where - type IDL M.CredentialUserEntity = IDL.PublicKeyCredentialUserEntity - -instance Convert M.Challenge where - type IDL M.Challenge = IDL.BufferSource - -instance Convert M.CredentialType where - type IDL M.CredentialType = IDL.DOMString - -instance Convert Cose.CoseSignAlg where - type IDL Cose.CoseSignAlg = IDL.COSEAlgorithmIdentifier - -instance Convert [M.CredentialParameters] where - type IDL [M.CredentialParameters] = [IDL.PublicKeyCredentialParameters] - -instance Convert M.Timeout where - type IDL M.Timeout = IDL.UnsignedLong - -instance Convert M.CredentialId where - type IDL M.CredentialId = IDL.BufferSource - -instance Convert [M.AuthenticatorTransport] where - type IDL [M.AuthenticatorTransport] = [IDL.DOMString] - -instance Convert M.CredentialDescriptor where - type IDL M.CredentialDescriptor = IDL.PublicKeyCredentialDescriptor - -instance Convert [M.CredentialDescriptor] where - type IDL [M.CredentialDescriptor] = Maybe [IDL.PublicKeyCredentialDescriptor] - -instance Convert M.AuthenticatorAttachment where - type IDL M.AuthenticatorAttachment = IDL.DOMString - -instance Convert M.ResidentKeyRequirement where - type IDL M.ResidentKeyRequirement = Maybe IDL.DOMString - -instance Convert M.UserVerificationRequirement where - type IDL M.UserVerificationRequirement = Maybe IDL.DOMString - -instance Convert M.AuthenticatorSelectionCriteria where - type IDL M.AuthenticatorSelectionCriteria = IDL.AuthenticatorSelectionCriteria - -instance Convert M.AttestationConveyancePreference where - type IDL M.AttestationConveyancePreference = Maybe IDL.DOMString - -instance Convert M.AuthenticationExtensionsClientInputs where - type IDL M.AuthenticationExtensionsClientInputs = Map Text Aeson.Value - -instance Convert (M.CredentialOptions 'K.Registration) where - type IDL (M.CredentialOptions 'K.Registration) = IDL.PublicKeyCredentialCreationOptions - -instance Convert (M.CredentialOptions 'K.Authentication) where - type IDL (M.CredentialOptions 'K.Authentication) = IDL.PublicKeyCredentialRequestOptions - -instance Convert (M.Credential 'K.Registration raw) where - type IDL (M.Credential 'K.Registration raw) = IDL.PublicKeyCredential IDL.AuthenticatorAttestationResponse - -instance Convert (M.AuthenticatorResponse 'K.Registration raw) where - type IDL (M.AuthenticatorResponse 'K.Registration raw) = IDL.AuthenticatorAttestationResponse - -instance Convert (M.Credential 'K.Authentication raw) where - type IDL (M.Credential 'K.Authentication raw) = IDL.PublicKeyCredential IDL.AuthenticatorAssertionResponse - -instance Convert (M.AuthenticatorResponse 'K.Authentication raw) where - type IDL (M.AuthenticatorResponse 'K.Authentication raw) = IDL.AuthenticatorAssertionResponse - -instance Convert M.AuthenticationExtensionsClientOutputs where - type IDL M.AuthenticationExtensionsClientOutputs = Map Text Aeson.Value - -instance Convert (M.CollectedClientData c 'True) where - type IDL (M.CollectedClientData c 'True) = IDL.ArrayBuffer - -instance Convert (M.AttestationObject 'True) where - type IDL (M.AttestationObject 'True) = IDL.ArrayBuffer - -instance Convert M.AssertionSignature where - type IDL M.AssertionSignature = IDL.ArrayBuffer - -instance Convert (M.AuthenticatorData 'K.Authentication raw) where - type IDL (M.AuthenticatorData 'K.Authentication raw) = IDL.ArrayBuffer diff --git a/src/Crypto/WebAuthn/Model/WebIDL/Internal/Decoding.hs b/src/Crypto/WebAuthn/Model/WebIDL/Internal/Decoding.hs deleted file mode 100644 --- a/src/Crypto/WebAuthn/Model/WebIDL/Internal/Decoding.hs +++ /dev/null @@ -1,246 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RecordWildCards #-} - --- | Stability: internal --- This module handles the decoding of structures returned by the --- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) --- and [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) --- methods while [Registering a New Credential](https://www.w3.org/TR/webauthn-2/#sctn-registering-a-new-credential) --- and [Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion) respectively. -module Crypto.WebAuthn.Model.WebIDL.Internal.Decoding - ( Decode (..), - DecodeCreated (..), - ) -where - -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose -import qualified Crypto.WebAuthn.Model.Kinds as K -import qualified Crypto.WebAuthn.Model.Types as M -import qualified Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Decoding as B -import Crypto.WebAuthn.Model.WebIDL.Internal.Convert (Convert (IDL)) -import qualified Crypto.WebAuthn.Model.WebIDL.Types as IDL -import qualified Crypto.WebAuthn.WebIDL as IDL -import Data.Coerce (Coercible, coerce) -import Data.Maybe (catMaybes, mapMaybe) -import Data.Singletons (SingI) -import Data.Text (Text) - --- | @'Decode' a@ indicates that the Haskell-specific type @a@ can be --- decoded from the more generic JavaScript type @'IDL' a@ with the 'decode' function. -class Convert a => Decode a where - decode :: IDL a -> Either Text a - default decode :: Coercible (IDL a) a => IDL a -> Either Text a - decode = pure . coerce - --- | Like 'Decode', but with a 'decodeCreated' function that also takes a --- 'M.SupportedAttestationStatementFormats' in order to allow decoding to depend --- on the supported attestation formats. -class Convert a => DecodeCreated a where - decodeCreated :: M.SupportedAttestationStatementFormats -> IDL a -> Either Text a - -instance Decode a => Decode (Maybe a) where - decode Nothing = pure Nothing - decode (Just a) = Just <$> decode a - -instance Decode M.CredentialId - -instance Decode M.AssertionSignature - -instance Decode M.UserHandle - -instance Decode M.AuthenticationExtensionsClientOutputs where - -- TODO: Extensions are not implemented by this library, see the TODO in the - -- module documentation of `Crypto.WebAuthn.Model` for more information. - decode _ = pure M.AuthenticationExtensionsClientOutputs {} - -instance SingI c => Decode (M.CollectedClientData (c :: K.CeremonyKind) 'True) where - decode (IDL.URLEncodedBase64 bytes) = B.decodeCollectedClientData bytes - -instance Decode (M.AuthenticatorData 'K.Authentication 'True) where - decode (IDL.URLEncodedBase64 bytes) = B.decodeAuthenticatorData bytes - -instance Decode (M.AuthenticatorResponse 'K.Authentication 'True) where - decode IDL.AuthenticatorAssertionResponse {..} = do - araClientData <- decode clientDataJSON - araAuthenticatorData <- decode authenticatorData - araSignature <- decode signature - araUserHandle <- decode userHandle - pure $ M.AuthenticatorResponseAuthentication {..} - -instance Decode (M.Credential 'K.Authentication 'True) where - decode IDL.PublicKeyCredential {..} = do - cIdentifier <- decode rawId - cResponse <- decode response - cClientExtensionResults <- decode clientExtensionResults - pure $ M.Credential {..} - -instance Decode M.RpId - -instance Decode M.RelyingPartyName - -instance Decode M.CredentialRpEntity where - decode IDL.PublicKeyCredentialRpEntity {..} = do - creId <- decode id - creName <- decode name - pure $ M.CredentialRpEntity {..} - -instance Decode M.UserAccountDisplayName - -instance Decode M.UserAccountName - -instance Decode M.CredentialUserEntity where - decode IDL.PublicKeyCredentialUserEntity {..} = do - cueId <- decode id - cueDisplayName <- decode displayName - cueName <- decode name - pure $ M.CredentialUserEntity {..} - -instance Decode M.Challenge - -instance Decode Cose.CoseSignAlg where - -- The specification does not inspect the algorithm until - -- assertion/attestation. We implement the check here to go to a Haskell - -- type. Erring on the side of caution by failing to parse if an unsupported - -- alg was encountered. - decode = Cose.toCoseSignAlg - -instance Decode M.Timeout - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-transport) -instance Decode [M.AuthenticatorTransport] where - decode = pure . mapMaybe decodeTransport - where - decodeTransport "usb" = Just M.AuthenticatorTransportUSB - decodeTransport "nfc" = Just M.AuthenticatorTransportNFC - decodeTransport "ble" = Just M.AuthenticatorTransportBLE - decodeTransport "internal" = Just M.AuthenticatorTransportInternal - decodeTransport _ = Nothing - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-credential-descriptor) --- [The type] member contains the type of the public key credential the caller --- is referring to. The value SHOULD be a member of --- PublicKeyCredentialType but client platforms MUST ignore any --- PublicKeyCredentialDescriptor with an unknown type. -instance Decode [M.CredentialDescriptor] where - decode Nothing = pure [] - decode (Just xs) = catMaybes <$> traverse decodeDescriptor xs - where - decodeDescriptor :: IDL.PublicKeyCredentialDescriptor -> Either Text (Maybe M.CredentialDescriptor) - decodeDescriptor IDL.PublicKeyCredentialDescriptor {littype = "public-key", ..} = do - let cdTyp = M.CredentialTypePublicKey - cdId <- decode id - cdTransports <- decode transports - pure . Just $ M.CredentialDescriptor {..} - decodeDescriptor _ = pure Nothing - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-userVerificationRequirement) --- The value SHOULD be a member of UserVerificationRequirement but client --- platforms MUST ignore unknown values, treating an unknown value as if the --- member does not exist. The default is "preferred". -instance Decode M.UserVerificationRequirement where - decode (Just "discouraged") = Right M.UserVerificationRequirementDiscouraged - decode (Just "preferred") = Right M.UserVerificationRequirementPreferred - decode (Just "required") = Right M.UserVerificationRequirementRequired - decode _ = Right M.UserVerificationRequirementPreferred - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-authenticatorSelection) -instance Decode M.AuthenticatorSelectionCriteria where - decode IDL.AuthenticatorSelectionCriteria {..} = do - let ascAuthenticatorAttachment = decodeAttachment =<< authenticatorAttachment - ascResidentKey = decodeResidentKey residentKey - ascUserVerification <- decode userVerification - pure $ M.AuthenticatorSelectionCriteria {..} - where - -- Any unknown values must be ignored, treating them as if the member does not exist - decodeAttachment "platform" = Just M.AuthenticatorAttachmentPlatform - decodeAttachment "cross-platform" = Just M.AuthenticatorAttachmentCrossPlatform - decodeAttachment _ = Nothing - - -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-residentkey) - -- The value SHOULD be a member of ResidentKeyRequirement but client platforms - -- MUST ignore unknown values, treating an unknown value as if the member does not - -- exist. If no value is given then the effective value is required if - -- requireResidentKey is true or discouraged if it is false or absent. - decodeResidentKey :: Maybe IDL.DOMString -> M.ResidentKeyRequirement - decodeResidentKey (Just "discouraged") = M.ResidentKeyRequirementDiscouraged - decodeResidentKey (Just "preferred") = M.ResidentKeyRequirementPreferred - decodeResidentKey (Just "required") = M.ResidentKeyRequirementRequired - decodeResidentKey _ = case requireResidentKey of - Just True -> M.ResidentKeyRequirementRequired - _ -> M.ResidentKeyRequirementDiscouraged - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-attestationconveyancepreference) --- Its values SHOULD be members of AttestationConveyancePreference. Client --- platforms MUST ignore unknown values, treating an unknown value as if the --- member does not exist. Its default value is "none". -instance Decode M.AttestationConveyancePreference where - decode (Just "none") = Right M.AttestationConveyancePreferenceNone - decode (Just "indirect") = Right M.AttestationConveyancePreferenceIndirect - decode (Just "direct") = Right M.AttestationConveyancePreferenceDirect - decode (Just "enterprise") = Right M.AttestationConveyancePreferenceEnterprise - decode _ = Right M.AttestationConveyancePreferenceNone - --- [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialparameters) --- [The type] member specifies the type of credential to be created. The value SHOULD --- be a member of PublicKeyCredentialType but client platforms MUST ignore --- unknown values, ignoring any PublicKeyCredentialParameters with an unknown --- type. -instance Decode [M.CredentialParameters] where - decode xs = catMaybes <$> traverse decodeParam xs - where - decodeParam :: IDL.PublicKeyCredentialParameters -> Either Text (Maybe M.CredentialParameters) - decodeParam IDL.PublicKeyCredentialParameters {littype = "public-key", ..} = do - let cpTyp = M.CredentialTypePublicKey - cpAlg <- decode alg - pure . Just $ M.CredentialParameters {..} - decodeParam _ = pure Nothing - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-makecredentialoptions) -instance Decode (M.CredentialOptions 'K.Registration) where - decode IDL.PublicKeyCredentialCreationOptions {..} = do - corRp <- decode rp - corUser <- decode user - corChallenge <- decode challenge - corPubKeyCredParams <- decode pubKeyCredParams - corTimeout <- decode timeout - corExcludeCredentials <- decode excludeCredentials - corAuthenticatorSelection <- decode authenticatorSelection - corAttestation <- decode attestation - let corExtensions = M.AuthenticationExtensionsClientInputs {} <$ extensions - pure $ M.CredentialOptionsRegistration {..} - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-assertion-options) -instance Decode (M.CredentialOptions 'K.Authentication) where - decode IDL.PublicKeyCredentialRequestOptions {..} = do - coaChallenge <- decode challenge - coaTimeout <- decode timeout - coaRpId <- decode rpId - coaAllowCredentials <- decode allowCredentials - coaUserVerification <- decode userVerification - let coaExtensions = M.AuthenticationExtensionsClientInputs {} <$ extensions - pure $ M.CredentialOptionsAuthentication {..} - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object) -instance DecodeCreated (M.AttestationObject 'True) where - decodeCreated supportedFormats (IDL.URLEncodedBase64 bytes) = - B.decodeAttestationObject supportedFormats bytes - -instance DecodeCreated (M.AuthenticatorResponse 'K.Registration 'True) where - decodeCreated supportedFormats IDL.AuthenticatorAttestationResponse {..} = do - arrClientData <- decode clientDataJSON - arrAttestationObject <- decodeCreated supportedFormats attestationObject - arrTransports <- case transports of - Nothing -> pure [] - Just t -> decode t - pure $ M.AuthenticatorResponseRegistration {..} - -instance DecodeCreated (M.Credential 'K.Registration 'True) where - decodeCreated supportedFormats IDL.PublicKeyCredential {..} = do - cIdentifier <- decode rawId - cResponse <- decodeCreated supportedFormats response - cClientExtensionResults <- decode clientExtensionResults - pure $ M.Credential {..} diff --git a/src/Crypto/WebAuthn/Model/WebIDL/Internal/Encoding.hs b/src/Crypto/WebAuthn/Model/WebIDL/Internal/Encoding.hs deleted file mode 100644 --- a/src/Crypto/WebAuthn/Model/WebIDL/Internal/Encoding.hs +++ /dev/null @@ -1,221 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} - --- | Stability: internal --- This module handles the encoding of structures passed to the --- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) --- and [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) --- methods while [Registering a New Credential](https://www.w3.org/TR/webauthn-2/#sctn-registering-a-new-credential) --- and [Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion) respectively. -module Crypto.WebAuthn.Model.WebIDL.Internal.Encoding - ( Encode (..), - ) -where - -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose -import qualified Crypto.WebAuthn.Model.Kinds as K -import qualified Crypto.WebAuthn.Model.Types as M -import qualified Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Encoding as B -import Crypto.WebAuthn.Model.WebIDL.Internal.Convert (Convert (IDL)) -import qualified Crypto.WebAuthn.Model.WebIDL.Types as IDL -import qualified Crypto.WebAuthn.WebIDL as IDL -import Data.Coerce (Coercible, coerce) -import qualified Data.Map as Map -import Data.Singletons (SingI) - --- | @'Encode' hs@ indicates that the Haskell-specific type @hs@ can be --- encoded to the more generic JavaScript type @'IDL' hs@ with the 'encode' function. -class Convert a => Encode a where - encode :: a -> IDL a - default encode :: Coercible a (IDL a) => a -> IDL a - encode = coerce - -instance Encode hs => Encode (Maybe hs) where - encode Nothing = Nothing - encode (Just hs) = Just $ encode hs - -instance Encode M.RpId - -instance Encode M.RelyingPartyName - -instance Encode M.UserHandle - -instance Encode M.UserAccountDisplayName - -instance Encode M.UserAccountName - -instance Encode M.Challenge - -instance Encode M.Timeout - -instance Encode M.CredentialId - -instance Encode M.AuthenticationExtensionsClientInputs where - -- TODO: Extensions are not implemented by this library, see the TODO in the - -- module documentation of `Crypto.WebAuthn.Model` for more information. - encode M.AuthenticationExtensionsClientInputs {} = Map.empty - --- | -instance Encode Cose.CoseSignAlg where - encode = Cose.fromCoseSignAlg - --- | -instance Encode M.CredentialType where - encode M.CredentialTypePublicKey = "public-key" - --- | -instance Encode [M.AuthenticatorTransport] where - encode = map encodeTransport - where - encodeTransport M.AuthenticatorTransportUSB = "usb" - encodeTransport M.AuthenticatorTransportNFC = "nfc" - encodeTransport M.AuthenticatorTransportBLE = "ble" - encodeTransport M.AuthenticatorTransportInternal = "internal" - --- | -instance Encode M.AuthenticatorAttachment where - encode M.AuthenticatorAttachmentPlatform = "platform" - encode M.AuthenticatorAttachmentCrossPlatform = "cross-platform" - --- | -instance Encode M.ResidentKeyRequirement where - encode M.ResidentKeyRequirementDiscouraged = Just "discouraged" - encode M.ResidentKeyRequirementPreferred = Just "preferred" - encode M.ResidentKeyRequirementRequired = Just "required" - --- | -instance Encode M.UserVerificationRequirement where - encode M.UserVerificationRequirementRequired = Just "required" - encode M.UserVerificationRequirementPreferred = Just "preferred" - encode M.UserVerificationRequirementDiscouraged = Just "discouraged" - --- | -instance Encode M.AttestationConveyancePreference where - encode M.AttestationConveyancePreferenceNone = Just "none" - encode M.AttestationConveyancePreferenceIndirect = Just "indirect" - encode M.AttestationConveyancePreferenceDirect = Just "direct" - encode M.AttestationConveyancePreferenceEnterprise = Just "enterprise" - -instance Encode M.CredentialRpEntity where - encode M.CredentialRpEntity {..} = - IDL.PublicKeyCredentialRpEntity - { id = encode creId, - name = encode creName - } - -instance Encode M.CredentialUserEntity where - encode M.CredentialUserEntity {..} = - IDL.PublicKeyCredentialUserEntity - { id = encode cueId, - displayName = encode cueDisplayName, - name = encode cueName - } - -instance Encode [M.CredentialParameters] where - encode = map encodeParameters - where - encodeParameters M.CredentialParameters {..} = - IDL.PublicKeyCredentialParameters - { littype = encode cpTyp, - alg = encode cpAlg - } - -instance Encode M.CredentialDescriptor where - encode M.CredentialDescriptor {..} = - IDL.PublicKeyCredentialDescriptor - { littype = encode cdTyp, - id = encode cdId, - transports = encode cdTransports - } - -instance Encode M.AuthenticatorSelectionCriteria where - encode M.AuthenticatorSelectionCriteria {..} = - IDL.AuthenticatorSelectionCriteria - { authenticatorAttachment = encode ascAuthenticatorAttachment, - residentKey = encode ascResidentKey, - -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-requireresidentkey) - -- Relying Parties SHOULD set it to true if, and only if, residentKey is set to required. - requireResidentKey = Just (ascResidentKey == M.ResidentKeyRequirementRequired), - userVerification = encode ascUserVerification - } - -instance Encode [M.CredentialDescriptor] where - encode = Just . map encode - -instance Encode (M.CredentialOptions 'K.Registration) where - encode M.CredentialOptionsRegistration {..} = - IDL.PublicKeyCredentialCreationOptions - { rp = encode corRp, - user = encode corUser, - challenge = encode corChallenge, - pubKeyCredParams = encode corPubKeyCredParams, - timeout = encode corTimeout, - excludeCredentials = encode corExcludeCredentials, - authenticatorSelection = encode corAuthenticatorSelection, - attestation = encode corAttestation, - extensions = encode corExtensions - } - -instance Encode (M.CredentialOptions 'K.Authentication) where - encode M.CredentialOptionsAuthentication {..} = - IDL.PublicKeyCredentialRequestOptions - { challenge = encode coaChallenge, - timeout = encode coaTimeout, - rpId = encode coaRpId, - allowCredentials = encode coaAllowCredentials, - userVerification = encode coaUserVerification, - extensions = encode coaExtensions - } - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-pkcredential) --- Encodes the PublicKeyCredential for attestation, this instance is mostly used in the tests where we emulate the --- of the client. -instance Encode (M.Credential 'K.Registration 'True) where - encode M.Credential {..} = - IDL.PublicKeyCredential - { rawId = encode cIdentifier, - response = encode cResponse, - -- TODO: Extensions are not implemented by this library, see the TODO in the - -- module documentation of `Crypto.WebAuthn.Model` for more information. - clientExtensionResults = Map.empty - } - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson) -instance SingI c => Encode (M.CollectedClientData (c :: K.CeremonyKind) 'True) where - encode ccd = IDL.URLEncodedBase64 $ B.encodeCollectedClientData ccd - -instance Encode (M.AuthenticatorResponse 'K.Authentication 'True) where - encode M.AuthenticatorResponseAuthentication {..} = - IDL.AuthenticatorAssertionResponse - { clientDataJSON = encode araClientData, - authenticatorData = IDL.URLEncodedBase64 $ M.unRaw $ M.adRawData araAuthenticatorData, - signature = IDL.URLEncodedBase64 $ M.unAssertionSignature araSignature, - userHandle = IDL.URLEncodedBase64 . M.unUserHandle <$> araUserHandle - } - -instance Encode (M.Credential 'K.Authentication 'True) where - encode M.Credential {..} = - IDL.PublicKeyCredential - { rawId = encode cIdentifier, - response = encode cResponse, - -- TODO: Extensions are not implemented by this library, see the TODO in the - -- module documentation of `Crypto.WebAuthn.Model` for more information. - clientExtensionResults = Map.empty - } - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authenticatorresponse) -instance Encode (M.AuthenticatorResponse 'K.Registration 'True) where - encode M.AuthenticatorResponseRegistration {..} = - IDL.AuthenticatorAttestationResponse - { clientDataJSON = encode arrClientData, - attestationObject = encode arrAttestationObject, - transports = Just $ encode arrTransports - } - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-attestationobject) -instance Encode (M.AttestationObject 'True) where - encode ao = IDL.URLEncodedBase64 $ B.encodeAttestationObject ao diff --git a/src/Crypto/WebAuthn/Model/WebIDL/Types.hs b/src/Crypto/WebAuthn/Model/WebIDL/Types.hs deleted file mode 100644 --- a/src/Crypto/WebAuthn/Model/WebIDL/Types.hs +++ /dev/null @@ -1,242 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} - --- | Stability: experimental --- This module models direct representations of JavaScript objects interacting with the --- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) --- and [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) methods, as used by [Webauthn2](https://www.w3.org/TR/webauthn-2). --- Note that these types don't encode the semantics of their values. E.g. if the JavaScript object has a @DOMString@ --- field, but only values @"foo"@ and @"bar"@ are possible, the type is still encoded as a generic 'IDL.DOMString'. --- This allows us to match the specification very closely, deferring decoding of these values to another module. --- This module also implements 'Aeson.FromJSON' and 'Aeson.ToJSON' instances of its types, which are compatible with --- [webauthn-json](https://github.com/github/webauthn-json)'s JSON schema. --- --- The defined types are --- --- - 'PublicKeyCredentialCreationOptions' and all its subtypes. Passed as the --- [publicKey](https://www.w3.org/TR/webauthn-2/#dom-credentialcreationoptions-publickey) field to the --- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) method --- in step 2 of [§ 7.1 Registering a New Credential](https://www.w3.org/TR/webauthn-2/#sctn-registering-a-new-credential) --- - 'PublicKeyCredentialRequestOptions' and all its subtypes. Passed as the --- [publicKey](https://www.w3.org/TR/webauthn-2/#dom-credentialrequestoptions-publickey) field to the --- [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) method --- in step 2 of [§ 7.2 Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion) --- - @'PublicKeyCredential' response@ and all its subtypes. Responses of the --- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) (in which case @response ~ 'AuthenticatorAttestationResponse'@) and --- [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) (in which case @response ~ 'AuthenticatorAssertionResponse'@ methods. -module Crypto.WebAuthn.Model.WebIDL.Types - ( -- * Top-level types - PublicKeyCredentialCreationOptions (..), - PublicKeyCredentialRequestOptions (..), - PublicKeyCredential (..), - - -- * Nested types - AuthenticatorAttestationResponse (..), - AuthenticatorAssertionResponse (..), - PublicKeyCredentialRpEntity (..), - PublicKeyCredentialUserEntity (..), - PublicKeyCredentialParameters (..), - COSEAlgorithmIdentifier, - PublicKeyCredentialDescriptor (..), - AuthenticatorSelectionCriteria (..), - ) -where - -import Crypto.WebAuthn.Internal.Utils (jsonEncodingOptions) -import qualified Crypto.WebAuthn.WebIDL as IDL -import qualified Data.Aeson as Aeson -import Data.Map (Map) -import Data.Text (Text) -import GHC.Generics (Generic) - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-makecredentialoptions) -data PublicKeyCredentialCreationOptions = PublicKeyCredentialCreationOptions - { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-rp) - rp :: PublicKeyCredentialRpEntity, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-user) - user :: PublicKeyCredentialUserEntity, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-challenge) - challenge :: IDL.BufferSource, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-pubkeycredparams) - pubKeyCredParams :: [PublicKeyCredentialParameters], - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-timeout) - timeout :: Maybe IDL.UnsignedLong, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-excludecredentials) - excludeCredentials :: Maybe [PublicKeyCredentialDescriptor], - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-authenticatorselection) - authenticatorSelection :: Maybe AuthenticatorSelectionCriteria, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-attestation) - attestation :: Maybe IDL.DOMString, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-extensions) - extensions :: Maybe (Map Text Aeson.Value) - } - deriving (Eq, Show, Generic) - -instance Aeson.FromJSON PublicKeyCredentialCreationOptions where - parseJSON = Aeson.genericParseJSON jsonEncodingOptions - -instance Aeson.ToJSON PublicKeyCredentialCreationOptions where - toJSON = Aeson.genericToJSON jsonEncodingOptions - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-rp-credential-params) -data PublicKeyCredentialRpEntity = PublicKeyCredentialRpEntity - { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrpentity-id) - id :: Maybe IDL.DOMString, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name) - name :: IDL.DOMString - } - deriving (Eq, Show, Generic) - -instance Aeson.FromJSON PublicKeyCredentialRpEntity where - parseJSON = Aeson.genericParseJSON jsonEncodingOptions - -instance Aeson.ToJSON PublicKeyCredentialRpEntity where - toJSON = Aeson.genericToJSON jsonEncodingOptions - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-user-credential-params) -data PublicKeyCredentialUserEntity = PublicKeyCredentialUserEntity - { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-id) - id :: IDL.BufferSource, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-displayname) - displayName :: IDL.DOMString, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name) - name :: IDL.DOMString - } - deriving (Eq, Show, Generic) - -instance Aeson.FromJSON PublicKeyCredentialUserEntity where - parseJSON = Aeson.genericParseJSON jsonEncodingOptions - -instance Aeson.ToJSON PublicKeyCredentialUserEntity where - toJSON = Aeson.genericToJSON jsonEncodingOptions - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-credential-params) -data PublicKeyCredentialParameters = PublicKeyCredentialParameters - { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialparameters-type) - littype :: IDL.DOMString, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialparameters-alg) - alg :: COSEAlgorithmIdentifier - } - deriving (Eq, Show, Generic) - -instance Aeson.FromJSON PublicKeyCredentialParameters where - parseJSON = Aeson.genericParseJSON jsonEncodingOptions - -instance Aeson.ToJSON PublicKeyCredentialParameters where - toJSON = Aeson.genericToJSON jsonEncodingOptions - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-alg-identifier) -type COSEAlgorithmIdentifier = IDL.Long - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialdescriptor) -data PublicKeyCredentialDescriptor = PublicKeyCredentialDescriptor - { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-type) - littype :: IDL.DOMString, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-id) - id :: IDL.BufferSource, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-transports) - transports :: Maybe [IDL.DOMString] - } - deriving (Eq, Show, Generic) - -instance Aeson.FromJSON PublicKeyCredentialDescriptor where - parseJSON = Aeson.genericParseJSON jsonEncodingOptions - -instance Aeson.ToJSON PublicKeyCredentialDescriptor where - toJSON = Aeson.genericToJSON jsonEncodingOptions - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-authenticatorselectioncriteria) -data AuthenticatorSelectionCriteria = AuthenticatorSelectionCriteria - { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-authenticatorattachment) - authenticatorAttachment :: Maybe IDL.DOMString, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-residentkey) - residentKey :: Maybe IDL.DOMString, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-requireresidentkey) - requireResidentKey :: Maybe IDL.Boolean, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-userverification) - userVerification :: Maybe IDL.DOMString - } - deriving (Eq, Show, Generic) - -instance Aeson.FromJSON AuthenticatorSelectionCriteria where - parseJSON = Aeson.genericParseJSON jsonEncodingOptions - -instance Aeson.ToJSON AuthenticatorSelectionCriteria where - toJSON = Aeson.genericToJSON jsonEncodingOptions - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-assertion-options) -data PublicKeyCredentialRequestOptions = PublicKeyCredentialRequestOptions - { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-challenge) - challenge :: IDL.BufferSource, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-timeout) - timeout :: Maybe IDL.UnsignedLong, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-rpid) - rpId :: Maybe IDL.USVString, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-allowcredentials) - allowCredentials :: Maybe [PublicKeyCredentialDescriptor], - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-userverification) - userVerification :: Maybe IDL.DOMString, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-extensions) - extensions :: Maybe (Map Text Aeson.Value) - } - deriving (Eq, Show, Generic) - -instance Aeson.FromJSON PublicKeyCredentialRequestOptions where - parseJSON = Aeson.genericParseJSON jsonEncodingOptions - -instance Aeson.ToJSON PublicKeyCredentialRequestOptions where - toJSON = Aeson.genericToJSON jsonEncodingOptions - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-pkcredential) -data PublicKeyCredential response = PublicKeyCredential - { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-identifier-slot) - rawId :: IDL.ArrayBuffer, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-response) - response :: response, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-getclientextensionresults) - clientExtensionResults :: Map Text Aeson.Value - } - deriving (Eq, Show, Generic) - -instance Aeson.FromJSON response => Aeson.FromJSON (PublicKeyCredential response) where - parseJSON = Aeson.genericParseJSON jsonEncodingOptions - -instance Aeson.ToJSON response => Aeson.ToJSON (PublicKeyCredential response) where - toJSON = Aeson.genericToJSON jsonEncodingOptions - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authenticatorattestationresponse) -data AuthenticatorAttestationResponse = AuthenticatorAttestationResponse - { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson) - clientDataJSON :: IDL.ArrayBuffer, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-attestationobject) - attestationObject :: IDL.ArrayBuffer, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-transports-slot) - -- This field is only being propagated by webauthn-json [since recently](https://github.com/github/webauthn-json/pull/44), - -- which is why we allow absence of this value - transports :: Maybe [IDL.DOMString] - } - deriving (Eq, Show, Generic) - -instance Aeson.FromJSON AuthenticatorAttestationResponse where - parseJSON = Aeson.genericParseJSON jsonEncodingOptions - -instance Aeson.ToJSON AuthenticatorAttestationResponse where - toJSON = Aeson.genericToJSON jsonEncodingOptions - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authenticatorassertionresponse) -data AuthenticatorAssertionResponse = AuthenticatorAssertionResponse - { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson) - clientDataJSON :: IDL.ArrayBuffer, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-authenticatordata) - authenticatorData :: IDL.ArrayBuffer, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-signature) - signature :: IDL.ArrayBuffer, - -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-userhandle) - userHandle :: Maybe IDL.ArrayBuffer - } - deriving (Eq, Show, Generic) - -instance Aeson.FromJSON AuthenticatorAssertionResponse where - parseJSON = Aeson.genericParseJSON jsonEncodingOptions - -instance Aeson.ToJSON AuthenticatorAssertionResponse where - toJSON = Aeson.genericToJSON jsonEncodingOptions diff --git a/src/Crypto/WebAuthn/Operation/Authentication.hs b/src/Crypto/WebAuthn/Operation/Authentication.hs --- a/src/Crypto/WebAuthn/Operation/Authentication.hs +++ b/src/Crypto/WebAuthn/Operation/Authentication.hs @@ -28,12 +28,10 @@ import Control.Monad (unless) import qualified Crypto.Hash as Hash import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose -import qualified Crypto.WebAuthn.Cose.Key as Cose import Crypto.WebAuthn.Internal.Utils (failure) import qualified Crypto.WebAuthn.Model as M import Crypto.WebAuthn.Operation.CredentialEntry (CredentialEntry (cePublicKeyBytes, ceSignCounter, ceUserHandle)) import Data.ByteArray (convert) -import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) @@ -42,28 +40,58 @@ -- | Errors that may occur during [assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion) data AuthenticationError = -- | The provided Credential was not one explicitly allowed by the server - -- (first: allowed credentials, second: received credential) - AuthenticationDisallowedCredential [M.CredentialDescriptor] (M.Credential 'M.Authentication 'True) + AuthenticationCredentialDisallowed + { -- | The credentials allowed by the server + aeAllowedCredentials :: [M.CredentialDescriptor], + -- | The credential returned by the client + aeReceivedCredential :: M.Credential 'M.Authentication 'True + } | -- | The received credential does not match the currently identified user - -- (first: identified, second: received) - AuthenticationIdentifiedUserHandleMismatch M.UserHandle M.UserHandle + AuthenticationIdentifiedUserHandleMismatch + { -- | The `M.UserHandle` of the user who is attempting authentication + aeIdentifiedUser :: M.UserHandle, + -- | The owner of the credential passed to the + -- `verifyAuthenticationResponse` function (retrieved from the + -- database) + aeRegisteredUser :: M.UserHandle + } | -- | The stored credential does not match the user specified in the -- response - -- (first: stored, second: received) - AuthenticationCredentialUserHandleMismatch M.UserHandle M.UserHandle + AuthenticationCredentialUserHandleMismatch + { -- | The `M.UserHandle` of the user who is attempting authentication + aeIdentifiedUser :: M.UserHandle, + -- | The `M.UserHandle` reported by the authenticator in the response + aeAuthenticatorUser :: M.UserHandle + } | -- | No user was identified and the response did not specify a user AuthenticationCannotVerifyUserHandle | -- | The received challenge does not match the originally created -- challenge - -- (first: expected, second: received) - AuthenticationChallengeMismatch M.Challenge M.Challenge + AuthenticationChallengeMismatch + { -- | The challenge created by the relying party and part of the + -- `M.CredentialOptions` + aeCreatedChallenge :: M.Challenge, + -- | The challenge received from the client, part of the response + aeReceivedChallenge :: M.Challenge + } | -- | The origin derived by the client does match the assumed origin - -- (first: expected, second: received) - AuthenticationOriginMismatch M.Origin M.Origin + AuthenticationOriginMismatch + { -- | The origin explicitly passed to the `verifyAuthenticationResponse` + -- response, set by the RP + aeExpectedOrigin :: M.Origin, + -- | The origin received from the client as part of the client data + aeReceivedOrigin :: M.Origin + } | -- | The rpIdHash in the authData is not a valid hash over the RpId -- expected by the Relying party - -- (first: expected, second: received) - AuthenticationRpIdHashMismatch M.RpIdHash M.RpIdHash + AuthenticationRpIdHashMismatch + { -- | The RP ID hash explicitly passed to the + -- `verifyAuthenticationResponse` response, set by the RP + aeExpectedRpIdHash :: M.RpIdHash, + -- | The RP ID hash received from the client as part of the authenticator + -- data + aeReceivedRpIdHash :: M.RpIdHash + } | -- | The UserPresent bit was not set in the authData AuthenticationUserNotPresent | -- | The UserVerified bit was not set in the authData while user @@ -71,8 +99,8 @@ AuthenticationUserNotVerified | -- | The public key provided in the 'CredentialEntry' could not be decoded AuthenticationSignatureDecodingError CBOR.DeserialiseFailure - | -- | the public key does verify the signature over the authData - AuthenticationInvalidSignature Cose.PublicKey BS.ByteString M.AssertionSignature Text + | -- | The public key doesn't verify the signature over the authData + AuthenticationSignatureInvalid Text deriving (Show, Exception) -- | [Section 6.1.1 of the specification](https://www.w3.org/TR/webauthn-2/#sctn-sign-counter) @@ -185,7 +213,10 @@ -- identifies one of the public key credentials listed in -- options.allowCredentials. let allowCredentials = M.coaAllowCredentials options - unless (null allowCredentials || M.cIdentifier credential `elem` map M.cdId allowCredentials) . failure $ AuthenticationDisallowedCredential allowCredentials credential + unless + (null allowCredentials || M.cIdentifier credential `elem` map M.cdId allowCredentials) + . failure + $ AuthenticationCredentialDisallowed allowCredentials credential -- 6. Identify the user being authenticated and verify that this user is the -- owner of the public key credential source credentialSource identified by @@ -307,12 +338,10 @@ message = rawData <> convert (M.unClientDataHash hash) case CBOR.deserialiseFromBytes decode pubKeyBytes of Left err -> failure $ AuthenticationSignatureDecodingError err - Right (_, coseKey) -> do - let signAlg = Cose.keySignAlg coseKey - publicKey = Cose.fromCose coseKey - case Cose.verify signAlg publicKey message (M.unAssertionSignature sig) of + Right (_, coseKey) -> + case Cose.verify coseKey message (M.unAssertionSignature sig) of Right () -> pure () - Left err -> failure $ AuthenticationInvalidSignature publicKey message sig err + Left err -> failure $ AuthenticationSignatureInvalid err -- 21. Let storedSignCount be the stored signature counter value associated -- with credential.id. If authData.signCount is nonzero or storedSignCount diff --git a/src/Crypto/WebAuthn/Operation/Registration.hs b/src/Crypto/WebAuthn/Operation/Registration.hs --- a/src/Crypto/WebAuthn/Operation/Registration.hs +++ b/src/Crypto/WebAuthn/Operation/Registration.hs @@ -29,8 +29,8 @@ import Control.Exception (Exception) import Control.Monad (unless) import qualified Crypto.Hash as Hash -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose -import qualified Crypto.WebAuthn.Cose.Key as Cose +import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose import Crypto.WebAuthn.Internal.Utils (certificateSubjectKeyIdentifier, failure) import Crypto.WebAuthn.Metadata.Service.Processing (queryMetadata) import qualified Crypto.WebAuthn.Metadata.Service.Types as Meta @@ -59,21 +59,45 @@ -- | All the errors that can result from a call to 'verifyRegistrationResponse' data RegistrationError - = -- | The returned challenge does not match the desired one - RegistrationChallengeMismatch M.Challenge M.Challenge + = -- | The received challenge does not match the originally created + -- challenge + RegistrationChallengeMismatch + { -- | The challenge created by the relying party and part of the + -- `M.CredentialOptions` + reCreatedChallenge :: M.Challenge, + -- | The challenge received from the client, part of the response + reReceivedChallenge :: M.Challenge + } | -- | The returned origin does not match the relying party's origin - RegistrationOriginMismatch M.Origin M.Origin - | -- | The hash of the relying party id does not match the has in the returned authentication data - RegistrationRpIdHashMismatch M.RpIdHash M.RpIdHash + RegistrationOriginMismatch + { -- | The origin explicitly passed to the `verifyRegistrationResponse` + -- response, set by the RP + reExpectedOrigin :: M.Origin, + -- | The origin received from the client as part of the client data + reReceivedOrigin :: M.Origin + } + | -- | The rpIdHash in the authData is not a valid hash over the RpId + -- expected by the Relying party + RegistrationRpIdHashMismatch + { -- | The RP ID hash explicitly passed to the + -- `verifyRegistrationResponse` response, set by the RP + reExpectedRpIdHash :: M.RpIdHash, + -- | The RP ID hash received from the client as part of the authenticator + -- data + reReceivedRpIdHash :: M.RpIdHash + } | -- | The userpresent bit in the authdata was not set RegistrationUserNotPresent | -- | The userverified bit in the authdata was not set RegistrationUserNotVerified | -- | The algorithm received from the client was not one of the algorithms -- we (the relying party) requested from the client. - -- first: The received algorithm - -- second: The list of requested algorithm - RegistrationUndesiredPublicKeyAlgorithm Cose.CoseSignAlg [Cose.CoseSignAlg] + RegistrationPublicKeyAlgorithmDisallowed + { -- | The signing algorithms requested by the RP + reAllowedSigningAlgorithms :: [Cose.CoseSignAlg], + -- | The signing algorithm received from the client + reReceivedSigningAlgorithm :: Cose.CoseSignAlg + } | -- | There was some exception in the statement format specific section forall a. M.AttestationStatementFormat a => RegistrationAttestationFormatError a (NonEmpty (M.AttStmtVerificationError a)) @@ -309,12 +333,12 @@ -- 8. Verify that the value of C.challenge equals the base64url encoding of -- options.challenge. - unless (M.ccdChallenge c == corChallenge) $ - failure $ RegistrationChallengeMismatch (M.ccdChallenge c) corChallenge + unless (corChallenge == M.ccdChallenge c) $ + failure $ RegistrationChallengeMismatch corChallenge (M.ccdChallenge c) -- 9. Verify that the value of C.origin matches the Relying Party's origin. - unless (M.ccdOrigin c == rpOrigin) $ - failure $ RegistrationOriginMismatch (M.ccdOrigin c) rpOrigin + unless (rpOrigin == M.ccdOrigin c) $ + failure $ RegistrationOriginMismatch rpOrigin (M.ccdOrigin c) -- 10. Verify that the value of C.tokenBinding.status matches the state of -- Token Binding for the TLS connection over which the assertion was @@ -338,8 +362,8 @@ -- 13. Verify that the rpIdHash in authData is the SHA-256 hash of the RP -- ID expected by the Relying Party. - unless (M.adRpIdHash authData == rpIdHash) $ - failure $ RegistrationRpIdHashMismatch (M.adRpIdHash authData) rpIdHash + unless (rpIdHash == M.adRpIdHash authData) $ + failure $ RegistrationRpIdHashMismatch rpIdHash (M.adRpIdHash authData) -- 14. Verify that the User Present bit of the flags in authData is set. unless (M.adfUserPresent (M.adFlags authData)) $ @@ -364,10 +388,10 @@ -- 16. Verify that the "alg" parameter in the credential public key in -- authData matches the alg attribute of one of the items in -- options.pubKeyCredParams. - let acdAlg = Cose.keySignAlg acdCredentialPublicKey + let acdAlg = Cose.signAlg acdCredentialPublicKey desiredAlgs = map M.cpAlg corPubKeyCredParams unless (acdAlg `elem` desiredAlgs) $ - failure $ RegistrationUndesiredPublicKeyAlgorithm acdAlg desiredAlgs + failure $ RegistrationPublicKeyAlgorithmDisallowed desiredAlgs acdAlg -- 17. Verify that the values of the client extension outputs in -- clientExtensionResults and the authenticator extension outputs in the diff --git a/src/Crypto/WebAuthn/WebIDL.hs b/src/Crypto/WebAuthn/WebIDL.hs deleted file mode 100644 --- a/src/Crypto/WebAuthn/WebIDL.hs +++ /dev/null @@ -1,80 +0,0 @@ --- | Stability: experimental --- | This module defines some types from the [Web IDL](https://webidl.spec.whatwg.org/) specification -module Crypto.WebAuthn.WebIDL - ( DOMString, - USVString, - UnsignedLongLong, - UnsignedLong, - Long, - UnsignedShort, - Octet, - Boolean, - Crypto.WebAuthn.WebIDL.Double, - BufferSource (..), - ArrayBuffer, - ) -where - -import qualified Data.Aeson as Aeson -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base64.URL as Base64 -import Data.Int (Int32) -import Data.Text (Text) -import qualified Data.Text.Encoding as Text -import Data.Word (Word16, Word32, Word64, Word8) - --- | [(spec)](https://webidl.spec.whatwg.org/#idl-DOMString) --- The `[DOMString](https://webidl.spec.whatwg.org/#idl-DOMString)` type --- corresponds to the set of all possible sequences of --- [code units](https://webidl.spec.whatwg.org/#dfn-code-unit). Such sequences --- are commonly interpreted as UTF-16 encoded strings --- [RFC2781](https://webidl.spec.whatwg.org/#biblio-rfc2781) although this is not required. --- TODO: This implementation doesn't allow invalid UTF-16 codepoints, which --- probably makes it not work regarding --- Write a test case that doesn't work and find a better representation. -type DOMString = Text - --- | [(spec)](https://webidl.spec.whatwg.org/#idl-USVString) --- The `[USVString](https://webidl.spec.whatwg.org/#idl-USVString)` type --- corresponds to the set of all possible sequences of --- [Unicode scalar values](http://www.unicode.org/glossary/#unicode_scalar_value), --- which are all of the Unicode code points apart from the surrogate code points. --- TODO: This implementation allows for surrogate code points. Figure out if --- this can violate the spec in any way. -type USVString = Text - --- | [(spec)](https://webidl.spec.whatwg.org/#idl-unsigned-long) -type UnsignedLong = Word32 - --- | [(spec)](https://webidl.spec.whatwg.org/#idl-unsigned-long) -type UnsignedLongLong = Word64 - --- | [(spec)](https://webidl.spec.whatwg.org/#idl-long) -type Long = Int32 - --- | [(spec)](https://webidl.spec.whatwg.org/#idl-unsigned-short) -type UnsignedShort = Word16 - --- | [(spec)](https://webidl.spec.whatwg.org/#idl-octet) -type Octet = Word8 - --- | [(spec)](https://webidl.spec.whatwg.org/#idl-boolean) -type Boolean = Bool - --- | [(spec)](https://webidl.spec.whatwg.org/#idl-double) -type Double = Prelude.Double - --- | [(spec)](https://webidl.spec.whatwg.org/#BufferSource) -newtype BufferSource = -- | base64url encoded buffersource as done by https://github.com/github/webauthn-json - URLEncodedBase64 {unUrlEncodedBase64 :: BS.ByteString} - deriving (Show, Eq) - -instance Aeson.FromJSON BufferSource where - parseJSON = Aeson.withText "base64url" $ \t -> - either fail (pure . URLEncodedBase64) (Base64.decode $ Text.encodeUtf8 t) - -instance Aeson.ToJSON BufferSource where - toJSON (URLEncodedBase64 bs) = Aeson.String . Text.decodeUtf8 . Base64.encodeUnpadded $ bs - --- | [(spec)](https://webidl.spec.whatwg.org/#idl-ArrayBuffer) -type ArrayBuffer = BufferSource diff --git a/tests/Emulation.hs b/tests/Emulation.hs --- a/tests/Emulation.hs +++ b/tests/Emulation.hs @@ -10,7 +10,7 @@ import Control.Monad.Except (ExceptT (ExceptT), MonadError, MonadTrans (lift), runExceptT, throwError) import Crypto.Hash (hash) import qualified Crypto.Random as Random -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose import qualified Crypto.WebAuthn.Metadata.Service.Types as Meta import qualified Crypto.WebAuthn.Model as M import qualified Crypto.WebAuthn.Operation as O @@ -164,7 +164,7 @@ isValidated O.RegistrationUserNotPresent = not $ M.adfUserPresent aAuthenticatorDataFlags -- The User not being valided must be a result of the authenticator not validating the user isValidated O.RegistrationUserNotVerified = not $ M.adfUserVerified aAuthenticatorDataFlags - isValidated (O.RegistrationUndesiredPublicKeyAlgorithm _ _) = False + isValidated (O.RegistrationPublicKeyAlgorithmDisallowed _ _) = False isValidated (O.RegistrationAttestationFormatError _ _) = False -- | Validates the result of assertion. Ensures that the proper errors are @@ -186,7 +186,7 @@ validAssertionResult AuthenticatorNone {..} uaConformance (Left errors) = all isValidated errors where isValidated :: O.AuthenticationError -> Bool - isValidated (O.AuthenticationDisallowedCredential _ _) = False + isValidated (O.AuthenticationCredentialDisallowed _ _) = False isValidated (O.AuthenticationIdentifiedUserHandleMismatch _ _) = False isValidated (O.AuthenticationCredentialUserHandleMismatch _ _) = False isValidated O.AuthenticationCannotVerifyUserHandle = False @@ -199,7 +199,7 @@ isValidated O.AuthenticationUserNotVerified = not $ M.adfUserVerified aAuthenticatorDataFlags -- The Signature being invalid can happen when the data was wrong or the wrong private key was used isValidated (O.AuthenticationSignatureDecodingError _) = False - isValidated O.AuthenticationInvalidSignature {} = elem RandomSignatureData aConformance || elem RandomPrivateKey aConformance + isValidated O.AuthenticationSignatureInvalid {} = elem RandomSignatureData aConformance || elem RandomPrivateKey aConformance -- | Create a default set of options for attestation. These options can be modified before using them in the tests defaultPkcoc :: M.CredentialUserEntity -> M.Challenge -> M.CredentialOptions 'M.Registration diff --git a/tests/Emulation/Authenticator.hs b/tests/Emulation/Authenticator.hs --- a/tests/Emulation/Authenticator.hs +++ b/tests/Emulation/Authenticator.hs @@ -19,9 +19,9 @@ import Crypto.Random (MonadRandom) import qualified Crypto.Random as Random import qualified Crypto.WebAuthn.AttestationStatementFormat.None as None -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose +import qualified Crypto.WebAuthn.Encoding.Binary as ME import qualified Crypto.WebAuthn.Model as M -import qualified Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Encoding as ME import qualified Data.ByteArray as BA import qualified Data.ByteString as BS import Data.List (find) @@ -252,7 +252,7 @@ M.AttestedCredentialData { M.acdAaguid = aAAGUID, M.acdCredentialId = credentialId, - M.acdCredentialPublicKey = pubKey, -- This is selfsigned + M.acdCredentialPublicKey = cosePubKey, -- This is selfsigned M.acdCredentialPublicKeyBytes = M.NoRaw } diff --git a/tests/Emulation/Client.hs b/tests/Emulation/Client.hs --- a/tests/Emulation/Client.hs +++ b/tests/Emulation/Client.hs @@ -17,8 +17,8 @@ import Crypto.Hash (hash) import qualified Crypto.Random as Random +import qualified Crypto.WebAuthn.Encoding.Binary as ME import qualified Crypto.WebAuthn.Model as M -import qualified Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Encoding as ME import Data.Maybe (fromMaybe) import qualified Data.Set as Set import Emulation.Authenticator @@ -64,7 +64,7 @@ M.CollectedClientData { ccdChallenge = challenge, ccdOrigin = aoOrigin, - ccdCrossOrigin = False, + ccdCrossOrigin = Just False, ccdRawData = M.NoRaw } clientDataHash = @@ -121,7 +121,7 @@ M.CollectedClientData { ccdChallenge = challenge, ccdOrigin = aoOrigin, - ccdCrossOrigin = False, + ccdCrossOrigin = Just False, ccdRawData = M.NoRaw } clientDataHash = M.ClientDataHash $ hash $ M.unRaw $ M.ccdRawData clientData diff --git a/tests/Encoding.hs b/tests/Encoding.hs --- a/tests/Encoding.hs +++ b/tests/Encoding.hs @@ -2,11 +2,11 @@ module Encoding (spec) where +import Control.Monad.Reader (runReaderT) import Crypto.WebAuthn.AttestationStatementFormat (allSupportedFormats) +import Crypto.WebAuthn.Encoding.Binary (encodeRawCredential) +import Crypto.WebAuthn.Encoding.Internal.WebAuthnJson (Decode (decode), Encode (encode)) import qualified Crypto.WebAuthn.Model as M -import Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Encoding (encodeRawCredential) -import Crypto.WebAuthn.Model.WebIDL.Internal.Decoding (Decode (decode), DecodeCreated (decodeCreated)) -import Crypto.WebAuthn.Model.WebIDL.Internal.Encoding (Encode (encode)) import Spec.Types () import Test.Hspec (Expectation, SpecWith, describe, expectationFailure, shouldBe) import Test.Hspec.QuickCheck (prop) @@ -40,7 +40,7 @@ prop_createdCredentialRoundtrip options = do let withRaw = encodeRawCredential options encoded = encode withRaw - case decodeCreated allSupportedFormats encoded of + case runReaderT (decode encoded) allSupportedFormats of Right decoded -> do decoded `shouldBe` withRaw Left err -> expectationFailure $ show err diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -10,8 +10,8 @@ where import Crypto.Hash (hash) -import Crypto.WebAuthn.AttestationStatementFormat (allSupportedFormats) -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose +import qualified Crypto.WebAuthn.Encoding.WebAuthnJson as WJ import qualified Crypto.WebAuthn.Metadata as Meta import qualified Crypto.WebAuthn.Metadata.Service.Types as Service import qualified Crypto.WebAuthn.Model as M @@ -80,7 +80,7 @@ registerTestFromFile :: FilePath -> M.Origin -> M.RpId -> Bool -> Service.MetadataServiceRegistry -> HG.DateTime -> IO () registerTestFromFile fp origin rpId verifiable service now = do pkCredential <- - either (error . show) id . M.decodeCredentialRegistration allSupportedFormats + either (error . show) id . WJ.wjDecodeCredentialRegistration <$> decodeFile fp let options = defaultPublicKeyCredentialCreationOptions pkCredential let registerResult = @@ -101,12 +101,12 @@ -- Check if all attestation responses can be decoded describe "attestation responses" $ canDecodeAllToJSRepr - @M.IDLCredentialRegistration + @WJ.WJCredentialRegistration "tests/responses/attestation/" -- Check if all assertion responses can be decoded describe "assertion responses" $ canDecodeAllToJSRepr - @M.IDLCredentialAuthentication + @WJ.WJCredentialAuthentication "tests/responses/assertion/" -- Test public key related tests describe "PublicKey" PublicKeySpec.spec @@ -124,7 +124,7 @@ it "tests whether the fixed register and login responses are matching" $ do pkCredential <- - either (error . show) id . M.decodeCredentialRegistration allSupportedFormats + either (error . show) id . WJ.wjDecodeCredentialRegistration <$> decodeFile "tests/responses/attestation/01-none.json" let options = defaultPublicKeyCredentialCreationOptions pkCredential @@ -140,9 +140,9 @@ registerResult `shouldSatisfy` isExpectedAttestationResponse pkCredential options False let Right O.RegistrationResult {O.rrEntry = credentialEntry} = registerResult loginReq <- - either (error . show) id . M.decodeCredentialAuthentication + either (error . show) id . WJ.wjDecodeCredentialAuthentication <$> decodeFile - @M.IDLCredentialAuthentication + @WJ.WJCredentialAuthentication "tests/responses/assertion/01-none.json" let M.Credential {M.cResponse = cResponse} = loginReq signInResult = diff --git a/tests/PublicKeySpec.hs b/tests/PublicKeySpec.hs --- a/tests/PublicKeySpec.hs +++ b/tests/PublicKeySpec.hs @@ -7,7 +7,8 @@ import Codec.Serialise.Properties (serialiseIdentity) import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose -import qualified Crypto.WebAuthn.Cose.Key as Cose +import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose +import qualified Crypto.WebAuthn.Cose.PublicKey as Cose import qualified Data.ByteString as BS import qualified Spec.Key as Key import Spec.Types () @@ -28,18 +29,18 @@ property prop_signverify prop_x509PublicKeyRoundtrip :: Cose.PublicKey -> Bool -prop_x509PublicKeyRoundtrip pubKey = +prop_x509PublicKeyRoundtrip (Cose.PublicKey pubKey) = case Cose.fromX509 (Key.toX509 pubKey) of - Right pubKey' + Right (Cose.PublicKey pubKey') | pubKey == pubKey' -> True | otherwise -> False Left _ -> False prop_signverify :: Integer -> Key.KeyPair -> BS.ByteString -> Bool prop_signverify seed Key.KeyPair {..} msg = do - let signAlg = Cose.keySignAlg pubKey + let signAlg = Cose.signAlg cosePubKey sig = runSeededMonadRandom seed $ Key.sign signAlg privKey msg - valid = Cose.verify signAlg (Cose.fromCose pubKey) msg sig + valid = Cose.verify cosePubKey msg sig in case valid of Left _ -> False Right () -> True diff --git a/tests/Spec/Key.hs b/tests/Spec/Key.hs --- a/tests/Spec/Key.hs +++ b/tests/Spec/Key.hs @@ -19,14 +19,16 @@ import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.RSA.PKCS15 as RSA import Crypto.Random (MonadRandom) -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose -import qualified Crypto.WebAuthn.Cose.Key as Cose +import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose +import qualified Crypto.WebAuthn.Cose.PublicKey as Cose import qualified Data.ASN1.BinaryEncoding as ASN1 import qualified Data.ASN1.Encoding as ASN1 import qualified Data.ASN1.Prim as ASN1 import Data.ByteArray (convert) import qualified Data.ByteString as BS +import Data.Either (fromRight) import qualified Data.X509 as X509 import Test.QuickCheck.Instances.ByteString () @@ -47,7 +49,7 @@ deriving (Eq, Show) data KeyPair = KeyPair - { pubKey :: Cose.CosePublicKey, + { cosePubKey :: Cose.CosePublicKey, privKey :: PrivateKey } deriving (Eq, Show) @@ -61,11 +63,13 @@ eddsaBytes = convert privKey' } pubKey' = Ed25519.toPublic privKey' - pubKey = - Cose.CosePublicKeyEdDSA + unchecked = + Cose.PublicKeyEdDSA { eddsaCurve = Cose.CoseCurveEd25519, eddsaX = convert pubKey' } + pubKey = fromRight (error "unreachable") $ Cose.checkPublicKey unchecked + cosePubKey = fromRight (error "unreachable") $ Cose.makePublicKeyWithSignAlg pubKey Cose.CoseSignAlgEdDSA pure KeyPair {..} newKeyPair (Cose.CoseSignAlgECDSA hash) = do let coseCurve = case hash of @@ -74,33 +78,33 @@ Cose.CoseHashAlgECDSASHA512 -> Cose.CoseCurveP521 curveName = Cose.toCryptCurveECDSA coseCurve curve = ECC.getCurveByName curveName - byteSize = (ECC.curveSizeBits curve + 7) `div` 8 (ECDSA.PublicKey {public_q = point}, ECDSA.PrivateKey {private_d = d}) <- ECC.generate curve let (x, y) = case point of ECC.Point x y -> (x, y) ECC.PointO -> error "newKeyPair: infinity point not supported" - pubKey = - Cose.CosePublicKeyECDSA - { ecdsaHash = hash, - ecdsaCurve = coseCurve, - ecdsaX = i2ospOf_ byteSize x, - ecdsaY = i2ospOf_ byteSize y + unchecked = + Cose.PublicKeyECDSA + { ecdsaCurve = coseCurve, + ecdsaX = x, + ecdsaY = y } privKey = PrivateKeyECDSA { ecdsaCurve = coseCurve, ecdsaD = d } + pubKey = fromRight (error "unreachable") $ Cose.checkPublicKey unchecked + cosePubKey = fromRight (error "unreachable") $ Cose.makePublicKeyWithSignAlg pubKey (Cose.CoseSignAlgECDSA hash) pure KeyPair {..} newKeyPair (Cose.CoseSignAlgRSA hash) = do -- https://www.rfc-editor.org/rfc/rfc8812.html#section-2 -- > A key of size 2048 bits or larger MUST be used with these algorithms. let publicSizeBytes = 2048 `div` 8 (RSA.PublicKey {..}, RSA.PrivateKey {..}) <- RSA.generate publicSizeBytes 65537 - let pubKey = - Cose.CosePublicKeyRSA - { rsaHash = hash, + let unchecked = + Cose.PublicKeyRSA + { -- rsaHash = hash, rsaN = public_n, rsaE = public_e } @@ -110,6 +114,8 @@ rsaE = public_e, rsaD = private_d } + pubKey = fromRight (error "unreachable") $ Cose.checkPublicKey unchecked + cosePubKey = fromRight (error "unreachable") $ Cose.makePublicKeyWithSignAlg pubKey (Cose.CoseSignAlgRSA hash) pure KeyPair {..} sign :: MonadRandom m => Cose.CoseSignAlg -> PrivateKey -> BS.ByteString -> m BS.ByteString @@ -149,7 +155,7 @@ Right res -> pure res sign signAlg privKey _ = error $ "sign: Combination of signature algorithm " <> show signAlg <> " and private key " <> show privKey <> " is not valid or supported" -toX509 :: Cose.PublicKey -> X509.PubKey +toX509 :: Cose.UncheckedPublicKey -> X509.PubKey toX509 Cose.PublicKeyEdDSA {eddsaCurve = Cose.CoseCurveEd25519, ..} = let key = case Ed25519.publicKey eddsaX of CryptoFailed err -> error $ "Failed to create a cryptonite Ed25519 public key of a bytestring with size " <> show (BS.length eddsaX) <> ": " <> show err @@ -157,7 +163,8 @@ in X509.PubKeyEd25519 key toX509 Cose.PublicKeyECDSA {..} = let curveName = Cose.toCryptCurveECDSA ecdsaCurve - serialisedPoint = X509.SerializedPoint $ BS.singleton 0x04 <> ecdsaX <> ecdsaY + size = Cose.coordinateSizeECDSA ecdsaCurve + serialisedPoint = X509.SerializedPoint $ BS.singleton 0x04 <> i2ospOf_ size ecdsaX <> i2ospOf_ size ecdsaY key = X509.PubKeyEC_Named curveName serialisedPoint in X509.PubKeyEC key toX509 Cose.PublicKeyRSA {..} = diff --git a/tests/Spec/Types.hs b/tests/Spec/Types.hs --- a/tests/Spec/Types.hs +++ b/tests/Spec/Types.hs @@ -12,9 +12,9 @@ import Crypto.Hash (hash) import qualified Crypto.Random as Random import qualified Crypto.WebAuthn.AttestationStatementFormat.None as None -import qualified Crypto.WebAuthn.Cose.Algorithm as Cose -import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose -import qualified Crypto.WebAuthn.Cose.Key as Cose +import qualified Crypto.WebAuthn.Cose.PublicKey as Cose +import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose +import qualified Crypto.WebAuthn.Cose.SignAlg as Cose import qualified Crypto.WebAuthn.Model as M import qualified Data.ByteString.Lazy as LBS import Data.Maybe (fromJust) @@ -54,10 +54,10 @@ ] instance Arbitrary Cose.PublicKey where - arbitrary = Cose.fromCose <$> arbitrary + arbitrary = Cose.publicKey <$> arbitrary instance Arbitrary Cose.CosePublicKey where - arbitrary = Key.pubKey <$> arbitrary + arbitrary = Key.cosePubKey <$> arbitrary instance Arbitrary Cose.CoseCurveEdDSA where arbitrary = arbitraryBoundedEnum @@ -75,8 +75,17 @@ arbitrary = arbitraryBoundedEnum instance Arbitrary M.AuthenticatorTransport where - arbitrary = arbitraryBoundedEnum + arbitrary = elements authenticatorTransportsList +authenticatorTransportsList :: [M.AuthenticatorTransport] +authenticatorTransportsList = + [ M.AuthenticatorTransportBLE, + M.AuthenticatorTransportInternal, + M.AuthenticatorTransportNFC, + M.AuthenticatorTransportUSB, + M.AuthenticatorTransportUnknown "unknown" + ] + instance Arbitrary M.AuthenticatorAttachment where arbitrary = arbitraryBoundedEnum @@ -107,7 +116,14 @@ arbitrary = pure M.NoRaw instance Arbitrary (M.CollectedClientData c 'False) where - arbitrary = M.CollectedClientData <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + arbitrary = + M.CollectedClientData + <$> arbitrary + <*> arbitrary + -- The crossOrigin value can't be roundtripped with Nothing values, + -- so let's just not generate Nothing values here + <*> (Just <$> arbitrary) + <*> arbitrary instance Arbitrary (M.AttestationObject 'False) where arbitrary = do @@ -211,7 +227,7 @@ arbitrary = M.CredentialDescriptor M.CredentialTypePublicKey <$> arbitrary - <*> liftArbitrary shuffledSubset + <*> liftArbitrary (shuffledSubsetWith $ Set.fromList authenticatorTransportsList) instance Arbitrary M.AuthenticatorSelectionCriteria where arbitrary = @@ -263,15 +279,9 @@ <*> arbitrary <*> arbitrary -shuffledSubset :: (Ord a, Bounded a, Enum a) => Gen [a] -shuffledSubset = subset >>= shuffle . Set.toList - shuffledSubsetWith :: Ord a => Set a -> Gen [a] shuffledSubsetWith set = subsetWith set >>= shuffle . Set.toList -subset :: (Ord a, Bounded a, Enum a) => Gen (Set a) -subset = Set.fromList <$> sublistOf (Set.toList completeSet) - subsetWith :: Ord a => Set a -> Gen (Set a) subsetWith set = Set.fromList <$> sublistOf (Set.toList set) @@ -279,9 +289,6 @@ parameters = do algs <- shuffledSubsetWith $ Set.fromList allCoseAlgs pure $ M.CredentialParameters M.CredentialTypePublicKey <$> algs - -completeSet :: (Ord a, Bounded a, Enum a) => Set a -completeSet = Set.fromList [minBound .. maxBound] allCoseAlgs :: [Cose.CoseSignAlg] allCoseAlgs = diff --git a/webauthn.cabal b/webauthn.cabal --- a/webauthn.cabal +++ b/webauthn.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: webauthn -version: 0.3.0.0 +version: 0.4.0.0 license: Apache-2.0 license-file: LICENSE copyright: @@ -113,14 +113,20 @@ Crypto.WebAuthn.AttestationStatementFormat.None, Crypto.WebAuthn.AttestationStatementFormat.Packed, Crypto.WebAuthn.AttestationStatementFormat.TPM, + Crypto.WebAuthn.Encoding, + Crypto.WebAuthn.Encoding.Binary, + Crypto.WebAuthn.Encoding.Internal.WebAuthnJson, + Crypto.WebAuthn.Encoding.Strings, + Crypto.WebAuthn.Encoding.WebAuthnJson, Crypto.WebAuthn.Operation, Crypto.WebAuthn.Operation.Authentication, Crypto.WebAuthn.Operation.CredentialEntry, Crypto.WebAuthn.Operation.Registration, - Crypto.WebAuthn.Cose.Algorithm, Crypto.WebAuthn.Cose.Internal.Registry, Crypto.WebAuthn.Cose.Internal.Verify, - Crypto.WebAuthn.Cose.Key, + Crypto.WebAuthn.Cose.PublicKey, + Crypto.WebAuthn.Cose.PublicKeyWithSignAlg, + Crypto.WebAuthn.Cose.SignAlg, Crypto.WebAuthn.Internal.DateOrphans, Crypto.WebAuthn.Internal.ToJSONOrphans, Crypto.WebAuthn.Internal.Utils, @@ -134,18 +140,12 @@ Crypto.WebAuthn.Metadata.Statement.Types, Crypto.WebAuthn.Metadata.Statement.WebIDL, Crypto.WebAuthn.Metadata.UAF, + Crypto.WebAuthn.Metadata.WebIDL, Crypto.WebAuthn.Model, + Crypto.WebAuthn.Model.Defaults, Crypto.WebAuthn.Model.Identifier, Crypto.WebAuthn.Model.Kinds, - Crypto.WebAuthn.Model.Types, - Crypto.WebAuthn.Model.WebIDL, - Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Decoding, - Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Encoding, - Crypto.WebAuthn.Model.WebIDL.Internal.Decoding, - Crypto.WebAuthn.Model.WebIDL.Internal.Encoding, - Crypto.WebAuthn.Model.WebIDL.Internal.Convert, - Crypto.WebAuthn.Model.WebIDL.Types, - Crypto.WebAuthn.WebIDL + Crypto.WebAuthn.Model.Types test-suite tests import: sanity