-- MessageAndArmor.hs: hOpenPGP test suite
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Tests.MessageAndArmor (messageAndArmorTests) where

import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor(..), ArmorType(..))
import Codec.Encryption.OpenPGP.BlockCipher (keySize)
import Codec.Encryption.OpenPGP.CFB (decryptPreservingNonce, validateSEIPD1MDC)
import Codec.Encryption.OpenPGP.Encrypt (encryptSEIPDv2WithSKESKBlock)
import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)
import Codec.Encryption.OpenPGP.Internal (emptyPSC, lastLD)
import Codec.Encryption.OpenPGP.KeyringParser (parseUnknownTKs)
import Codec.Encryption.OpenPGP.Message
import Codec.Encryption.OpenPGP.Policy (signatureV6SaltSizeForHashAlgorithm)
import Codec.Encryption.OpenPGP.S2K (renderS2KError, string2Key)
import Codec.Encryption.OpenPGP.Serialize
  ( armorPayloadsOfType
  , parsePkts
  , parsePktsEither
  , recommendedArmorType
  , singleClearSignedBlock
  , singleArmorPayloadOfType
  )
import Codec.Encryption.OpenPGP.SerializeForSigs (payloadForSig, payloadForSigWith)
import Codec.Encryption.OpenPGP.Signatures
  ( renderSignError
  , renderVerificationError
  , signCertRevocationWithRSA
  , signCertificationWithRSA
  , signDataWithEd25519
  , signDataWithEd25519V6
  , signDataWithEd448
  , signDataWithEd448V6
  , signDataWithRSA
  , signDataWithRSABuilder
  , signDataWithEd25519Builder
  , signDataWithEd25519V6Builder
  , signDirectKeyWithRSA
  , signKeyRevocationWithRSA
  , signSubkeyRevocationWithRSA
  , SignError(..)
  , verifyAgainstKeyring
  , verifyAgainstKeys
  , verifySigWith
  , VerificationError(..)
  )
import Codec.Encryption.OpenPGP.Subpackets
  ( addHashedSubs
  , addUnhashedSubs
  , listToHashedSubs
  , listToUnhashedSubs
  , sbTextNormMode
  , sigBuilderInit
  , TextNormalizationMode(..)
  )
import Codec.Encryption.OpenPGP.Types
import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.Ed25519 as Ed25519
import Data.Binary (get, put)
import Data.Binary.Get (Get, runGetOrFail)
import Data.Binary.Put (putByteString, putWord16be, putWord32be, putWord8, runPut)
import Data.Bits (xor)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Conduit.OpenPGP.Message (verifyMessage, verifyMessagePackets)
import Data.Conduit.OpenPGP.Verify (VerificationMode(..))
import Data.Either (isLeft, isRight)
import Data.List (isInfixOf)
import qualified Data.List.NonEmpty as NE
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, assertFailure, testCase)
import Tests.Common
  ( addTimestampSeconds
  , assertSingleFailureContainsTimeline
  , assertSingleSignerFingerprint
  , encryptMessageDefault
  , expectV4PKPayload
  , expectV6PKPayload
  , extractV4SignatureAlgorithmFields
  , fp
  , loadAndDecompressPkts
  , loadArmor
  , loadKeyring
  , loadDeterministicEd25519Signer
  , loadDeterministicEd25519SignerV6
  , loadDeterministicEd448Signer
  , loadDeterministicEd448SignerV6
  , loadUnencryptedRsaSigner
  , loadUnencryptedRsaSignerV6
  , messageIssuerSubpacketsAt
  , mkTestKeyring
  , readFixtureLazy
  , setPKAlgorithm
  , signBinaryMessageWithRSAAt
  , signBinaryMessageWithEd25519At
  , signKeyRevocationWithReasonAt
  , signKeyRevocationWithReasonAndExtrasAt
  , signSubkeyBindingWithRSAAt
  , signSubkeyRevocationWithRSAAt
  , verifyTimelinePackets
  )

messageAndArmorTests :: TestTree
messageAndArmorTests =
  testGroup
    "Message API and armor fixtures"
    [ testGroup
        "Message API group"
        [ testCase "default encrypt/decrypt message" testDefaultedEncryptDecrypt
        , testCase "specific encrypt/decrypt message" testExplicitEncryptDecrypt
        , testCase
            "specific encrypt can expose effective session material"
            testExplicitEncryptExposesEffectiveSessionMaterial
        , testCase
            "default encrypt does not expose session material"
            testDefaultEncryptDoesNotExposeSessionMaterial
        , testCase "AES-128 EAX encrypt/decrypt message" testExplicitAES128EAXEncryptDecrypt
        , testCase "AES-128 GCM encrypt/decrypt message" testExplicitAES128GCMEncryptDecrypt
        , testCase
            "specific encrypt rejects deprecated S2K hash in modern mode"
            testExplicitEncryptRejectsDeprecatedS2KHash
        , testCase "legacy fallback encrypt/decrypt message" testLegacyFallbackEncryptDecrypt
        , testCase
            "RFC4880 encryptMessage SEIPDv1 cleartext parses without trailing junk"
            testRFC4880EncryptMessageSEIPDv1ParsesCleanly
        , testCase "decryptMessage returns typed parse failures" testDecryptMessageTypedParseFailure
        , testCase
            "decryptMessage rejects unknown critical packets"
            testDecryptMessageRejectsUnknownCriticalPacket
        , testCase "decryptMessage returns typed decrypt failures" testDecryptMessageTypedDecryptFailure
        , testCase
            "decryptMessage rejects SEIPDv1 MDC tampering"
            testDecryptMessageSEIPDv1MDCTampering
        , testCase "sign message shape" testSignMessageShape
        , testCase "sign message shape (RSA SigV6)" testSignMessageRSAV6
        , testCase "sign message shape (Ed25519)" testSignMessageEd25519
        , testCase "sign message shape (Ed25519 SigV6)" testSignMessageEd25519V6
        , testCase "sign message shape (Ed448)" testSignMessageEd448
        , testCase "sign message shape (Ed448 SigV6)" testSignMessageEd448V6
        , testCase
            "v4 Ed25519/Ed448 signatures use native fixed-width encoding"
            testV4EdSignaturesUseNativeFixedWidthEncoding
        , testCase
            "v4 Ed25519Legacy key parsing rejects missing 0x40 prefix"
            testV4Ed25519LegacyKeyRejectsMissingPrefix
        , testCase
            "detached v4 Ed25519 verification tolerates missing issuer hints"
            testVerifyDetachedEd25519WithoutIssuerHints
        , testCase
            "detached v4 Ed25519 verification tolerates fake issuer hints"
            testVerifyDetachedEd25519WithFakeIssuerHint
        , testCase
            "detached v4 Ed25519 verifyAgainstKeys tolerates missing issuer hints"
            testVerifyDetachedEd25519WithoutIssuerHintsAgainstKeys
        , testCase
            "detached v4 Ed25519 verifyAgainstKeys tolerates fake issuer hints"
            testVerifyDetachedEd25519WithFakeIssuerHintAgainstKeys
        , testCase
            "v4 EdDSA signatures verify with Ed25519 key algorithm identifier"
            testVerifyV4EdDSASignatureWithEd25519KeyAlgorithm
        , testCase "sign message convenience API" testSignMessageConvenience
        , testCase "typed verify surface matches legacy results" testTypedVerifySurfaceMatchesLegacy
        , testCase "strict typed verify rejects tamper" testVerifyMessageStrictRejectsTamper
        , testCase "verifySignedMessage convenience API" testVerifySignedMessageConvenience
        , testCase "signature generation primitives" testSignaturePrimitives
        , testCase
            "typed signature payload coercions"
            testSignatureDataKindsCoercions
        , testCase
            "typed armor payload helpers centralize block selection"
            testTypedArmorPayloadHelpers
        , testCase
            "recommendedArmorType infers canonical armor labels from packets"
            testRecommendedArmorType
        , testCase
            "singleClearSignedBlock validates cleartext signature envelopes"
            testSingleClearSignedBlock
        , testCase
            "canonical text signature payload normalization"
            testCanonicalTextSigPayloadNormalization
        , testCase
            "canonical text signatures normalize during signing"
            testCanonicalTextSignatureSigningPaths
        , testCase
            "text normalization modes (RFC9580Strict vs CleartextCompat)"
            testTextNormalizationModes
        ]
    , testGroup
        "ASCII armor fixture group"
        [ testCase
            "v4-encrypted-secret.pgp.aa decodes as an encrypted v4 secret key"
            testV4EncryptedSecretArmor
        , testCase
            "v4-encrypted.rev.aa decodes as a v4 revocation certificate"
            testV4EncryptedRevocationArmor
        , testCase
            "v4-encrypted.rev.aa SigV4 key-revocation semantics"
            testV4RevocationSignatureSemantics
        , testCase
            "v4-encrypted.rev.aa parses as single revocation TKUnknown"
            (testRevocationArmorParsesAsSingleTransferableKey "v4-encrypted.rev.aa" True)
        , testCase
            "v6.rev.aa decodes as a v6 revocation certificate"
            (testV6RevocationArmor "v6.rev.aa")
        , testCase
            "v6.rev.aa SigV6 salt semantics"
            (testV6RevocationSignatureSaltSemantics "v6.rev.aa")
        , testCase
            "v6.rev.aa forbids legacy Issuer key-id subpackets"
            (testV6RevocationSignatureRejectsLegacyIssuerKeyID "v6.rev.aa")
        , testCase
            "v6.rev.aa parses as single revocation TKUnknown"
            (testRevocationArmorParsesAsSingleTransferableKey "v6.rev.aa" True)
        , testCase
            "v6-encrypted.rev.aa decodes as a v6 revocation certificate"
            (testV6RevocationArmor "v6-encrypted.rev.aa")
        , testCase
            "v6-encrypted.rev.aa SigV6 salt semantics"
            (testV6RevocationSignatureSaltSemantics "v6-encrypted.rev.aa")
        , testCase
            "v6-encrypted.rev.aa forbids legacy Issuer key-id subpackets"
            (testV6RevocationSignatureRejectsLegacyIssuerKeyID "v6-encrypted.rev.aa")
        , testCase
            "v6-encrypted.rev.aa parses as single revocation TKUnknown"
            (testRevocationArmorParsesAsSingleTransferableKey "v6-encrypted.rev.aa" True)
        , testCase
            "msg1.asc decodes as a parseable armored message"
            testMsg1ArmorFixture
        ]
    , testGroup
        "timeline-aware group"
        [ testCase
            "timeline-aware primary soft revocation keeps pre-revocation signatures"
            testSignerTimelineSoftPrimaryRevocation
        , testCase
            "timeline-aware primary hard revocation rejects historical signatures"
            testSignerTimelineHardPrimaryRevocation
        , testCase
            "timeline-aware no-reason primary revocation rejects historical signatures"
            testSignerTimelineNoReasonPrimaryRevocation
        , testCase
            "timeline-aware unknown-reason primary revocation rejects historical signatures"
            testSignerTimelineUnknownReasonPrimaryRevocation
        , testCase
            "timeline-aware non-compromise primary revocation stays historical until effective"
            testSignerTimelineNonCompromisePrimaryRevocationIsHistorical
        , testCase
            "timeline-aware temporary primary revocation expires and restores validity"
            testSignerTimelineTemporaryPrimaryRevocationExpires
        , testCase
            "timeline-aware subkey revocation distinguishes pre/post signatures"
            testSignerTimelineSubkeyRevocation
        ]
  ]

