diff --git a/Codec/Encryption/OpenPGP/Encrypt.hs b/Codec/Encryption/OpenPGP/Encrypt.hs --- a/Codec/Encryption/OpenPGP/Encrypt.hs +++ b/Codec/Encryption/OpenPGP/Encrypt.hs @@ -1268,11 +1268,7 @@ encryptForRecipientsWithCapabilityNegotiation RecipientCapabilityNegotiationOn -{- | Encrypt for recipient targets without recipient capability negotiation. - -This preserves legacy behavior by using policy defaults unless request -overrides are provided. --} +{-# DEPRECATED encryptForRecipientsLegacy "use encryptForRecipients" #-} encryptForRecipientsLegacy :: MonadRandom m => RecipientEncryptRequest v @@ -1308,7 +1304,7 @@ pkeskPkts <- ExceptT $ buildPKESKPktsForRecipientTargetsWithSelectorTyped - (recipientVersionStrategyForProfileTyped profileW) + effectiveSelector targets sessionMaterial buildEncryptedPayload @@ -1341,9 +1337,29 @@ case recipientEncryptRequestOverrides request of RecipientEncryptRequestSEIPDv1Overrides {} -> SEIPDv1 RecipientEncryptRequestSEIPDv2Overrides {} -> - if null (recipientsMissingSEIPDv2Support targets) + if null + ( recipientsRequiringV3PKESK targets + ++ recipientsMissingSEIPDv2Support targets + ) then SEIPDv2 else SEIPDv1 + -- \| Per-message PKESK version coerced to the resolved SEIPD version. + -- + -- RFC 9580 §10.3.2.1 requires a uniform PKESK version per message, paired + -- with the envelope protection version (all PKESKv6 with a v2 SEIPD, all + -- PKESKv3 with a v1 SEIPD). The per-recipient strategy is a capability + -- hint used only to compute the aggregate above; the actual PKESK packets + -- are forced to the aggregate's version here so the two never diverge. + effectiveSelector + :: RecipientEncryptionTarget + -> Either PKESKEncryptError SomeRecipientPKESKVersionStrategyW + effectiveSelector _ = + case seipdVersion of + SEIPDv1 -> + Right + (SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW) + SEIPDv2 -> + Right (SomeRecipientPKESKVersionStrategyW RecipientPreferV6W) buildEncryptedPayload :: MonadRandom m => RecipientEncryptRequest v @@ -1359,8 +1375,8 @@ { recipientEncryptRequestChunkSizeOverride = chunkSizeOverride , recipientEncryptRequestSaltOverride = saltOverride } -> - case recipientsMissingSEIPDv2Support targets of - [] -> do + case seipdVersion of + SEIPDv2 -> do salt <- lift $ maybe (Salt <$> getRandomBytes 32) pure saltOverride let chunkSize = @@ -1386,7 +1402,7 @@ pkeskPkts (recipientEncryptRequestPayload request) ) - _missingSEIPDv2 -> + SEIPDv1 -> case recipientsMissingSEIPDv1Support targets of [] -> do pkts <- @@ -1475,6 +1491,35 @@ recipientsMissingSEIPDv2Support = map recipientEncryptionTargetKey . filter (not . targetAdvertisesSEIPDv2Support) + + -- \| Recipients that force a v1 (PKESKv3 + SEIPDv1) message because they + -- cannot be served by a v6 PKESK. Capability-advertising recipients are + -- decided by 'recipientsMissingSEIPDv2Support'; this covers the remaining + -- cases an explicit v3 hint or an auto-detected v3-only key with no + -- capability hints (RFC 9580 §10.3.2.1 demands a uniform PKESK version). + recipientsRequiringV3PKESK + :: [RecipientEncryptionTarget] -> [SomePKPayload] + recipientsRequiringV3PKESK = + map recipientEncryptionTargetKey + . filter + ( \target -> + case recipientEncryptionTargetStrategy target of + Just RecipientForceV3Interop -> True + Just RecipientPreferV6 -> False + Nothing -> + case recipientEncryptionTargetCapabilities target of + Just _ -> False + Nothing -> + case recipientVersionStrategyForProfileTyped + profileW + target of + Right + ( SomeRecipientPKESKVersionStrategyW + RecipientForceV3InteropW + ) -> + True + _ -> False + ) targetAdvertisesSEIPDv1Support :: RecipientEncryptionTarget -> Bool diff --git a/hOpenPGP.cabal b/hOpenPGP.cabal --- a/hOpenPGP.cabal +++ b/hOpenPGP.cabal @@ -1,6 +1,6 @@ Cabal-version: 3.4 Name: hOpenPGP -Version: 3.6.3 +Version: 3.6.4 Synopsis: native Haskell implementation of OpenPGP (RFC9580) Description: native Haskell implementation of OpenPGP (RFC9580), with some backwards compatibility Homepage: https://salsa.debian.org/clint/hOpenPGP @@ -346,4 +346,4 @@ source-repository this type: git location: https://salsa.debian.org/clint/hOpenPGP.git - tag: v3.6.3 + tag: v3.6.4 diff --git a/tests/Tests/Encryption.hs b/tests/Tests/Encryption.hs --- a/tests/Tests/Encryption.hs +++ b/tests/Tests/Encryption.hs @@ -737,9 +737,12 @@ "encrypt-side profile helper honors recipient capability hints" testRecipientVersionStrategyForProfileHonorsHints , testCase - "encryptForRecipients auto-detects mixed recipient PKESK strategies" - testEncryptRecipientsWithRequestAutoDetectsMixedRecipientStrategies + "encryptForRecipients auto-demotes to SEIPDv1 when any recipient requires v3 PKESK" + testEncryptRecipientsAutoDemotesToSEIPDv1WhenAnyRecipientRequiresV3PKESK , testCase + "encryptForRecipients keeps SEIPDv2 when all recipients prefer v6" + testEncryptRecipientsKeepsSEIPDv2WhenAllRecipientsPreferV6 + , testCase "encryptForRecipients negotiates symmetric algorithm from recipient capabilities when enabled" testEncryptRecipientsNegotiatesSymmetricAlgorithmWhenEnabled , testCase @@ -2637,9 +2640,9 @@ assertFailure "Expected strict profile auto-detect to force v3 for legacy recipients, got non-Right result" -testEncryptRecipientsWithRequestAutoDetectsMixedRecipientStrategies +testEncryptRecipientsAutoDemotesToSEIPDv1WhenAnyRecipientRequiresV3PKESK :: Assertion -testEncryptRecipientsWithRequestAutoDetectsMixedRecipientStrategies = do +testEncryptRecipientsAutoDemotesToSEIPDv1WhenAnyRecipientRequiresV3PKESK = do (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner let v4Recipient = setKeyVersion V4 baseRecipient v6Recipient = setKeyVersion V6 baseRecipient @@ -2665,17 +2668,78 @@ case result of Left err -> assertFailure - ( "Expected mixed-recipient request to encrypt successfully, got " + ( "Expected mixed-recipient request to demote to SEIPDv1, got " ++ show err ) Right RecipientEncryptResult {recipientEncryptPackets = packets} -> do let pkesks = [p | PKESKPkt p <- packets] assertBool - "strict profile auto-detect should emit PKESKv6 for v6 recipients" - (any isPKESK6 pkesks) + "a v3-only recipient forces a uniform v1 message (no PKESKv6)" + (not (any isPKESK6 pkesks)) assertBool - "strict profile auto-detect should emit PKESKv3 for v4 recipients" - (any isPKESK3 pkesks) + "a v3-only recipient forces a uniform v1 message (all PKESKv3)" + (all isPKESK3 pkesks) + let seipdPkts = [p | SymEncIntegrityProtectedDataPkt p <- packets] + case seipdPkts of + [SEIPD1 1 _] -> pure () + other -> + assertFailure + ( "Expected exactly one SEIPD1 packet, got " + ++ show other + ) + where + isPKESK6 PKESKPayloadV6Packet {} = True + isPKESK6 _ = False + isPKESK3 PKESKPayloadV3Packet {} = True + isPKESK3 _ = False + +testEncryptRecipientsKeepsSEIPDv2WhenAllRecipientsPreferV6 + :: Assertion +testEncryptRecipientsKeepsSEIPDv2WhenAllRecipientsPreferV6 = do + (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner + let v6Recipient1 = setKeyVersion V6 baseRecipient + v6Recipient2 = setKeyVersion V6 baseRecipient + request = + RecipientEncryptRequest + { recipientEncryptRequestTargets = + [ recipientEncryptionTarget v6Recipient1 + , recipientEncryptionTarget v6Recipient2 + ] + , recipientEncryptRequestPayloadShape = + defaultRecipientPayloadShape + , recipientEncryptRequestPayload = "all recipients prefer v6" + , recipientEncryptRequestSymmetricOverride = Just AES256 + , recipientEncryptRequestOverrides = + RecipientEncryptRequestSEIPDv2Overrides + { recipientEncryptRequestAEADOverride = Just OCB + , recipientEncryptRequestChunkSizeOverride = Just 6 + , recipientEncryptRequestSaltOverride = + Just (Salt (B.replicate 32 0x55)) + } + } + result <- encryptForRecipients request + case result of + Left err -> + assertFailure + ( "Expected all-v6 recipients to keep SEIPDv2, got " + ++ show err + ) + Right RecipientEncryptResult {recipientEncryptPackets = packets} -> do + let pkesks = [p | PKESKPkt p <- packets] + assertBool + "all v6 recipients must emit only PKESKv6" + (all isPKESK6 pkesks) + assertBool + "all v6 recipients must not emit any PKESKv3" + (not (any isPKESK3 pkesks)) + let seipdPkts = [p | SymEncIntegrityProtectedDataPkt p <- packets] + case seipdPkts of + [SEIPD2 {}] -> pure () + other -> + assertFailure + ( "Expected exactly one SEIPD2 packet, got " + ++ show other + ) where isPKESK6 PKESKPayloadV6Packet {} = True isPKESK6 _ = False