cryptostore 0.4.0.0 → 0.5.0.0

raw patch · 25 files changed

+927/−151 lines, 25 filesdep +crypton-asn1-encodingdep +crypton-asn1-typesdep +crypton-pemdep ~asn1-encodingdep ~crypton-x509dep ~crypton-x509-validationPVP ok

version bump matches the API change (PVP)

Dependencies added: crypton-asn1-encoding, crypton-asn1-types, crypton-pem, time-hourglass

Dependency ranges changed: asn1-encoding, crypton-x509, crypton-x509-validation, hourglass

API changes (from Hackage documentation)

Files

• ChangeLog.md +13/−0
• LICENSE +1/−1
• README.md +59/−0
• cryptostore.cabal +18/−10
• src/Crypto/Store/ASN1/Generate.hs +1/−1
• src/Crypto/Store/ASN1/Parse.hs +1/−1
• src/Crypto/Store/CMS.hs +12/−4
• src/Crypto/Store/CMS/Algorithms.hs +168/−9
• src/Crypto/Store/CMS/Attribute.hs +1/−1
• src/Crypto/Store/CMS/Authenticated.hs +1/−1
• src/Crypto/Store/CMS/Enveloped.hs +206/−33
• src/Crypto/Store/CMS/PEM.hs +2/−2
• src/Crypto/Store/CMS/Signed.hs +4/−5
• src/Crypto/Store/Keys.hs +1/−1
• src/Crypto/Store/PEM.hs +3/−0
• src/Crypto/Store/PKCS12.hs +5/−5
• src/Crypto/Store/PKCS8.hs +165/−74
• src/Crypto/Store/PubKey/RSA/KEM.hs +93/−0
• src/Crypto/Store/X509.hs +2/−2
• tests/CMS/Instances.hs +34/−1
• tests/CMS/Tests.hs +20/−0
• tests/PKCS8/Tests.hs +7/−0
• tests/X509/Tests.hs +7/−0
• tests/files/rfc8410.pem +19/−0
• tests/files/rfc9690.pem +84/−0

@@ -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

@@ -1,4 +1,4 @@-Copyright (c) 2018-2025, Olivier Chéron+Copyright (c) 2018-2026, Olivier Chéron  All rights reserved. 

@@ -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

@@ -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

@@ -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 

@@ -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.

@@ -22,7 +22,9 @@ -- * <https://tools.ietf.org/html/rfc8418 RFC 8418>: Use of the Elliptic Curve Diffie-Hellman Key Agreement Algorithm with X25519 and X448 in the Cryptographic Message Syntax (CMS) -- * <https://tools.ietf.org/html/rfc8419 RFC 8419>: Use of Edwards-Curve Digital Signature Algorithm (EdDSA) Signatures in the Cryptographic Message Syntax (CMS) -- * <https://tools.ietf.org/html/rfc8702 RFC 8702>: Use of the SHAKE One-Way Hash Functions in the Cryptographic Message Syntax (CMS)+-- * <https://tools.ietf.org/html/rfc9629 RFC 9629>: Using Key Encapsulation Mechanism (KEM) Algorithms in the Cryptographic Message Syntax (CMS) -- * <https://tools.ietf.org/html/rfc9688 RFC 9688>: Use of the SHA3 One-Way Hash Functions in the Cryptographic Message Syntax (CMS)+-- * <https://tools.ietf.org/html/rfc9690 RFC 9690>: Use of the RSA-KEM Algorithm in the Cryptographic Message Syntax (CMS) -- * <https://tools.ietf.org/html/rfc9709 RFC 9709>: 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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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)

@@ -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

@@ -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'. --

@@ -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 

@@ -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.

@@ -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)

@@ -0,0 +1,93 @@+-- |+-- Module      : Crypto.Store.PubKey.RSA.KEM+-- License     : BSD-style+-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>+-- 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

@@ -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)

@@ -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

@@ -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         ]

@@ -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         ]

@@ -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         ]

@@ -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-----

@@ -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-----