testV4EncryptedSecretArmor :: Assertion
testV4EncryptedSecretArmor = do
  armors <- loadArmor "v4-encrypted-secret.pgp.aa"
  armor <-
    case armors of
      [a] -> pure a
      _ ->
        assertFailure "v4 encrypted secret fixture should contain one armored payload" >>
        fail "expected one armored payload"
  (headers, payload) <-
    case armor of
      Armor ArmorPrivateKeyBlock hs p -> pure (hs, p)
      Armor atype _ _ ->
        assertFailure
          ("v4 encrypted secret fixture should decode as a private key block, got " ++
           show atype) >>
        fail "expected private key block"
      _ ->
        assertFailure "v4 encrypted secret fixture should decode as an armored payload" >>
        fail "expected armored payload"
  assertEqual
    "v4 encrypted secret fixture should keep identifying comments"
    [ ("Comment", "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")
    , ("Comment", "<v4test@example.org>")
    , ("Comment", "v4 Test User")
    ]
    headers
  let packets = parsePkts payload
      userIds = [u | UserIdPkt u <- packets]
      primarySecretKeys = [(pkp, ska) | SecretKeyPkt pkp ska <- packets]
      secretSubkeys = [(pkp, ska) | SecretSubkeyPkt pkp ska <- packets]
  assertEqual
    "v4 encrypted secret fixture should include expected user IDs"
    ["<v4test@example.org>", "v4 Test User"]
    userIds
  assertEqual
    "v4 encrypted secret fixture should contain one primary secret key packet"
    1
    (length primarySecretKeys)
  assertEqual
    "v4 encrypted secret fixture should contain three encrypted secret subkeys"
    3
    (length secretSubkeys)
  case packets of
    (SecretKeyPkt pkp ska:_) -> do
      assertEqual
        "v4 encrypted secret fixture should contain a v4 primary key"
        V4
        (_keyVersion pkp)
      assertEqual
        "v4 encrypted secret fixture should have the expected primary-key fingerprint"
        (fp "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")
        (fingerprint pkp)
      assertEqual
        "v4 encrypted secret fixture should use EdDSA for its primary key"
        EdDSA
        (_pkalgo pkp)
      assertEncryptedS2K "primary key" ska
      mapM_ (assertEncryptedS2K "subkey" . snd) secretSubkeys
      assertEqual
        "v4 encrypted secret fixture should contain two EdDSA subkeys and one ECDH subkey"
        [EdDSA, EdDSA, ECDH]
        (map (_pkalgo . fst) secretSubkeys)
    _ -> assertFailure "v4 encrypted secret fixture should start with a secret key packet"
  where
    assertEncryptedS2K :: String -> SKAddendum -> Assertion
    assertEncryptedS2K testLabel ska =
      case ska of
        SUSSHA1 AES256 (IteratedSalted SHA256 _ iter) _ encryptedPayload -> do
          assertEqual
            (testLabel ++ " should use expected S2K iteration count")
            (IterationCount 65011712)
            iter
          if BL.null encryptedPayload
            then assertFailure (testLabel ++ " should have non-empty encrypted key material")
            else pure ()
        SUUnencrypted _ _ ->
          assertFailure (testLabel ++ " should be encrypted, got unencrypted secret material")
        _ ->
          assertFailure
            (testLabel ++ " should be encrypted with SUSSHA1/AES256/IteratedSalted SHA256")

testV4EncryptedRevocationArmor :: Assertion
testV4EncryptedRevocationArmor = do
  armors <- loadArmor "v4-encrypted.rev.aa"
  armor <-
    case armors of
      [a] -> pure a
      _ ->
        assertFailure "v4 encrypted revocation fixture should contain one armored payload" >>
        fail "expected one armored payload"
  (headers, payload) <-
    case armor of
      Armor ArmorPublicKeyBlock hs p -> pure (hs, p)
      Armor atype _ _ ->
        assertFailure
          ("v4 encrypted revocation fixture should decode as a public key block, got " ++
           show atype) >>
        fail "expected public key block"
      _ ->
        assertFailure
          "v4 encrypted revocation fixture should decode as an armored payload" >>
        fail "expected armored payload"
  assertEqual
    "v4 encrypted revocation fixture should keep identifying comments"
    [ ("Comment", "Revocation certificate for")
    , ("Comment", "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")
    , ("Comment", "<v4test@example.org>")
    , ("Comment", "v4 Test User")
    ]
    headers
  let packets = parsePkts payload
  case packets of
    [PublicKeyPkt pkp, SignaturePkt _] -> do
      assertEqual
        "v4 encrypted revocation fixture should contain a v4 public key"
        V4
        (_keyVersion pkp)
      assertEqual
        "v4 encrypted revocation fixture should contain the expected public key fingerprint"
        (fp "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")
        (fingerprint pkp)
      assertEqual
        "v4 encrypted revocation fixture should use EdDSA for its public key"
        EdDSA
        (_pkalgo pkp)
    _ ->
      assertFailure
        ("v4 encrypted revocation fixture should contain [PublicKeyPkt, SignaturePkt], got: " ++
         show packets)

testV6RevocationArmor :: FilePath -> Assertion
testV6RevocationArmor fixture = do
  armors <- loadArmor fixture
  armor <-
    case armors of
      [a] -> pure a
      _ ->
        assertFailure (fixture ++ " fixture should contain one armored payload") >>
        fail "expected one armored payload"
  payload <-
    case armor of
      Armor ArmorPublicKeyBlock _ p -> pure p
      Armor atype _ _ ->
        assertFailure
          (fixture ++ " fixture should decode as a public key block, got " ++ show atype) >>
        fail "expected public key block"
      _ ->
        assertFailure (fixture ++ " fixture should decode as an armored payload") >>
        fail "expected armored payload"
  let packets = parsePkts payload
  case packets of
    [PublicKeyPkt pkp, SignaturePkt sig] -> do
      assertEqual
        (fixture ++ " should contain a v6 public key")
        V6
        (_keyVersion pkp)
      case sig of
        SigV6 KeyRevocationSig _ _ _ hashed unhashed _ _ -> do
          let issuerFps =
                [ ifp
                | SigSubPacket _ (IssuerFingerprint IssuerFingerprintV6 ifp) <- hashed ++ unhashed
                ]
          if fingerprint pkp `elem` issuerFps
            then pure ()
            else
              assertFailure
                (fixture ++ " should include an IssuerFingerprint v6 matching the public key")
        _ ->
          assertFailure
            (fixture ++ " should contain a SigV6 key-revocation signature")
    _ ->
      assertFailure
        (fixture ++ " should contain [PublicKeyPkt, SignaturePkt], got: " ++
         show packets)

testV6RevocationSignatureSaltSemantics :: FilePath -> Assertion
testV6RevocationSignatureSaltSemantics fixture = do
  armors <- loadArmor fixture
  payload <-
    case armors of
      [Armor ArmorPublicKeyBlock _ p] -> pure p
      _ ->
        assertFailure
          (fixture ++ " should contain one armored public-key payload") >>
        fail "expected one armored payload"
  let packets = parsePkts payload
  (pkp, sig) <-
    case packets of
      [PublicKeyPkt pk, SignaturePkt sigV6@(SigV6 _ _ _ _ _ _ _ _)] -> pure (pk, sigV6)
      _ ->
        assertFailure
          (fixture ++ " should parse as [PublicKeyPkt, SignaturePkt SigV6], got " ++ show packets) >>
        fail "unexpected revocation fixture packet shape"
  case sig of
    SigV6 _ _ ha salt _ _ _ _ ->
      case expectedV6SaltSizeForTest ha of
        Nothing ->
          assertFailure
            (fixture ++ " uses unsupported v6 signature salt hash algorithm: " ++ show ha)
        Just expected ->
          assertEqual
            (fixture ++ " SigV6 salt size should match hash algorithm")
            expected
            (fromIntegral (BL.length (unSignatureSalt salt)))
    other ->
      assertFailure
        (fixture ++ " expected SigV6 revocation signature payload, got: " ++ show other)
  assertBool
    (fixture ++ " should include IssuerFingerprint v6 for the revoked key")
    (signatureHasIssuerFingerprintV6 (fingerprint pkp) sig)

testV4RevocationSignatureSemantics :: Assertion
testV4RevocationSignatureSemantics = do
  armors <- loadArmor "v4-encrypted.rev.aa"
  payload <-
    case armors of
      [Armor ArmorPublicKeyBlock _ p] -> pure p
      _ ->
        assertFailure
          "v4-encrypted.rev.aa should contain one armored public-key payload" >>
        fail "expected one armored payload"
  let packets = parsePkts payload
  case packets of
    [PublicKeyPkt _, SignaturePkt (SigV4 KeyRevocationSig _ _ hashed unhashed _ _)] -> do
      assertBool
        "v4-encrypted.rev.aa key-revocation signature should include an Issuer key-id subpacket"
        (any isIssuerSubpacket (hashed ++ unhashed))
    _ ->
      assertFailure
        ("v4-encrypted.rev.aa should parse as [PublicKeyPkt, SignaturePkt SigV4 KeyRevocationSig], got " ++
         show packets)
  where
    isIssuerSubpacket (SigSubPacket _ Issuer {}) = True
    isIssuerSubpacket _ = False

testV6RevocationSignatureRejectsLegacyIssuerKeyID :: FilePath -> Assertion
testV6RevocationSignatureRejectsLegacyIssuerKeyID fixture = do
  armors <- loadArmor fixture
  payload <-
    case armors of
      [Armor ArmorPublicKeyBlock _ p] -> pure p
      _ ->
        assertFailure
          (fixture ++ " should contain one armored public-key payload") >>
        fail "expected one armored payload"
  let packets = parsePkts payload
  case packets of
    [PublicKeyPkt _, SignaturePkt (SigV6 KeyRevocationSig _ _ _ hashed unhashed _ _)] ->
      assertBool
        (fixture ++ " SigV6 key-revocation signature must not include Issuer key-id subpackets")
        (all (not . isIssuerSubpacket) (hashed ++ unhashed))
    _ ->
      assertFailure
        (fixture ++
         " should parse as [PublicKeyPkt, SignaturePkt SigV6 KeyRevocationSig]")
  where
    isIssuerSubpacket (SigSubPacket _ Issuer {}) = True
    isIssuerSubpacket _ = False

testRevocationArmorParsesAsSingleTransferableKey :: FilePath -> Bool -> Assertion
testRevocationArmorParsesAsSingleTransferableKey fixture expectDirectRevs = do
  armors <- loadArmor fixture
  payload <-
    case armors of
      [Armor ArmorPublicKeyBlock _ p] -> pure p
      _ ->
        assertFailure
          (fixture ++ " should contain one armored public-key payload") >>
        fail "expected one armored payload"
  let tks = parseUnknownTKs True (parsePkts payload)
  case tks of
    [tk] -> do
      if expectDirectRevs
        then
          assertBool
            (fixture ++ " transferable key should contain at least one direct-key revocation signature")
            (not (null (_tkuRevs tk)))
        else pure ()
      assertEqual
        (fixture ++ " revocation certificate should not carry user IDs")
        []
        (_tkuUIDs tk)
      assertEqual
        (fixture ++ " revocation certificate should not carry user attributes")
        []
        (_tkuUAts tk)
      assertEqual
        (fixture ++ " revocation certificate should not carry subkeys")
        []
        (_tkuSubs tk)
    _ ->
      assertFailure
        (fixture ++ " should parse into exactly one transferable key")

