diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,18 @@ # Revision history for cryptostore +## 0.5.0.0 - 2026-02-08 + +* Add support for key encapsulation to CMS, aka KEMRecipientInfo. The only + mechanism implemented for now is RSA-KEM. + +* Decoding private keys in `Crypto.Store.PKCS8` is now more strict and makes + sure that the optional public key matches the private key when present. + +* Raise minimum bounds to crypton-x509-* >= 1.8.0 when flag `use_crypton` + is enabled, and reflect the new transitive dependencies + +* Fix encoding of key identifiers in CMS signer, originator and recipient info + ## 0.4.0.0 - 2025-10-12 * Private keys are now represented as type `KeyPair` defined in module diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2018-2025, Olivier Chéron +Copyright (c) 2018-2026, Olivier Chéron All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,6 +2,7 @@ [![BSD](https://img.shields.io/badge/License-BSD-blue)](https://en.wikipedia.org/wiki/BSD_licenses) [![Haskell](https://img.shields.io/badge/Language-Haskell-lightgrey)](https://haskell.org/) +[![Hackage](https://img.shields.io/hackage/v/cryptostore?label=Hackage&color=green)](https://hackage.haskell.org/package/cryptostore) This package allows to read and write cryptographic objects to/from ASN.1. @@ -343,6 +344,64 @@ > let doValidation _ chain = null <$> validateNoFQHN store def noServiceID chain > verifySignedData (withSignerCertificate doValidation) signedData Right (DataCI "Some trustworthy content") +``` + +### Authenticated-enveloped data + +The following examples generate a CMS structure auth-enveloping some data to a +KEM recipient, then decrypt the data to recover the content. + +#### Generating authenticated-enveloped data + +```haskell +> :set -XOverloadedStrings +> :m Crypto.Store.CMS Data.X509 Crypto.Store.X509 + +-- Input content info +> let info = DataCI "Powered by Haskell" + +-- Read receipient certificate +> [cert] <- readSignedObject "/path/to/cert.pem" :: IO [SignedCertificate] + +-- Content encryption will use AES-128-GCM, and we protect against manipulation +-- of algorithm identifiers as defined in RFC 9709 +> aceParams' <- generateGCMParams AES128 16 +> let aceParams = authDeriveEncryptionKey aceParams' +> aceKey <- generateKey aceParams :: IO ContentEncryptionKey + +-- Encrypt the Content Encryption Key with a KEM Recipient Info, +-- i.e. a KDF will derive the Key Encryption Key from a shared secret produced +-- by a Key Encapsulation Mechanism. We are using RSA-KEM based on KDF3 with +-- SHA-256 to produce a 16-byte shared secret. Further derivation of the KEK +-- uses HKDF with SHA-256. The CEK is finally wrapped with AES-Wrap-128. +> let kem = KeyEncapsulationRSA (KDF3 (DigestAlgorithm SHA256)) 16 +> let kdf = HKDF (DigestAlgorithm SHA256) +> let kri = forKeyEncapRecipient cert kdf AES128_WRAP kem + +-- Generate the auth-enveloped structure for this single recipient. Encrypted +-- content is kept attached in the structure. +> Right authEnvData <- authEnvelopData mempty aceKey aceParams [kri] [] [] info +> let authEnvCI = toAttachedCI authEnvData +> writeCMSFile "/path/to/authEnveloped.pem" [authEnvCI] +``` + +#### Opening the authenticated-enveloped data + +```haskell +> :set -XOverloadedStrings +> :m Crypto.Store.CMS Data.X509 Crypto.Store.X509 Crypto.Store.PKCS8 + +-- Read receipient certificate and private key +> (key : _) <- readKeyFile "/path/to/privkey.pem" -- assuming single key +> let Right pair = recover "mypassword" key +> [cert] <- readSignedObject "/path/to/cert.pem" :: IO [SignedCertificate] + +-- Then this recipient just has to read the file and recover enveloped +-- content using the private key and certificate +> [AuthEnvelopedDataCI authEnvEncapData] <- readCMSFile "/path/to/authEnveloped.pem" +> authEnvData <- fromAttached authEnvEncapData +> openAuthEnvelopedData (withRecipientKeyEncap pair cert) authEnvData +Right (DataCI "Powered by Haskell") ``` ## Algorithms and security diff --git a/cryptostore.cabal b/cryptostore.cabal --- a/cryptostore.cabal +++ b/cryptostore.cabal @@ -1,5 +1,5 @@ name: cryptostore -version: 0.4.0.0 +version: 0.5.0.0 synopsis: Serialization of cryptographic data types description: Haskell implementation of PKCS \#8, PKCS \#12 and CMS (Cryptographic Message Syntax). @@ -56,24 +56,29 @@ , Crypto.Store.PEM , Crypto.Store.PKCS5.PBES1 , Crypto.Store.PKCS8.EC + , Crypto.Store.PubKey.RSA.KEM , Crypto.Store.Util -- other-extensions: build-depends: base >= 4.9 && < 5 , bytestring , basement , memory - , pem >= 0.1 && < 0.3 - , asn1-types >= 0.3.1 && < 0.4 - , asn1-encoding >= 0.9 && < 0.10 - , hourglass >= 0.2 if flag(use_crypton) build-depends: crypton - , crypton-x509 - , crypton-x509-validation + , crypton-asn1-encoding >= 0.10.0 && < 0.11 + , crypton-asn1-types >= 0.4.1 && < 0.5 + , crypton-pem >= 0.2.4 && <0.4 + , crypton-x509 >= 1.8.0 + , crypton-x509-validation >= 1.8.0 + , time-hourglass else build-depends: cryptonite >=0.26 , x509 >= 1.7.5 , x509-validation >= 1.5 + , pem >= 0.1 && < 0.3 + , asn1-types >= 0.3.1 && < 0.4 + , asn1-encoding >= 0.9.6 && < 0.10 + , hourglass >= 0.2.10 default-language: Haskell2010 ghc-options: -Wall @@ -96,19 +101,22 @@ , X509.Tests build-depends: base >= 4.9 && < 5 , bytestring - , asn1-types >= 0.3.1 && < 0.4 , memory , tasty , tasty-hunit , tasty-quickcheck - , hourglass - , pem , cryptostore if flag(use_crypton) build-depends: crypton + , crypton-asn1-types >= 0.4.1 && < 0.5 + , crypton-pem >= 0.2.4 && <0.4 , crypton-x509 + , time-hourglass else build-depends: cryptonite >=0.25 , x509 + , asn1-types >= 0.3.1 && < 0.4 + , hourglass + , pem default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Crypto/Store/ASN1/Generate.hs b/src/Crypto/Store/ASN1/Generate.hs --- a/src/Crypto/Store/ASN1/Generate.hs +++ b/src/Crypto/Store/ASN1/Generate.hs @@ -107,7 +107,7 @@ gIntVal :: ASN1Elem e => Integer -> ASN1Stream e gIntVal = gOne . IntVal --- | Generate an 'OID' ASN.1 element. +-- | Generate an t'OID' ASN.1 element. gOID :: ASN1Elem e => OID -> ASN1Stream e gOID = gOne . OID diff --git a/src/Crypto/Store/ASN1/Parse.hs b/src/Crypto/Store/ASN1/Parse.hs --- a/src/Crypto/Store/ASN1/Parse.hs +++ b/src/Crypto/Store/ASN1/Parse.hs @@ -9,7 +9,7 @@ -- with the following additions: -- -- * Parsed stream is annotated, i.e. parser input is @('ASN1', e)@ instead of --- @'ASN1'@. Main motivation is to allow to parse a sequence of 'ASN1Repr' +-- @'ASN1'@. Main motivation is to allow to parse a sequence of @ASN1Repr@ -- and hold the exact binary content that has been parsed. As consequence, -- no @getObject@ function is provided. Function 'withAnnotations' runs -- a parser and returns all annotations consumed in a monoid concatenation. diff --git a/src/Crypto/Store/CMS.hs b/src/Crypto/Store/CMS.hs --- a/src/Crypto/Store/CMS.hs +++ b/src/Crypto/Store/CMS.hs @@ -22,7 +22,9 @@ -- * : Use of the Elliptic Curve Diffie-Hellman Key Agreement Algorithm with X25519 and X448 in the Cryptographic Message Syntax (CMS) -- * : Use of Edwards-Curve Digital Signature Algorithm (EdDSA) Signatures in the Cryptographic Message Syntax (CMS) -- * : Use of the SHAKE One-Way Hash Functions in the Cryptographic Message Syntax (CMS) +-- * : Using Key Encapsulation Mechanism (KEM) Algorithms in the Cryptographic Message Syntax (CMS) -- * : Use of the SHA3 One-Way Hash Functions in the Cryptographic Message Syntax (CMS) +-- * : Use of the RSA-KEM Algorithm in the Cryptographic Message Syntax (CMS) -- * : Encryption Key Derivation in the Cryptographic Message Syntax (CMS) Using HKDF with SHA-256 {-# LANGUAGE RecordWildCards #-} module Crypto.Store.CMS @@ -64,6 +66,7 @@ , KeyTransportParams(..) , KeyAgreementParams(..) , KeyAgreementKDF(..) + , KeyEncapsulationMechanism(..) , RecipientInfo(..) , EnvelopedData(..) , ProducerOfRI @@ -95,6 +98,10 @@ , PasswordRecipientInfo(..) , forPasswordRecipient , withRecipientPassword + -- ** Key Encapsulation recipients + , KEMRecipientInfo(..) + , forKeyEncapRecipient + , withRecipientKeyEncap -- * Digested data , DigestProxy(..) , DigestAlgorithm(..) @@ -141,6 +148,7 @@ , generateSalt , KeyDerivationFunc(..) , PBKDF2_PRF(..) + , KeyDerivationFn(..) -- * Secret-key algorithms , HasKeySize(..) , generateKey @@ -261,7 +269,7 @@ -> ContentInfo -> f (Either StoreError (EnvelopedData EncryptedContent)) envelopData oinfo key params envFns attrs ci = - f <$> (sequence <$> traverse ($ key) envFns) + f . sequence <$> traverse ($ key) envFns where ebs = contentEncrypt key params (encapsulate ci) f ris = build <$> ebs <*> ris @@ -311,7 +319,7 @@ -> ContentInfo -> f (Either StoreError (AuthenticatedData EncapsulatedContent)) generateAuthenticatedData oinfo key macAlg digAlg envFns aAttrs uAttrs ci = - f <$> (sequence <$> traverse ($ key) envFns) + f . sequence <$> traverse ($ key) envFns where msg = encapsulate ci ct = getContentType ci @@ -390,7 +398,7 @@ -> ContentInfo -> f (Either StoreError (AuthEnvelopedData EncryptedContent)) authEnvelopData oinfo key params envFns aAttrs uAttrs ci = - f <$> (sequence <$> traverse ($ key) envFns) + f . sequence <$> traverse ($ key) envFns where prm = derObjectExact params aad = encodeAuthAttrs aAttrs @@ -430,7 +438,7 @@ signData :: Applicative f => [ProducerOfSI f] -> ContentInfo -> f (Either StoreError (SignedData EncapsulatedContent)) signData sigFns ci = - f <$> (sequence <$> traverse (\fn -> fn ct msg) sigFns) + f . sequence <$> traverse (\fn -> fn ct msg) sigFns where msg = encapsulate ci ct = getContentType ci diff --git a/src/Crypto/Store/CMS/Algorithms.hs b/src/Crypto/Store/CMS/Algorithms.hs --- a/src/Crypto/Store/CMS/Algorithms.hs +++ b/src/Crypto/Store/CMS/Algorithms.hs @@ -17,6 +17,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} module Crypto.Store.CMS.Algorithms ( DigestAlgorithm(..) @@ -62,6 +63,8 @@ , kdfKeyLength , kdfKeyLengthModify , kdfDerive + , KeyDerivationFn(..) + , kdfApply , KeyEncryptionParams(..) , keyEncrypt , keyDecrypt @@ -76,6 +79,9 @@ , ecdhPublic , ecdhEncrypt , ecdhDecrypt + , KeyEncapsulationMechanism(..) + , kemEncap + , kemDecap , MaskGenerationFunc(..) , mgf , SignatureValue @@ -151,6 +157,7 @@ import qualified Crypto.Store.KeyWrap.RC2 as RC2_KW import Crypto.Store.Keys import Crypto.Store.PKCS8.EC +import qualified Crypto.Store.PubKey.RSA.KEM as RsaKem import Crypto.Store.Util @@ -1201,17 +1208,11 @@ deriveHKDF :: (Hash.HashAlgorithm a, ProduceASN1Object ASN1P params, ByteArrayAccess ikm) => DigestProxy a -> params -> ikm -> Either StoreError B.ScrubbedBytes -deriveHKDF hashAlg params ikm - | len > maxLen = Left (InvalidParameter "HKDF IKM is too long") - | otherwise = Right $ HKDF.expand (extract hashAlg ikm) info len +deriveHKDF hashAlg params ikm = + kdfApply (HKDF (DigestAlgorithm hashAlg)) (salt :: B.Bytes) len info ikm where - maxLen = 255 * digestSizeFromProxy hashAlg info = encodeASN1S (asn1s params) - len = B.length ikm - - extract :: (Hash.HashAlgorithm a, ByteArrayAccess ikm) - => DigestProxy a -> ikm -> HKDF.PRK a - extract _ = HKDF.extract (salt :: B.Bytes) + len = B.length ikm -- "The Cryptographic Message Syntax" salt = B.pack [84,104,101,32,67,114,121,112,116,111,103,114,97,112,104,105 @@ -1398,6 +1399,10 @@ fromObjectID oid = unOIDNW <$> fromObjectID oid -- | Key derivation algorithm and associated parameters. +-- +-- Implementations are specialized to password inputs. For other +-- implementations specialized to inputs having good entropy, like the shared +-- secrets produced by key-agreement schemes, see 'KeyDerivationFn'. data KeyDerivationFunc = -- | Key derivation with PBKDF2 PBKDF2 { pbkdf2Salt :: Salt -- ^ Salt value @@ -1492,7 +1497,82 @@ generateSalt :: MonadRandom m => Int -> m Salt generateSalt = getRandomBytes +data TypeKeyDerivationFn + = TypeHKDF DigestAlgorithm + | TypeKDF3 + deriving (Show,Eq) +instance Enumerable TypeKeyDerivationFn where + values = [ TypeHKDF (DigestAlgorithm SHA256) + , TypeHKDF (DigestAlgorithm SHA384) + , TypeHKDF (DigestAlgorithm SHA512) + , TypeHKDF (DigestAlgorithm SHA3_224) + , TypeHKDF (DigestAlgorithm SHA3_256) + , TypeHKDF (DigestAlgorithm SHA3_384) + , TypeHKDF (DigestAlgorithm SHA3_512) + , TypeKDF3 + ] + +instance OIDable TypeKeyDerivationFn where + getObjectID (TypeHKDF (DigestAlgorithm SHA256)) = [1,2,840,113549,1,9,16,3,28] + getObjectID (TypeHKDF (DigestAlgorithm SHA384)) = [1,2,840,113549,1,9,16,3,29] + getObjectID (TypeHKDF (DigestAlgorithm SHA512)) = [1,2,840,113549,1,9,16,3,30] + getObjectID (TypeHKDF (DigestAlgorithm SHA3_224)) = [1,2,840,113549,1,9,16,3,32] + getObjectID (TypeHKDF (DigestAlgorithm SHA3_256)) = [1,2,840,113549,1,9,16,3,33] + getObjectID (TypeHKDF (DigestAlgorithm SHA3_384)) = [1,2,840,113549,1,9,16,3,34] + getObjectID (TypeHKDF (DigestAlgorithm SHA3_512)) = [1,2,840,113549,1,9,16,3,35] + getObjectID (TypeHKDF hashAlg) = error ("Unsupported HKDF hash: " ++ show hashAlg) + getObjectID TypeKDF3 = [1,3,133,16,840,9,44,1,2] + +instance OIDNameable TypeKeyDerivationFn where + fromObjectID oid = unOIDNW <$> fromObjectID oid + +-- | Key derivation algorithm and associated parameters. +-- +-- Implementations are specialized to inputs having good entropy, like the +-- shared secrets produced by key-agreement schemes. For other implementations +-- specialized to password inputs, see 'KeyDerivationFunc'. +data KeyDerivationFn + -- | Key derivation with HKDF + = HKDF DigestAlgorithm + -- | Key derivation with KDF3 + | KDF3 DigestAlgorithm + deriving (Show,Eq) + +instance AlgorithmId KeyDerivationFn where + type AlgorithmType KeyDerivationFn = TypeKeyDerivationFn + + algorithmName _ = "key derivation algorithm" + algorithmType (HKDF alg) = TypeHKDF alg + algorithmType (KDF3 _) = TypeKDF3 + + parameterASN1S (HKDF _) = id + parameterASN1S (KDF3 alg) = algorithmASN1S Sequence alg + + parseParameter (TypeHKDF alg) = return (HKDF alg) + parseParameter TypeKDF3 = KDF3 <$> parseAlgorithm Sequence + +kdfApply :: (ByteArrayAccess salt, ByteArrayAccess ikm, ByteArray out) + => KeyDerivationFn -> salt -> Int -> ByteString -> ikm -> Either StoreError out +kdfApply (HKDF (DigestAlgorithm p)) salt len info ikm + | len > maxLen = Left (InvalidParameter "HKDF OKM is too long") + | otherwise = Right $ HKDF.expand (extract p ikm) info len + where + maxLen = 255 * digestSizeFromProxy p + + extract :: (Hash.HashAlgorithm a, ByteArrayAccess ikm) + => DigestProxy a -> ikm -> HKDF.PRK a + extract _ = HKDF.extract salt + +kdfApply (KDF3 dig@(DigestAlgorithm p)) salt len info ikm + | not (securityAcceptable dig) = + Left (InvalidParameter "KDF3 digest too weak") + | B.null salt = + let RsaKem.KDF kdf = RsaKem.kdf3 (hashFromProxy p) len + in Right $ kdf info ikm + | otherwise = Left (InvalidInput "KDF3 salt must be empty") + + -- Key encryption data KeyEncryptionType = TypePWRIKEK @@ -2088,6 +2168,85 @@ 14 -> return CCM_M14 16 -> return CCM_M16 i -> throwParseError ("Parsed invalid CCM parameter M: " ++ show i) + + +-- Key encapsulation + +data KeyEncapsulationType + = TypeKeyEncapsulationRSA + deriving (Show,Eq) + +instance Enumerable KeyEncapsulationType where + values = [TypeKeyEncapsulationRSA] + +instance OIDable KeyEncapsulationType where + getObjectID TypeKeyEncapsulationRSA = [1,0,18033,2,2,4] + +instance OIDNameable KeyEncapsulationType where + fromObjectID oid = unOIDNW <$> fromObjectID oid + +-- | Key encapsulation mechanism (KEM) with associated parameters. +data KeyEncapsulationMechanism + = KeyEncapsulationRSA KeyDerivationFn Int + -- ^ Key encapsulation with RSA-KEM + deriving (Show,Eq) + +instance AlgorithmId KeyEncapsulationMechanism where + type AlgorithmType KeyEncapsulationMechanism = KeyEncapsulationType + algorithmName _ = "key encapsulation mechanism" + + algorithmType (KeyEncapsulationRSA _ _) = TypeKeyEncapsulationRSA + + parameterASN1S (KeyEncapsulationRSA kdf len) + | (kdf, len) == defaultRsaKemParams = id + | otherwise = asn1Container Sequence $ + algorithmASN1S Sequence kdf . gIntVal (toInteger len) + + parseParameter TypeKeyEncapsulationRSA = + fmap manageDef $ onNextContainerMaybe Sequence $ do + kdf <- parseAlgorithm Sequence + IntVal len <- getNext + when (len < 1) $ + throwParseError "Illegal keyLength in RsaKemParameters" + return $ KeyEncapsulationRSA kdf (fromInteger len) + where + manageDef = fromMaybe (KeyEncapsulationRSA kdfDef lenDef) + (kdfDef, lenDef) = defaultRsaKemParams + +defaultRsaKemParams :: (KeyDerivationFn, Int) +defaultRsaKemParams = (KDF3 $ DigestAlgorithm SHA256, 16) + +newtype RsaKemLen = RsaKemLen Int + +instance HasStrength RsaKemLen where + getSecurityBits (RsaKemLen len) = 8 * len + +kdfRsaKem :: (ByteArrayAccess bIn, ByteArray bOut) + => KeyDerivationFn -> Int -> RsaKem.KDF bIn (Either StoreError bOut) +kdfRsaKem kdf len + | securityAcceptable (RsaKemLen len) = RsaKem.KDF $ kdfApply kdf noSalt len + | otherwise = RsaKem.KDF $ \_ _ -> + Left $ InvalidParameter "RSA-KEM shared-secret length too short" + +kemEncap :: (MonadRandom m, ByteArray ct, ByteArray ss) + => KeyEncapsulationMechanism -> X509.PubKey -> m (Either StoreError (ct, ss)) +kemEncap (KeyEncapsulationRSA kdf len) (X509.PubKeyRSA pub) = do + (ss, ct) <- RsaKem.encapsulate kdFn pub + return $ (ct, ) <$> ss + where kdFn = kdfRsaKem kdf len +kemEncap _ _ = return (Left UnexpectedPublicKeyType) + +kemDecap :: (ByteArrayAccess ct, ByteArray ss) + => KeyEncapsulationMechanism -> KeyPair -> ct -> Either StoreError ss +kemDecap (KeyEncapsulationRSA kdf len) (KeyPairRSA priv _) ct = + case RsaKem.decapsulate kdFn priv (B.convert ct :: B.Bytes) of + Just ss -> ss + Nothing -> Left $ InvalidParameter "Invalid RSA-KEM ciphertext" + where kdFn = kdfRsaKem kdf len +kemDecap _ _ _ = Left UnexpectedPrivateKeyType + +noSalt :: ByteString +noSalt = mempty -- Mask generation functions diff --git a/src/Crypto/Store/CMS/Attribute.hs b/src/Crypto/Store/CMS/Attribute.hs --- a/src/Crypto/Store/CMS/Attribute.hs +++ b/src/Crypto/Store/CMS/Attribute.hs @@ -37,7 +37,7 @@ import Data.Hourglass import Data.Maybe (fromMaybe) -import System.Hourglass (dateCurrent) +import Time.System (dateCurrent) import Crypto.Store.ASN1.Generate import Crypto.Store.ASN1.Parse diff --git a/src/Crypto/Store/CMS/Authenticated.hs b/src/Crypto/Store/CMS/Authenticated.hs --- a/src/Crypto/Store/CMS/Authenticated.hs +++ b/src/Crypto/Store/CMS/Authenticated.hs @@ -78,7 +78,7 @@ parse = onNextContainer Sequence $ do IntVal v <- getNext - when (v `notElem` [0, 1, 3]) $ + unless (v `elem` [0, 1, 3]) $ throwParseError ("AuthenticatedData: parsed invalid version: " ++ show v) oi <- parseOriginatorInfo (Container Context 0) <|> return mempty ris <- onNextContainer Set parse diff --git a/src/Crypto/Store/CMS/Enveloped.hs b/src/Crypto/Store/CMS/Enveloped.hs --- a/src/Crypto/Store/CMS/Enveloped.hs +++ b/src/Crypto/Store/CMS/Enveloped.hs @@ -42,6 +42,10 @@ , PasswordRecipientInfo(..) , forPasswordRecipient , withRecipientPassword + -- * Key Encapsulation recipients + , KEMRecipientInfo(..) + , forKeyEncapRecipient + , withRecipientKeyEncap ) where import Control.Applicative @@ -96,14 +100,13 @@ instance ASN1Elem e => ProduceASN1Object e RecipientIdentifier where asn1s (RecipientIASN iasn) = asn1s iasn - asn1s (RecipientSKI ski) = asn1Container (Container Context 0) - (gOctetString ski) + asn1s (RecipientSKI ski) = gMany [Other Context 0 ski] instance Monoid e => ParseASN1Object e RecipientIdentifier where parse = parseIASN <|> parseSKI where parseIASN = RecipientIASN <$> parse parseSKI = RecipientSKI <$> - onNextContainer (Container Context 0) parseOctetStringPrim + do { Other Context 0 bs <- getNext; return bs } getKTVersion :: RecipientIdentifier -> Integer getKTVersion (RecipientIASN _) = 0 @@ -168,8 +171,7 @@ instance ASN1Elem e => ProduceASN1Object e OriginatorIdentifierOrKey where asn1s (OriginatorIASN iasn) = asn1s iasn - asn1s (OriginatorSKI ski) = asn1Container (Container Context 0) - (gOctetString ski) + asn1s (OriginatorSKI ski) = gMany [Other Context 0 ski] asn1s (OriginatorPublic pub) = originatorPublicKeyASN1S (Container Context 1) pub @@ -177,7 +179,7 @@ parse = parseIASN <|> parseSKI <|> parsePublic where parseIASN = OriginatorIASN <$> parse parseSKI = OriginatorSKI <$> - onNextContainer (Container Context 0) parseOctetStringPrim + do { Other Context 0 bs <- getNext; return bs } parsePublic = OriginatorPublic <$> parseOriginatorPublicKey (Container Context 1) @@ -189,14 +191,13 @@ instance ASN1Elem e => ProduceASN1Object e KeyAgreeRecipientIdentifier where asn1s (KeyAgreeRecipientIASN iasn) = asn1s iasn - asn1s (KeyAgreeRecipientKI ki) = asn1Container (Container Context 0) - (asn1s ki) + asn1s (KeyAgreeRecipientKI ki) = keyIdentifierASN1S (Container Context 0) ki instance Monoid e => ParseASN1Object e KeyAgreeRecipientIdentifier where parse = parseIASN <|> parseKI where parseIASN = KeyAgreeRecipientIASN <$> parse parseKI = KeyAgreeRecipientKI <$> - onNextContainer (Container Context 0) parse + parseKeyIdentifier (Container Context 0) -- | Encrypted key for a recipient in a key-agreement RI. data RecipientEncryptedKey = RecipientEncryptedKey @@ -221,6 +222,16 @@ -> Maybe EncryptedKey findRecipientEncryptedKey cert list = rekEncryptedKey <$> find fn list where + fn rek = matchRecipient cert $ case rekRid rek of + KeyAgreeRecipientIASN iasn -> RecipientIASN iasn + KeyAgreeRecipientKI ki -> RecipientSKI (keyIdentifier ki) + +matchRecipient :: SignedCertificate -> RecipientIdentifier -> Bool +matchRecipient cert rid = + case rid of + RecipientIASN iasn -> matchIASN iasn + RecipientSKI ski -> matchSKI ski + where c = signedObject (getSigned cert) matchIASN iasn = (iasnIssuer iasn, iasnSerial iasn) == (certIssuerDN c, certSerial c) @@ -228,11 +239,8 @@ case extensionGet (certExtensions c) of Just (ExtSubjectKeyId idBs) -> idBs == ski Nothing -> False - fn rek = case rekRid rek of - KeyAgreeRecipientIASN iasn -> matchIASN iasn - KeyAgreeRecipientKI ki -> matchSKI (keyIdentifier ki) --- | Additional information in a 'KeyIdentifier'. +-- | Additional information in a t'KeyIdentifier'. data OtherKeyAttribute = OtherKeyAttribute { keyAttrId :: OID -- ^ attribute identifier , keyAttr :: [ASN1] -- ^ attribute value @@ -258,23 +266,26 @@ } deriving (Show,Eq) -instance ASN1Elem e => ProduceASN1Object e KeyIdentifier where - asn1s KeyIdentifier{..} = asn1Container Sequence (keyId . date . other) - where - keyId = gOctetString keyIdentifier - date = optASN1S keyDate $ \v -> gASN1Time TimeGeneralized v Nothing - other = optASN1S keyOther asn1s +keyIdentifierASN1S :: ASN1Elem e + => ASN1ConstructionType -> KeyIdentifier -> ASN1Stream e +keyIdentifierASN1S ty KeyIdentifier{..} = + asn1Container ty (keyId . date . other) + where + keyId = gOctetString keyIdentifier + date = optASN1S keyDate $ \v -> gASN1Time TimeGeneralized v Nothing + other = optASN1S keyOther asn1s -instance Monoid e => ParseASN1Object e KeyIdentifier where - parse = onNextContainer Sequence $ do - OctetString keyId <- getNext - date <- getNextMaybe dateTimeOrNothing - b <- hasNext - other <- if b then Just <$> parse else return Nothing - return KeyIdentifier { keyIdentifier = keyId - , keyDate = date - , keyOther = other - } +parseKeyIdentifier :: Monoid e + => ASN1ConstructionType -> ParseASN1 e KeyIdentifier +parseKeyIdentifier ty = onNextContainer ty $ do + OctetString keyId <- getNext + date <- getNextMaybe dateTimeOrNothing + b <- hasNext + other <- if b then Just <$> parse else return Nothing + return KeyIdentifier { keyIdentifier = keyId + , keyDate = date + , keyOther = other + } -- | Recipient using key transport. data KTRecipientInfo = KTRecipientInfo @@ -309,7 +320,73 @@ } deriving (Show,Eq) --- | Information for a recipient of an 'EnvelopedData'. An element contains +-- | Recipient using key encapsulation. +data KEMRecipientInfo = KEMRecipientInfo + { kemRid :: RecipientIdentifier -- ^ identifier of recipient + , kemEncapsulationParams :: KeyEncapsulationMechanism -- ^ key encapsulation mechanism + , kemCipherText :: ByteString -- ^ ciphertext for this recipient + , kemDerivationFn :: KeyDerivationFn -- ^ key derivation used + , kemKekLength :: Int -- ^ size of key encryption key + , kemUkm :: Maybe UserKeyingMaterial -- ^ user keying material + , kemEncryptionParams :: KeyEncryptionParams -- ^ key encryption algorithm + , kemEncryptedKey :: EncryptedKey -- ^ encrypted content-encryption key + } + deriving (Show,Eq) + +instance ASN1Elem e => ProduceASN1Object e KEMRecipientInfo where + asn1s KEMRecipientInfo{..} = + asn1Container Sequence (ver . rid . kem . ct . kdf . len . ukm . kep . ek) + where + ver = gIntVal 0 + rid = asn1s kemRid + kem = algorithmASN1S Sequence kemEncapsulationParams + ct = gOctetString kemCipherText + kdf = algorithmASN1S Sequence kemDerivationFn + len = gIntVal (toInteger kemKekLength) + ukm = optASN1S kemUkm $ asn1Container (Container Context 0) . gOctetString + kep = algorithmASN1S Sequence kemEncryptionParams + ek = gOctetString kemEncryptedKey + +instance Monoid e => ParseASN1Object e KEMRecipientInfo where + parse = onNextContainer Sequence $ do + IntVal 0 <- getNext + rid <- parse + kem <- parseAlgorithm Sequence + OctetString ct <- getNext + kdf <- parseAlgorithm Sequence + IntVal len <- getNext + when (len < 1 || len > 65535) $ + throwParseError ("KEMRecipientInfo: parsed invalid kekLength: " ++ show len) + ukm <- onNextContainerMaybe (Container Context 0) $ + do { OctetString bs <- getNext; return bs } + kep <- parseAlgorithm Sequence + OctetString ek <- getNext + return KEMRecipientInfo { kemRid = rid + , kemEncapsulationParams = kem + , kemCipherText = ct + , kemDerivationFn = kdf + , kemKekLength = fromInteger len + , kemUkm = ukm + , kemEncryptionParams = kep + , kemEncryptedKey = ek + } + +data CMSORIforKEMOtherInfo = CMSORIforKEMOtherInfo + { kemoiWrap :: KeyEncryptionParams + , kemoiKekLength :: Int + , kemoiUkm :: Maybe UserKeyingMaterial + } + deriving (Show,Eq) + +instance ASN1Elem e => ProduceASN1Object e CMSORIforKEMOtherInfo where + asn1s CMSORIforKEMOtherInfo{..} = + asn1Container Sequence (wrap . len . ukm) + where + wrap = algorithmASN1S Sequence kemoiWrap + len = gIntVal (toInteger kemoiKekLength) + ukm = optASN1S kemoiUkm $ asn1Container (Container Context 0) . gOctetString + +-- | Information for a recipient of an t'EnvelopedData'. An element contains -- the content-encryption key in encrypted form. data RecipientInfo = KTRI KTRecipientInfo -- ^ Recipient using key transport @@ -319,6 +396,8 @@ -- ^ Recipient using key encryption | PasswordRI PasswordRecipientInfo -- ^ Recipient using password-based protection + | KEMRI KEMRecipientInfo + -- ^ Recipient using key encapsulation deriving (Show,Eq) instance ASN1Elem e => ProduceASN1Object e RecipientInfo where @@ -346,7 +425,7 @@ asn1Container (Container Context 2) (ver . kid . kep . ek) where ver = gIntVal 4 - kid = asn1s kekId + kid = keyIdentifierASN1S Sequence kekId kep = algorithmASN1S Sequence kekKeyEncryptionParams ek = gOctetString kekEncryptedKey @@ -358,19 +437,26 @@ kep = algorithmASN1S Sequence priKeyEncryptionParams ek = gOctetString priEncryptedKey + asn1s (KEMRI ri) = + asn1Container (Container Context 4) (typ . val) + where + typ = gOID [1,2,840,113549,1,9,16,13,3] + val = asn1s ri + instance Monoid e => ParseASN1Object e RecipientInfo where parse = do c <- onNextContainerMaybe Sequence parseKT `orElse` onNextContainerMaybe (Container Context 1) parseKA `orElse` onNextContainerMaybe (Container Context 2) parseKEK `orElse` onNextContainerMaybe (Container Context 3) parsePassword + `orElse` onNextContainerMaybe (Container Context 4) parseOther case c of Just val -> return val Nothing -> throwParseError "RecipientInfo: unable to parse" where parseKT = KTRI <$> do IntVal v <- getNext - when (v `notElem` [0, 2]) $ + unless (v `elem` [0, 2]) $ throwParseError ("RecipientInfo: parsed invalid KT version: " ++ show v) rid <- parse ktp <- parseAlgorithm Sequence @@ -395,7 +481,7 @@ parseKEK = KEKRI <$> do IntVal 4 <- getNext - kid <- parse + kid <- parseKeyIdentifier Sequence kep <- parseAlgorithm Sequence OctetString ek <- getNext return KEKRecipientInfo { kekId = kid @@ -413,17 +499,23 @@ , priEncryptedKey = ek } + parseOther = KEMRI <$> do + OID [1,2,840,113549,1,9,16,13,3] <- getNext + parse + isVersion0 :: RecipientInfo -> Bool isVersion0 (KTRI x) = getKTVersion (ktRid x) == 0 isVersion0 (KARI _) = False -- because version is always 3 isVersion0 (KEKRI _) = False -- because version is always 4 isVersion0 (PasswordRI _) = True -- because version is always 0 +isVersion0 (KEMRI _) = True -- because version is always 0 isPwriOri :: RecipientInfo -> Bool isPwriOri (KTRI _) = False isPwriOri (KARI _) = False isPwriOri (KEKRI _) = False isPwriOri (PasswordRI _) = True +isPwriOri (KEMRI _) = True -- | Enveloped content information. data EnvelopedData content = EnvelopedData @@ -632,3 +724,84 @@ len = fromMaybe (getMaximumKeySize priKeyEncryptionParams) (kdfKeyLength priKeyDerivationFunc) withRecipientPassword _ _ = pure (Left RecipientTypeMismatch) + +-- | Generate a Key Encapsulation recipient from a certificate and +-- desired algorithms. The recipient info will contain the KEM ciphertext. +-- +-- This function can be used as parameter to 'Crypto.Store.CMS.envelopData'. +-- +-- To avoid decreasing the security strength, selected algorithms should all be +-- equal or stronger than the content encryption key. +forKeyEncapRecipient :: MonadRandom m + => SignedCertificate + -> KeyDerivationFn + -> KeyEncryptionParams + -> KeyEncapsulationMechanism + -> ProducerOfRI m +forKeyEncapRecipient cert kdf kep params inkey = do + ephemeral <- kemEncap params (certPubKey obj) + case ephemeral of + Right (ct, ss) -> + case kdfApply kdf noSalt len prm (ss :: EncryptedKey) of + Left err -> pure $ Left err + Right kek -> do + ek <- keyEncrypt (kek :: EncryptedKey) kep inkey + pure (KEMRI . build ct <$> ek) + Left err -> pure $ Left err + where + obj = signedObject (getSigned cert) + isn = IssuerAndSerialNumber (certIssuerDN obj) (certSerial obj) + prm = encodeASN1S (asn1s info) + + len = getMaximumKeySize kep + info = CMSORIforKEMOtherInfo + { kemoiWrap = kep + , kemoiKekLength = len + , kemoiUkm = Nothing + } + + build ct ek = + KEMRecipientInfo + { kemRid = RecipientIASN isn + , kemEncapsulationParams = params + , kemCipherText = ct + , kemDerivationFn = kdf + , kemKekLength = len + , kemUkm = Nothing + , kemEncryptionParams = kep + , kemEncryptedKey = ek + } + +-- | Use a Key Encapsulation recipient, knowing the recipient private key. +-- The recipient certificate is also used to determine if a recipient info +-- is applicable. +-- +-- This function can be used as parameter to +-- 'Crypto.Store.CMS.openEnvelopedData'. +withRecipientKeyEncap :: MonadRandom m => KeyPair -> SignedCertificate -> ConsumerOfRI m +withRecipientKeyEncap pair cert (KEMRI KEMRecipientInfo{..}) + | not (keyPairMatchesCert pair cert) = + pure $ Left PublicPrivateKeyMismatch + | not (matchRecipient cert kemRid) = + pure $ Left NoRecipientInfoMatched + | otherwise = + case kemDecap kemEncapsulationParams pair kemCipherText of + Left err -> pure $ Left err + Right ss | len == kemKekLength -> pure $ + case kdfApply kemDerivationFn noSalt kemKekLength prm (ss :: EncryptedKey) of + Left err -> Left err + Right kek -> keyDecrypt (kek :: EncryptedKey) + kemEncryptionParams kemEncryptedKey + Right _ -> pure $ Left (InvalidInput "Wrong kekLength in KEMRecipientInfo") + where + len = getMaximumKeySize kemEncryptionParams + prm = encodeASN1S (asn1s info) + info = CMSORIforKEMOtherInfo + { kemoiWrap = kemEncryptionParams + , kemoiKekLength = kemKekLength + , kemoiUkm = kemUkm + } +withRecipientKeyEncap _ _ _ = pure (Left RecipientTypeMismatch) + +noSalt :: ByteString +noSalt = mempty diff --git a/src/Crypto/Store/CMS/PEM.hs b/src/Crypto/Store/CMS/PEM.hs --- a/src/Crypto/Store/CMS/PEM.hs +++ b/src/Crypto/Store/CMS/PEM.hs @@ -44,13 +44,13 @@ berToContentInfo :: B.ByteString -> Either StoreError ContentInfo berToContentInfo = decodeASN1Object --- | Read a content info from a 'PEM' element and add it to the accumulator +-- | Read a content info from a t'PEM' element and add it to the accumulator -- list. pemToContentInfoAccum :: [Maybe ContentInfo] -> PEM -> [Maybe ContentInfo] pemToContentInfoAccum acc pem = either (const Nothing) Just (pemToContentInfo pem) : acc --- | Read a content info from a 'PEM' element. +-- | Read a content info from a t'PEM' element. pemToContentInfo :: PEM -> Either StoreError ContentInfo pemToContentInfo pem | pemName pem `elem` names = berToContentInfo (pemContent pem) diff --git a/src/Crypto/Store/CMS/Signed.hs b/src/Crypto/Store/CMS/Signed.hs --- a/src/Crypto/Store/CMS/Signed.hs +++ b/src/Crypto/Store/CMS/Signed.hs @@ -118,14 +118,13 @@ instance ASN1Elem e => ProduceASN1Object e SignerIdentifier where asn1s (SignerIASN iasn) = asn1s iasn - asn1s (SignerSKI ski) = asn1Container (Container Context 0) - (gOctetString ski) + asn1s (SignerSKI ski) = gMany [Other Context 0 ski] instance Monoid e => ParseASN1Object e SignerIdentifier where parse = parseIASN <|> parseSKI where parseIASN = SignerIASN <$> parse parseSKI = SignerSKI <$> - onNextContainer (Container Context 0) parseOctetStringPrim + do { Other Context 0 bs <- getNext; return bs } -- | Try to find a certificate with the specified identifier. findSigner :: SignerIdentifier @@ -150,10 +149,10 @@ (x : _, r) -> Just (x, r) ([] , _) -> Nothing --- | Function able to produce a 'SignerInfo'. +-- | Function able to produce a t'SignerInfo'. type ProducerOfSI m = ContentType -> ByteString -> m (Either StoreError (SignerInfo, [CertificateChoice], [RevocationInfoChoice])) --- | Function able to consume a 'SignerInfo'. +-- | Function able to consume a t'SignerInfo'. type ConsumerOfSI m = ContentType -> ByteString -> SignerInfo -> [CertificateChoice] -> [RevocationInfoChoice] -> m Bool -- | Create a signer info with the specified signature algorithm and diff --git a/src/Crypto/Store/Keys.hs b/src/Crypto/Store/Keys.hs --- a/src/Crypto/Store/Keys.hs +++ b/src/Crypto/Store/Keys.hs @@ -27,7 +27,7 @@ import Crypto.Store.PKCS8.EC --- | Holds a private and public key together, with guaranty that they both +-- | Holds a private and public key together, with a guarantee that they both -- match. Therefore no constructor is exposed. Content may be accessed -- through functions 'keyPairToPrivKey' and 'keyPairToPubKey'. -- diff --git a/src/Crypto/Store/PEM.hs b/src/Crypto/Store/PEM.hs --- a/src/Crypto/Store/PEM.hs +++ b/src/Crypto/Store/PEM.hs @@ -20,6 +20,9 @@ import qualified Data.ByteString.Lazy as L -- | Read a PEM file from disk. +-- +-- The function uses lazy IO so will retain an open file descriptor until the +-- list spine is fully evaluated. readPEMs :: FilePath -> IO [PEM] readPEMs filepath = either error id . pemParseLBS <$> L.readFile filepath diff --git a/src/Crypto/Store/PKCS12.hs b/src/Crypto/Store/PKCS12.hs --- a/src/Crypto/Store/PKCS12.hs +++ b/src/Crypto/Store/PKCS12.hs @@ -313,7 +313,7 @@ -- AuthenticatedSafe --- | PKCS #12 privacy wrapper, adding optional encryption to 'SafeContents'. +-- | PKCS #12 privacy wrapper, adding optional encryption to t'SafeContents'. -- ASN.1 equivalent is @AuthenticatedSafe@. -- -- The semigroup interface allows to combine multiple pieces encrypted @@ -665,7 +665,7 @@ pure (buildCertificateChain leaf certs, keyPairToPrivKey k) filterWithPrivKey = filter . keyPairMatchesCert --- | Extract the private key and certificate chain from a 'PKCS12' value. A +-- | Extract the private key and certificate chain from a t'PKCS12' value. A -- credential is returned when the structure contains exactly one private key -- and at least one X.509 certificate. toCredential :: PKCS12 -> OptProtected (Maybe (X509.CertificateChain, X509.PrivKey)) @@ -684,13 +684,13 @@ pure (buildCertificateChain leaf certs, keyPairToPrivKey k) -- | Extract a private key and certificate chain with the specified friendly --- name from a 'PKCS12' value. A credential is returned when the structure +-- name from a t'PKCS12' value. A credential is returned when the structure -- contains exactly one private key and one X.509 certificate with the name. toNamedCredential :: String -> PKCS12 -> OptProtected (Maybe (X509.CertificateChain, X509.PrivKey)) toNamedCredential name p12 = unSamePassword $ SamePassword (unPKCS12 p12) >>= getInnerCredentialNamed name --- | Build a 'PKCS12' value containing a private key and certificate chain. +-- | Build a t'PKCS12' value containing a private key and certificate chain. -- Distinct encryption is applied for both. Encrypting the certificate chain is -- optional. -- @@ -703,7 +703,7 @@ -> Either StoreError PKCS12 fromCredential = fromCredential' id --- | Build a 'PKCS12' value containing a private key and certificate chain +-- | Build a t'PKCS12' value containing a private key and certificate chain -- identified with the specified friendly name. Distinct encryption is applied -- for private key and certificates. Encrypting the certificate chain is -- optional. diff --git a/src/Crypto/Store/PKCS8.hs b/src/Crypto/Store/PKCS8.hs --- a/src/Crypto/Store/PKCS8.hs +++ b/src/Crypto/Store/PKCS8.hs @@ -9,10 +9,11 @@ -- -- Presents an API similar to "Data.X509.Memory" and "Data.X509.File" but -- allows to write private keys and provides support for password-based --- encryption. Private keys are actually stored along with the corresponding --- public key in a type 'KeyPair'. 'X509.PrivKey' and 'X509.PubKey' components --- can be obtained by calling functions 'keyPairToPrivKey' and --- 'keyPairToPubKey'. Call function 'keyPairFromPrivKey' to build a 'KeyPair'. +-- encryption. Private keys are now stored along with the corresponding +-- public key in a type 'KeyPair'. Components of type 'X509.PrivKey' and +-- 'X509.PubKey' can be obtained through functions 'keyPairToPrivKey' and +-- 'keyPairToPubKey'. Function 'keyPairFromPrivKey' can be called to build a +-- 'KeyPair'. -- -- Functions to read a private key return an object wrapped in the -- 'OptProtected' data type. @@ -63,6 +64,7 @@ import Data.ASN1.BinaryEncoding import Data.ASN1.BitArray import Data.ASN1.Encoding +import Data.ASN1.Prim import Data.Bifunctor (first) import Data.ByteArray (ByteArrayAccess, convert) import Data.Either (rights) @@ -77,7 +79,7 @@ import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.Ed448 as Ed448 -import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.RSA.Types as RSA import Crypto.Store.ASN1.Generate import Crypto.Store.ASN1.Parse @@ -138,7 +140,8 @@ accumulate :: [PEM] -> [OptProtected KeyPair] accumulate = rights . map pemToKey --- | Read a private key from a 'PEM' element and add it to the accumulator list. +-- | Read a private key from a t'PEM' element and add it to the accumulator +-- list. -- -- This API is modelled after the original @pemToKey@ in "Data.X509.Memory". pemToKeyAccum :: [Maybe (OptProtected KeyPair)] -> PEM -> [Maybe (OptProtected KeyPair)] @@ -148,7 +151,7 @@ Left _ -> Nothing : acc Right key -> Just key : acc --- | Read a private key from a 'PEM' element. +-- | Read a private key from a t'PEM' element. pemToKey :: PEM -> Either StoreError (OptProtected KeyPair) pemToKey pem = do asn1 <- mapLeft DecodingError $ decodeASN1' BER (pemContent pem) @@ -157,13 +160,13 @@ where allTypes = unFormat <$> parse - rsa = keyPairFromPrivKey . X509.PrivKeyRSA . unFormat <$> parse - dsa = KeyPairDSA . unFormat <$> parse - ecdsa = keyPairFromPrivKey . X509.PrivKeyEC . unFormat <$> parse - x25519 = keyPairFromPrivKey . X509.PrivKeyX25519 <$> parseModern - x448 = keyPairFromPrivKey . X509.PrivKeyX448 <$> parseModern - ed25519 = keyPairFromPrivKey . X509.PrivKeyEd25519 <$> parseModern - ed448 = keyPairFromPrivKey . X509.PrivKeyEd448 <$> parseModern + rsa = parseFormattedKeyPair (keyPairFromPrivKey . X509.PrivKeyRSA) + dsa = parseFormattedKeyPair KeyPairDSA + ecdsa = parseFormattedKeyPair (keyPairFromPrivKey . X509.PrivKeyEC) + x25519 = parseModernKeyPair (keyPairFromPrivKey . X509.PrivKeyX25519) + x448 = parseModernKeyPair (keyPairFromPrivKey . X509.PrivKeyX448) + ed25519 = parseModernKeyPair (keyPairFromPrivKey . X509.PrivKeyEd25519) + ed448 = parseModernKeyPair (keyPairFromPrivKey . X509.PrivKeyEd448) encrypted = inner . decrypt <$> parse getParser "PRIVATE KEY" = return (Unprotected <$> allTypes) @@ -242,15 +245,19 @@ KeyPairEd25519 k _ -> ("ED25519", tradModern k) KeyPairEd448 k _ -> ("ED448", tradModern k) where + traditional :: ProduceASN1Object e (Traditional a) => a -> ASN1Stream e traditional a = asn1s (Traditional a) - tradModern a = asn1s (Modern [] a) + tradModern :: ProduceASN1Object e (Modern a) => a -> ASN1Stream e + tradModern = modernASN1S (const $ keyPairToPubKey keyPair) + keyToModernPEM :: KeyPair -> PEM keyToModernPEM keyPair = mkPEM "PRIVATE KEY" (encodeASN1S asn1) - where asn1 = modernPrivKeyASN1S [] keyPair + where asn1 = modernASN1S keyPairToPubKey keyPair -modernPrivKeyASN1S :: ASN1Elem e => [Attribute] -> KeyPair -> ASN1Stream e -modernPrivKeyASN1S attrs keyPair = +modernPrivKeyASN1S :: ASN1Elem e + => [Attribute] -> Maybe GenericPubKey -> KeyPair -> ASN1Stream e +modernPrivKeyASN1S attrs mPub keyPair = case keyPair of KeyPairRSA k _ -> modern k KeyPairDSA p -> modern p @@ -260,7 +267,7 @@ KeyPairEd25519 k _ -> modern k KeyPairEd448 k _ -> modern k where - modern a = asn1s (Modern attrs a) + modern a = asn1s (Modern attrs mPub a) -- | Generate a PKCS #8 encrypted PEM for a private key. -- @@ -287,15 +294,65 @@ parseTraditional :: ParseASN1Object e (Traditional a) => ParseASN1 e a parseTraditional = unTraditional <$> parse -data Modern a = Modern [Attribute] a +data Modern a = Modern [Attribute] (Maybe GenericPubKey) a instance Functor Modern where - fmap f (Modern attrs a) = Modern attrs (f a) + fmap f (Modern attrs mPub a) = Modern attrs mPub (f a) -parseModern :: ParseASN1Object e (Modern a) => ParseASN1 e a -parseModern = unModern <$> parse - where unModern (Modern _ a) = a +modernASN1S :: ProduceASN1Object e (Modern a) + => (a -> X509.PubKey) -> a -> ASN1Stream e +modernASN1S toPubKey a = asn1s (Modern [] mPub a) + where + noPubKey = True -- we never generate with publicKey but the code exists + mPub | noPubKey = Nothing + | otherwise = case getGenericPubKey toPubKey a of + Right (gpk, []) -> Just gpk + _ -> Nothing +parseModernKeyPair :: ParseASN1Object e (Modern a) + => (a -> KeyPair) -> ParseASN1 e KeyPair +parseModernKeyPair = parseModern keyPairToPubKey + +parseModern :: ParseASN1Object e (Modern b) + => (a -> X509.PubKey) -> (b -> a) -> ParseASN1 e a +parseModern toPubKey mapFn = do + Modern _ mPub b <- parse + verifyPubKey toPubKey (mapFn b) mPub + +verifyPubKey :: (a -> X509.PubKey) -> a -> Maybe GenericPubKey -> ParseASN1 e a +verifyPubKey _ a Nothing = return a +verifyPubKey toPubKey a (Just gpk) + | Right (gpk, []) == derived = return a + | otherwise = throwParseError "PKCS8 public key does not match private key" + where derived = getGenericPubKey toPubKey a + +getGenericPubKey :: (a -> X509.PubKey) -> a -> Either String (GenericPubKey, [ASN1]) +getGenericPubKey toPubKey a = runParseASN1State parsePubKeyGen asn1 + where asn1 = toASN1 (toPubKey a) [] + +parsePubKeyGen :: Monoid e => ParseASN1 e GenericPubKey +parsePubKeyGen = onNextContainer Sequence $ do + void $ getNextContainer Sequence -- ignore algorithm, + BitString bits <- getNext -- we want the bit string only + return (GenericPubKey $ bitArrayGetData bits) + +newtype GenericPubKey = GenericPubKey B.ByteString + deriving (Show,Eq) + +instance ASN1Elem e => ProduceASN1Object e (Maybe GenericPubKey) where + asn1s Nothing = id + asn1s (Just (GenericPubKey bits)) = gMany [Other Context 1 bs] + where bs = putBitString (toBitArray bits 0) + +instance Monoid e => ParseASN1Object e (Maybe GenericPubKey) where + parse = Just . GenericPubKey <$> parseTaggedBitString <|> return Nothing + where + parseTaggedBitString = do + Other _ 1 bs <- getNext + case getBitString bs of + Right (BitString bits) -> return (bitArrayGetData bits) + r -> throwParseError ("GenericPubKey: invalid bit string: " ++ show r) + -- | A key associated with format. Allows to implement 'ASN1Object' instances. data FormattedKey a = FormattedKey PrivateKeyFormat a deriving (Show,Eq) @@ -303,16 +360,35 @@ instance Functor FormattedKey where fmap f (FormattedKey fmt a) = FormattedKey fmt (f a) -instance (ProduceASN1Object e (Traditional a), ProduceASN1Object e (Modern a)) => ProduceASN1Object e (FormattedKey a) where - asn1s (FormattedKey TraditionalFormat k) = asn1s (Traditional k) - asn1s (FormattedKey PKCS8Format k) = asn1s (Modern [] k) +instance ASN1Elem e => ProduceASN1Object e (FormattedKey KeyPair) where + asn1s = formattedASN1S keyPairToPubKey -instance (Monoid e, ParseASN1Object e (Traditional a), ParseASN1Object e (Modern a)) => ParseASN1Object e (FormattedKey a) where - parse = (modern <$> parseModern) <|> (traditional <$> parseTraditional) - where - traditional = FormattedKey TraditionalFormat - modern = FormattedKey PKCS8Format +instance Monoid e => ParseASN1Object e (FormattedKey KeyPair) where + parse = parseFormatted keyPairToPubKey +formattedASN1S :: (ProduceASN1Object e (Traditional a), ProduceASN1Object e (Modern a)) + => (a -> X509.PubKey) -> FormattedKey a -> ASN1Stream e +formattedASN1S _ (FormattedKey TraditionalFormat k) = asn1s (Traditional k) +formattedASN1S toPubKey (FormattedKey PKCS8Format k) = modernASN1S toPubKey k + +parseFormattedKeyPair :: ParseASN1Object e (Modern a) + => (a -> KeyPair) -> ParseASN1 e KeyPair +parseFormattedKeyPair mapFn = + unFormat <$> parseFormattedInternal keyPairToPubKey mapFn + +parseFormatted :: (ParseASN1Object e (Traditional a), ParseASN1Object e (Modern a)) + => (a -> X509.PubKey) -> ParseASN1 e (FormattedKey a) +parseFormatted toPubKey = parseFormattedInternal toPubKey id + +parseFormattedInternal :: (ParseASN1Object e (Traditional a), ParseASN1Object e (Modern b)) + => (a -> X509.PubKey) -> (b -> a) -> ParseASN1 e (FormattedKey a) +parseFormattedInternal toPubKey mapFn = + (modern <$> parseModern toPubKey mapFn) <|> + (traditional <$> parseTraditional) + where + traditional = FormattedKey TraditionalFormat + modern = FormattedKey PKCS8Format + unFormat :: FormattedKey a -> a unFormat (FormattedKey _ a) = a @@ -338,7 +414,7 @@ ecdsa = Traditional . keyPairFromPrivKey . X509.PrivKeyEC . unTraditional <$> parse instance ASN1Elem e => ProduceASN1Object e (Modern KeyPair) where - asn1s (Modern attrs keyPair) = modernPrivKeyASN1S attrs keyPair + asn1s (Modern attrs mPub keyPair) = modernPrivKeyASN1S attrs mPub keyPair instance Monoid e => ParseASN1Object e (Modern KeyPair) where parse = rsa <|> dsa <|> ecdsa <|> x25519 <|> x448 <|> ed25519 <|> ed448 @@ -354,9 +430,12 @@ -- RSA +toPubKeyRSA :: RSA.PrivateKey -> X509.PubKey +toPubKeyRSA = X509.PubKeyRSA . RSA.toPublicKey . RSA.KeyPair + instance ASN1Object (FormattedKey RSA.PrivateKey) where - toASN1 = asn1s - fromASN1 = runParseASN1State parse + toASN1 = formattedASN1S toPubKeyRSA + fromASN1 = runParseASN1State (parseFormatted toPubKeyRSA) instance ASN1Elem e => ProduceASN1Object e (Traditional RSA.PrivateKey) where asn1s (Traditional privKey) = @@ -400,34 +479,37 @@ return (Traditional privKey) instance ASN1Elem e => ProduceASN1Object e (Modern RSA.PrivateKey) where - asn1s (Modern attrs privKey) = + asn1s (Modern attrs mPub privKey) = asn1Container Sequence (v . alg . bs . att) where - v = gIntVal 0 + v = versionASN1S mPub alg = asn1Container Sequence (oid . gNull) oid = gOID [1,2,840,113549,1,1,1] bs = gOctetString (encodeASN1Object $ Traditional privKey) - att = attributesASN1S (Container Context 0) attrs + att = attrKeysASN1S attrs mPub instance Monoid e => ParseASN1Object e (Modern RSA.PrivateKey) where parse = onNextContainer Sequence $ do - skipVersion + v2 <- parseVersion Null <- onNextContainer Sequence $ do OID [1,2,840,113549,1,1,1] <- getNext getNext - (attrs, bs) <- parseAttrKeys + (attrs, bs, mPub) <- parseAttrKeys v2 let inner = decodeASN1' BER bs strError = Left . ("PKCS8: error decoding inner RSA: " ++) . show case either strError (runParseASN1 parseTraditional) inner of Left err -> throwParseError ("PKCS8: error parsing inner RSA: " ++ err) - Right privKey -> return (Modern attrs privKey) + Right privKey -> return (Modern attrs mPub privKey) -- DSA +toPubKeyDSA :: DSA.KeyPair -> X509.PubKey +toPubKeyDSA = X509.PubKeyDSA . DSA.toPublicKey + instance ASN1Object (FormattedKey DSA.KeyPair) where - toASN1 = asn1s - fromASN1 = runParseASN1State parse + toASN1 = formattedASN1S toPubKeyDSA + fromASN1 = runParseASN1State (parseFormatted toPubKeyDSA) instance ASN1Elem e => ProduceASN1Object e (Traditional DSA.KeyPair) where asn1s (Traditional (DSA.KeyPair params pub priv)) = @@ -446,27 +528,27 @@ return (Traditional $ DSA.KeyPair params pub priv) instance ASN1Elem e => ProduceASN1Object e (Modern DSA.KeyPair) where - asn1s (Modern attrs (DSA.KeyPair params _ priv)) = + asn1s (Modern attrs mPub (DSA.KeyPair params _ priv)) = asn1Container Sequence (v . alg . bs . att) where - v = gIntVal 0 + v = versionASN1S mPub alg = asn1Container Sequence (oid . pr) oid = gOID [1,2,840,10040,4,1] pr = asn1Container Sequence (pqgASN1S params) bs = gOctetString (encodeASN1S $ gIntVal priv) - att = attributesASN1S (Container Context 0) attrs + att = attrKeysASN1S attrs mPub instance Monoid e => ParseASN1Object e (Modern DSA.KeyPair) where parse = onNextContainer Sequence $ do - skipVersion + v2 <- parseVersion params <- onNextContainer Sequence $ do OID [1,2,840,10040,4,1] <- getNext onNextContainer Sequence parsePQG - (attrs, bs) <- parseAttrKeys + (attrs, bs, mPub) <- parseAttrKeys v2 case decodeASN1' BER bs of Right [IntVal priv] -> let pub = DSA.calculatePublic params priv - in return (Modern attrs $ DSA.KeyPair params pub priv) + in return (Modern attrs mPub $ DSA.KeyPair params pub priv) Right _ -> throwParseError "PKCS8: invalid format when parsing inner DSA" Left e -> throwParseError ("PKCS8: error parsing inner DSA: " ++ show e) @@ -489,9 +571,12 @@ -- ECDSA +toPubKeyEC :: X509.PrivKeyEC -> X509.PubKey +toPubKeyEC = keyPairToPubKey . keyPairFromPrivKey . X509.PrivKeyEC + instance ASN1Object (FormattedKey X509.PrivKeyEC) where - toASN1 = asn1s - fromASN1 = runParseASN1State parse + toASN1 = formattedASN1S toPubKeyEC + fromASN1 = runParseASN1State (parseFormatted toPubKeyEC) instance ASN1Elem e => ProduceASN1Object e (Traditional X509.PrivKeyEC) where asn1s = innerEcdsaASN1S True . unTraditional @@ -500,27 +585,27 @@ parse = Traditional <$> parseInnerEcdsa Nothing instance ASN1Elem e => ProduceASN1Object e (Modern X509.PrivKeyEC) where - asn1s (Modern attrs privKey) = asn1Container Sequence (v . f . bs . att) + asn1s (Modern attrs mPub privKey) = asn1Container Sequence (v . f . bs . att) where - v = gIntVal 0 + v = versionASN1S mPub f = asn1Container Sequence (oid . curveFnASN1S privKey) oid = gOID [1,2,840,10045,2,1] bs = gOctetString (encodeASN1S inner) inner = innerEcdsaASN1S False privKey - att = attributesASN1S (Container Context 0) attrs + att = attrKeysASN1S attrs mPub instance Monoid e => ParseASN1Object e (Modern X509.PrivKeyEC) where parse = onNextContainer Sequence $ do - skipVersion + v2 <- parseVersion f <- onNextContainer Sequence $ do OID [1,2,840,10045,2,1] <- getNext parseCurveFn - (attrs, bs) <- parseAttrKeys + (attrs, bs, mPub) <- parseAttrKeys v2 let inner = decodeASN1' BER bs strError = Left . ("PKCS8: error decoding inner EC: " ++) . show case either strError (runParseASN1 $ parseInnerEcdsa $ Just f) inner of Left err -> throwParseError ("PKCS8: error parsing inner EC: " ++ err) - Right privKey -> return (Modern attrs privKey) + Right privKey -> return (Modern attrs mPub privKey) innerEcdsaASN1S :: ASN1Elem e => Bool -> X509.PrivKeyEC -> ASN1Stream e innerEcdsaASN1S addC k @@ -655,12 +740,12 @@ -- * Producer helpers produceModernEddsa :: (ASN1Elem e, ByteArrayAccess key) => OID -> Modern key -> ASN1Stream e -produceModernEddsa oid (Modern attrs privKey) = asn1Container Sequence (v . alg . bs . att) +produceModernEddsa oid (Modern attrs mPub privKey) = asn1Container Sequence (v . alg . bs . att) where - v = gIntVal 0 + v = versionASN1S mPub alg = asn1Container Sequence (gOID oid) bs = innerEddsaASN1S privKey - att = attributesASN1S (Container Context 0) attrs + att = attrKeysASN1S attrs mPub innerEddsaASN1S :: (ASN1Elem e, ByteArrayAccess key) => key -> ASN1Stream e innerEddsaASN1S key = gOctetString (encodeASN1S inner) @@ -670,13 +755,13 @@ parseModernEddsa :: Monoid e => String -> OID -> (B.ByteString -> CryptoFailable a) -> ParseASN1 e (Modern a) parseModernEddsa name expectedOid buildKey = onNextContainer Sequence $ do - skipVersion + v2 <- parseVersion onNextContainer Sequence $ do OID oid <- getNext when (oid /= expectedOid) $ throwParseError ("PKCS8: while parsing " ++ name ++ " expected OID " ++ show expectedOid ++ " while got " ++ show oid) - (attrs, bs) <- parseAttrKeys - Modern attrs <$> parseInnerEddsa name buildKey bs + (attrs, bs, mPub) <- parseAttrKeys v2 + Modern attrs mPub <$> parseInnerEddsa name buildKey bs parseInnerEddsa :: Monoid e => String @@ -697,21 +782,27 @@ CryptoFailed _ -> throwParseError ("PKCS8: parsed invalid " ++ name ++ " secret key") -skipVersion :: Monoid e => ParseASN1 e () -skipVersion = do +versionASN1S :: ASN1Elem e => Maybe GenericPubKey -> ASN1Stream e +versionASN1S mPub = gIntVal (if isJust mPub then 1 else 0) + +parseVersion :: Monoid e => ParseASN1 e Bool +parseVersion = do IntVal v <- getNext when (v /= 0 && v /= 1) $ throwParseError ("PKCS8: parsed invalid version: " ++ show v) + return (v /= 0) --- todo: ideally should not skip but parse the public key and verify that it --- is consistent with the private key -skipPublicKey :: Monoid e => ParseASN1 e () -skipPublicKey = void (fmap Just parseTaggedPrimitive <|> return Nothing) - where parseTaggedPrimitive = do { Other _ 1 bs <- getNext; return bs } +attrKeysASN1S :: ASN1Elem e => [Attribute] -> Maybe GenericPubKey -> ASN1Stream e +attrKeysASN1S attrs mPub = att . asn1s mPub + where att = attributesASN1S (Container Context 0) attrs -parseAttrKeys :: Monoid e => ParseASN1 e ([Attribute], B.ByteString) -parseAttrKeys = do +parseAttrKeys :: Monoid e + => Bool + -> ParseASN1 e ([Attribute], B.ByteString, Maybe GenericPubKey) +parseAttrKeys v2 = do OctetString bs <- getNext attrs <- parseAttributes (Container Context 0) - skipPublicKey - return (attrs, bs) + mPub <- parse + when (isJust mPub && not v2) $ + throwParseError "PKCS8: public key allowed only for version 2" + return (attrs, bs, mPub) diff --git a/src/Crypto/Store/PubKey/RSA/KEM.hs b/src/Crypto/Store/PubKey/RSA/KEM.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Store/PubKey/RSA/KEM.hs @@ -0,0 +1,93 @@ +-- | +-- Module : Crypto.Store.PubKey.RSA.KEM +-- License : BSD-style +-- Maintainer : Olivier Chéron +-- Stability : experimental +-- Portability : unknown +-- +-- RSA as a Key-Encapsulation Mechanism (KEM). +module Crypto.Store.PubKey.RSA.KEM + ( KDF(..), kdf3 + -- * Operations + , encapsulate, encapsulateWith, decapsulate + ) where + +import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes) +import qualified Data.ByteArray as B +import Data.ByteString (ByteString, empty) + +import Crypto.Hash +import Crypto.Number.Generate +import Crypto.Number.Serialize (os2ip, i2ospOf_) +import qualified Crypto.PubKey.RSA.Prim as RSA +import qualified Crypto.PubKey.RSA.Types as RSA +import Crypto.Random + +-- | Key derivation used by RSA-KEM. +newtype KDF bIn bOut = KDF (ByteString -> bIn -> bOut) + +-- | KDF3 from ANSI X9.44-2007 (R2017) +kdf3 :: (HashAlgorithm a, ByteArrayAccess bIn, ByteArray bOut) + => a -> Int -> KDF bIn bOut +kdf3 hashAlg outLen = KDF (doKDF3 hashAlg outLen) + +doKDF3 :: (HashAlgorithm a, ByteArrayAccess bIn, ByteArray bOut) + => a -> Int -> ByteString -> bIn -> bOut +doKDF3 hashAlg outLen otherInfo input + | r == 0 = B.concat $ map doChunk [ 1 .. k ] + | otherwise = B.take outLen $ B.concat $ map doChunk [ 1 .. k + 1 ] + where + (k, r) = outLen `divMod` blk + blk = hashDigestSize hashAlg + doChunk i = + let ctx0 = hashInitWith hashAlg + ctx1 = hashUpdate ctx0 (i2ospOf_ 4 (toInteger i) :: Bytes) + ctx2 = hashUpdate ctx1 input + ctx3 = hashUpdate ctx2 otherInfo + in hashFinalize ctx3 + +-- | Generate a shared secret key and an associated ciphertext using randomness. +encapsulate :: (MonadRandom m, ByteArray ciphertext) + => KDF ciphertext sharedSecret + -> RSA.PublicKey + -> m (sharedSecret, ciphertext) +encapsulate kdf pub = encap kdf pub <$> generateMax (RSA.public_n pub) + +-- | Generate a shared secret key and an associated ciphertext using a +-- specified random input. This input must be an integer in range [0, n) and +-- not repeated with other encapsulations. For testing purposes. +encapsulateWith :: ByteArray ciphertext + => KDF ciphertext sharedSecret + -> RSA.PublicKey + -> Integer + -> Maybe (sharedSecret, ciphertext) +encapsulateWith kdf pub z + | z < 0 || z >= RSA.public_n pub = Nothing + | otherwise = Just $ encap kdf pub z + +encap :: ByteArray ciphertext + => KDF ciphertext sharedSecret + -> RSA.PublicKey + -> Integer + -> (sharedSecret, ciphertext) +encap (KDF kdf) pub z = (ss, ct) + where + zz = i2ospOf_ (RSA.public_size pub) z + ct = RSA.ep pub zz + ss = kdf empty zz + +-- | Return the shared secret for a given ciphertext. +decapsulate :: ByteArray ciphertext + => KDF ciphertext sharedSecret + -> RSA.PrivateKey + -> ciphertext + -> Maybe sharedSecret +decapsulate (KDF kdf) priv ct + | B.length ct < RSA.public_size pub = Nothing + | c >= RSA.public_n pub = Nothing + | otherwise = Just ss + where + pub = RSA.private_pub priv + c = os2ip ct + zz = RSA.dp Nothing priv ct + ss = kdf empty zz diff --git a/src/Crypto/Store/X509.hs b/src/Crypto/Store/X509.hs --- a/src/Crypto/Store/X509.hs +++ b/src/Crypto/Store/X509.hs @@ -83,7 +83,7 @@ accumulate :: [PEM] -> [X509.PubKey] accumulate = rights . map pemToPubKey --- | Read a public key from a 'PEM' element and add it to the accumulator list. +-- | Read a public key from a t'PEM' element and add it to the accumulator list. -- -- This API is modelled after function @pemToKey@ in "Data.X509.Memory". pemToPubKeyAccum :: [Maybe X509.PubKey] -> PEM -> [Maybe X509.PubKey] @@ -93,7 +93,7 @@ Left _ -> Nothing : acc Right pubKey -> Just pubKey : acc --- | Read a public key from a 'PEM' element. +-- | Read a public key from a t'PEM' element. pemToPubKey :: PEM -> Either StoreError X509.PubKey pemToPubKey pem = do asn1 <- mapLeft DecodingError $ decodeASN1' BER (pemContent pem) diff --git a/tests/CMS/Instances.hs b/tests/CMS/Instances.hs --- a/tests/CMS/Instances.hs +++ b/tests/CMS/Instances.hs @@ -364,6 +364,18 @@ , scryptKeyLength = Nothing } +instance Arbitrary KeyDerivationFn where + arbitrary = elements (map HKDF digests ++ map KDF3 digests) + where + digests = [ DigestAlgorithm SHA256 + , DigestAlgorithm SHA384 + , DigestAlgorithm SHA512 + , DigestAlgorithm SHA3_224 + , DigestAlgorithm SHA3_256 + , DigestAlgorithm SHA3_384 + , DigestAlgorithm SHA3_512 + ] + instance Arbitrary KeyTransportParams where arbitrary = oneof [ pure RSAES @@ -425,7 +437,7 @@ return (envFns, devFn) where len = B.length cek - onePair = oneof [ arbitraryKT, arbitraryKA, arbitraryKEK, arbitraryPW ] + onePair = oneof [ arbitraryKT, arbitraryKA, arbitraryKEK, arbitraryPW, arbitraryKEM ] arbitraryKT = do (pub, priv) <- arbitraryLargeRSA @@ -460,6 +472,14 @@ let es = PWRIKEK cea return (forPasswordRecipient pwd kdf es, withRecipientPassword pwd) + arbitraryKEM = do + (cert, pair, params) <- arbitraryKEMParams + kdf <- arbitrary + kep <- arbitraryAlg + let envFn = forKeyEncapRecipient cert kdf kep params + devFn = withRecipientKeyEncap pair cert + return (envFn, devFn) + arbitraryAlg | len == 24 = oneof [ return AES128_WRAP , return AES192_WRAP @@ -489,6 +509,13 @@ , arbitraryCredX448 ] + arbitraryKEMParams = arbitraryCredRSA >>= rsaKemToKEM + + rsaKemToKEM (cert, pair) = do + kdf <- arbitrary + keyLen <- choose (8,32) + return (cert, pair, KeyEncapsulationRSA kdf keyLen) + arbitraryCredNamedEC = do (pub, priv) <- arbitraryNamedEC let pair = keyPairFromPrivKey (PrivKeyEC priv) @@ -505,6 +532,12 @@ (pub, priv) <- arbitraryX448 let pair = keyPairFromPrivKey (PrivKeyX448 priv) cert <- arbitrarySignedCertificate (PubKeyX448 pub) + return (cert, pair) + + arbitraryCredRSA = do + (pub, priv) <- arbitraryRSA + let pair = keyPairFromPrivKey (PrivKeyRSA priv) + cert <- arbitrarySignedCertificate (PubKeyRSA pub) return (cert, pair) -- key wrapping in PWRIKEK is incompatible with CTR mode or HKDF key diff --git a/tests/CMS/Tests.hs b/tests/CMS/Tests.hs --- a/tests/CMS/Tests.hs +++ b/tests/CMS/Tests.hs @@ -300,6 +300,25 @@ , "SHA512" ] +rfc9690Tests :: TestTree +rfc9690Tests = testCase "rfc9690" $ do + keys <- readKeyFile path + length keys @?= 1 + certs <- readSignedObject path + length certs @?= 1 + cms <- readCMSFile path + length cms @?= 1 + + let Right pair = recover (fromString "not-used") key + [EnvelopedDataCI envelopedEncapData] = cms + [cert] = certs + [key] = keys + + envelopedData <- fromAttached envelopedEncapData + result <- openEnvelopedData (withRecipientKeyEncap pair cert) envelopedData + result @?= Right (DataCI $ fromString "Hello, world!") + where path = testFile "rfc9690.pem" + propertyTests :: TestTree propertyTests = localOption (QuickCheckMaxSize 5) $ testGroup "properties" [ testProperty "marshalling" $ \l -> @@ -371,5 +390,6 @@ , digestedDataTests , encryptedDataTests , authEnvelopedDataTests + , rfc9690Tests , propertyTests ] diff --git a/tests/PKCS8/Tests.hs b/tests/PKCS8/Tests.hs --- a/tests/PKCS8/Tests.hs +++ b/tests/PKCS8/Tests.hs @@ -95,6 +95,12 @@ , encryptedKeyTests prefix ] +rfc8410Tests :: TestTree +rfc8410Tests = testCase "rfc8410" $ do + keys <- readKeyFile path + length keys @?= 2 + where path = testFile "rfc8410.pem" + propertyTests :: TestTree propertyTests = localOption (QuickCheckMaxSize 5) $ testGroup "properties" [ testProperty "marshalling" $ \fmt l -> @@ -117,5 +123,6 @@ , testType "X448" OnlyOuter "x448" , testType "Ed25519" OnlyOuter "ed25519" , testType "Ed448" OnlyOuter "ed448" + , rfc8410Tests , propertyTests ] diff --git a/tests/X509/Tests.hs b/tests/X509/Tests.hs --- a/tests/X509/Tests.hs +++ b/tests/X509/Tests.hs @@ -44,6 +44,12 @@ fCert = testFile (prefix ++ "-self-signed-cert.pem") fKey = testFile (prefix ++ "-public.pem") +rfc8410Tests :: TestTree +rfc8410Tests = testCase "rfc8410" $ do + keys <- readPubKeyFile path + length keys @?= 1 + where path = testFile "rfc8410.pem" + propertyTests :: TestTree propertyTests = localOption (QuickCheckMaxSize 5) $ testGroup "properties" [ testProperty "marshalling public keys" $ \keys -> @@ -71,5 +77,6 @@ , keyTests "X448" "x448" 1 , keyTests "Ed25519" "ed25519" 1 , keyTests "Ed448" "ed448" 1 + , rfc8410Tests , propertyTests ] diff --git a/tests/files/rfc8410.pem b/tests/files/rfc8410.pem new file mode 100644 --- /dev/null +++ b/tests/files/rfc8410.pem @@ -0,0 +1,19 @@ +-----BEGIN PUBLIC KEY----- +MCowBQYDK2VwAyEAGb9ECWmEzf6FQbrBZ9w7lshQhqowtrbLDFw4rXAxZuE= +-----END PUBLIC KEY----- +-----BEGIN PRIVATE KEY----- +MC4CAQAwBQYDK2VwBCIEINTuctv5E1hK1bbY8fdp+K06/nwoy/HU++CXqI9EdVhC +-----END PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MHICAQEwBQYDK2VwBCIEINTuctv5E1hK1bbY8fdp+K06/nwoy/HU++CXqI9EdVhC +oB8wHQYKKoZIhvcNAQkJFDEPDA1DdXJkbGUgQ2hhaXJzgSEAGb9ECWmEzf6FQbrB +Z9w7lshQhqowtrbLDFw4rXAxZuE= +-----END PRIVATE KEY----- + +same private key with a modified public key: + +-----BEGIN PRIVATE KEY----- +MHICAQEwBQYDK2VwBCIEINTuctv5E1hK1bbY8fdp+K06/nwoy/HU++CXqI9EdVhC +oB8wHQYKKoZIhvcNAQkJFDEPDA1DdXJkbGUgQ2hhaXJzgSEAGb9ECWmEzf6FQbrB +Z9w7lshQhqowtrbLDFw4sXAxZuE= +-----END PRIVATE KEY----- diff --git a/tests/files/rfc9690.pem b/tests/files/rfc9690.pem new file mode 100644 --- /dev/null +++ b/tests/files/rfc9690.pem @@ -0,0 +1,84 @@ +-----BEGIN CMS----- +MIICXAYJKoZIhvcNAQcDoIICTTCCAkkCAQMxggIEpIICAAYLKoZIhvcNAQkQDQMw +ggHvAgEAgBSe62fJuVp01E0vFjlmgOgBtcuknDAJBgcogYxxAgIEBIIBgMBx/Cc6 ++Oe9sVLga/czEDYQdBVKQ6vPPJPBNJnSBlNEPu2e9dPAaF5Kp2poVIFbuXaR/5+N +rBXup9dPRSvzUKZGFj1oKI6XjL96cwie5ScS+aT0ngas57vIWrFNTjNsl8VyiiZU +E4x7JuiDXGsKn77SZJXE6t90Wikzvig/aoixZpX8BmZoc8+202cY7zN2zvwQDDlB +88SUlEB4MlgHpVkYa5XMq/NxTPr3n4O9MFN/3ZrtWkzcvYvQSG+u1z6dSGswh9bI +BlRrbiZxV1yYRh5EH2VUK9ld4m0PU6ZOeEjXMdlgjQU+jTRVRmAthiNv/jcEyYrV +kUTzCJ5ebVJ7VJe6EDx51i6A0CNUELBvcafZvRw4AA+RDWMS6i8go1V1Na0Bswk/ +tffuUHCA0Pd9SMnDs3lva33TeGCF+4lRI/BMofHBviLHR6jfrOMjcPsNVweD4n27 +fnT8qU7jlnb949ipVT2HgiRzbjfhkdq5U8fiKMB61coxIkIcFN69ByqatjAbBgor +gQUQhkgJLAECMA0GCWCGSAFlAwQCAQUAAgEQMAsGCWCGSAFlAwQBBQQYKHguXT15 +SnYWuGP7z8cZt48S3gjPKG4JMDwGCSqGSIb3DQEHATAdBglghkgBZQMEAQIEEEgM +yv66vvrO263eyviId4GAEMbKZdt73Xaw834vq2Jktm0= +-----END CMS----- +-----BEGIN RSA PRIVATE KEY----- +MIIG5AIBAAKCAYEA3ocW14cxncPJ47fnEjBZAyfC2lqapL3ET4jvV6C7gGeVrRQx +WPDwl+cFYBBR2ej3j3/0ecDmu+XuVi2+s5JHKeeza+itfuhsz3yifgeEpeK8T+Su +sHhn20/NBLhYKbh3kiAcCgQ56dpDrDvDcLqqvS3jg/VO+OPnZbofoHOOevt8Q/ro +ahJe1PlIyQ4udWB8zZezJ4mLLfbOA9YVaYXx2AHHZJevo3nmRnlgJXo6mE00E/6q +khjDHKSMdl2WG6mO9TCDZc9qY3cAJDU6Ir0vSH7qUl8/vN13y4UOFkn8hM4kmZ6b +JqbZt5NbjHtY4uQ0VMW3RyESzhrO02mrp39auLNnH3EXdXaV1tk75H3qC7zJaeGW +MJyQfOE3YfEGRKn8fxubji716D8UecAxAzFyFL6m1JiOyV5acAiOpxN14qRYZdHn +XOM9DqGIGpoeY1UuD4Mo05osOqOUpBJHA9fSwhSZG7VNf+vgNWTLNYSYLI04KiMd +ulnvU6ds+QPz+KKtAgMBAAECggGATFfkSkUjjJCjLvDk4aScpSx6+Rakf2hrdS3x +jwqhyUfAXgTTeUQQBs1HVtHCgxQd+qlXYn3/qu8TeZVwG4NPztyi/Z5yB1wOGJEV +3k8N/ytul6pJFFn6p48VM01bUdTrkMJbXERe6g/rr6dBQeeItCaOK7N5SIJH3Oqh +9xYuB5tH4rquCdYLmt17Tx8CaVqU9qPY3vOdQEOwIjjMV8uQUR8rHSO9KkSj8AGs +Lq9kcuPpvgJc2oqMRcNePS2WVh8xPFktRLLRazgLP8STHAtjT6SlJ2UzkUqfDHGK +q/BoXxBDu6L1VDwdnIS5HXtL54ElcXWsoOyKF8/ilmhRUIUWRZFmlS1ok8IC5IgX +UdL9rJVZFTRLyAwmcCEvRM1asbBrhyEyshSOuN5nHJi2WVJ+wSHijeKl1qeLlpMk +HrdIYBq4Nz7/zXmiQphpAy+yQeanhP8O4O6C8e7RwKdpxe44su4Z8fEgA5yQx0u7 +8yR1EhGKydX5bhBLR5Cm1VM7rT2BAoHBAP/+e5gZLNf/ECtEBZjeiJ0VshszOoUq +haUQPA+9Bx9pytsoKm5oQhB7QDaxAvrn8/FUW2aAkaXsaj9F+/q30AYSQtExai9J +fdKKook3oimN8/yNRsKmhfjGOj8hd4+GjX0qoMSBCEVdT+bAjjry8wgQrqReuZnu +oXU85dmb3jvv0uIczIKvTIeyjXE5afjQIJLmZFXsBm09BG87Ia5EFUKly96BOMJh +/QWEzuYYXDqOFfzQtkAefXNFW21Kz4Hw2QKBwQDeiGh4lxCGTjECvG7fauMGlu+q +DSdYyMHif6t6mx57eS16EjvOrlXKItYhIyzW8Kw0rf/CSB2j8ig1GkMLTOgrGIJ1 +0322o50FOr5oOmZPueeR4pOyAP0fgQ8DD1L3JBpY68/8MhYbsizVrR+Ar4jM0f96 +W2bF5Xj3h+fQTDMkx6VrCCQ6miRmBUzH+ZPs5n/lYOzAYrqiKOanaiHy4mjRvlsy +mjZ6z5CG8sISqcLQ/k3Qli5pOY/v0rdBjgwAW/UCgcEAqGVYGjKdXCzuDvf9EpV4 +mpTWB6yIV2ckaPOn/tZi5BgsmEPwvZYZt0vMbu28Px7sSpkqUuBKbzJ4pcy8uC3I +SuYiTAhMiHS4rxIBX3BYXSuDD2RD4vG1+XM0h6jVRHXHh0nOXdVfgnmigPGz3jVJ +B8oph/jD8O2YCk4YCTDOXPEi8Rjusxzro+whvRR+kG0gsGGcKSVNCPj1fNISEte4 +gJId7O1mUAAzeDjn/VaS/PXQovEMolssPPKn9NocbKbpAoHBAJnFHJunl22W/lrr +ppmPnIzjI30YVcYOA5vlqLKyGaAsnfYqP1WUNgfVhq2jRsrHx9cnHQI9Hu442PvI +x+c5H30YFJ4ipE3eRRRmAUi4ghY5WgD+1hw8fqyUW7E7l5LbSbGEUVXtrkU5G64T +UR91LEyMF8OPATdiV/KD4PWYkgaqRm3tVEuCVACDTQkqNsOOi3YPQcm270w6gxfQ +SOEy/kdhCFexJFA8uZvmh6Cp2crczxyBilR/yCxqKOONqlFdOQKBwFbJk5eHPjJz +AYueKMQESPGYCrwIqxgZGCxaqeVArHvKsEDx5whI6JWoFYVkFA8F0MyhukoEb/2x +2qB5T88Dg3EbqjTiLg3qxrWJ2OxtUo8pBP2I2wbl2NOwzcbrlYhzEZ8bJyxZu5i1 +sYILC8PJ4Qzw6jS4Qpm4y1WHz8e/ElW6VyfmljZYA7f9WMntdfeQVqCVzNTvKn6f +hg6GSpJTzp4LV3ougi9nQuWXZF2wInsXkLYpsiMbL6Fz34RwohJtYA== +-----END RSA PRIVATE KEY----- + +adding also a recipient certificate generated with: + + openssl req -new -subj /emailAddress=test@example.com \ + -key tests/files/rfc9690.pem \ + | openssl x509 -req \ + -CA tests/files/rsa-self-signed-cert.pem \ + -CAkey tests/files/rsa-unencrypted-pkcs8.pem \ + -force_pubkey tests/files/rfc9690.pem \ + -set_serial 1 + +-----BEGIN CERTIFICATE----- +MIIC/jCCAmegAwIBAgIBATANBgkqhkiG9w0BAQsFADAhMR8wHQYJKoZIhvcNAQkB +FhB0ZXN0QGV4YW1wbGUuY29tMB4XDTI1MTAyNjA1MzM1NloXDTI1MTEyNTA1MzM1 +NlowITEfMB0GCSqGSIb3DQEJARYQdGVzdEBleGFtcGxlLmNvbTCCAaIwDQYJKoZI +hvcNAQEBBQADggGPADCCAYoCggGBAN6HFteHMZ3DyeO35xIwWQMnwtpamqS9xE+I +71egu4Bnla0UMVjw8JfnBWAQUdno949/9HnA5rvl7lYtvrOSRynns2vorX7obM98 +on4HhKXivE/krrB4Z9tPzQS4WCm4d5IgHAoEOenaQ6w7w3C6qr0t44P1Tvjj52W6 +H6Bzjnr7fEP66GoSXtT5SMkOLnVgfM2XsyeJiy32zgPWFWmF8dgBx2SXr6N55kZ5 +YCV6OphNNBP+qpIYwxykjHZdlhupjvUwg2XPamN3ACQ1OiK9L0h+6lJfP7zdd8uF +DhZJ/ITOJJmemyam2beTW4x7WOLkNFTFt0chEs4aztNpq6d/WrizZx9xF3V2ldbZ +O+R96gu8yWnhljCckHzhN2HxBkSp/H8bm44u9eg/FHnAMQMxchS+ptSYjsleWnAI +jqcTdeKkWGXR51zjPQ6hiBqaHmNVLg+DKNOaLDqjlKQSRwPX0sIUmRu1TX/r4DVk +yzWEmCyNOCojHbpZ71OnbPkD8/iirQIDAQABo0IwQDAdBgNVHQ4EFgQUnutnybla +dNRNLxY5ZoDoAbXLpJwwHwYDVR0jBBgwFoAU/JTTK/+8Q86nWQwPMu+1PpT6Bg4w +DQYJKoZIhvcNAQELBQADgYEAOdp9bzCo2D2IQIrYk1mLwHkJ8IQLd1+3O968DPem +dofgQDm7PwG/+qzmXdNFkU6cJmz+7E70DEsciw50mkzuH5zsKkTe8IbCfJ4oAN5p +M5p495h6r1a678GJJ45ornqe3D0v1mmraCJpV0hK9lO03ph+4nfrof31eW5AVXyN +/Ho= +-----END CERTIFICATE-----