hOpenPGP 3.6.3 → 3.6.4
raw patch · 3 files changed
+130/−21 lines, 3 files
Files
- Codec/Encryption/OpenPGP/Encrypt.hs +55/−10
- hOpenPGP.cabal +2/−2
- tests/Tests/Encryption.hs +73/−9
Codec/Encryption/OpenPGP/Encrypt.hs view
@@ -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
hOpenPGP.cabal view
@@ -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
tests/Tests/Encryption.hs view
@@ -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