testMsg1ArmorFixture :: Assertion
testMsg1ArmorFixture = do
  armors <- loadArmor "msg1.asc"
  assertBool "msg1.asc should decode to at least one armor block" (not (null armors))
  let packetBlocks =
        [ parsePkts payload
        | Armor _ _ payload <- armors
        ]
  assertBool
    "msg1.asc should contain at least one parseable packet block"
    (any (not . null) packetBlocks)

expectedV6SaltSizeForTest :: HashAlgorithm -> Maybe Int
expectedV6SaltSizeForTest =
  fmap fromIntegral . signatureV6SaltSizeForHashAlgorithm

signatureHasIssuerFingerprintV6 :: Fingerprint -> SignaturePayload -> Bool
signatureHasIssuerFingerprintV6 expectedFp (SigV6 _ _ _ _ hashed unhashed _ _) =
  expectedFp `elem`
  [ ifp
  | SigSubPacket _ (IssuerFingerprint IssuerFingerprintV6 ifp) <- hashed ++ unhashed
  ]
signatureHasIssuerFingerprintV6 _ _ = False

testDefaultedEncryptDecrypt :: Assertion
testDefaultedEncryptDecrypt = do
  let passphrase = mkPassphrase "roundtrip1"
      payload = mkClearPayload "hello from a balloon farm on Mars"
      encryptedResult = encryptMessageDefault DoNotExposeSessionMaterial passphrase payload
  encrypted <-
    case encryptedResult of
      Left err ->
        assertFailure ("encryptMessageDefault failed: " ++ show err) >>
        fail "encryptMessageDefault failed"
      Right (bs, _) -> pure bs
  case parsePkts (encryptedPayloadBytes encrypted) of
    [SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 AES256 OCB _ iv esk tag)), SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 _ _)] -> do
      assertBool "default SKESK v6 IV should be present" (not (BL.null iv))
      assertBool "default SKESK v6 wrapped session key should be present" (not (BL.null esk))
      assertEqual "default SKESK v6 tag length" 16 (BL.length tag)
    other ->
      assertFailure
        ("default encryption should emit SKESK v6 + SEIPD v2 packets, got " ++
         show other)
  decrypted <-
    case decryptMessage passphrase encrypted of
      Left err ->
        assertFailure ("decryptMessage failed: " ++ show err) >> fail "decryptMessage failed"
      Right bs -> pure bs
  assertEqual "default encrypt/decrypt payload roundtrip" payload decrypted

testExplicitEncryptDecrypt :: Assertion
testExplicitEncryptDecrypt = do
  let passphrase = mkPassphrase "roundtrip2"
      payload = mkClearPayload "hello from nonsenseville"
      s2k = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15
      iv = IV "1234567890ABCDEF"
  encrypted <-
    case
        encryptMessage
          (RFC9580EncryptMessageOptions
             { rfc9580EncryptMessageExposure = DoNotExposeSessionMaterial
             , rfc9580EncryptMessageSymmetricAlgorithm = AES128
             , rfc9580EncryptMessageS2K = s2k
             , rfc9580EncryptMessageIV = iv
             })
          passphrase
          payload of
      Left err ->
        assertFailure ("micro-managed encryption failed: " ++ show err) >>
        fail "encryptMessage failed"
      Right (bs, _) -> pure bs
  case parsePkts (encryptedPayloadBytes encrypted) of
    [SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 AES128 OCB _ packetIv esk tag)), SymEncIntegrityProtectedDataPkt (SEIPD2 AES128 OCB 6 _ _)] -> do
      assertBool "explicit SKESK v6 IV should be present" (not (BL.null packetIv))
      assertBool "explicit SKESK v6 wrapped session key should be present" (not (BL.null esk))
      assertEqual "explicit SKESK v6 tag length" 16 (BL.length tag)
    other ->
      assertFailure
        ("explicit AES encryption should default to SKESK v6 + SEIPD v2 packets, got " ++
         show other)
  decrypted <-
    case decryptMessage passphrase encrypted of
      Left err ->
        assertFailure ("decryption failed: " ++ show err) >> fail "decryptMessage failed"
      Right bs -> pure bs
  assertEqual "specific encrypt/decrypt payload roundtrip" payload decrypted

testExplicitEncryptExposesEffectiveSessionMaterial :: Assertion
testExplicitEncryptExposesEffectiveSessionMaterial = do
  let passphraseBytes = "roundtrip2-session-material"
      passphrase = mkPassphrase passphraseBytes
      payload = mkClearPayload "hello from session material town"
      sa = AES128
      s2k = Argon2 (Salt16 (B.pack [0x40 .. 0x4f])) 1 4 15
      iv = IV "ABCDEF1234567890"
  (encrypted, recovered) <-
    case
        encryptMessage
          (RFC9580EncryptMessageOptions
             { rfc9580EncryptMessageExposure = ExposeSessionMaterial
             , rfc9580EncryptMessageSymmetricAlgorithm = sa
             , rfc9580EncryptMessageS2K = s2k
             , rfc9580EncryptMessageIV = iv
             })
          passphrase
          payload of
      Left err ->
        assertFailure ("explicit encryption with session material failed: " ++ show err) >>
        fail "encryptMessage failed"
      Right x -> pure x
  expectedSessionKey <-
    case keySize sa of
      Left err ->
        assertFailure ("failed to derive expected key size: " ++ show err) >>
        fail "keySize failed"
      Right keyLen ->
        case string2Key s2k keyLen passphraseBytes of
          Left err ->
            assertFailure ("failed to derive expected session key: " ++ renderS2KError err) >>
            fail "string2Key failed"
          Right bs -> pure bs
  case recovered of
    Just recoveredSessionMaterial -> do
      assertEqual "recovered session material algorithm" sa (recoveredSessionAlgorithm recoveredSessionMaterial)
      assertEqual
        "recovered session material key"
        (SessionKey expectedSessionKey)
        (recoveredSessionKey recoveredSessionMaterial)
    Nothing ->
      assertFailure "expected exposed session material"
  decrypted <-
    case decryptMessage passphrase encrypted of
      Left err ->
        assertFailure ("decryption failed: " ++ show err) >> fail "decryptMessage failed"
      Right bs -> pure bs
  assertEqual "session-material exposing encrypt/decrypt payload roundtrip" payload decrypted

testDefaultEncryptDoesNotExposeSessionMaterial :: Assertion
testDefaultEncryptDoesNotExposeSessionMaterial = do
  let passphrase = mkPassphrase "roundtrip-default-no-session-material"
      payload = mkClearPayload "hello from hidden-session-material town"
  (_, recovered) <-
    do
      let encryptedResult =
            encryptMessageDefault DoNotExposeSessionMaterial passphrase payload
      case encryptedResult of
        Left err ->
          assertFailure ("default encryption with exposure mode failed: " ++ show err) >>
          fail "encryptMessageDefault failed"
        Right x -> pure x
  case recovered of
    Nothing -> pure ()
    Just _ -> assertFailure "default exposure mode should not return session material"

testExplicitAES128AEADEncryptDecrypt :: AEADAlgorithm -> Int -> String -> Assertion
testExplicitAES128AEADEncryptDecrypt aead expectedIvLen label = do
  let passphraseBytes = "roundtrip-" <> BL.fromStrict (B.pack (map (fromIntegral . fromEnum) label))
      passphrase = mkPassphrase passphraseBytes
      payload = mkClearPayload ("hello from " <> BL.fromStrict (B.pack (map (fromIntegral . fromEnum) label)))
      s2k = Argon2 (Salt16 (B.pack [0x10 .. 0x1f])) 1 4 15
      salt = Salt (B.pack [0x20 .. 0x3f])
      block = Block [LiteralDataPkt BinaryData BL.empty 0 (clearPayloadBytes payload)]
  packets <-
    case encryptSEIPDv2WithSKESKBlock AES128 aead 6 salt s2k passphraseBytes block of
      Left err ->
        assertFailure ("AES-128 " ++ label ++ " encryption failed: " ++ err) >>
        fail "encryptSEIPDv2WithSKESKBlock failed"
      Right ps -> pure ps
  let encrypted = mkEncryptedPayload (runPut (put (Block packets)))
  case parsePkts (encryptedPayloadBytes encrypted) of
    [SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 AES128 parsedAead _ iv esk tag)), SymEncIntegrityProtectedDataPkt (SEIPD2 AES128 payloadAead 6 _ _)] -> do
      assertEqual ("AES-128 " ++ label ++ " SKESK AEAD") aead parsedAead
      assertEqual ("AES-128 " ++ label ++ " payload AEAD") aead payloadAead
      assertEqual
        ("AES-128 " ++ label ++ " SKESK v6 IV length")
        (fromIntegral expectedIvLen)
        (BL.length iv)
      assertBool ("AES-128 " ++ label ++ " wrapped session key should be present") (not (BL.null esk))
      assertEqual ("AES-128 " ++ label ++ " SKESK tag length") 16 (BL.length tag)
    other ->
      assertFailure
        ("AES-128 " ++ label ++ " encryption should emit matching SKESK v6 + SEIPD v2 packets, got " ++
         show other)
  decrypted <-
    case decryptMessage passphrase encrypted of
      Left err ->
        assertFailure ("AES-128 " ++ label ++ " decryption failed: " ++ show err) >>
        fail "decryptMessage failed"
      Right bs -> pure bs
  assertEqual ("AES-128 " ++ label ++ " payload roundtrip") payload decrypted

testExplicitAES128EAXEncryptDecrypt :: Assertion
testExplicitAES128EAXEncryptDecrypt = do
  let passphraseBytes = "roundtrip-EAX"
      s2k = Argon2 (Salt16 (B.pack [0x10 .. 0x1f])) 1 4 15
      salt = Salt (B.pack [0x20 .. 0x3f])
      block = Block [LiteralDataPkt BinaryData BL.empty 0 "hello from EAX"]
  case encryptSEIPDv2WithSKESKBlock AES128 EAX 6 salt s2k passphraseBytes block of
    Left err
      | "EAX is currently unsupported by the crypton AEAD backend" `isInfixOf` err ->
          pure ()
      | otherwise ->
          assertFailure ("expected explicit EAX backend limitation, got: " ++ err)
    Right packets ->
      assertFailure
        ("expected AES-128 EAX encryption to fail explicitly, got packets: " ++ show packets)

testExplicitAES128GCMEncryptDecrypt :: Assertion
testExplicitAES128GCMEncryptDecrypt =
  testExplicitAES128AEADEncryptDecrypt GCM 12 "GCM"

