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 @@ -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 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.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 diff --git a/tests/Tests/Encryption.hs b/tests/Tests/Encryption.hs --- a/tests/Tests/Encryption.hs +++ b/tests/Tests/Encryption.hs @@ -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