hOpenPGP 3.6.8 → 3.6.9
raw patch · 6 files changed
+87/−62 lines, 6 files
Files
- Codec/Encryption/OpenPGP/Encrypt.hs +1/−27
- Codec/Encryption/OpenPGP/Internal.hs +9/−2
- Codec/Encryption/OpenPGP/Serialize.hs +5/−17
- Codec/Encryption/OpenPGP/Signatures.hs +5/−14
- hOpenPGP.cabal +2/−2
- tests/Tests/Encryption.hs +65/−0
Codec/Encryption/OpenPGP/Encrypt.hs view
@@ -1638,11 +1638,7 @@ RecipientCapabilityNegotiationOn -> case seipdVersion of SEIPDv2 ->- negotiateAEADAlgorithmWithSymmetric- messagePolicy- targets- symOverride- >>= \aead -> Right (symOverride, aead)+ negotiateCiphersuite messagePolicy targets SEIPDv1 -> Right ( symOverride@@ -1703,28 +1699,6 @@ ] in nubOrd (supportedPreferred ++ [implicitSEIPDv2Ciphersuite]) Nothing -> [implicitSEIPDv2Ciphersuite]--negotiateAEADAlgorithmWithSymmetric- :: MessageEncryptionPolicy- -> [RecipientEncryptionTarget]- -> SymmetricAlgorithm- -> Either PKESKEncryptError AEADAlgorithm-negotiateAEADAlgorithmWithSymmetric messagePolicy targets symOverride =- chooseCommonAlgorithm- recipientChoices- (RecipientCapabilityNoCommonAEADAlgorithms [])- where- supportedAEADSet = supportedSEIPDv2AEADAlgorithms- recipientChoices = map choicesForTarget targets- choicesForTarget target =- case recipientEncryptionTargetCapabilities target of- Just caps ->- let preferred = recipientCapabilityPreferredCiphersuites caps- matching = [a | (s, a) <- preferred, s == symOverride]- supportedMatching = [a | a <- matching, a `Set.member` supportedAEADSet]- in nubOrd- (supportedMatching ++ [messageDefaultAEADAlgorithm messagePolicy])- Nothing -> [messageDefaultAEADAlgorithm messagePolicy] negotiateSymmetricAlgorithmWithAEADOverride :: MessageEncryptionPolicy
Codec/Encryption/OpenPGP/Internal.hs view
@@ -70,8 +70,15 @@ leftPadTo :: Int -> B.ByteString -> B.ByteString leftPadTo targetLen bs- | B.length bs >= targetLen = bs- | otherwise = B.replicate (targetLen - B.length bs) 0 <> bs+ | B.length bs > targetLen =+ error+ ( "byte string length "+ ++ show (B.length bs)+ ++ " exceeds target "+ ++ show targetLen+ )+ | otherwise =+ B.replicate (targetLen - B.length bs) 0 <> bs checksum16 :: B.ByteString -> Word16 checksum16 =
Codec/Encryption/OpenPGP/Serialize.hs view
@@ -2326,11 +2326,11 @@ putPubkeyV6 :: PKey -> Put putPubkeyV6 (EdDSAPubKey P.EdSigningCurve25519 (NativeEPoint (EPoint x))) = do- let bs = fixedLengthOctets 32 x+ let bs = leftPadTo 32 (i2osp x) putWord32be . fromIntegral . B.length $ bs putByteString bs putPubkeyV6 (EdDSAPubKey P.EdSigningCurve448 (NativeEPoint (EPoint x))) = do- let bs = fixedLengthOctets 57 x+ let bs = leftPadTo 57 (i2osp x) putWord32be . fromIntegral . B.length $ bs putByteString bs putPubkeyV6@@ -2339,7 +2339,7 @@ kha ksa ) = do- let bs = fixedLengthOctets 32 x+ let bs = leftPadTo 32 (i2osp x) putWord32be . fromIntegral . B.length $ bs putByteString bs put kha@@ -2350,7 +2350,7 @@ kha ksa ) = do- let bs = fixedLengthOctets 56 x+ let bs = leftPadTo 56 (i2osp x) putWord32be . fromIntegral . B.length $ bs putByteString bs put kha@@ -2366,18 +2366,6 @@ putByteString bs putPubkeyV6 p = putPubkey p -fixedLengthOctets :: Int -> Integer -> B.ByteString-fixedLengthOctets targetLen x =- let bs = i2osp x- in if B.length bs > targetLen- then- error- ( "public key element does not fit in "- ++ show targetLen- ++ " octets"- )- else B.replicate (targetLen - B.length bs) 0 <> bs- validatePrefixedNativePoint :: Int -> String -> Integer -> Get EPoint validatePrefixedNativePoint targetLen label i =@@ -2707,7 +2695,7 @@ putPubkeyV4Fixed :: Int -> P.EdSigningCurve -> PKey -> Put putPubkeyV4Fixed targetLen expectedCurve (EdDSAPubKey curve (NativeEPoint (EPoint x))) | curve == expectedCurve =- putByteString (fixedLengthOctets targetLen x)+ putByteString (leftPadTo targetLen (i2osp x)) putPubkeyV4Fixed _ _ pk = putPubkey pk getSKAddendum :: SomePKPayload -> Get SKAddendum
Codec/Encryption/OpenPGP/Signatures.hs view
@@ -1222,7 +1222,7 @@ Right ep -> case cf2es ( Ed25519.signature- (pad32 (i2osp (unMPI r)) <> pad32 (i2osp (unMPI s)))+ (leftPadTo 32 (i2osp (unMPI r)) <> leftPadTo 32 (i2osp (unMPI s))) ) of Left err -> verificationError (SignatureEncodingInvalidCrypto sigPka err)@@ -1248,7 +1248,7 @@ Right ep -> case cf2es ( Ed448.signature- (padN 57 (i2osp (unMPI r)) <> padN 57 (i2osp (unMPI s)))+ (leftPadTo 57 (i2osp (unMPI r)) <> leftPadTo 57 (i2osp (unMPI s))) ) of Left err -> verificationError (SignatureEncodingInvalidCrypto sigPka err)@@ -1275,16 +1275,8 @@ exactLengthPublic expectedLen label bs | B.length bs == expectedLen = Right bs | otherwise = Left (BadLength label expectedLen (B.length bs))- pad32 bs =- let l = B.length bs- in if l >= 32- then bs- else B.replicate (32 - l) 0 <> bs- padN n bs =- let l = B.length bs- in if l >= n- then bs- else B.replicate (n - l) 0 <> bs+ pad32 bs = leftPadTo 32 bs+ padN n bs = leftPadTo n bs cf2es = eitherCryptoError rsaVerify pub mpis hd pkey bs = if P15.verify (Just hd) pkey bs (rsaMPItoSig pkey mpis)@@ -1295,8 +1287,7 @@ rsaMPItoSig pkey (s :| []) = let sz = RSATypes.public_size pkey raw = i2osp (unMPI s)- pad = sz - B.length raw- in B.replicate pad 0 <> raw+ in leftPadTo sz raw crazyHash h = BA.convert . hashWith h isSignatureExpired
hOpenPGP.cabal view
@@ -1,6 +1,6 @@ Cabal-version: 3.4 Name: hOpenPGP-Version: 3.6.8+Version: 3.6.9 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@@ -347,4 +347,4 @@ source-repository this type: git location: https://salsa.debian.org/clint/hOpenPGP.git- tag: v3.6.8+ tag: v3.6.9
tests/Tests/Encryption.hs view
@@ -780,6 +780,9 @@ "encryptForRecipients falls back to SEIPDv1 when recipients do not advertise SEIPDv2 support" testEncryptRecipientsSEIPDv2FallsBackWhenRecipientsDoNotAdvertiseV2 , testCase+ "encryptForRecipients SEIPDv2 ignores symmetricOverride and negotiates from ciphersuites"+ testEncryptRecipientsSEIPDv2IgnoresSymmetricOverride+ , testCase "SEIPDv1 negotiation selects symmetric algorithm from PreferredSymmetricAlgorithms ignoring ciphersuites" testEncryptRecipientsSEIPDv1NegotiatesSymmetricAlgorithmIgnoringAEADCiphersuites , testCase@@ -3558,6 +3561,68 @@ assertFailure "Expected SEIPDv1 fallback when recipients do not advertise SEIPDv2 support" other -> assertFailure ("Unexpected SEIPD packets: " ++ show other)++testEncryptRecipientsSEIPDv2IgnoresSymmetricOverride+ :: Assertion+testEncryptRecipientsSEIPDv2IgnoresSymmetricOverride = do+ (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+ let v6Recipient = setKeyVersion V6 baseRecipient+ v6Caps =+ RecipientCapabilities+ { recipientCapabilityKeyVersion = V6+ , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient+ , recipientCapabilityKeyFlags = Set.empty+ , recipientCapabilityFeatures =+ Set.fromList [FeatureSEIPDv1, FeatureSEIPDv2]+ , recipientCapabilityPreferredSymmetricAlgorithms = []+ , recipientCapabilityPreferredCiphersuites = [(AES128, OCB)]+ }+ request =+ RecipientEncryptRequest+ { recipientEncryptRequestTargets =+ [recipientEncryptionTargetWithCapabilities v6Recipient v6Caps]+ , recipientEncryptRequestPayloadShape =+ defaultRecipientPayloadShape+ , recipientEncryptRequestPayload =+ "seipd v2 symmetric override ignored payload"+ , recipientEncryptRequestSymmetricOverride = Just AES256+ , recipientEncryptRequestOverrides =+ RecipientEncryptRequestSEIPDv2Overrides+ { recipientEncryptRequestAEADOverride = Nothing+ , recipientEncryptRequestChunkSizeOverride = Just 6+ , recipientEncryptRequestSaltOverride =+ Just (Salt (B.replicate 32 0x29))+ }+ }+ result <-+ encryptForRecipientsWithCapabilityNegotiation+ RecipientCapabilityNegotiationOn+ request+ case result of+ Left err ->+ assertFailure+ ( "Expected SEIPDv2 negotiation to ignore symmetricOverride and succeed, got "+ ++ show err+ )+ Right+ RecipientEncryptResult+ { recipientEncryptPackets = packets+ , recipientEncryptSessionMaterial = material+ } -> do+ assertEqual+ "SEIPDv2 negotiation should ignore symmetricOverride and select symmetric from ciphersuite"+ AES128+ (pkeskSessionAlgorithm material)+ case [ aa+ | SymEncIntegrityProtectedDataPkt (SEIPD2 _ aa _ _ _) <- packets+ ] of+ [selectedAEAD] ->+ assertEqual+ "SEIPDv2 negotiation should pick AEAD from common ciphersuite entry"+ OCB+ selectedAEAD+ other ->+ assertFailure ("Expected one SEIPDv2 packet, got " ++ show other) testEncryptRecipientsSEIPDv1NegotiatesSymmetricAlgorithmIgnoringAEADCiphersuites :: Assertion