testExplicitEncryptRejectsDeprecatedS2KHash :: Assertion
testExplicitEncryptRejectsDeprecatedS2KHash = do
  let passphrase = mkPassphrase "roundtrip2b"
      payload = mkClearPayload "modern-path deprecated s2k hash rejection"
      s2k = Salted SHA1 (Salt8 "12345678")
      iv = IV "1234567890ABCDEF"
  case
      encryptMessage
        (RFC9580EncryptMessageOptions
           { rfc9580EncryptMessageExposure = DoNotExposeSessionMaterial
           , rfc9580EncryptMessageSymmetricAlgorithm = AES128
           , rfc9580EncryptMessageS2K = s2k
           , rfc9580EncryptMessageIV = iv
           })
        passphrase
        payload of
    Left (MessageEncryptError err)
      | "deprecated hash algorithm disallowed for modern message generation" `isInfixOf` err ->
          pure ()
      | otherwise ->
          assertFailure ("Expected deprecated modern S2K hash rejection, got: " ++ err)
    Left err ->
      assertFailure ("Expected MessageEncryptError for deprecated modern S2K hash, got " ++ show err)
    Right _ ->
      assertFailure "Expected encryptMessage AES128 to reject deprecated SHA1 S2K"

testLegacyFallbackEncryptDecrypt :: Assertion
testLegacyFallbackEncryptDecrypt = do
  let passphrase = mkPassphrase "roundtrip3"
      payload = mkClearPayload "hello from legacy town"
      s2k = Salted SHA1 (Salt8 "12345678")
      iv = IV mempty
  encrypted <-
    case
        encryptMessage
          (RFC4880EncryptMessageOptions
             { rfc4880EncryptMessageExposure = DoNotExposeSessionMaterial
             , rfc4880EncryptMessageSymmetricAlgorithm = Plaintext
             , rfc4880EncryptMessageS2K = s2k
             , rfc4880EncryptMessageIV = iv
             })
          passphrase
          payload of
      Left err ->
        assertFailure ("legacy fallback encryption failed: " ++ show err) >>
        fail "encryptMessage fallback failed"
      Right (bs, _) -> pure bs
  case parsePkts (encryptedPayloadBytes encrypted) of
    [SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 Plaintext _ Nothing)), SymEncIntegrityProtectedDataPkt (SEIPD1 1 _)] -> pure ()
    other ->
      assertFailure
        ("non-AES explicit encryption should use RFC4880 SKESKv4 + SEIPDv1 packets, got " ++
         show other)
  decrypted <-
    case decryptMessage passphrase encrypted of
      Left err ->
        assertFailure ("legacy fallback decryption failed: " ++ show err) >>
        fail "decryptMessage fallback failed"
      Right bs -> pure bs
  assertEqual "legacy fallback encrypt/decrypt payload roundtrip" payload decrypted

testRFC4880EncryptMessageSEIPDv1ParsesCleanly :: Assertion
testRFC4880EncryptMessageSEIPDv1ParsesCleanly = do
  let passphraseBytes = "legacy-clean-parse" :: BL.ByteString
      passphrase = mkPassphrase passphraseBytes
      payload = mkClearPayload "hello from clean legacy town"
      s2k = IteratedSalted SHA256 (Salt8 "saltxyz!") (IterationCount 65536)
      iv = IV "1234567890ABCDEF"
  encrypted <-
    case
        encryptMessage
          (RFC4880EncryptMessageOptions
             { rfc4880EncryptMessageExposure = DoNotExposeSessionMaterial
             , rfc4880EncryptMessageSymmetricAlgorithm = AES128
             , rfc4880EncryptMessageS2K = s2k
             , rfc4880EncryptMessageIV = iv
             })
          passphrase
          payload of
      Left err ->
        assertFailure ("RFC4880 encryption failed: " ++ show err) >>
        fail "encryptMessage failed"
      Right (bs, _) -> pure bs
  packets <-
    case parsePktsEither (encryptedPayloadBytes encrypted) of
      Left err ->
        assertFailure ("encrypted packet parse failed: " ++ show err) >>
        fail "parsePktsEither failed"
      Right ps -> pure ps
  ciphertext <-
    case packets of
      [SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 parsedSA parsedS2K Nothing)), SymEncIntegrityProtectedDataPkt (SEIPD1 1 payloadBytes)] -> do
        assertEqual "RFC4880 encrypted SKESK algorithm" AES128 parsedSA
        assertEqual "RFC4880 encrypted S2K" s2k parsedS2K
        pure (BL.toStrict payloadBytes)
      other ->
        assertFailure
          ("RFC4880 encryption should emit SKESKv4 + SEIPDv1 packets, got " ++
           show other) >>
        fail "unexpected encrypted packet layout"
  keyLen <-
    case keySize AES128 of
      Left err ->
        assertFailure ("keySize failed for AES128: " ++ show err) >>
        fail "keySize failed"
      Right n -> pure n
  sessionKey <-
    case string2Key s2k keyLen passphraseBytes of
      Left err ->
        assertFailure ("string2Key failed: " ++ renderS2KError err) >>
        fail "string2Key failed"
      Right keyBytes -> pure keyBytes
  (nonce, decrypted) <-
    case decryptPreservingNonce AES128 ciphertext sessionKey of
      Left err ->
        assertFailure ("decryptPreservingNonce failed: " ++ show err) >>
        fail "decryptPreservingNonce failed"
      Right out -> pure out
  cleartext <-
    case validateSEIPD1MDC nonce decrypted of
      Left err ->
        assertFailure ("validateSEIPD1MDC failed: " ++ err) >>
        fail "validateSEIPD1MDC failed"
      Right out -> pure out
  case parsePktsEither (BL.fromStrict cleartext) of
    Right [LiteralDataPkt BinaryData filename timestamp clearPayload] -> do
      assertEqual "RFC4880 decrypted literal filename" BL.empty filename
      assertEqual "RFC4880 decrypted literal timestamp" 0 timestamp
      assertEqual "RFC4880 decrypted literal payload" (clearPayloadBytes payload) clearPayload
    Right other ->
      assertFailure
        ("RFC4880 decrypted cleartext should contain exactly one literal packet, got " ++
         show other)
    Left err ->
      assertFailure
        ("RFC4880 decrypted cleartext should parse without trailing junk, got " ++
         show err)

testDecryptMessageTypedParseFailure :: Assertion
testDecryptMessageTypedParseFailure = do
  let passphrase = mkPassphrase "unused"
      encrypted = mkEncryptedPayload BL.empty
  case decryptMessage passphrase encrypted of
    Left (MessageParseFailureError MissingEncryptedMessage) -> pure ()
    Left err ->
      assertFailure ("Expected MissingEncryptedMessage parse failure, got " ++ show err)
    Right clear ->
      assertFailure ("Expected parse failure, got payload " ++ show clear)

testDecryptMessageRejectsUnknownCriticalPacket :: Assertion
testDecryptMessageRejectsUnknownCriticalPacket = do
  let passphrase = mkPassphrase "unused"
      encrypted =
        mkEncryptedPayload . runPut . put $
          Block [OtherPacketPkt 39 "unknown-critical"]
  case decryptMessage passphrase encrypted of
    Left (MessageParseFailureError (UnknownCriticalPacketType 39)) -> pure ()
    Left err ->
      assertFailure
        ("Expected UnknownCriticalPacketType 39 parse failure, got " ++ show err)
    Right clear ->
      assertFailure
        ("Expected unknown critical packet rejection, got payload " ++ show clear)

testDecryptMessageTypedDecryptFailure :: Assertion
testDecryptMessageTypedDecryptFailure = do
  let correctPassphrase = mkPassphrase "correct passphrase"
      wrongPassphrase = mkPassphrase "wrong passphrase"
      payload = mkClearPayload "typed decrypt failure payload"
      encryptedResult =
        encryptMessageDefault DoNotExposeSessionMaterial correctPassphrase payload
  encrypted <-
    case encryptedResult of
      Left err ->
        assertFailure ("encryptMessageDefault failed: " ++ show err) >>
        fail "encryptMessageDefault failed"
      Right (bs, _) -> pure bs
  case decryptMessage wrongPassphrase encrypted of
    Left (MessageDecryptFailureError (PayloadDecryptFailed _)) -> pure ()
    Left (MessageDecryptFailureError (SessionMaterialDerivationFailed _)) -> pure ()
    Left err ->
      assertFailure ("Expected typed decrypt failure, got " ++ show err)
    Right clear ->
      assertFailure ("Expected decrypt failure, got payload " ++ show clear)

testDecryptMessageSEIPDv1MDCTampering :: Assertion
testDecryptMessageSEIPDv1MDCTampering = do
  let passphrase = mkPassphrase "mdc-tamper-test"
      payload    = mkClearPayload "payload for MDC tampering test"
      s2k        = IteratedSalted SHA256 (Salt8 "saltxyz!") (IterationCount 65536)
      iv         = IV "1234567890ABCDEF"
  encrypted <-
    case encryptMessage
           (RFC4880EncryptMessageOptions
              { rfc4880EncryptMessageExposure          = DoNotExposeSessionMaterial
              , rfc4880EncryptMessageSymmetricAlgorithm = AES128
              , rfc4880EncryptMessageS2K                = s2k
              , rfc4880EncryptMessageIV                 = iv
              })
           passphrase
           payload of
      Left err ->
        assertFailure ("SEIPDv1 encryption failed: " ++ show err) >>
        fail "encryptMessage failed"
      Right (bs, _) -> pure bs
  let raw        = encryptedPayloadBytes encrypted
      midpoint   = BL.length raw `div` 2
      tampered   = BL.take midpoint raw <>
                   BL.cons (BL.head (BL.drop midpoint raw) `xor` 0xFF)
                            (BL.drop (midpoint + 1) raw)
  case decryptMessage passphrase (mkEncryptedPayload tampered) of
    Left (MessageDecryptFailureError (PayloadDecryptFailed msg))
      | "MDC" `isInfixOf` msg -> pure ()
      | otherwise ->
          assertFailure
            ("Expected MDC-related PayloadDecryptFailed, got: " ++ msg)
    Left err ->
      assertFailure
        ("Expected PayloadDecryptFailed with MDC error, got: " ++ show err)
    Right _ ->
      assertFailure "Expected MDC tampering rejection, but decryption succeeded"

testSignMessageShape :: Assertion
testSignMessageShape = do
  (signer, signingKey) <- loadUnencryptedRsaSigner
  signerV4 <- expectV4PKPayload "RSA v4 signer" signer
  signedResult <- signMessageWith (mkRSASignerV4 signerV4 signingKey) (mkClearPayload "message-api signing payload")
  signedMessage <-
    case signedResult of
      Left err ->
        assertFailure ("message signing failed: " ++ show err) >> pure mempty
      Right bs -> pure bs
  case parsePkts signedMessage of
    [LiteralDataPkt {}, SignaturePkt _] -> pure ()
    _ -> assertFailure "signing output should contain literal data and one signature packet"

