-- 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 Control.Lens ((^.))
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.RSA as RSA
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.Either (isLeft, isRight)
import Data.Foldable (forM_)
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 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 qualified Codec.Encryption.OpenPGP.Internal.Whitespace as WS
import Codec.Encryption.OpenPGP.KeyringParser (parsePublicTKs)
import Codec.Encryption.OpenPGP.Message
import Codec.Encryption.OpenPGP.Policy
    ( defaultVerificationPolicy
    , signatureV6SaltSizeForHashAlgorithm
    )
import Codec.Encryption.OpenPGP.S2K (renderS2KError, string2Key)
import Codec.Encryption.OpenPGP.Serialize
    ( armorPayloadsOfType
    , parsePkts
    , parsePktsEither
    , recommendedArmorType
    , singleArmorPayloadOfType
    , singleClearSignedBlock
    )
import Codec.Encryption.OpenPGP.SerializeForSigs
    ( payloadForSig
    , payloadForSigWith
    )
import Codec.Encryption.OpenPGP.Signatures
    ( SignError (..)
    , VerificationError (..)
    , renderSignError
    , renderVerificationError
    , signCertRevocationWithRSA
    , signCertificationWithRSA
    , signDataWithEd25519
    , signDataWithEd25519Builder
    , signDataWithEd25519V6
    , signDataWithEd25519V6Builder
    , signDataWithEd448
    , signDataWithEd448V6
    , signDataWithRSA
    , signDataWithRSABuilder
    , signDirectKeyWithRSA
    , signKeyRevocationWithRSA
    , signSubkeyRevocationWithRSA
    , verifyAgainstKeyring
    , verifyAgainstKeys
    , verifySigWith
    )
import Codec.Encryption.OpenPGP.Subpackets
    ( TextNormalizationMode (..)
    , addHashedSubs
    , addUnhashedSubs
    , listToHashedSubs
    , listToUnhashedSubs
    , sbTextNormMode
    , sigBuilderInit
    )
import Codec.Encryption.OpenPGP.Types
import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA
import Codec.Encryption.OpenPGP.Types.Internal.TK
    ( someTKToPublicTK
    )
import Data.Conduit.OpenPGP.Message
    ( verifyMessage
    , verifyMessagePackets
    )
