hOpenPGP 3.6.4 → 3.6.5
raw patch · 3 files changed
+361/−2 lines, 3 files
Files
- Codec/Encryption/OpenPGP/Encrypt.hs +80/−0
- hOpenPGP.cabal +2/−2
- tests/Tests/Encryption.hs +279/−0
Codec/Encryption/OpenPGP/Encrypt.hs view
@@ -1150,6 +1150,8 @@ RSA -> buildRsaPKESKv3 recipient material DeprecatedRSAEncryptOnly -> buildRsaPKESKv3 recipient material ECDH -> buildECDHPKESKv3 recipient material+ X25519 -> buildX25519PKESKv3 recipient material+ X448 -> buildX448PKESKv3 recipient material pka -> pure (Left (UnsupportedRecipientAlgorithm pka)) -- | Build a legacy PKESKv3 packet for v4/v3 RSA recipient interop.@@ -2372,6 +2374,84 @@ X448 (EncryptedSessionKey esk) )++buildX25519PKESKv3+ :: MonadRandom m+ => SomePKPayload+ -> PKESKV3SessionMaterial+ -> m (Either PKESKEncryptError PKESKPayloadV3)+buildX25519PKESKv3 recipient material =+ case eightOctetKeyID recipient of+ Left err ->+ pure+ (Left (InvalidRecipientKeyMaterialKeyId X25519 err))+ Right eoki -> do+ ephSecretRaw <- getRandomBytes 32+ pure $+ do+ recipientPublic <- extractX25519RecipientPublic recipient+ ephSecret <-+ first (RecipientKeyWrapFailureCrypto X25519)+ . CE.eitherCryptoError+ $ C25519.secretKey (leftPadTo 32 ephSecretRaw)+ recipientPub <-+ first (RecipientKeyWrapFailureCrypto X25519)+ . CE.eitherCryptoError+ $ C25519.publicKey recipientPublic+ let ephPublicBytes = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+ sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+ kek = deriveX25519Kek ephPublicBytes recipientPublic sharedSecret+ wrapped <-+ first (RecipientKeyWrapFailureCipher X25519)+ . aesKeyWrapRFC3394 AES128 kek+ . padToMultipleOf8+ $ unPKESKV3SessionMaterial material+ Right+ ( PKESKPayloadV3+ 3+ eoki+ X25519+ (MPI (os2ip ephPublicBytes) :| [MPI (os2ip wrapped)])+ )++buildX448PKESKv3+ :: MonadRandom m+ => SomePKPayload+ -> PKESKV3SessionMaterial+ -> m (Either PKESKEncryptError PKESKPayloadV3)+buildX448PKESKv3 recipient material =+ case eightOctetKeyID recipient of+ Left err ->+ pure+ (Left (InvalidRecipientKeyMaterialKeyId X448 err))+ Right eoki -> do+ ephSecretRaw <- getRandomBytes 56+ pure $+ do+ recipientPublic <- extractX448RecipientPublic recipient+ ephSecret <-+ first (RecipientKeyWrapFailureCrypto X448)+ . CE.eitherCryptoError+ $ C448.secretKey (leftPadTo 56 ephSecretRaw)+ recipientPub <-+ first (RecipientKeyWrapFailureCrypto X448)+ . CE.eitherCryptoError+ $ C448.publicKey recipientPublic+ let ephPublicBytes = BA.convert (C448.toPublic ephSecret) :: B.ByteString+ sharedSecret = BA.convert (C448.dh recipientPub ephSecret) :: B.ByteString+ kek = deriveX448Kek ephPublicBytes recipientPublic sharedSecret+ wrapped <-+ first (RecipientKeyWrapFailureCipher X448)+ . aesKeyWrapRFC3394 AES256 kek+ . padToMultipleOf8+ $ unPKESKV3SessionMaterial material+ Right+ ( PKESKPayloadV3+ 3+ eoki+ X448+ (MPI (os2ip ephPublicBytes) :| [MPI (os2ip wrapped)])+ ) buildEcdhV6Esk :: SomePKPayload
hOpenPGP.cabal view
@@ -1,6 +1,6 @@ Cabal-version: 3.4 Name: hOpenPGP-Version: 3.6.4+Version: 3.6.5 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.4+ tag: v3.6.5
tests/Tests/Encryption.hs view
@@ -722,6 +722,12 @@ "encrypt-side PKESKv3 builder supports RFC6637 Curve25519Legacy recipients" testBuildPKESKv3PayloadForRecipientCurve25519LegacyInterop , testCase+ "encrypt-side PKESKv3 builder supports v6 X25519 recipients"+ testBuildPKESKv3PayloadForRecipientV6X25519+ , testCase+ "encrypt-side PKESKv3 builder supports v6 X448 recipients"+ testBuildPKESKv3PayloadForRecipientV6X448+ , testCase "encrypt-side PKESKv3 builder rejects non-RFC6637 Curve448Legacy recipients" testBuildPKESKv3PayloadForRecipientRejectsCurve448Legacy , testCase@@ -740,6 +746,12 @@ "encryptForRecipients auto-demotes to SEIPDv1 when any recipient requires v3 PKESK" testEncryptRecipientsAutoDemotesToSEIPDv1WhenAnyRecipientRequiresV3PKESK , testCase+ "encryptForRecipients auto-demotes to SEIPDv1 when v6 X25519 recipient requires v3 PKESK"+ testEncryptRecipientsAutoDemotesToSEIPDv1WithV6X25519+ , testCase+ "encryptForRecipients auto-demotes to SEIPDv1 when v6 X448 recipient requires v3 PKESK"+ testEncryptRecipientsAutoDemotesToSEIPDv1WithV6X448+ , testCase "encryptForRecipients keeps SEIPDv2 when all recipients prefer v6" testEncryptRecipientsKeepsSEIPDv2WhenAllRecipientsPreferV6 , testCase@@ -2460,6 +2472,106 @@ ++ show payload ) +testBuildPKESKv3PayloadForRecipientV6X25519 :: Assertion+testBuildPKESKv3PayloadForRecipientV6X25519 = do+ let recipientSecretRaw = B.pack [0xa1 .. 0xc0]+ recipientSecret =+ case CE.eitherCryptoError+ (C25519.secretKey recipientSecretRaw) of+ Left err ->+ error+ ( "failed to initialize X25519 recipient secret key: "+ ++ show err+ )+ Right sk -> sk+ recipientPublicRaw =+ BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+ v4Recipient =+ PKPayload+ V4+ (ThirtyTwoBitTimeStamp 0)+ 0+ X25519+ ( EdDSAPubKey+ EdSigningCurve25519+ (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+ )+ recipient = setKeyVersion V6 v4Recipient+ sessionKey = SessionKey (B.replicate 32 0x26)+ sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+ pkeskPayloadResult <-+ buildPKESKv3PayloadForRecipient+ recipient+ (pkeskV3SessionMaterial sessionMaterial)+ case pkeskPayloadResult of+ Left err ->+ assertFailure+ ( "buildPKESKv3PayloadForRecipient failed for v6 X25519: "+ ++ show err+ )+ Right+ ( PKESKPayloadV3Packet+ (PKESKPayloadV3 _ _ X25519 (ephMPI NE.:| _))+ ) -> do+ let ephemeralBytes = i2osp (unMPI ephMPI)+ assertEqual+ "PKESKv3 v6 X25519 ephemeral must be raw 32 bytes (no 0x40 prefix)"+ 32+ (B.length ephemeralBytes)+ Right other ->+ assertFailure+ ("Expected PKESKPayloadV3 with X25519, got " ++ show other)++testBuildPKESKv3PayloadForRecipientV6X448 :: Assertion+testBuildPKESKv3PayloadForRecipientV6X448 = do+ let recipientSecretRaw = B.pack [0xa1 .. 0xd8]+ recipientSecret =+ case CE.eitherCryptoError+ (C448.secretKey recipientSecretRaw) of+ Left err ->+ error+ ( "failed to initialize X448 recipient secret key: "+ ++ show err+ )+ Right sk -> sk+ recipientPublicRaw =+ BA.convert (C448.toPublic recipientSecret) :: B.ByteString+ v4Recipient =+ PKPayload+ V4+ (ThirtyTwoBitTimeStamp 0)+ 0+ X448+ ( EdDSAPubKey+ EdSigningCurve448+ (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+ )+ recipient = setKeyVersion V6 v4Recipient+ sessionKey = SessionKey (B.replicate 32 0x27)+ sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+ pkeskPayloadResult <-+ buildPKESKv3PayloadForRecipient+ recipient+ (pkeskV3SessionMaterial sessionMaterial)+ case pkeskPayloadResult of+ Left err ->+ assertFailure+ ( "buildPKESKv3PayloadForRecipient failed for v6 X448: "+ ++ show err+ )+ Right+ ( PKESKPayloadV3Packet+ (PKESKPayloadV3 _ _ X448 (ephMPI NE.:| _))+ ) -> do+ let ephemeralBytes = i2osp (unMPI ephMPI)+ assertEqual+ "PKESKv3 v6 X448 ephemeral must be raw 56 bytes (no 0x40 prefix)"+ 56+ (B.length ephemeralBytes)+ Right other ->+ assertFailure+ ("Expected PKESKPayloadV3 with X448, got " ++ show other)+ testBuildPKESKv6PayloadForRecipientX25519RawKeySemantics :: Assertion testBuildPKESKv6PayloadForRecipientX25519RawKeySemantics = do@@ -2692,6 +2804,173 @@ isPKESK6 _ = False isPKESK3 PKESKPayloadV3Packet {} = True isPKESK3 _ = False++testEncryptRecipientsAutoDemotesToSEIPDv1WithV6X25519+ :: Assertion+testEncryptRecipientsAutoDemotesToSEIPDv1WithV6X25519 = do+ (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+ let recipientSecretRaw = B.pack [0x21 .. 0x40]+ recipientSecret =+ case CE.eitherCryptoError+ (C25519.secretKey recipientSecretRaw) of+ Left err ->+ error+ ( "failed to initialize X25519 recipient secret key: "+ ++ show err+ )+ Right sk -> sk+ recipientPublicRaw =+ BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+ v6X25519Recipient =+ setKeyVersion+ V6+ ( PKPayload+ V4+ (ThirtyTwoBitTimeStamp 0)+ 0+ X25519+ ( EdDSAPubKey+ EdSigningCurve25519+ (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+ )+ )+ v4Recipient = setKeyVersion V4 baseRecipient+ request =+ RecipientEncryptRequest+ { recipientEncryptRequestTargets =+ [ recipientEncryptionTarget v6X25519Recipient+ , recipientEncryptionTarget v4Recipient+ ]+ , recipientEncryptRequestPayloadShape =+ defaultRecipientPayloadShape+ , recipientEncryptRequestPayload = "v6 x25519 demote to v1"+ , recipientEncryptRequestSymmetricOverride = Just AES256+ , recipientEncryptRequestOverrides =+ RecipientEncryptRequestSEIPDv2Overrides+ { recipientEncryptRequestAEADOverride = Just OCB+ , recipientEncryptRequestChunkSizeOverride = Just 6+ , recipientEncryptRequestSaltOverride =+ Just (Salt (B.replicate 32 0x91))+ }+ }+ result <- encryptForRecipients request+ case result of+ Left err ->+ assertFailure+ ( "Expected mixed v6 X25519 + v4 recipient to demote to SEIPDv1, got "+ ++ show err+ )+ Right RecipientEncryptResult {recipientEncryptPackets = packets} -> do+ let pkesks = [p | PKESKPkt p <- packets]+ assertBool+ "v4 RSA should force uniform PKESKv3"+ (all isPKESK3 pkesks)+ assertEqual+ "v6 X25519 recipient should emit a PKESKv3 X25519 packet"+ 2+ (length pkesks)+ assertBool+ "PKESKv3 packets should include X25519 recipient"+ (any isX25519PKESK3 pkesks)+ let seipdPkts = [p | SymEncIntegrityProtectedDataPkt p <- packets]+ case seipdPkts of+ [SEIPD1 1 _] -> pure ()+ other ->+ assertFailure+ ( "Expected exactly one SEIPD1 packet, got "+ ++ show other+ )+ where+ isPKESK3 PKESKPayloadV3Packet {} = True+ isPKESK3 _ = False+ isX25519PKESK3+ ( PKESKPayloadV3Packet+ (PKESKPayloadV3 _ _ X25519 _)+ ) = True+ isX25519PKESK3 _ = False++testEncryptRecipientsAutoDemotesToSEIPDv1WithV6X448 :: Assertion+testEncryptRecipientsAutoDemotesToSEIPDv1WithV6X448 = do+ (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+ let recipientSecretRaw = B.pack [0x21 .. 0x58]+ recipientSecret =+ case CE.eitherCryptoError+ (C448.secretKey recipientSecretRaw) of+ Left err ->+ error+ ( "failed to initialize X448 recipient secret key: "+ ++ show err+ )+ Right sk -> sk+ recipientPublicRaw =+ BA.convert (C448.toPublic recipientSecret) :: B.ByteString+ v6X448Recipient =+ setKeyVersion+ V6+ ( PKPayload+ V4+ (ThirtyTwoBitTimeStamp 0)+ 0+ X448+ ( EdDSAPubKey+ EdSigningCurve448+ (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+ )+ )+ v4Recipient = setKeyVersion V4 baseRecipient+ request =+ RecipientEncryptRequest+ { recipientEncryptRequestTargets =+ [ recipientEncryptionTarget v6X448Recipient+ , recipientEncryptionTarget v4Recipient+ ]+ , recipientEncryptRequestPayloadShape =+ defaultRecipientPayloadShape+ , recipientEncryptRequestPayload = "v6 x448 demote to v1"+ , recipientEncryptRequestSymmetricOverride = Just AES256+ , recipientEncryptRequestOverrides =+ RecipientEncryptRequestSEIPDv2Overrides+ { recipientEncryptRequestAEADOverride = Just OCB+ , recipientEncryptRequestChunkSizeOverride = Just 6+ , recipientEncryptRequestSaltOverride =+ Just (Salt (B.replicate 32 0x92))+ }+ }+ result <- encryptForRecipients request+ case result of+ Left err ->+ assertFailure+ ( "Expected mixed v6 X448 + v4 recipient to demote to SEIPDv1, got "+ ++ show err+ )+ Right RecipientEncryptResult {recipientEncryptPackets = packets} -> do+ let pkesks = [p | PKESKPkt p <- packets]+ assertBool+ "v4 RSA should force uniform PKESKv3"+ (all isPKESK3 pkesks)+ assertEqual+ "v6 X448 recipient should emit a PKESKv3 X448 packet"+ 2+ (length pkesks)+ assertBool+ "PKESKv3 packets should include X448 recipient"+ (any isX448PKESK3 pkesks)+ let seipdPkts = [p | SymEncIntegrityProtectedDataPkt p <- packets]+ case seipdPkts of+ [SEIPD1 1 _] -> pure ()+ other ->+ assertFailure+ ( "Expected exactly one SEIPD1 packet, got "+ ++ show other+ )+ where+ isPKESK3 PKESKPayloadV3Packet {} = True+ isPKESK3 _ = False+ isX448PKESK3+ ( PKESKPayloadV3Packet+ (PKESKPayloadV3 _ _ X448 _)+ ) = True+ isX448PKESK3 _ = False testEncryptRecipientsKeepsSEIPDv2WhenAllRecipientsPreferV6 :: Assertion