testSignMessageRSAV6 :: Assertion
testSignMessageRSAV6 = do
  (signer, signingKey) <- loadUnencryptedRsaSignerV6
  signerV6 <- expectV6PKPayload "RSA v6 signer" signer
  let payload = "message-api signing payload with RSA SigV6"
  signedResult <- signMessageWith (mkRSASignerV6 signerV6 signingKey) (mkClearPayload payload)
  signedMessage <-
    case signedResult of
      Left err ->
        assertFailure ("RSA SigV6 message signing failed: " ++ show err) >> pure mempty
      Right bs -> pure bs
  signaturePkt <-
    case parsePkts signedMessage of
      [LiteralDataPkt {}, sig@(SignaturePkt (SigV6 BinarySig RSA SHA512 salt _ _ _ _))] -> do
        assertEqual "SigV6 RSA salt must be 32 bytes for SHA512" 32 (BL.length (unSignatureSalt salt))
        pure sig
      other ->
        assertFailure
          ("RSA SigV6 signing output should contain [LiteralDataPkt, RSA SigV6], got " ++
           show other) >>
        fail "unexpected RSA SigV6 signMessage output shape"
  let state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}
      keyring = [TKUnknown (signer, Nothing) [] [] [] []]
  case verifySigWith (verifyAgainstKeys keyring) signaturePkt state Nothing of
    Left err ->
      assertFailure
        ("RSA SigV6 signed message verification failed: " ++
         renderVerificationError err)
    Right _ -> pure ()

testSignMessageEd25519 :: Assertion
testSignMessageEd25519 = do
  (signer, signingKey) <- loadDeterministicEd25519Signer
  signerV4 <- expectV4PKPayload "Ed25519 v4 signer" signer
  let payload = "message-api signing payload with Ed25519"
  signedResult <- signMessageWith (mkEd25519SignerV4 signerV4 signingKey) (mkClearPayload payload)
  signedMessage <-
    case signedResult of
      Left err ->
        assertFailure ("Ed25519 message signing failed: " ++ show err) >> pure mempty
      Right bs -> pure bs
  signaturePkt <-
    case parsePkts signedMessage of
      [LiteralDataPkt {}, sig@(SignaturePkt (SigV4 BinarySig PKA.Ed25519 SHA512 _ _ _ _))] ->
        pure sig
      other ->
        assertFailure
          ("Ed25519 signing output should contain [LiteralDataPkt, Ed25519 SigV4], got " ++
           show other) >>
        fail "unexpected Ed25519 signMessage output shape"
  let state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}
      keyring = [TKUnknown (signer, Nothing) [] [] [] []]
  case verifySigWith (verifyAgainstKeys keyring) signaturePkt state Nothing of
    Left err ->
      assertFailure
        ("Ed25519 signed message verification failed: " ++
         renderVerificationError err)
    Right _ -> pure ()

testSignMessageEd25519V6 :: Assertion
testSignMessageEd25519V6 = do
  (signer, signingKey) <- loadDeterministicEd25519SignerV6
  signerV6 <- expectV6PKPayload "Ed25519 v6 signer" signer
  let payload = "message-api signing payload with Ed25519 SigV6"
  signedResult <- signMessageWith (mkEd25519SignerV6 signerV6 signingKey) (mkClearPayload payload)
  signedMessage <-
    case signedResult of
      Left err ->
        assertFailure ("Ed25519 SigV6 message signing failed: " ++ show err) >> pure mempty
      Right bs -> pure bs
  signaturePkt <-
    case parsePkts signedMessage of
      [LiteralDataPkt {}, sig@(SignaturePkt (SigV6 BinarySig PKA.Ed25519 SHA512 salt _ _ _ _))] -> do
        assertEqual "SigV6 Ed25519 salt must be 32 bytes for SHA512" 32 (BL.length (unSignatureSalt salt))
        pure sig
      other ->
        assertFailure
          ("Ed25519 SigV6 signing output should contain [LiteralDataPkt, Ed25519 SigV6], got " ++
           show other) >>
        fail "unexpected Ed25519 SigV6 signMessage output shape"
  case signaturePkt of
    SignaturePkt (SigV6 BinarySig PKA.Ed25519 SHA512 _ _ _ _ _) -> do
      let state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}
          keyring = [TKUnknown (signer, Nothing) [] [] [] []]
      case verifySigWith (verifyAgainstKeys keyring) signaturePkt state Nothing of
        Left err ->
          assertFailure
            ("Ed25519 SigV6 signed message verification failed: " ++
             renderVerificationError err)
        Right _ -> pure ()
    _ -> assertFailure "expected an Ed25519 SigV6 signature packet"

testV4Ed25519LegacyKeyRejectsMissingPrefix :: Assertion
testV4Ed25519LegacyKeyRejectsMissingPrefix = do
  let legacyEd25519Oid = B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0xDA, 0x47, 0x0F, 0x01]
      rawEd25519Public = B.replicate 32 0x01
      encoded =
        runPut $ do
          putWord8 4
          putWord32be 0
          putWord8 (fromFVal EdDSA)
          putWord8 (fromIntegral (B.length legacyEd25519Oid))
          putByteString legacyEd25519Oid
          putWord16be 256
          putByteString rawEd25519Public
  case runGetOrFail (get :: Get SomePKPayload) encoded of
    Left (_, _, err) ->
      assertBool
        ("expected invalid-legacy-point parse failure, got: " ++ err)
        ("invalid Ed25519Legacy public key" `isInfixOf` err)
    Right _ ->
      assertFailure "legacy Ed25519 key without 0x40 prefix should be rejected"

testSignMessageEd448 :: Assertion
testSignMessageEd448 = do
  (signer, signingKey) <- loadDeterministicEd448Signer
  signerV4 <- expectV4PKPayload "Ed448 v4 signer" signer
  let payload = "message-api signing payload with Ed448"
  signedResult <- signMessageWith (mkEd448SignerV4 signerV4 signingKey) (mkClearPayload payload)
  signedMessage <-
    case signedResult of
      Left err ->
        assertFailure ("Ed448 message signing failed: " ++ show err) >> pure mempty
      Right bs -> pure bs
  signaturePkt <-
    case parsePkts signedMessage of
      [LiteralDataPkt {}, sig@(SignaturePkt (SigV4 BinarySig PKA.Ed448 SHA512 _ _ _ _))] ->
        pure sig
      other ->
        assertFailure
          ("Ed448 signing output should contain [LiteralDataPkt, Ed448 SigV4], got " ++
           show other) >>
        fail "unexpected Ed448 signMessage output shape"
  let state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}
      keyring = [TKUnknown (signer, Nothing) [] [] [] []]
  case verifySigWith (verifyAgainstKeys keyring) signaturePkt state Nothing of
    Left err ->
      assertFailure
        ("Ed448 signed message verification failed: " ++
         renderVerificationError err)
    Right _ -> pure ()

testSignMessageEd448V6 :: Assertion
testSignMessageEd448V6 = do
  (signer, signingKey) <- loadDeterministicEd448SignerV6
  signerV6 <- expectV6PKPayload "Ed448 v6 signer" signer
  let payload = "message-api signing payload with Ed448 SigV6"
  signedResult <- signMessageWith (mkEd448SignerV6 signerV6 signingKey) (mkClearPayload payload)
  signedMessage <-
    case signedResult of
      Left err ->
        assertFailure ("Ed448 SigV6 message signing failed: " ++ show err) >> pure mempty
      Right bs -> pure bs
  signaturePkt <-
    case parsePkts signedMessage of
      [LiteralDataPkt {}, sig@(SignaturePkt (SigV6 BinarySig PKA.Ed448 SHA512 salt _ _ _ _))] -> do
        assertEqual "SigV6 Ed448 salt must be 32 bytes for SHA512" 32 (BL.length (unSignatureSalt salt))
        pure sig
      other ->
        assertFailure
          ("Ed448 SigV6 signing output should contain [LiteralDataPkt, Ed448 SigV6], got " ++
           show other) >>
        fail "unexpected Ed448 SigV6 signMessage output shape"
  case signaturePkt of
    SignaturePkt (SigV6 BinarySig PKA.Ed448 SHA512 _ _ _ _ _) -> pure ()
    _ -> assertFailure "expected an Ed448 SigV6 signature packet"

testV4EdSignaturesUseNativeFixedWidthEncoding :: Assertion
testV4EdSignaturesUseNativeFixedWidthEncoding = do
  (_, ed25519SigningKey) <- loadDeterministicEd25519Signer
  ed25519Sig <-
    case signDataWithEd25519 BinarySig ed25519SigningKey [] [] "v4 ed25519 encoding" of
      Left err ->
        assertFailure ("Ed25519 v4 signing failed: " ++ renderSignError err) >>
        fail "expected Ed25519 signature"
      Right sig -> pure sig
  case extractV4SignatureAlgorithmFields (runPut (put ed25519Sig)) of
    Left err ->
      assertFailure ("failed to decode serialized Ed25519 v4 signature payload: " ++ err)
    Right (pka, algorithmFields) -> do
      assertEqual "Ed25519 v4 signature packet algorithm id" PKA.Ed25519 pka
      assertEqual "Ed25519 v4 algorithm field width" 64 (B.length algorithmFields)

  (_, ed448SigningKey) <- loadDeterministicEd448Signer
  ed448Sig <-
    case signDataWithEd448 BinarySig ed448SigningKey [] [] "v4 ed448 encoding" of
      Left err ->
        assertFailure ("Ed448 v4 signing failed: " ++ renderSignError err) >>
        fail "expected Ed448 signature"
      Right sig -> pure sig
  case extractV4SignatureAlgorithmFields (runPut (put ed448Sig)) of
    Left err ->
      assertFailure ("failed to decode serialized Ed448 v4 signature payload: " ++ err)
    Right (pka, algorithmFields) -> do
      assertEqual "Ed448 v4 signature packet algorithm id" PKA.Ed448 pka
      assertEqual "Ed448 v4 algorithm field width" 114 (B.length algorithmFields)

testVerifyDetachedEd25519WithoutIssuerHints :: Assertion
testVerifyDetachedEd25519WithoutIssuerHints = do
  (signer, signingKey) <- loadDeterministicEd25519Signer
  let payload = "detached v4 eddsa payload without issuer hints"
      state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}
      keyring = mkTestKeyring [TKUnknown (signer, Nothing) [] [] [] []]
  sigPayload <-
    case signDataWithEd25519 BinarySig signingKey [] [] payload of
      Left err ->
        assertFailure ("Ed25519 detached signing failed: " ++ renderSignError err) >>
        fail (renderSignError err)
      Right sig -> pure sig
  case verifySigWith (verifyAgainstKeyring keyring) (SignaturePkt sigPayload) state Nothing of
    Left err ->
      assertFailure
        ("Ed25519 detached verification without issuer hints failed: " ++
         renderVerificationError err)
    Right _ -> pure ()

testVerifyDetachedEd25519WithFakeIssuerHint :: Assertion
testVerifyDetachedEd25519WithFakeIssuerHint = do
  (signer, signingKey) <- loadDeterministicEd25519Signer
  let payload = "detached v4 eddsa payload with fake issuer hint"
      state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}
      keyring = mkTestKeyring [TKUnknown (signer, Nothing) [] [] [] []]
      fakeIssuer = EightOctetKeyId "\x01\x23\x45\x67\x89\xab\xcd\xef"
      unhashed = [SigSubPacket False (Issuer fakeIssuer)]
  sigPayload <-
    case signDataWithEd25519 BinarySig signingKey [] unhashed payload of
      Left err ->
        assertFailure ("Ed25519 detached signing failed: " ++ renderSignError err) >>
        fail (renderSignError err)
      Right sig -> pure sig
  case verifySigWith (verifyAgainstKeyring keyring) (SignaturePkt sigPayload) state Nothing of
    Left err ->
      assertFailure
        ("Ed25519 detached verification with fake issuer hint failed: " ++
         renderVerificationError err)
    Right _ -> pure ()