import Data.Conduit.OpenPGP.Verify (VerificationMode (..))
import Tests.Common
    ( addTimestampSeconds
    , assertSingleFailureContainsTimeline
    , assertSingleSignerFingerprint
    , encryptMessageDefault
    , expectV4PKPayload
    , expectV6PKPayload
    , extractV4SignatureAlgorithmFields
    , fp
    , loadAndDecompressPkts
    , loadArmor
    , loadDeterministicEd25519Signer
    , loadDeterministicEd25519SignerV6
    , loadDeterministicEd448Signer
    , loadDeterministicEd448SignerV6
    , loadKeyring
    , loadUnencryptedRsaSigner
    , loadUnencryptedRsaSignerV6
    , messageIssuerSubpacketsAt
    , mkTestKeyring
    , readFixtureLazy
    , setPKAlgorithm
    , signBinaryMessageWithEd25519At
    , signBinaryMessageWithRSAAt
    , signKeyRevocationWithReasonAndExtrasAt
    , signKeyRevocationWithReasonAt
    , 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
            , testCase
                "streaming whitespace functions match strict variants"
                testStreamingWhitespaceMatchesStrict
            ]
        , 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 TK"
                ( 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 TK"
                (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 TK"
                ( 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 = parsePublicTKs 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 (tk ^. tkRevs)))
                else pure ()
            assertEqual
                (fixture ++ " revocation certificate should not carry user IDs")
                []
                (tk ^. tkUIDs)
            assertEqual
                ( fixture
                    ++ " revocation certificate should not carry user attributes"
                )
                []
                (tk ^. tkUAts)
            assertEqual
                (fixture ++ " revocation certificate should not carry subkeys")
                []
                (tk ^. tkSubs)
        _ ->
            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 = Passphrase "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 = Passphrase "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 = Passphrase 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 = Passphrase "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 = Passphrase 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 = Passphrase "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 = Passphrase "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 = Passphrase 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 = Passphrase "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 = Passphrase "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 = Passphrase "correct passphrase"
        wrongPassphrase = Passphrase "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 = Passphrase "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 =
            [ TK
                { _tkPrimaryKey = KeyPktPublicPrimary signer
                , _tkRevs = []
                , _tkUIDs = []
                , _tkUAts = []
                , _tkSubs = []
                }
            ]
    case verifySigWith
        defaultVerificationPolicy
        (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 =
            [ TK
                { _tkPrimaryKey = KeyPktPublicPrimary signer
                , _tkRevs = []
                , _tkUIDs = []
                , _tkUAts = []
                , _tkSubs = []
                }
            ]
    case verifySigWith
        defaultVerificationPolicy
        (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 =
                    [ TK
                        { _tkPrimaryKey = KeyPktPublicPrimary signer
                        , _tkRevs = []
                        , _tkUIDs = []
                        , _tkUAts = []
                        , _tkSubs = []
                        }
                    ]
            case verifySigWith
                defaultVerificationPolicy
                (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 =
            [ TK
                { _tkPrimaryKey = KeyPktPublicPrimary signer
                , _tkRevs = []
                , _tkUIDs = []
                , _tkUAts = []
                , _tkSubs = []
                }
            ]
    case verifySigWith
        defaultVerificationPolicy
        (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
                [ TK
                    { _tkPrimaryKey = KeyPktPublicPrimary signer
                    , _tkRevs = []
                    , _tkUIDs = []
                    , _tkUAts = []
                    , _tkSubs = []
                    }
                ]
    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
        defaultVerificationPolicy
        (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
                [ TK
                    { _tkPrimaryKey = KeyPktPublicPrimary signer
                    , _tkRevs = []
                    , _tkUIDs = []
                    , _tkUAts = []
                    , _tkSubs = []
                    }
                ]
        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
        defaultVerificationPolicy
        (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 =
            [ TK
                { _tkPrimaryKey = KeyPktPublicPrimary signer
                , _tkRevs = []
                , _tkUIDs = []
                , _tkUAts = []
                , _tkSubs = []
                }
            ]
    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
        defaultVerificationPolicy
        (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 =
            [ TK
                { _tkPrimaryKey = KeyPktPublicPrimary signer
                , _tkRevs = []
                , _tkUIDs = []
                , _tkUAts = []
                , _tkSubs = []
                }
            ]
        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
        defaultVerificationPolicy
        (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)

testStreamingWhitespaceMatchesStrict :: Assertion
testStreamingWhitespaceMatchesStrict = do
    let inputs =
            [ BL.pack [0x0d, 0x0a, 0x0a, 0x0d, 0x0d, 0x0a]
            , BL.pack [0x0a, 0x0d, 0x0d, 0x0a]
            , BL.pack [0x20, 0x09, 0x0d, 0x0a, 0x20, 0x09]
            , BL.empty
            , BL.singleton 0x0d
            , BL.singleton 0x0a
            , BL.fromChunks [B.pack [0x0a], B.pack [0x0d], B.pack [0x0d, 0x0a]]
            , BL.fromChunks [B.pack [0x0d], B.pack [0x0a], B.pack [0x0a]]
            , BL.fromChunks
                [B.pack [0x0d, 0x0a], B.pack [0x20, 0x09, 0x0d, 0x0a]]
            , BL.fromChunks [B.pack [0x20, 0x09, 0x0d], B.pack [0x0a]]
            ]
    forM_ inputs $ \bs -> do
        let chunks = BL.toChunks bs
            go (st, acc) c =
                let (st', out) = WS.canonicalizeLineEndingsChunk st c
                 in (st', out : acc)
            (st1, out1) = foldl' go (WS.CRState False, []) chunks
            finalOut = WS.canonicalizeLineEndingsFlush st1
            chunkResult = BL.fromChunks $ reverse $ finalOut : out1
        assertEqual
            ( "canonicalizeLineEndingsChunk+Flush matches canonicalizeLineEndings for "
                ++ show (BL.unpack bs)
            )
            (WS.canonicalizeLineEndings bs)
            chunkResult

        let go2 (st, acc) c =
                let (st', out) = WS.stripTrailingWhitespacePerLineChunk st c
                 in (st', out : acc)
            (st2, out2) = foldl' go2 (WS.StripWSState False B.empty, []) chunks
            wsFinalOut = WS.stripTrailingWhitespacePerLineFlush st2
            wsChunkResult = BL.fromChunks $ reverse $ wsFinalOut : out2
        assertEqual
            ( "stripTrailingWhitespacePerLineChunk+Flush matches stripTrailingWhitespacePerLine for "
                ++ show (BL.unpack bs)
            )
            (WS.stripTrailingWhitespacePerLine bs)
            wsChunkResult

    let chunks = BL.toChunks $ BL.pack [0x0d, 0x0a, 0x0a, 0x0d, 0x0d, 0x0a]
        go (st, acc) c =
            let (st', out) = WS.canonicalizeLineEndingsChunk st c
             in (st', out : acc)
        (st1, out1) = foldl' go (WS.CRState False, []) chunks
        finalOut = WS.canonicalizeLineEndingsFlush st1
        chunkResult = BL.fromChunks $ reverse $ finalOut : out1
    assertEqual
        "canonicalizeLineEndingsChunk+Flush matches canonicalizeLineEndings"
        ( WS.canonicalizeLineEndings $
            BL.pack [0x0d, 0x0a, 0x0a, 0x0d, 0x0d, 0x0a]
        )
        chunkResult

    let wsInput = BL.pack [0x20, 0x09, 0x0d, 0x0a, 0x20, 0x09, 0x0d, 0x0a]
        wsChunks = BL.toChunks wsInput
        go2 (st, acc) c =
            let (st', out) = WS.stripTrailingWhitespacePerLineChunk st c
             in (st', out : acc)
        (st2, out2) = foldl' go2 (WS.StripWSState False B.empty, []) wsChunks
        wsFinalOut = WS.stripTrailingWhitespacePerLineFlush st2
        wsChunkResult = BL.fromChunks $ reverse $ wsFinalOut : out2
    assertEqual
        "stripTrailingWhitespacePerLineChunk+Flush matches stripTrailingWhitespacePerLine"
        (WS.stripTrailingWhitespacePerLine wsInput)
        wsChunkResult

    let wsInput2 = BL.pack [0x20, 0x09, 0x0d, 0x0a, 0x20, 0x09, 0x0d, 0x0a]
        wsChunks2 = BL.toChunks wsInput2
        go3 (st, acc) c =
            let (st', out) = WS.stripTrailingWhitespacePerLineChunk st c
             in (st', out : acc)
        (st3, out3) = foldl' go3 (WS.StripWSState False B.empty, []) wsChunks2
        wsFinalOut3 = WS.stripTrailingWhitespacePerLineFlush st3
        wsChunkResult3 = BL.fromChunks $ reverse $ wsFinalOut3 : out3
    assertEqual
        "stripTrailingWhitespacePerLineChunk+Flush matches stripTrailingWhitespacePerLine on combined input"
        (WS.stripTrailingWhitespacePerLine wsInput2)
        wsChunkResult3

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
                [ TK
                    { _tkPrimaryKey = KeyPktPublicPrimary signer
                    , _tkRevs = []
                    , _tkUIDs = []
                    , _tkUAts = []
                    , _tkSubs = []
                    }
                ]
    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
                [ TK
                    { _tkPrimaryKey = KeyPktPublicPrimary signer
                    , _tkRevs = [revocation]
                    , _tkUIDs = []
                    , _tkUAts = []
                    , _tkSubs = []
                    }
                ]
    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
                [ TK
                    { _tkPrimaryKey = KeyPktPublicPrimary signer
                    , _tkRevs = [revocation]
                    , _tkUIDs = []
                    , _tkUAts = []
                    , _tkSubs = []
                    }
                ]
    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
                [ TK
                    { _tkPrimaryKey = KeyPktPublicPrimary signer
                    , _tkRevs = [revocation]
                    , _tkUIDs = []
                    , _tkUAts = []
                    , _tkSubs = []
                    }
                ]
    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
                [ TK
                    { _tkPrimaryKey = KeyPktPublicPrimary signer
                    , _tkRevs = [revocation]
                    , _tkUIDs = []
                    , _tkUAts = []
                    , _tkSubs = []
                    }
                ]
    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
                [ TK
                    { _tkPrimaryKey = KeyPktPublicPrimary signer
                    , _tkRevs = [revocation]
                    , _tkUIDs = []
                    , _tkUAts = []
                    , _tkSubs = []
                    }
                ]
    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
                [ TK
                    { _tkPrimaryKey = KeyPktPublicPrimary signer
                    , _tkRevs = [revocation]
                    , _tkUIDs = []
                    , _tkUAts = []
                    , _tkSubs = []
                    }
                ]
    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 = KeyPktPublicSubkey 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
                [ TK
                    { _tkPrimaryKey = KeyPktPublicPrimary primarySigner
                    , _tkRevs = []
                    , _tkUIDs = []
                    , _tkUAts = []
                    , _tkSubs = [(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
                [ TK
                    { _tkPrimaryKey = KeyPktPublicPrimary signerWithEd25519Pka
                    , _tkRevs = []
                    , _tkUIDs = []
                    , _tkUAts = []
                    , _tkSubs = []
                    }
                ]
    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
        defaultVerificationPolicy
        (verifyAgainstKeyring keyring)
        signaturePkt
        state
        Nothing of
        Left err ->
            assertFailure
                ( "Ed25519 SigV4 verification with Ed25519 key algorithm failed: "
                    ++ renderVerificationError err
                )
        Right _ -> pure ()
