From 04c14173f3c2ef3cf37aec1ff1f3a6f00c0ab2ac Mon Sep 17 00:00:00 2001 From: Edmund Noble Date: Tue, 17 Oct 2023 17:20:50 -0400 Subject: [PATCH] Vendor webauthn dependency --- pact.cabal | 11 +- src/Pact/Crypto/WebAuthn/Cose/PublicKey.hs | 197 ++++++++++++ .../WebAuthn/Cose/PublicKeyWithSignAlg.hs | 265 ++++++++++++++++ src/Pact/Crypto/WebAuthn/Cose/Registry.hs | 300 ++++++++++++++++++ src/Pact/Crypto/WebAuthn/Cose/SignAlg.hs | 243 ++++++++++++++ src/Pact/Crypto/WebAuthn/Cose/Verify.hs | 141 ++++++++ src/Pact/Types/Crypto.hs | 5 +- 7 files changed, 1159 insertions(+), 3 deletions(-) create mode 100644 src/Pact/Crypto/WebAuthn/Cose/PublicKey.hs create mode 100644 src/Pact/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs create mode 100644 src/Pact/Crypto/WebAuthn/Cose/Registry.hs create mode 100644 src/Pact/Crypto/WebAuthn/Cose/SignAlg.hs create mode 100644 src/Pact/Crypto/WebAuthn/Cose/Verify.hs diff --git a/pact.cabal b/pact.cabal index b64668d09..52571a1f2 100644 --- a/pact.cabal +++ b/pact.cabal @@ -183,6 +183,13 @@ library Pact.Types.Version Pact.Utils.Servant + other-modules: + Pact.Crypto.WebAuthn.Cose.PublicKey + Pact.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg + Pact.Crypto.WebAuthn.Cose.Registry + Pact.Crypto.WebAuthn.Cose.SignAlg + Pact.Crypto.WebAuthn.Cose.Verify + build-depends: -- internal , pact-prettyprinter @@ -192,12 +199,15 @@ library , QuickCheck >=2.12.6.1 , aeson >=2 , attoparsec >=0.13.0.2 + , asn1-encoding >=0.9.6 + , asn1-types >=0.3.4 , base >= 4.18.0.0 , base16-bytestring >=0.1.1.6 , base64-bytestring >=1.0.0.1 -- base64-bytestring >=1.2.0.0 is less lenient then previous versions, which can cause pact failures (e.g. (env-hash "aa")) , bound >=2 , bytestring >=0.10.8.1 + , cborg >= 0.2.9 , cereal >=0.5.4.0 , containers >=0.5.7 , criterion >=1.1.4 @@ -242,7 +252,6 @@ library , vector-algorithms >=0.7 , vector-space >=0.10.4 , yaml - , webauthn >= 0.7 if flag(build-tool) cpp-options: -DBUILD_TOOL diff --git a/src/Pact/Crypto/WebAuthn/Cose/PublicKey.hs b/src/Pact/Crypto/WebAuthn/Cose/PublicKey.hs new file mode 100644 index 000000000..4723b7f5c --- /dev/null +++ b/src/Pact/Crypto/WebAuthn/Cose/PublicKey.hs @@ -0,0 +1,197 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | 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 Pact.Crypto.WebAuthn.Cose.PublicKey + ( -- * Public key + UncheckedPublicKey (..), + checkPublicKey, + PublicKey (PublicKey), + + -- * COSE Elliptic Curves + CoseCurveEdDSA (..), + coordinateSizeEdDSA, + CoseCurveECDSA (..), + toCryptCurveECDSA, + 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 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) + +-- | Same as 'UncheckedPublicKey', but checked to be valid using +-- 'checkPublicKey'. +newtype PublicKey = CheckedPublicKey UncheckedPublicKey + deriving newtype (Eq, Show) + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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/Pact/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs b/src/Pact/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs new file mode 100644 index 000000000..c0e79fba3 --- /dev/null +++ b/src/Pact/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs @@ -0,0 +1,265 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | 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 Pact.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg + ( -- * COSE public Key + PublicKeyWithSignAlg (PublicKeyWithSignAlg, Pact.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg.publicKey, signAlg), + CosePublicKey + ) +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 Pact.Crypto.WebAuthn.Cose.Registry as R +import qualified Pact.Crypto.WebAuthn.Cose.PublicKey as P +import qualified Pact.Crypto.WebAuthn.Cose.SignAlg as A +import qualified Data.ByteString as BS +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) + +-- | [(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 #-} + +-- | 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/Pact/Crypto/WebAuthn/Cose/Registry.hs b/src/Pact/Crypto/WebAuthn/Cose/Registry.hs new file mode 100644 index 000000000..da53bb2d3 --- /dev/null +++ b/src/Pact/Crypto/WebAuthn/Cose/Registry.hs @@ -0,0 +1,300 @@ +{-# language LambdaCase #-} +{-# language RecordWildCards #-} +{-# language DeriveAnyClass #-} +{-# language DeriveGeneric #-} +{-# language TypeApplications #-} +{-# language ScopedTypeVariables #-} +{-# language AllowAmbiguousTypes #-} + +-- | Stability: internal +-- 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 Pact.Crypto.WebAuthn.Cose.Registry + ( -- * COSE Key Types + CoseKeyType (..), + + -- * COSE Parameters + CoseKeyCommonParameter (..), + CoseKeyTypeParameterOKP (..), + CoseKeyTypeParameterEC2 (..), + CoseKeyTypeParameterRSA (..), + parameterCount, + + -- * COSE Elliptic Curves + CoseEllipticCurveOKP (..), + CoseEllipticCurveEC2 (..), + ) +where + +import Codec.CBOR.Decoding (decodeIntCanonical) +import Codec.CBOR.Encoding (encodeInt) +import Codec.Serialise (Serialise) +import Codec.Serialise.Class (decode, encode) + +-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters) +-- All the entries from the [COSE Key Common Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters) +-- that are needed for Webauthn public keys +data CoseKeyCommonParameter + = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1) + -- + -- * COSE value type: tstr / int + -- * Value registry: 'CoseKeyType' + -- * Description: Identification of the key type + -- + -- This parameter is used to identify the family of keys for this + -- structure and, thus, the set of key-type-specific parameters to be + -- found. The key type MUST be included as part of the trust decision + -- process. + CoseKeyCommonParameterKty + | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1) + -- + -- * COSE value type: tstr / int + -- * Value registry: 'Crypto.WebAuthn.Cose.Algorithm.CoseSignAlg' + -- * Description: Key usage restriction to this algorithm + -- + -- This parameter is used to restrict the algorithm that is used + -- with the key. + CoseKeyCommonParameterAlg + deriving (Eq, Show, Bounded, Enum) + +-- | Serialises the parameters using the @Label@ column from the +-- [COSE Key Common Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters) +instance Serialise CoseKeyCommonParameter where + encode CoseKeyCommonParameterKty = encodeInt 1 + encode CoseKeyCommonParameterAlg = encodeInt 3 + decode = + decodeIntCanonical >>= \case + 1 -> pure CoseKeyCommonParameterKty + 3 -> pure CoseKeyCommonParameterAlg + value -> fail $ "Unknown COSE key common parameter " <> show value + +-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type) +-- All the entries from the [COSE Key Types registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type) +-- that are known to be needed for Webauthn public keys +data CoseKeyType + = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) + -- Octet Key Pair. + -- See 'CoseKeyTypeParameterOKP' for the parameters specific to this key type. + CoseKeyTypeOKP + | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) + -- Elliptic Curve Keys w/ x- and y-coordinate pair. + -- See 'CoseKeyTypeParameterEC2' for the parameters specific to this key type. + CoseKeyTypeEC2 + | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) + -- RSA Key. + -- See 'CoseKeyTypeParameterRSA' for the parameters specific to this key type. + CoseKeyTypeRSA + deriving (Eq, Show) + +-- | Serialises the key type using the @Value@ column from the +-- [COSE Key Types registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type) +instance Serialise CoseKeyType where + encode CoseKeyTypeOKP = encodeInt 1 + encode CoseKeyTypeEC2 = encodeInt 2 + encode CoseKeyTypeRSA = encodeInt 3 + decode = + decodeIntCanonical >>= \case + 1 -> pure CoseKeyTypeOKP + 2 -> pure CoseKeyTypeEC2 + 3 -> pure CoseKeyTypeRSA + value -> fail $ "Unknown COSE key type " <> show value + +-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) +-- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) +-- for key type 'CoseKeyTypeOKP' (aka @Key Type@ is @1@) that are required for +-- public keys +data CoseKeyTypeParameterOKP + = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) + -- + -- * COSE value type: int / tstr + -- * Value registry: 'CoseEllipticCurveOKP' + -- * Description: EC identifier + -- + -- This contains an identifier of the curve to be used with the key. + CoseKeyTypeParameterOKPCrv + | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) + -- + -- * COSE value type: bstr + -- * Description: Public Key + -- + -- This contains the public key. The byte string contains the public key as defined by the algorithm. + CoseKeyTypeParameterOKPX + deriving (Eq, Show, Bounded, Enum) + +-- | Serialises the parameters using the @Label@ column from the +-- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) +instance Serialise CoseKeyTypeParameterOKP where + encode CoseKeyTypeParameterOKPCrv = encodeInt (-1) + encode CoseKeyTypeParameterOKPX = encodeInt (-2) + decode = + decodeIntCanonical >>= \case + -1 -> pure CoseKeyTypeParameterOKPCrv + -2 -> pure CoseKeyTypeParameterOKPX + value -> fail $ "Unknown COSE key type parameter " <> show value <> " for key type OKP" + +-- | Elliptic curves for key type 'CoseKeyTypeOKP' from the +-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves), +-- limited to the ones that are currently needed for Webauthn +data CoseEllipticCurveOKP + = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) + -- Ed25519 for use w/ EdDSA only + CoseEllipticCurveEd25519 + deriving (Eq, Show) + +-- | Serialises COSE Elliptic Curves using the @Value@ column from the +-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves). +instance Serialise CoseEllipticCurveOKP where + encode CoseEllipticCurveEd25519 = encodeInt 6 + decode = + decodeIntCanonical >>= \case + 6 -> pure CoseEllipticCurveEd25519 + value -> fail $ "Unknown COSE elliptic curve " <> show value <> " for key type OKP" + +-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) +-- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) +-- for key type 'CoseKeyTypeEC2' (aka @Key Type@ is @2@) that are required for +-- public keys +data CoseKeyTypeParameterEC2 + = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) + -- + -- * COSE value type: int / tstr + -- * Value registry: 'CoseEllipticCurveEC2' + -- * Description: EC identifier + -- + -- This contains an identifier of the curve to be used with the key. + CoseKeyTypeParameterEC2Crv + | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) + -- + -- * COSE value type: bstr + -- * Description: x-coordinate + -- + -- 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. + CoseKeyTypeParameterEC2X + | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) + -- + -- * COSE value type: bstr / bool + -- * Description: y-coordinate + -- + -- This contains either the sign bit or 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. The compressed point encoding is also supported. + -- Compute the sign bit as laid out in the Elliptic-Curve-Point-to- + -- Octet-String Conversion function of + -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1). + -- If the sign bit is zero, then encode y as a CBOR false value; + -- otherwise, encode y as a CBOR true value. + -- The encoding of the infinity point is not supported. + CoseKeyTypeParameterEC2Y + deriving (Eq, Show, Bounded, Enum) + +-- | Serialises the parameters using the @Label@ column from the +-- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) +instance Serialise CoseKeyTypeParameterEC2 where + encode CoseKeyTypeParameterEC2Crv = encodeInt (-1) + encode CoseKeyTypeParameterEC2X = encodeInt (-2) + encode CoseKeyTypeParameterEC2Y = encodeInt (-3) + decode = + decodeIntCanonical >>= \case + -1 -> pure CoseKeyTypeParameterEC2Crv + -2 -> pure CoseKeyTypeParameterEC2X + -3 -> pure CoseKeyTypeParameterEC2Y + value -> fail $ "Unknown COSE key type parameter " <> show value <> " for key type EC2" + +-- | Elliptic curves for key type 'CoseKeyTypeEC2' from the +-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves), +-- limited to the ones that are currently needed for Webauthn +data CoseEllipticCurveEC2 + = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) + -- NIST P-256 also known as secp256r1 + CoseEllipticCurveEC2P256 + | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) + -- NIST P-384 also known as secp384r1 + CoseEllipticCurveEC2P384 + | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) + -- NIST P-521 also known as secp521r1 + CoseEllipticCurveEC2P521 + deriving (Eq, Show) + +-- | Serialises COSE Elliptic Curves using the @Value@ column from the +-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves). +instance Serialise CoseEllipticCurveEC2 where + encode CoseEllipticCurveEC2P256 = encodeInt 1 + encode CoseEllipticCurveEC2P384 = encodeInt 2 + encode CoseEllipticCurveEC2P521 = encodeInt 3 + decode = + decodeIntCanonical >>= \case + 1 -> pure CoseEllipticCurveEC2P256 + 2 -> pure CoseEllipticCurveEC2P384 + 3 -> pure CoseEllipticCurveEC2P521 + value -> fail $ "Unknown COSE elliptic curve " <> show value <> " for key type EC2" + +-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) +-- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) +-- for key type 'CoseKeyTypeRSA' (aka @Key Type@ is @3@) that are required for +-- public keys +data CoseKeyTypeParameterRSA + = -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) + -- + -- * COSE value type: bstr + -- * Description: the RSA modulus n + -- + -- The RSA modulus n is a product of u distinct odd primes + -- r_i, i = 1, 2, ..., u, where u >= 2 + -- + -- All numeric key parameters are encoded in an unsigned big-endian + -- representation as an octet sequence using the CBOR byte string + -- type (major type 2). The octet sequence MUST utilize the minimum + -- number of octets needed to represent the value. For instance, the + -- value 32,768 is represented as the CBOR byte sequence 0b010_00010, + -- 0x80 0x00 (major type 2, additional information 2 for the length). + CoseKeyTypeParameterRSAN + | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) + -- + -- * COSE value type: bstr + -- * Description: the RSA public exponent e + -- + -- 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) + -- + -- All numeric key parameters are encoded in an unsigned big-endian + -- representation as an octet sequence using the CBOR byte string + -- type (major type 2). The octet sequence MUST utilize the minimum + -- number of octets needed to represent the value. For instance, the + -- value 32,768 is represented as the CBOR byte sequence 0b010_00010, + -- 0x80 0x00 (major type 2, additional information 2 for the length). + CoseKeyTypeParameterRSAE + deriving (Eq, Show, Bounded, Enum) + +-- | Serialises the parameters using the @Label@ column from the +-- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) +instance Serialise CoseKeyTypeParameterRSA where + encode CoseKeyTypeParameterRSAN = encodeInt (-1) + encode CoseKeyTypeParameterRSAE = encodeInt (-2) + decode = + decodeIntCanonical >>= \case + -1 -> pure CoseKeyTypeParameterRSAN + -2 -> pure CoseKeyTypeParameterRSAE + value -> fail $ "Unknown COSE key type parameter " <> show value <> " for key type RSA" + +-- | The number of parameters for a 'CoseKeyType' relevant for Webauthn public +-- keys +parameterCount :: CoseKeyType -> Word +parameterCount CoseKeyTypeOKP = cardinality @CoseKeyCommonParameter + cardinality @CoseKeyTypeParameterOKP +parameterCount CoseKeyTypeEC2 = cardinality @CoseKeyCommonParameter + cardinality @CoseKeyTypeParameterEC2 +parameterCount CoseKeyTypeRSA = cardinality @CoseKeyCommonParameter + cardinality @CoseKeyTypeParameterRSA + +-- | A utility function for getting the number of constructors for a type +-- that implements both 'Bounded' and 'Enum' +cardinality :: forall a b. (Bounded a, Enum a, Num b) => b +cardinality = fromIntegral $ 1 + fromEnum @a maxBound - fromEnum @a minBound diff --git a/src/Pact/Crypto/WebAuthn/Cose/SignAlg.hs b/src/Pact/Crypto/WebAuthn/Cose/SignAlg.hs new file mode 100644 index 000000000..1fbb94b44 --- /dev/null +++ b/src/Pact/Crypto/WebAuthn/Cose/SignAlg.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | 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 Pact.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.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) + +-- | 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) + +-- | 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) + +-- | [(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/Pact/Crypto/WebAuthn/Cose/Verify.hs b/src/Pact/Crypto/WebAuthn/Cose/Verify.hs new file mode 100644 index 000000000..37e624c61 --- /dev/null +++ b/src/Pact/Crypto/WebAuthn/Cose/Verify.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Stability: internal +-- public keys and signature algorithms are represented with three +-- different types: +-- +-- * 'Cose.CoseSignAlg', which is the signature algorithm used, equivalent to a +-- COSE Algorithm from the COSE registry +-- * '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 +-- * '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.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 Pact.Crypto.WebAuthn.Cose.Verify + ( + -- * Signature verification + verify + ) +where + +import Crypto.Error (CryptoFailable (CryptoFailed, CryptoPassed)) +import qualified Crypto.Hash as Hash +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 Pact.Crypto.WebAuthn.Cose.PublicKey as Cose +import qualified Pact.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose +import qualified Pact.Crypto.WebAuthn.Cose.SignAlg as Cose +import qualified Data.ASN1.BinaryEncoding as ASN1 +import qualified Data.ASN1.Encoding as ASN1 +import qualified Data.ASN1.Types as ASN1 +import qualified Data.ByteString as BS +import Data.Text (Text) +import qualified Data.Text as Text + +-- | 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 + + -- 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 {..} + + -- 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 :: 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 :: 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/Pact/Types/Crypto.hs b/src/Pact/Types/Crypto.hs index 663592d75..03e75c7fc 100644 --- a/src/Pact/Types/Crypto.hs +++ b/src/Pact/Types/Crypto.hs @@ -51,8 +51,9 @@ import GHC.Generics import qualified Codec.Serialise as Serialise import Control.Monad (unless) import qualified Crypto.Hash as H -import qualified Crypto.WebAuthn as WA -import qualified Crypto.WebAuthn.Cose.Internal.Verify as WAVerify +import qualified Pact.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as WA +import qualified Pact.Crypto.WebAuthn.Cose.SignAlg as WA +import qualified Pact.Crypto.WebAuthn.Cose.Verify as WAVerify import Data.Bifunctor (first) import Data.ByteString (ByteString) import Data.ByteString.Short (fromShort)