testVerifyDetachedEd25519WithoutIssuerHintsAgainstKeys :: Assertion
testVerifyDetachedEd25519WithoutIssuerHintsAgainstKeys = do
  (signer, signingKey) <- loadDeterministicEd25519Signer
  let payload = "detached v4 eddsa payload without issuer hints (verifyAgainstKeys)"
      state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}
      keys = [TKUnknown (signer, Nothing) [] [] [] []]
  sigPayload <-
    case signDataWithEd25519 BinarySig signingKey [] [] payload of
      Left err ->
        assertFailure ("Ed25519 detached signing failed: " ++ renderSignError err) >>
        fail (renderSignError err)
      Right sig -> pure sig
  case verifySigWith (verifyAgainstKeys keys) (SignaturePkt sigPayload) state Nothing of
    Left err ->
      assertFailure
        ("Ed25519 detached verification against keys without issuer hints failed: " ++
         renderVerificationError err)
    Right _ -> pure ()

testVerifyDetachedEd25519WithFakeIssuerHintAgainstKeys :: Assertion
testVerifyDetachedEd25519WithFakeIssuerHintAgainstKeys = do
  (signer, signingKey) <- loadDeterministicEd25519Signer
  let payload = "detached v4 eddsa payload with fake issuer hint (verifyAgainstKeys)"
      state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}
      keys = [TKUnknown (signer, Nothing) [] [] [] []]
      fakeIssuer = EightOctetKeyId "\x01\x23\x45\x67\x89\xab\xcd\xef"
      unhashed = [SigSubPacket False (Issuer fakeIssuer)]
  sigPayload <-
    case signDataWithEd25519 BinarySig signingKey [] unhashed payload of
      Left err ->
        assertFailure ("Ed25519 detached signing failed: " ++ renderSignError err) >>
        fail (renderSignError err)
      Right sig -> pure sig
  case verifySigWith (verifyAgainstKeys keys) (SignaturePkt sigPayload) state Nothing of
    Left err ->
      assertFailure
        ("Ed25519 detached verification against keys with fake issuer hint failed: " ++
         renderVerificationError err)
    Right _ -> pure ()

testCanonicalTextSigPayloadNormalization :: Assertion
testCanonicalTextSigPayloadNormalization = do
  let state =
        emptyPSC
          { lastLD =
              LiteralDataPkt
                TextData
                BL.empty
                (ThirtyTwoBitTimeStamp 0)
                "line1 \t\nline2\t \rline3\t \r\nline4 \t"
          }
  assertEqual
    "Binary signatures preserve original line endings"
    "line1 \t\nline2\t \rline3\t \r\nline4 \t"
    (payloadForSig BinarySig state)
  assertEqual
    "Canonical text signatures normalize line endings and trim trailing whitespace"
    "line1\r\nline2\r\nline3\r\nline4"
    (payloadForSig CanonicalTextSig state)

testTextNormalizationModes :: Assertion
testTextNormalizationModes = do
  let state =
        emptyPSC
          { lastLD =
              LiteralDataPkt
                TextData
                BL.empty
                (ThirtyTwoBitTimeStamp 0)
                "line1 \t\nline2\t \r\nline3"
          }
  let cleartextResult = payloadForSigWith CleartextCompat CanonicalTextSig state
      strictResult     = payloadForSigWith RFC9580Strict    CanonicalTextSig state
  assertEqual
    "CleartextCompat mode strips trailing whitespace per line"
    "line1\r\nline2\r\nline3"
    cleartextResult
  assertEqual
    "RFC9580Strict mode preserves trailing whitespace (CRLF-only normalization)"
    "line1 \t\r\nline2\t \r\nline3"
    strictResult
  (signer, signingKey) <- loadUnencryptedRsaSigner
  issuerKeyId <-
    case eightOctetKeyID signer of
      Left err ->
        assertFailure ("failed to derive issuer key id: " ++ err) >>
        fail "expected issuer key id"
      Right i -> pure i
  let payload = "line with trailing space \nno trailing space\n"
      hashed = [SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint signer))]
      unhashed = [SigSubPacket False (Issuer issuerKeyId)]
      builderCompat = sigBuilderInit @'PKA.RSA CanonicalTextSig SHA512
      builderStrict = (sigBuilderInit @'PKA.RSA CanonicalTextSig SHA512) { sbTextNormMode = RFC9580Strict }
      withSubs b = addUnhashedSubs (listToUnhashedSubs unhashed) (addHashedSubs (listToHashedSubs hashed) b)
      bc = withSubs builderCompat
      bs = withSubs builderStrict
  sigCompat  <- case signDataWithRSABuilder bc  signingKey payload of
    Left err -> assertFailure ("CleartextCompat sign failed: " ++ renderSignError err) >> fail ""
    Right s  -> pure s
  sigStrict  <- case signDataWithRSABuilder bs  signingKey payload of
    Left err -> assertFailure ("RFC9580Strict sign failed: " ++ renderSignError err) >> fail ""
    Right s  -> pure s
  assertBool
    "CleartextCompat and RFC9580Strict produce different signatures for payloads with trailing whitespace"
    (sigCompat /= sigStrict)

testCanonicalTextSignatureSigningPaths :: Assertion
testCanonicalTextSignatureSigningPaths = do
  (signer, signingKey) <- loadUnencryptedRsaSigner
  issuerKeyId <-
    case eightOctetKeyID signer of
      Left err ->
        assertFailure ("failed to derive issuer key id: " ++ err) >>
        fail "expected issuer key id"
      Right i -> pure i
  let mixedPayload = "line1 \t\nline2\t \rline3\t \r\nline4 \t"
      normalizedPayload = "line1\r\nline2\r\nline3\r\nline4"
      hashed = [SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint signer))]
      unhashed = [SigSubPacket False (Issuer issuerKeyId)]
  primitiveMixed <-
    case signDataWithRSA CanonicalTextSig signingKey hashed unhashed mixedPayload of
      Left err ->
        assertFailure ("canonical text primitive signing failed: " ++ renderSignError err) >>
        fail (renderSignError err)
      Right sig -> pure sig
  primitiveNormalized <-
    case signDataWithRSA CanonicalTextSig signingKey hashed unhashed normalizedPayload of
      Left err ->
        assertFailure ("canonical text primitive signing (normalized payload) failed: " ++ renderSignError err) >>
        fail (renderSignError err)
      Right sig -> pure sig
  assertEqual
    "primitive canonical text signing should normalize mixed line endings"
    primitiveNormalized
    primitiveMixed

  let builder = sigBuilderInit @'PKA.RSA CanonicalTextSig SHA512
      withHashed = addHashedSubs (listToHashedSubs hashed) builder
      withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed
  builderMixed <-
    case signDataWithRSABuilder withUnhashed signingKey mixedPayload of
      Left err ->
        assertFailure ("canonical text builder signing failed: " ++ renderSignError err) >>
        fail (renderSignError err)
      Right sig -> pure sig
  builderNormalized <-
    case signDataWithRSABuilder withUnhashed signingKey normalizedPayload of
      Left err ->
        assertFailure ("canonical text builder signing (normalized payload) failed: " ++ renderSignError err) >>
        fail (renderSignError err)
      Right sig -> pure sig
  assertEqual
    "builder canonical text signing should normalize mixed line endings"
    builderNormalized
    builderMixed

testSignaturePrimitives :: Assertion
testSignaturePrimitives = do
  (signer, signingKey) <- loadUnencryptedRsaSigner
  let userId = UserId "primitive-api@example.org"
      assertSigType ::
           String -> SigType -> Either SignError SignaturePayload -> Assertion
      assertSigType testLabel expected result =
        case result of
          Left err -> assertFailure (testLabel ++ " failed: " ++ renderSignError err)
          Right (SigV4 sigType _ _ _ _ _ _) ->
            assertEqual (testLabel ++ " uses expected signature type") expected sigType
          Right _ -> assertFailure (testLabel ++ " should generate a V4 signature payload")
  assertSigType
    "certification signature"
    GenericCert
    (signCertificationWithRSA GenericCert signer userId [] [] signingKey)
  assertSigType
    "key revocation signature"
    KeyRevocationSig
    (signKeyRevocationWithRSA signer [] [] signingKey)
  assertSigType
    "subkey revocation signature"
    SubkeyRevocationSig
    (signSubkeyRevocationWithRSA signer signer [] [] signingKey)
  assertSigType
    "certification revocation signature"
    CertRevocationSig
    (signCertRevocationWithRSA signer userId [] [] signingKey)
  let left16Payload = "left16 primitive payload"
      left16Keyring = mkTestKeyring [TKUnknown (signer, Nothing) [] [] [] []]
  left16Sig <-
    case signDataWithRSA BinarySig signingKey [] [] left16Payload of
      Left err ->
        assertFailure ("RSA primitive signing for left16 failed: " ++ renderSignError err) >>
        fail "expected RSA signature payload"
      Right sigPayload -> pure sigPayload
  case verifyAgainstKeyring left16Keyring (SignaturePkt left16Sig) Nothing left16Payload of
    Right _ -> pure ()
    Left err ->
      assertFailure
        ("fresh RSA signature should verify with matching left16, got: " ++
         renderVerificationError err)
  let tamperedLeft16Sig =
        case left16Sig of
          SigV4 st pka ha hs us l16 mpis -> SigV4 st pka ha hs us (l16 + 1) mpis
          other -> other
  case verifyAgainstKeyring left16Keyring (SignaturePkt tamperedLeft16Sig) Nothing left16Payload of
    Left _ -> pure ()
    Right _ ->
      assertFailure "verification unexpectedly succeeded with tampered left16"
  if isRight (signCertificationWithRSA KeyRevocationSig signer userId [] [] signingKey)
    then
      assertFailure
        "certification primitive should reject non-certification signature types"
    else pure ()
  (edSigner, edSigningKey) <- loadDeterministicEd25519Signer
  edIssuerKeyId <-
    case eightOctetKeyID edSigner of
      Left err ->
        assertFailure ("failed to derive Ed25519 issuer key id: " ++ err) >>
        fail "expected Ed25519 issuer key id"
      Right i -> pure i
  let edPayload = "primitive Ed25519 payload"
      edHashed = [SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint edSigner))]
      edUnhashed = [SigSubPacket False (Issuer edIssuerKeyId)]
  case signDataWithEd25519 BinarySig edSigningKey edHashed edUnhashed edPayload of
    Left err -> assertFailure ("Ed25519 primitive signing failed: " ++ renderSignError err)
    Right (SigV4 BinarySig PKA.Ed25519 SHA512 _ _ _ _) -> pure ()
    Right other ->
      assertFailure ("Ed25519 primitive should generate an Ed25519 SigV4 payload, got " ++ show other)
  let v6Salt = SignatureSalt (BL.replicate 32 0x42)
  case signDataWithEd25519V6 BinarySig v6Salt edSigningKey edHashed edUnhashed edPayload of
    Left err -> assertFailure ("Ed25519 SigV6 primitive signing failed: " ++ renderSignError err)
    Right (SigV6 BinarySig PKA.Ed25519 SHA512 salt _ _ _ _) ->
      assertEqual "Ed25519 SigV6 primitive should preserve 32-byte salt" 32 (BL.length (unSignatureSalt salt))
    Right other ->
      assertFailure ("Ed25519 SigV6 primitive should generate an Ed25519 SigV6 payload, got " ++ show other)
  (ed448Signer, ed448SigningKey) <- loadDeterministicEd448Signer
  ed448IssuerKeyId <-
    case eightOctetKeyID ed448Signer of
      Left err ->
        assertFailure ("failed to derive Ed448 issuer key id: " ++ err) >>
        fail "expected Ed448 issuer key id"
      Right i -> pure i
  let ed448Payload = "primitive Ed448 payload"
      ed448Hashed = [SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint ed448Signer))]
      ed448Unhashed = [SigSubPacket False (Issuer ed448IssuerKeyId)]
  case signDataWithEd448 BinarySig ed448SigningKey ed448Hashed ed448Unhashed ed448Payload of
    Left err -> assertFailure ("Ed448 primitive signing failed: " ++ renderSignError err)
    Right (SigV4 BinarySig PKA.Ed448 SHA512 _ _ _ _) -> pure ()
    Right other ->
      assertFailure ("Ed448 primitive should generate an Ed448 SigV4 payload, got " ++ show other)
  case signDataWithEd448V6 BinarySig v6Salt ed448SigningKey ed448Hashed ed448Unhashed ed448Payload of
    Left err -> assertFailure ("Ed448 SigV6 primitive signing failed: " ++ renderSignError err)
    Right (SigV6 BinarySig PKA.Ed448 SHA512 salt _ _ _ _) ->
      assertEqual "Ed448 SigV6 primitive should preserve 32-byte salt" 32 (BL.length (unSignatureSalt salt))
    Right other ->
      assertFailure ("Ed448 SigV6 primitive should generate an Ed448 SigV6 payload, got " ++ show other)

testSignatureDataKindsCoercions :: Assertion
testSignatureDataKindsCoercions = do
  let sigV3 =
        SigV3
          BinarySig
          (ThirtyTwoBitTimeStamp 1)
          (EightOctetKeyId "\x01\x02\x03\x04\x05\x06\x07\x08")
          RSA
          SHA256
          0
          (NE.fromList [MPI 1])
      sigV4 =
        SigV4
          BinarySig
          RSA
          SHA256
          []
          []
          0
          (NE.fromList [MPI 2])
      sigV6 =
        SigV6
          BinarySig
          PKA.Ed25519
          SHA512
          (SignatureSalt (BL.replicate 32 0x01))
          []
          []
          0
          (NE.fromList [MPI 3, MPI 4])
      sigOther = SigVOther 77 "opaque-signature-body"
      assertPacketRoundTrip label expected pkt =
        case fromPktEitherSomeSignatureV pkt of
          Left err -> assertFailure (label ++ " packet coercion failed: " ++ err)
          Right (SomeSignatureV typedSig) ->
            assertEqual
              (label ++ " packet coercion preserves payload")
              expected
              (signaturePayloadFromSignatureV typedSig)
  assertBool
    "toSomeSignaturePayload should preserve SigV3 witness"
    (isRight (asSignaturePayloadV3 sigV3))
  assertBool
    "toSomeSignaturePayload should preserve SigV4 witness"
    (isRight (asSignaturePayloadV4 sigV4))
  assertBool
    "toSomeSignaturePayload should preserve SigV6 witness"
    (isRight (asSignaturePayloadV6 sigV6))
  assertBool
    "toSomeSignaturePayload should preserve SigVOther witness"
    (isRight (asSignaturePayloadOther sigOther))
  case asSignaturePayloadV3 sigV3 of
    Left err -> assertFailure ("asSignaturePayloadV3 should accept SigV3: " ++ err)
    Right typed ->
      assertEqual "asSignaturePayloadV3 round-trips SigV3" sigV3 (toSignaturePayload typed)
  case asSignaturePayloadV4 sigV4 of
    Left err -> assertFailure ("asSignaturePayloadV4 should accept SigV4: " ++ err)
    Right typed ->
      assertEqual "asSignaturePayloadV4 round-trips SigV4" sigV4 (toSignaturePayload typed)
  case asSignaturePayloadV6 sigV6 of
    Left err -> assertFailure ("asSignaturePayloadV6 should accept SigV6: " ++ err)
    Right typed ->
      assertEqual "asSignaturePayloadV6 round-trips SigV6" sigV6 (toSignaturePayload typed)
  case asSignaturePayloadOther sigOther of
    Left err -> assertFailure ("asSignaturePayloadOther should accept SigVOther: " ++ err)
    Right typed ->
      assertEqual "asSignaturePayloadOther round-trips SigVOther" sigOther (toSignaturePayload typed)
  assertBool
    "asSignaturePayloadV6 rejects SigV4"
    (not (isRight (asSignaturePayloadV6 sigV4)))
  assertBool
    "asSignaturePayloadV4 rejects SigVOther"
    (not (isRight (asSignaturePayloadV4 sigOther)))
  assertPacketRoundTrip "SigV3" sigV3 (SignaturePkt sigV3)
  assertPacketRoundTrip "SigV4" sigV4 (SignaturePkt sigV4)
  assertPacketRoundTrip "SigV6" sigV6 (SignaturePkt sigV6)
  assertPacketRoundTrip "SigVOther" sigOther (SignaturePkt sigOther)
  assertBool
    "fromPktEitherSomeSignatureV rejects non-signature packets"
    (not (isRight (fromPktEitherSomeSignatureV (LiteralDataPkt BinaryData "" 0 ""))))

testTypedArmorPayloadHelpers :: Assertion
testTypedArmorPayloadHelpers = do
  let armors =
        [ Armor ArmorPublicKeyBlock [] "public-one"
        , Armor ArmorMessage [] "message-one"
        , Armor ArmorPublicKeyBlock [] "public-two"
        ]
      publicPayloads = map BL.toStrict (armorPayloadsOfType ArmorPublicKeyBlock armors)
  assertEqual
    "armorPayloadsOfType returns all matching typed blocks in order"
    ["public-one", "public-two"]
    publicPayloads
  assertEqual
    "singleArmorPayloadOfType returns the sole matching message payload"
    (Right "message-one")
    (fmap BL.toStrict (singleArmorPayloadOfType ArmorMessage armors))
  assertBool
    "singleArmorPayloadOfType fails when no typed blocks exist"
    (isLeft (singleArmorPayloadOfType ArmorPrivateKeyBlock armors))
  assertBool
    "singleArmorPayloadOfType fails when multiple typed blocks exist"
    (isLeft (singleArmorPayloadOfType ArmorPublicKeyBlock armors))
testRecommendedArmorType :: Assertion
testRecommendedArmorType = do
  secretArmors <- loadArmor "v4-encrypted-secret.pgp.aa"
  publicArmors <- loadArmor "v4-encrypted.rev.aa"
  secretPayload <-
    case singleArmorPayloadOfType ArmorPrivateKeyBlock secretArmors of
      Left err -> assertFailure err >> fail err
      Right payload -> pure payload
  publicPayload <-
    case singleArmorPayloadOfType ArmorPublicKeyBlock publicArmors of
      Left err -> assertFailure err >> fail err
      Right payload -> pure payload
  let secretPkts = parsePkts secretPayload
      publicPkts = parsePkts publicPayload
      firstPkt label pkts =
        case pkts of
          [] -> assertFailure (label ++ " should contain at least one packet") >> fail "missing packet"
          pkt:_ -> pure pkt
  firstSecret <- firstPkt "secret armor fixture" secretPkts
  firstPublic <- firstPkt "public armor fixture" publicPkts
  let sig = SignaturePkt (SigV4 BinarySig RSA SHA256 [] [] 0 (NE.fromList [MPI 1]))
  assertEqual "recommendedArmorType rejects empty packet streams" Nothing (recommendedArmorType [])
  assertEqual
    "recommendedArmorType maps secret-key packets to private key armor"
    (Just ArmorPrivateKeyBlock)
    (recommendedArmorType [firstSecret])
  assertEqual
    "recommendedArmorType maps public-key packets to public key armor"
    (Just ArmorPublicKeyBlock)
    (recommendedArmorType [firstPublic])
  assertEqual
    "recommendedArmorType maps signature packets to signature armor"
    (Just ArmorSignature)
    (recommendedArmorType [sig])
  assertEqual
    "recommendedArmorType defaults non-key/signature packets to message armor"
    (Just ArmorMessage)
    (recommendedArmorType [LiteralDataPkt BinaryData "" 0 "payload"])
testSingleClearSignedBlock :: Assertion
testSingleClearSignedBlock = do
  let clearSigned =
        ClearSigned
          [("Hash", "SHA256")]
          "signed cleartext payload\n"
          (Armor ArmorSignature [("Version", "test-suite")] "detached-signature")
  assertEqual
    "singleClearSignedBlock extracts cleartext and signature payloads"
    (Right ([("Hash", "SHA256")], "signed cleartext payload\n", "detached-signature"))
    (singleClearSignedBlock [clearSigned])
  assertBool
    "singleClearSignedBlock rejects absent clear-signed blocks"
    (isLeft (singleClearSignedBlock [Armor ArmorMessage [] "payload"]))
  assertBool
    "singleClearSignedBlock rejects multiple clear-signed blocks"
    (isLeft (singleClearSignedBlock [clearSigned, clearSigned]))
  assertBool
    "singleClearSignedBlock rejects non-signature inner armor blocks"
    (isLeft (singleClearSignedBlock [ClearSigned [] "payload" (Armor ArmorMessage [] "not-signature")]))
testSignerTimelineSoftPrimaryRevocation :: Assertion
testSignerTimelineSoftPrimaryRevocation = do
  (signer, signingKey) <- loadUnencryptedRsaSigner
  let payload = "soft primary revocation timeline payload"
      keyCreated = _timestamp signer
      sigBeforeTime = addTimestampSeconds keyCreated 10
      revocationTime = addTimestampSeconds keyCreated 20
      sigAfterTime = addTimestampSeconds keyCreated 30
  sigBefore <-
    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload
  revocation <-
    signKeyRevocationWithReasonAt signer signingKey revocationTime KeySuperseded
  sigAfter <-
    signBinaryMessageWithRSAAt signer signingKey sigAfterTime payload
  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]
  assertSingleSignerFingerprint
    "soft primary revocation should preserve pre-revocation signatures"
    (fingerprint signer)
    (verifyTimelinePackets keyring payload sigBefore)
  assertSingleFailureContainsTimeline
    "soft primary revocation should reject post-revocation signatures"
    "signing key is revoked"
    (verifyTimelinePackets keyring payload sigAfter)

testSignerTimelineHardPrimaryRevocation :: Assertion
testSignerTimelineHardPrimaryRevocation = do
  (signer, signingKey) <- loadUnencryptedRsaSigner
  let payload = "hard primary revocation timeline payload"
      keyCreated = _timestamp signer
      sigBeforeTime = addTimestampSeconds keyCreated 10
      revocationTime = addTimestampSeconds keyCreated 20
  sigBefore <-
    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload
  revocation <-
    signKeyRevocationWithReasonAt signer signingKey revocationTime KeyMaterialCompromised
  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]
  assertSingleFailureContainsTimeline
    "hard primary revocation should reject even pre-revocation signatures"
    "signing key is revoked"
    (verifyTimelinePackets keyring payload sigBefore)

testSignerTimelineNoReasonPrimaryRevocation :: Assertion
testSignerTimelineNoReasonPrimaryRevocation = do
  (signer, signingKey) <- loadUnencryptedRsaSigner
  let payload = "no-reason primary revocation timeline payload"
      keyCreated = _timestamp signer
      sigBeforeTime = addTimestampSeconds keyCreated 10
      revocationTime = addTimestampSeconds keyCreated 20
  sigBefore <-
    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload
  revocation <-
    signKeyRevocationWithReasonAt signer signingKey revocationTime NoReason
  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]
  assertSingleFailureContainsTimeline
    "no-reason primary revocation should reject even pre-revocation signatures"
    "signing key is revoked"
    (verifyTimelinePackets keyring payload sigBefore)

testSignerTimelineUnknownReasonPrimaryRevocation :: Assertion
testSignerTimelineUnknownReasonPrimaryRevocation = do
  (signer, signingKey) <- loadUnencryptedRsaSigner
  let payload = "unknown-reason primary revocation timeline payload"
      keyCreated = _timestamp signer
      sigBeforeTime = addTimestampSeconds keyCreated 10
      revocationTime = addTimestampSeconds keyCreated 20
  sigBefore <-
    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload
  revocation <-
    signKeyRevocationWithReasonAt signer signingKey revocationTime (RCoOther 100)
  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]
  assertSingleFailureContainsTimeline
    "unknown-reason primary revocation should reject even pre-revocation signatures"
    "signing key is revoked"
    (verifyTimelinePackets keyring payload sigBefore)

testSignerTimelineNonCompromisePrimaryRevocationIsHistorical :: Assertion
testSignerTimelineNonCompromisePrimaryRevocationIsHistorical = do
  (signer, signingKey) <- loadUnencryptedRsaSigner
  let payload = "non-compromise primary revocation timeline payload"
      keyCreated = _timestamp signer
      sigBeforeTime = addTimestampSeconds keyCreated 10
      revocationTime = addTimestampSeconds keyCreated 20
      sigAfterTime = addTimestampSeconds keyCreated 30
  sigBefore <-
    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload
  revocation <-
    signKeyRevocationWithReasonAt
      signer
      signingKey
      revocationTime
      UserIdInfoNoLongerValid
  sigAfter <-
    signBinaryMessageWithRSAAt signer signingKey sigAfterTime payload
  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]
  assertSingleSignerFingerprint
    "non-compromise primary revocation should preserve pre-revocation signatures"
    (fingerprint signer)
    (verifyTimelinePackets keyring payload sigBefore)
  assertSingleFailureContainsTimeline
    "non-compromise primary revocation should reject post-revocation signatures"
    "signing key is revoked"
    (verifyTimelinePackets keyring payload sigAfter)

testSignerTimelineTemporaryPrimaryRevocationExpires :: Assertion
testSignerTimelineTemporaryPrimaryRevocationExpires = do
  (signer, signingKey) <- loadUnencryptedRsaSigner
  let payload = "temporary primary revocation expiry timeline payload"
      keyCreated = _timestamp signer
      sigBeforeTime = addTimestampSeconds keyCreated 10
      revocationTime = addTimestampSeconds keyCreated 20
      sigDuringTime = addTimestampSeconds keyCreated 25
      sigAfterTime = addTimestampSeconds keyCreated 35
  sigBefore <-
    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload
  revocation <-
    signKeyRevocationWithReasonAndExtrasAt
      signer
      signingKey
      revocationTime
      KeySuperseded
      [SigSubPacket False (SigExpirationTime 10)]
  sigDuring <-
    signBinaryMessageWithRSAAt signer signingKey sigDuringTime payload
  sigAfter <-
    signBinaryMessageWithRSAAt signer signingKey sigAfterTime payload
  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]
  assertSingleSignerFingerprint
    "temporary primary revocation should preserve pre-revocation signatures"
    (fingerprint signer)
    (verifyTimelinePackets keyring payload sigBefore)
  assertSingleFailureContainsTimeline
    "temporary primary revocation should reject signatures while revocation is effective"
    "signing key is revoked"
    (verifyTimelinePackets keyring payload sigDuring)
  assertSingleSignerFingerprint
    "temporary primary revocation should allow signatures after revocation expiration"
    (fingerprint signer)
    (verifyTimelinePackets keyring payload sigAfter)

testSignerTimelineSubkeyRevocation :: Assertion
testSignerTimelineSubkeyRevocation = do
  (primarySigner, primarySigningKey) <- loadUnencryptedRsaSigner
  (subkeySigner, subkeySigningKey) <- loadDeterministicEd25519Signer
  let payload = "subkey revocation timeline payload"
      keyCreated = _timestamp primarySigner
      bindingTime = addTimestampSeconds keyCreated 10
      sigBeforeTime = addTimestampSeconds keyCreated 20
      revocationTime = addTimestampSeconds keyCreated 30
      sigAfterTime = addTimestampSeconds keyCreated 40
      subkeyPacket = PublicSubkeyPkt subkeySigner
  bindingSig <-
    signSubkeyBindingWithRSAAt primarySigner subkeySigner primarySigningKey bindingTime
  sigBefore <-
    signBinaryMessageWithEd25519At subkeySigner subkeySigningKey sigBeforeTime payload
  revocationSig <-
    signSubkeyRevocationWithRSAAt primarySigner subkeySigner primarySigningKey revocationTime
  sigAfter <-
    signBinaryMessageWithEd25519At subkeySigner subkeySigningKey sigAfterTime payload
  let keyring =
        mkTestKeyring
          [TKUnknown (primarySigner, Nothing) [] [] [] [(subkeyPacket, [bindingSig, revocationSig])]]
  assertSingleSignerFingerprint
    "subkey revocation should preserve pre-revocation signatures"
    (fingerprint subkeySigner)
    (verifyTimelinePackets keyring payload sigBefore)
  assertSingleFailureContainsTimeline
    "subkey revocation should reject post-revocation signatures"
    "signing key was not valid at the signature creation time"
    (verifyTimelinePackets keyring payload sigAfter)

testSignMessageConvenience :: Assertion
testSignMessageConvenience = do
  (signer, signingKey) <- loadUnencryptedRsaSigner
  signerV4 <- expectV4PKPayload "RSA v4 convenience signer" signer
  signedResult <- signMessage (mkRSASignerV4 signerV4 signingKey) "message-api convenience signing payload"
  signedMessage <-
    case signedResult of
      Left err ->
        assertFailure ("message signing convenience API failed: " ++ show err) >> pure mempty
      Right bs -> pure bs
  case parsePkts signedMessage of
    [LiteralDataPkt {}, SignaturePkt _] -> pure ()
    _ -> assertFailure "convenience signing output should contain literal data and one signature packet"

testTypedVerifySurfaceMatchesLegacy :: Assertion
testTypedVerifySurfaceMatchesLegacy = do
  kr <- loadKeyring "pubring.gpg"
  signedMessage <- readFixtureLazy "uncompressed-ops-rsa.gpg"
  let typedResults =
        verifyMessage
          defaultVerificationOptions
            { verificationPolicy = VerifyInformational
            , verificationMode = VerificationStreaming
            }
          kr
          signedMessage
      strictResults =
        verifyMessage
          defaultVerificationOptions
            { verificationPolicy = VerifyStrict
            , verificationMode = VerificationStreaming
            }
          kr
          signedMessage
      normalizeTyped :: Either VerificationError Verification -> Either Bool Fingerprint
      normalizeTyped (Left _) = Left False
      normalizeTyped (Right v) = Right (fingerprint (_verificationSigner v))
  assertEqual
    "strict verification should collapse informational failures"
    (map normalizeTyped (either (pure . Left) (Right <$>) (sequence typedResults)))
    (map normalizeTyped strictResults)
  assertBool
    "informational verification should emit at least one result for known-good fixture"
    (not (null (map normalizeTyped typedResults)))

testVerifyMessageStrictRejectsTamper :: Assertion
testVerifyMessageStrictRejectsTamper = do
  kr <- loadKeyring "pubring.gpg"
  packets <- loadAndDecompressPkts "uncompressed-ops-rsa.gpg"
  let tamperedPackets = map tamperLiteral packets
      strictOptions =
        defaultVerificationOptions
          { verificationPolicy = VerifyStrict
          , verificationMode = VerificationStreaming
          }
  case verifyMessagePackets strictOptions kr tamperedPackets of
    [Left _] -> pure ()
    _ -> assertFailure "strict typed verification should fail on tampered payload"
  where
    tamperLiteral (LiteralDataPkt dt fn ts payload) =
      LiteralDataPkt dt fn ts (BL.snoc payload 0)
    tamperLiteral pkt = pkt

testVerifySignedMessageConvenience :: Assertion
testVerifySignedMessageConvenience = do
  kr <- loadKeyring "pubring.gpg"
  signedMessage <- readFixtureLazy "uncompressed-ops-rsa.gpg"
  strictResult <-
    pure
      (verifySignedMessage
         defaultVerificationOptions
           { verificationPolicy = VerifyStrict
           , verificationMode = VerificationStreaming
           }
         kr
         signedMessage)
  case strictResult of
    [Left _] -> assertFailure "verifySignedMessage should succeed for known-good fixture"
    verifications ->
      assertBool "verifySignedMessage should emit at least one verification" (not (null verifications))

testVerifyV4EdDSASignatureWithEd25519KeyAlgorithm :: Assertion
testVerifyV4EdDSASignatureWithEd25519KeyAlgorithm = do
  (signer, signingKey) <- loadDeterministicEd25519Signer
  let signerWithEd25519Pka = setPKAlgorithm PKA.Ed25519 signer
  signerV4 <- expectV4PKPayload "Ed25519 v4 signer with Ed25519 key algorithm" signerWithEd25519Pka
  let payload = "v4 eddsa signature with Ed25519 key algorithm"
      state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}
      keyring = mkTestKeyring [TKUnknown (signerWithEd25519Pka, Nothing) [] [] [] []]
  signedResult <-
    signMessageWith
      (mkEd25519SignerV4 signerV4 signingKey)
      (mkClearPayload payload)
  signaturePkt <-
    case signedResult of
      Left err ->
        assertFailure ("Ed25519 message signing failed: " ++ show err) >>
        fail "expected signed Ed25519 payload"
      Right signedMessage ->
        case parsePkts signedMessage of
          [LiteralDataPkt {}, sig@(SignaturePkt (SigV4 BinarySig PKA.Ed25519 SHA512 _ _ _ _))] ->
            pure sig
          other ->
            assertFailure
              ("Expected [LiteralDataPkt, Ed25519 SigV4] for Ed25519-key-algorithm verification test, got " ++
               show other) >>
            fail "unexpected Ed25519-key-algorithm signature shape"
  case verifySigWith (verifyAgainstKeyring keyring) signaturePkt state Nothing of
    Left err ->
      assertFailure
        ("Ed25519 SigV4 verification with Ed25519 key algorithm failed: " ++
         renderVerificationError err)
    Right _ -> pure ()
