-- Keys.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 ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Tests.Keys (keyAndVerificationTests) where

import Control.Error.Util (isRight)
import Crypto.Number.Serialize (os2ip)
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import Data.Bifunctor (first)
import Data.Binary (get, put)
import Data.Binary.Get (Get, runGetOrFail)
import Data.Binary.Put (runPut)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Conduit as DC
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import Data.Conduit.Serialization.Binary (conduitGet)
import Data.IxSet.Typed (getOne, size, (@=))
import Data.List (find, isInfixOf)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (isJust, mapMaybe)
import qualified Data.Set as Set
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Prettyprinter (pretty)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit
    ( Assertion
    , assertBool
    , assertEqual
    , assertFailure
    , testCase
    )

import Codec.Encryption.OpenPGP.Expirations
    ( effectiveKeyPreferencesAtTimestamp
    , effectiveUIDPreferencesAtTimestamp
    , isTKTimeValid
    )
import Codec.Encryption.OpenPGP.Fingerprint
    ( eightOctetKeyID
    , fingerprint
    )
import Codec.Encryption.OpenPGP.Internal
    ( emptyPSC
    , lastPrimaryKey
    , lastSubkey
    )
import Codec.Encryption.OpenPGP.KeyInfo
    ( pkalgoAbbrev
    , pubkeySize
    )
import Codec.Encryption.OpenPGP.Message
    ( asV6PKPayload
    , mkEd25519SignerV6
    , mkRSASignerV6
    )
import Codec.Encryption.OpenPGP.Policy
    ( OpenPGPRFC (..)
    , defaultPolicy
    , defaultVerificationPolicy
    , isAllowedPrimaryKeySig
    , isAllowedSubkeySig
    , isAllowedUIDSig
    )
import Codec.Encryption.OpenPGP.SecretKey
    ( SecretKeyEncryptOptions (..)
    , changePrivateKeyPassphrase
    , changeSecretKeyPassphrase
    , decryptPrivateKey
    , decryptSecretKey
    , decryptSecretKeyAddendum
    , encryptSecretKey
    , encryptSecretKeyWithPolicy
    , mkUnencryptedSKAddendum
    , reencryptSecretKey
    , reencryptSecretKeyRandom
    , reinterpretUnknownSKeyForPKPayload
    )
import Codec.Encryption.OpenPGP.Serialize
    ( getSecretKey
    , parsePkts
    , putSKeyForPKPayload
    )
import Codec.Encryption.OpenPGP.SerializeForSigs (payloadForSig)
import Codec.Encryption.OpenPGP.Signatures
import Codec.Encryption.OpenPGP.Subpackets
    ( LegalSubpacket (..)
    , addHashedSubs
    , addUnhashedSubs
    , listToHashedSubs
    , listToLegalSubs
    , listToUnhashedSubs
    , sigBuilderInit
    , sigBuilderInitRuntime
    , sigBuilderInitV6
    , sigBuilderInitV6Runtime
    )
import Codec.Encryption.OpenPGP.Types
import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA
import Data.Conduit.OpenPGP.Compression (conduitDecompress)
import Data.Conduit.OpenPGP.Keyring
    ( conduitDropErrorsAndNothings
    , conduitToSomeTKsEither
    )
import Data.Conduit.OpenPGP.Verify (conduitVerify)
import Tests.Common
    ( addTimestampSeconds
    , armorPayload
    , assertFalse
    , assertSingleFailureContainsTimeline
    , assertSingleSignerFingerprint
    , assertTrue
    , certificateVerificationFixtures
    , fixturePath
    , loadAndDecompressPkts
    , loadArmor
    , loadDeterministicEd25519Signer
    , loadKeyring
    , loadUnencryptedRsaSigner
    , loadUnencryptedRsaSignerV6
    , messageIssuerSubpacketsAt
    , messageVerificationFixtures
    , mkTestKeyring
    , readFixturePayload
    , readPKIPassphrase
    , runGet
    , setKeyVersion
    , signBinaryMessageWithRSAAt
    , signCertificationAt
    , signCertificationRevocationAt
    , signCertificationRevocationWithEd25519At
    , signCertificationWithEd25519At
    , signSubkeyBindingWithRSAExtrasAt
    , timestampToUTCTime
    , verificationFixtureGroup
    , verifyMessageFromBytestring
    , verifyMessageFromBytestringBatch
    , verifyMessageFromPackets
    , verifyMessageFromPacketsBatch
    , verifyTimelinePackets
    )

keyAndVerificationTests :: TestTree
keyAndVerificationTests =
    testGroup
        "Keys and verification"
        [ testGroup
            "PKA/Size/KeyID/fingerprint group"
            [ testCase
                "v3 key"
                ( testPKAandSizeAndKeyIDandFingerprint
                    "v3.key"
                    "rsa/1024:6DC580F5C7261095/CBD9 F412 6807 E405 CC2D  2712 1DF5 E86E"
                )
            , testCase
                "v4 key"
                ( testPKAandSizeAndKeyIDandFingerprint
                    "000001-006.public_key"
                    "rsa/1248:D4D54EA16F87040E/421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"
                )
            , testCase
                "ECDSA key"
                ( testPKAandSizeAndKeyIDandFingerprint
                    "nist_p-256_key.gpg"
                    "ecd/256:F7708BADD6063224/174C CF12 C571 6D0E 527F  B50E F770 8BAD D606 3224"
                )
            , testCase
                "EdDSA key"
                ( testPKAandSizeAndKeyIDandFingerprint
                    "sample-eddsa.pubkey"
                    "edd/256:8CFDE12197965A9A/C959 BDBA FA32 A2F8 9A15  3B67 8CFD E121 9796 5A9A"
                )
            , testCase
                "EdDSA secret key (projected to public key packet)"
                ( testPKAandSizeAndKeyIDandFingerprint
                    "ed25519.secretkey"
                    "edd/256:B05F9287601D5914/B6FE 0C23 12EB D832 0238  C252 B05F 9287 601D 5914"
                )
            , testCase
                "v6 secret key (projected to public key packet)"
                ( testPKAandSizeAndKeyIDandFingerprint
                    "v6-secret.pgp.aa"
                    "e25/256:7106CB6DB27E4FC9/7106 CB6D B27E 4FC9 B050  B02B B316 4DBD 4BBD 7263  D4D2 9E78 A3BB 3BDB B022  2D19"
                )
            ]
        , testGroup
            "Keyring group"
            [ testCase
                "pubring 7732CF988A63EA86"
                (testKeyringLookup "pubring.gpg" "7732CF988A63EA86" True)
            , testCase
                "pubring 123456789ABCDEF0"
                (testKeyringLookup "pubring.gpg" "123456789ABCDEF0" False)
            , testCase
                "pubsub AD992E9C24399832"
                (testKeyringLookup "pubring.gpg" "AD992E9C24399832" True)
            , testCase
                "secring 7732CF988A63EA86"
                (testKeyringLookup "secring.gpg" "7732CF988A63EA86" True)
            , testCase
                "secring 123456789ABCDEF0"
                (testKeyringLookup "secring.gpg" "123456789ABCDEF0" False)
            , testCase
                "secsub AD992E9C24399832"
                (testKeyringLookup "secring.gpg" "AD992E9C24399832" True)
            , testCase
                "pubring.gpg has 4 keys"
                (testKeyringSize "pubring.gpg" 4)
            , testCase
                "secring.gpg has 4 keys"
                (testKeyringSize "secring.gpg" 4)
            ]
        , verificationFixtureGroup
            "Message verification group (packet-based)"
            verifyMessageFromPackets
            messageVerificationFixtures
        , verificationFixtureGroup
            "Message verification group (packet-based, batch)"
            verifyMessageFromPacketsBatch
            messageVerificationFixtures
        , verificationFixtureGroup
            "Message verification group (bytestring-based)"
            verifyMessageFromBytestring
            messageVerificationFixtures
        , verificationFixtureGroup
            "Message verification group (bytestring-based, batch)"
            verifyMessageFromBytestringBatch
            messageVerificationFixtures
        , verificationFixtureGroup
            "Certificate verification group (packet-based)"
            verifyMessageFromPackets
            certificateVerificationFixtures
        , verificationFixtureGroup
            "Certificate verification group (packet-based, batch)"
            verifyMessageFromPacketsBatch
            certificateVerificationFixtures
        , verificationFixtureGroup
            "Certificate verification group (bytestring-based)"
            verifyMessageFromBytestring
            certificateVerificationFixtures
        , verificationFixtureGroup
            "Certificate verification group (bytestring-based, batch)"
            verifyMessageFromBytestringBatch
            certificateVerificationFixtures
        , testGroup
            "Key verification group"
            [ testCase
                "6F87040E pubkey"
                (testKeysSelfVerification True "6F87040E.pubkey")
            , testCase
                "revoked pubkey"
                (testKeysSelfVerification False "revoked.pubkey")
            , testCase
                "expired pubkey"
                (testKeysSelfVerification True "expired.pubkey")
            , testCase
                "nist_p-256 pubkey"
                (testKeysSelfVerification True "nist_p-256_key.gpg")
            , testCase
                "ed25519 pubkey"
                (testKeysSelfVerification True "ed25519.pubkey")
            ]
        , testGroup
            "Verification error messaging group"
            [ testCase
                "missing signing key in keyring"
                ( testMissingSigningKeyMessage
                    "ecdsa-key-without-ecdh.pubkey"
                    "uncompressed-ops-rsa.gpg"
                )
            , testCase
                "tampered message signature mismatch"
                ( testTamperedSignatureMessage
                    "pubring.gpg"
                    "uncompressed-ops-rsa.gpg"
                )
            , testCase
                "revoked certificate reports revocation"
                (testRevokedCertificateMessage "revoked.pubkey")
            ]
        , testGroup
            "Key expiration group"
            [ testCase
                "6F87040E pubkey"
                (testKeysExpiration True "6F87040E.pubkey")
            , testCase
                "expired pubkey"
                (testKeysExpiration False "expired.pubkey")
            , testCase
                "nist_p-256 pubkey"
                (testKeysExpiration True "nist_p-256_key.gpg")
            , testCase
                "ed25519-without-curve25519.pubkey"
                (testKeysExpiration True "ed25519-without-curve25519.pubkey")
            , testCase
                "ed25519.pubkey"
                (testKeysExpiration True "ed25519.pubkey")
            ]
        , testGroup
            "misc group"
            [ testCase
                "conduitVerify processes SigV6 packets"
                testConduitVerifyProcessesSigV6
            , testCase "signature builder API (Phase 2)" testSignatureBuilders
            , testCase
                "typed legal subpacket builder API (P2.1)"
                testLegalSubpacketBuilders
            , testCase
                "legacy secret key passphrase changes preserve protection"
                testChangePrivateKeyPassphraseLegacy
            , testCase
                "change private key passphrase"
                testChangePrivateKeyPassphraseV6
            , testCase
                "high-level decrypt secret key (legacy)"
                testHighLevelDecryptSecretKeyLegacy
            , testCase
                "high-level decrypt secret key (v6)"
                testHighLevelDecryptSecretKeyV6
            , testCase
                "high-level re-encrypt secret key (legacy)"
                testHighLevelReencryptSecretKeyLegacy
            , testCase
                "high-level re-encrypt secret key (v6)"
                testHighLevelReencryptSecretKeyV6
            , testCase
                "high-level deterministic re-encrypt"
                testHighLevelReencryptDeterministic
            , testCase
                "getSecretKey parses v4 X25519 ECDH key material"
                testGetSecretKeyHandlesV4X25519ECDHPubkey
            , testCase
                "v4 Ed25519 secret-key roundtrip preserves leading zero byte"
                testV4Ed25519SecretKeyRoundTripPreservesLeadingZeroByte
            , testCase
                "v4 Ed448 secret-key roundtrip preserves leading zero byte"
                testV4Ed448SecretKeyRoundTripPreservesLeadingZeroByte
            , testCase
                "mkUnencryptedSKAddendum computes legacy secret-key checksum"
                testMkUnencryptedSKAddendumComputesLegacyChecksum
            , testCase
                "mkUnencryptedSKAddendum sets v6 unencrypted checksum to zero"
                testMkUnencryptedSKAddendumUsesV6ChecksumConvention
            , testCase
                "reinterpretUnknownSKeyForPKPayload decodes EdDSA unknown key material"
                testReinterpretUnknownSKeyForPKPayloadDecodesEdDSA
            , testCase
                "fromPrimaryKeyPktToSomeTK rejects subkey packets"
                testFromPrimaryKeyPktToSomeTKRejectsSubkey
            , testCase
                "policy signature context validation (RFC9580)"
                testPolicySignatureContextValidation
            , testCase
                "temporary validity uses latest effective self-signature window"
                testTemporaryKeyValidityRespectsLatestSelfSignature
            , testCase
                "temporary validity rejects gaps with no effective self-signature"
                testTemporaryKeyValidityRejectsSelfSignatureGaps
            , testCase
                "temporary validity rejects the gap before the first self-signature"
                testTemporaryKeyValidityRejectsPreCertificationGap
            , testCase
                "temporary validity follows temporary self-revocations"
                testTemporaryKeyValidityFollowsTemporarySelfRevocation
            , testCase
                "temporary validity does not revive older self-signatures after newer expiry"
                testTemporaryKeyValidityDoesNotReviveOlderSelfSignatures
            , testCase
                "uid-retired revocation is historical until effective"
                testUidRetiredRevocationIsHistorical
            , testCase
                "third-party certifications do not affect primary key validity windows"
                testThirdPartyCertificationDoesNotAffectKeyValidityWindow
            , testCase
                "certification revocations only remove matching signer certifications"
                testCertificationRevocationOnlyRemovesMatchingSigner
            , testCase
                "preference resolution tracks active self-certification timeline"
                testPreferencesAtTimestamp
            , testCase
                "verifySigWith rejects v6 revocation Issuer key-id subpackets"
                testVerifySigWithV6RevocationRejectsLegacyIssuerKeyID
            , testCase
                "verifySigWith rejects v6 revocation unhashed Issuer key-id subpackets"
                testVerifySigWithV6RevocationRejectsLegacyIssuerKeyIDInUnhashed
            , testCase
                "verifySigWith accepts matching v6 revocation IssuerFingerprint"
                testVerifySigWithV6RevocationAcceptsMatchingIssuerFingerprint
            , testCase
                "v6 signer constructor rejects v4 key"
                testV6SignerConstructorRejectsV4Key
            , testCase
                "primary key binding rejects unsupported critical hashed subpackets"
                testPrimaryKeyBindingRejectsUnsupportedCriticalSubpacket
            , testCase
                "subkey binding missing back-signature is surfaced as a warning"
                testSubkeyBindingMissingBackSignatureProducesWarning
            , testCase
                "subkey binding rejects unsupported critical hashed subpackets"
                testSubkeyBindingRejectsUnsupportedCriticalSubpacket
            ]
        ]

testPKAandSizeAndKeyIDandFingerprint
    :: FilePath -> String -> Assertion
testPKAandSizeAndKeyIDandFingerprint fpr kf = do
    bs <- readFixturePayload fpr
    case runGet (get :: Get Pkt) bs of
        Left _ -> assertFailure $ "Decoding of " ++ fpr ++ " broke."
        Right pkt ->
            case publicKeyPacketOf pkt of
                PublicKeyPkt pkp -> do
                    let pref =
                            concat
                                [ pkalgoAbbrev (_pkalgo pkp)
                                , "/"
                                , either (const "unknown") show (pubkeySize (_pubkey pkp))
                                , ":"
                                , either (const "unknown") (show . pretty) (eightOctetKeyID pkp)
                                , "/"
                                ]
                    assertEqual
                        ("for " ++ fpr ++ " (spaceless)")
                        (spaceless kf)
                        (pref ++ show (pretty (fingerprint pkp)))
                    assertEqual
                        ("for " ++ fpr ++ " (spaced)")
                        kf
                        (pref ++ show (pretty (SpacedFingerprint (fingerprint pkp))))
                _ ->
                    assertFailure
                        "Expected (possibly secret) key packet, got something else."
  where
    spaceless = filter (/= ' ')

testKeyringLookup :: FilePath -> String -> Bool -> Assertion
testKeyringLookup fpr eok expected = do
    kr <- loadKeyring fpr
    let foundKey = getOne (kr @= (read eok :: EightOctetKeyId))
    assertEqual (eok ++ " in " ++ fpr) expected (isJust foundKey)

testKeyringSize :: FilePath -> Int -> Assertion
testKeyringSize fpr expected = do
    kr <- loadKeyring fpr
    assertEqual ("key count in " ++ fpr) expected (size kr)

assertLeftContains
    :: String -> Either VerificationError a -> Assertion
assertLeftContains needle result =
    case result of
        Left err ->
            let rendered = renderVerificationError err
             in if needle `isInfixOf` rendered
                    then pure ()
                    else
                        assertFailure
                            ( "Expected error containing '"
                                ++ needle
                                ++ "', got '"
                                ++ rendered
                                ++ "'."
                            )
        Right _ ->
            assertFailure
                ("Expected Left containing '" ++ needle ++ "', got Right.")

testMissingSigningKeyMessage :: FilePath -> FilePath -> Assertion
testMissingSigningKeyMessage keyring message = do
    kr <- loadKeyring keyring
    verification <-
        DC.runConduitRes $
            CB.sourceFile (fixturePath message)
                DC..| conduitGet get
                DC..| conduitDecompress
                DC..| conduitVerify kr Nothing
                DC..| CL.consume
    case verification of
        [] -> assertFailure "Expected at least one verification result."
        (firstResult : _) ->
            assertLeftContains "signing key not found in keyring" firstResult

testTamperedSignatureMessage :: FilePath -> FilePath -> Assertion
testTamperedSignatureMessage keyring message = do
    kr <- loadKeyring keyring
    packets <- loadAndDecompressPkts message
    let tamperedPackets = map tamperLiteral packets
    verification <-
        DC.runConduitRes $
            CL.sourceList tamperedPackets
                DC..| conduitVerify kr Nothing
                DC..| CL.consume
    case verification of
        [] -> assertFailure "Expected at least one verification result."
        (firstResult : _) ->
            assertLeftContains "signature mismatch" firstResult
  where
    tamperLiteral (LiteralDataPkt dt fn ts payload) =
        LiteralDataPkt dt fn ts (BL.snoc payload 0)
    tamperLiteral pkt = pkt

testRevokedCertificateMessage :: FilePath -> Assertion
testRevokedCertificateMessage keyfile = do
    ks <-
        DC.runConduitRes $
            CB.sourceFile ("tests/data/" ++ keyfile)
                DC..| conduitGet get
                DC..| conduitToSomeTKsEither
                DC..| conduitDropErrorsAndNothings
                DC..| CL.consume
    let publicKs = mapMaybe someTKToPublicTK ks
    assertLeftContains
        "signing key is revoked"
        ( mapM
            ( verifyTKWith
                ( verifySigWith
                    defaultVerificationPolicy
                    (verifyAgainstKeys publicKs)
                )
                Nothing
            )
            publicKs
        )

testKeysSelfVerification :: Bool -> FilePath -> Assertion
testKeysSelfVerification expectsuccess keyfile = do
    ks <-
        DC.runConduitRes $
            CB.sourceFile ("tests/data/" ++ keyfile)
                DC..| conduitGet get
                DC..| conduitToSomeTKsEither
                DC..| conduitDropErrorsAndNothings
                DC..| CL.consume
    let publicKs = mapMaybe someTKToPublicTK ks
        verifieds =
            mapM
                ( verifyTKWith
                    ( verifySigWith
                        defaultVerificationPolicy
                        (verifyAgainstKeys publicKs)
                    )
                    Nothing
                )
                publicKs
    assertEqual
        (keyfile ++ " self-verification")
        expectsuccess
        (isRight verifieds)

testKeysExpiration :: Bool -> FilePath -> Assertion
testKeysExpiration expectsuccess keyfile = do
    ks <-
        DC.runConduitRes $
            CB.sourceFile (fixturePath keyfile)
                DC..| conduitGet get
                DC..| conduitToSomeTKsEither
                DC..| conduitDropErrorsAndNothings
                DC..| CL.consume
    let publicKs = mapMaybe someTKToPublicTK ks
    case mapM
        ( verifyTKWith
            ( verifySigWith
                defaultVerificationPolicy
                (verifyAgainstKeys publicKs)
            )
            Nothing
        )
        publicKs of
        Left err ->
            assertFailure
                ( keyfile
                    ++ " key self-verification failed before expiration check: "
                    ++ renderVerificationError err
                )
        Right verifieds -> do
            let tvalid =
                    all
                        ( isTKTimeValid
                            (posixSecondsToUTCTime (realToFrac (1400000000 :: Integer)))
                        )
                        verifieds
            assertEqual (keyfile ++ " key expiration") expectsuccess tvalid

testConduitVerifyProcessesSigV6 :: Assertion
testConduitVerifyProcessesSigV6 = do
    kr <- loadKeyring "pubring.gpg"
    let sigPayload =
            SigV6
                BinarySig
                RSA
                SHA256
                (SignatureSalt (BL.replicate 16 0))
                []
                []
                0
                (MPI 0 :| [])
        packets =
            [ LiteralDataPkt
                BinaryData
                BL.empty
                (ThirtyTwoBitTimeStamp 0)
                "payload"
            , SignaturePkt sigPayload
            ]
    verification <-
        DC.runConduitRes $
            CL.sourceList packets
                DC..| conduitVerify kr Nothing
                DC..| CL.consume
    case verification of
        [Left _] -> return ()
        other ->
            assertFailure
                ( "Expected one v6 verification result (failure is fine), got "
                    ++ show (length other)
                    ++ " results"
                )

testSubkeyBindingRejectsUnsupportedCriticalSubpacket :: Assertion
testSubkeyBindingRejectsUnsupportedCriticalSubpacket = do
    (primarySigner, primarySigningKey) <- loadUnencryptedRsaSigner
    (subkeySigner, _) <- loadDeterministicEd25519Signer
    let creationTime = addTimestampSeconds (_timestamp primarySigner) 10
    (hashed, unhashed) <-
        messageIssuerSubpacketsAt primarySigner creationTime
    let bindingPayload =
            payloadForSig
                SubkeyBindingSig
                emptyPSC
                    { lastPrimaryKey = PublicKeyPkt primarySigner
                    , lastSubkey = PublicSubkeyPkt subkeySigner
                    }
        hashedWithUnsupportedCritical =
            SigSubPacket True (OtherSigSub 111 "unsupported-critical")
                : hashed
        keyring =
            [ TK
                { _tkPrimaryKey = KeyPktPublicPrimary primarySigner
                , _tkRevs = []
                , _tkUIDs = []
                , _tkUAts = []
                , _tkSubs = []
                }
            ]
        state =
            emptyPSC
                { lastPrimaryKey = PublicKeyPkt primarySigner
                , lastSubkey = PublicSubkeyPkt subkeySigner
                }
    sigPayload <-
        case signDataWithRSA
            SubkeyBindingSig
            primarySigningKey
            hashedWithUnsupportedCritical
            unhashed
            bindingPayload of
            Left err ->
                assertFailure
                    ( "failed to sign subkey binding with unsupported critical subpacket: "
                        ++ renderSignError err
                    )
                    >> fail "expected subkey binding signature"
            Right sig -> pure sig
    case verifySigWith
        defaultVerificationPolicy
        (verifyAgainstKeys keyring)
        (SignaturePkt sigPayload)
        state
        Nothing of
        Left (UnsupportedCriticalSubpacket SubkeyBindingSig) -> pure ()
        Left err ->
            assertFailure
                ( "Expected unsupported critical subpacket rejection for subkey binding signature, got: "
                    ++ renderVerificationError err
                )
        Right _ ->
            assertFailure
                "Expected unsupported critical subpacket rejection for subkey binding signature, but verification succeeded"

testSubkeyBindingMissingBackSignatureProducesWarning :: Assertion
testSubkeyBindingMissingBackSignatureProducesWarning = do
    (primarySigner, primarySigningKey) <- loadUnencryptedRsaSigner
    (subkeySignerRaw, _) <- loadDeterministicEd25519Signer
    let subkeySigner = setKeyVersion V6 subkeySignerRaw
        creationTime = addTimestampSeconds (_timestamp primarySigner) 10
        keyring =
            [ TK
                { _tkPrimaryKey = KeyPktPublicPrimary primarySigner
                , _tkRevs = []
                , _tkUIDs = []
                , _tkUAts = []
                , _tkSubs = []
                }
            ]
        state =
            emptyPSC
                { lastPrimaryKey = PublicKeyPkt primarySigner
                , lastSubkey = PublicSubkeyPkt subkeySigner
                }
    sigPayload <-
        signSubkeyBindingWithRSAExtrasAt
            primarySigner
            subkeySigner
            primarySigningKey
            creationTime
            [SigSubPacket False (KeyFlags (Set.singleton SignDataKey))]
    case verifySigWith
        defaultVerificationPolicy
        (verifyAgainstKeys keyring)
        (SignaturePkt sigPayload)
        state
        Nothing of
        Left err ->
            assertFailure
                ( "Expected successful verification with warning for missing back-signature, got: "
                    ++ renderVerificationError err
                )
        Right verification ->
            assertBool
                "v6 signing-capable subkey binding without embedded back-signature should emit warning"
                ( MissingSubkeyBackSignatureWarning
                    `elem` _verificationWarnings verification
                )

testPrimaryKeyBindingRejectsUnsupportedCriticalSubpacket
    :: Assertion
testPrimaryKeyBindingRejectsUnsupportedCriticalSubpacket = do
    (signer, _) <- loadUnencryptedRsaSigner
    let sigPayload =
            SigV4
                PrimaryKeyBindingSig
                RSA
                SHA256
                [SigSubPacket True (OtherSigSub 111 "unsupported-critical")]
                []
                0
                (MPI 0 :| [])
        verifyFn _ _ _ = Right (Verification signer sigPayload [])
        state =
            emptyPSC
                { lastPrimaryKey = PublicKeyPkt signer
                , lastSubkey = PublicSubkeyPkt signer
                }
    case verifySigWith
        defaultVerificationPolicy
        verifyFn
        (SignaturePkt sigPayload)
        state
        Nothing of
        Left (UnsupportedCriticalSubpacket PrimaryKeyBindingSig) -> pure ()
        Left err ->
            assertFailure
                ( "Expected unsupported critical subpacket rejection for primary key binding signature, got: "
                    ++ renderVerificationError err
                )
        Right _ ->
            assertFailure
                "Expected unsupported critical subpacket rejection for primary key binding signature, but verification succeeded"

testSignatureBuilders :: Assertion
testSignatureBuilders = do
    (_, signingKey) <- loadUnencryptedRsaSigner
    -- Test RSA builder API with empty subpackets
    let builderRsa = sigBuilderInit @'PKA.RSA BinarySig SHA512
    let builderRsaWithHashed = addHashedSubs (listToHashedSubs []) builderRsa
    let builderRsaFinal = addUnhashedSubs (listToUnhashedSubs []) builderRsaWithHashed
    case signDataWithRSABuilder builderRsaFinal signingKey "test payload" of
        Left err ->
            assertFailure ("RSA builder API failed: " ++ renderSignError err)
        Right (SigV4 BinarySig RSA SHA512 _ _ _ _) -> pure ()
        Right other ->
            assertFailure
                ( "RSA builder API should generate BinarySig RSA SHA512, got "
                    ++ show other
                )

    -- Test RSA builder API with non-default hash algorithm
    let builderRsaSha256 = sigBuilderInit @'PKA.RSA BinarySig SHA256
        builderRsaSha256WithHashed =
            addHashedSubs (listToHashedSubs []) builderRsaSha256
        builderRsaSha256Final =
            addUnhashedSubs
                (listToUnhashedSubs [])
                builderRsaSha256WithHashed
    case signDataWithRSABuilder
        builderRsaSha256Final
        signingKey
        "test payload" of
        Left err ->
            assertFailure
                ("RSA SHA256 builder API failed: " ++ renderSignError err)
        Right (SigV4 BinarySig RSA SHA256 _ _ _ _) ->
            pure ()
        Right other ->
            assertFailure
                ( "RSA builder API should generate BinarySig RSA SHA256, got "
                    ++ show other
                )

    -- Unsupported hash algorithms should be rejected by RSA PKCS#1 v1.5 backend
    let builderRsaUnsupported = sigBuilderInit @'PKA.RSA BinarySig (OtherHA 99)
        builderRsaUnsupportedWithHashed =
            addHashedSubs (listToHashedSubs []) builderRsaUnsupported
        builderRsaUnsupportedFinal =
            addUnhashedSubs
                (listToUnhashedSubs [])
                builderRsaUnsupportedWithHashed
    case signDataWithRSABuilder
        builderRsaUnsupportedFinal
        signingKey
        "test payload" of
        Left (SignBackendError _) -> pure ()
        Left err ->
            assertFailure
                ( "RSA builder API should reject unsupported hash with backend error, got "
                    ++ renderSignError err
                )
        Right sig ->
            assertFailure
                ( "RSA builder API should reject unsupported hash algorithm, got "
                    ++ show sig
                )

    -- Runtime hash witness promotion should build RFC9580-compatible builders.
    let runtimeRsa =
            case sigBuilderInitRuntime @'PKA.RSA RFC9580 BinarySig SHA512 of
                Left err -> Left err
                Right builder ->
                    let withHashed = addHashedSubs (listToHashedSubs []) builder
                        withUnhashed = addUnhashedSubs (listToUnhashedSubs []) withHashed
                     in first
                            renderSignError
                            (signDataWithRSABuilder withUnhashed signingKey "test payload")
    case runtimeRsa of
        Left err ->
            assertFailure
                ( "runtime RFC9580 SHA512 builder initialization should succeed, got "
                    ++ err
                )
        Right (SigV4 BinarySig RSA SHA512 _ _ _ _) -> pure ()
        Right other ->
            assertFailure
                ( "runtime RFC9580 SHA512 builder should produce BinarySig RSA SHA512, got "
                    ++ show other
                )

    case sigBuilderInitRuntime @'PKA.RSA RFC9580 BinarySig SHA1 of
        Left _ -> pure ()
        Right _ ->
            assertFailure
                "runtime RFC9580 builder initialization should reject deprecated SHA1"

    case sigBuilderInitRuntime @'PKA.RSA RFC9580 BinarySig (OtherHA 99) of
        Left _ -> pure ()
        Right _ ->
            assertFailure
                "runtime builder initialization should reject non-witness-backed hash algorithms"

    -- Test Ed25519 builder API with empty subpackets
    (_, edSigningKey) <- loadDeterministicEd25519Signer
    let builderEd25519 = sigBuilderInit @'PKA.Ed25519 BinarySig SHA512
    let builderEd25519WithHashed = addHashedSubs (listToHashedSubs []) builderEd25519
    let builderEd25519Final =
            addUnhashedSubs (listToUnhashedSubs []) builderEd25519WithHashed
    case signDataWithEd25519Builder
        builderEd25519Final
        edSigningKey
        "test payload" of
        Left err ->
            assertFailure
                ("Ed25519 builder API failed: " ++ renderSignError err)
        Right (SigV4 BinarySig PKA.Ed25519 SHA512 _ _ _ _) -> pure ()
        Right other ->
            assertFailure
                ( "Ed25519 builder API should generate BinarySig Ed25519 SHA512, got "
                    ++ show other
                )

    -- Test Ed25519 v6 builder API
    let v6Salt = SignatureSalt (BL.replicate 32 0x42)
    let builderEd25519V6 = sigBuilderInitV6 @'PKA.Ed25519 BinarySig SHA512 v6Salt
    let builderEd25519V6WithHashed = addHashedSubs (listToHashedSubs []) builderEd25519V6
    let builderEd25519V6Final =
            addUnhashedSubs
                (listToUnhashedSubs [])
                builderEd25519V6WithHashed
    case signDataWithEd25519V6Builder
        builderEd25519V6Final
        edSigningKey
        "test payload" of
        Left err ->
            assertFailure
                ("Ed25519 v6 builder API failed: " ++ renderSignError err)
        Right (SigV6 BinarySig PKA.Ed25519 SHA512 salt _ _ _ _) ->
            assertEqual
                "Ed25519 v6 builder API should preserve 32-byte salt"
                32
                (BL.length (unSignatureSalt salt))
        Right other ->
            assertFailure
                ( "Ed25519 v6 builder API should generate BinarySig Ed25519 SHA512 SigV6, got "
                    ++ show other
                )

    -- Runtime v6 builder initialization should support SHA3 witness-backed hashes.
    let v6Sha3Salt = SignatureSalt (BL.replicate 16 0x33)
        runtimeEd25519V6Sha3 =
            case sigBuilderInitV6Runtime @'PKA.Ed25519
                RFC9580
                BinarySig
                SHA3_256
                v6Sha3Salt of
                Left err -> Left err
                Right builder ->
                    let withHashed = addHashedSubs (listToHashedSubs []) builder
                        withUnhashed = addUnhashedSubs (listToUnhashedSubs []) withHashed
                     in first
                            renderSignError
                            ( signDataWithEd25519V6Builder
                                withUnhashed
                                edSigningKey
                                "test payload"
                            )
    case runtimeEd25519V6Sha3 of
        Left err ->
            assertFailure
                ("runtime RFC9580 SHA3-256 v6 builder should succeed, got " ++ err)
        Right (SigV6 BinarySig PKA.Ed25519 SHA3_256 salt _ _ _ _) ->
            assertEqual
                "runtime RFC9580 SHA3-256 v6 builder should preserve 16-byte salt"
                16
                (BL.length (unSignatureSalt salt))
        Right other ->
            assertFailure
                ( "runtime RFC9580 SHA3-256 v6 builder should produce Ed25519 SigV6 SHA3_256, got "
                    ++ show other
                )

testLegalSubpacketBuilders :: Assertion
testLegalSubpacketBuilders = do
    (signer, signingKey) <- loadUnencryptedRsaSigner
    issuerKeyId <-
        case eightOctetKeyID signer of
            Left err ->
                assertFailure
                    ( "failed to derive issuer key id for legal-subpacket builder test: "
                        ++ err
                    )
                    >> fail "expected issuer key id"
            Right i -> pure i

    let signerFp = fingerprint signer
        creation = ThirtyTwoBitTimeStamp 1
        v4Builder = sigBuilderInit @'PKA.RSA BinarySig SHA512
        v4WithHashed =
            addHashedSubs
                ( listToLegalSubs
                    [ LegalSigCreationTime creation
                    , LegalIssuerFingerprintV4 signerFp
                    ]
                )
                v4Builder
        v4Final =
            addUnhashedSubs
                (listToLegalSubs [LegalIssuerV4 issuerKeyId])
                v4WithHashed

    case signDataWithRSABuilder
        v4Final
        signingKey
        "typed legal subpacket payload" of
        Left err ->
            assertFailure
                ("v4 legal-subpacket builder failed: " ++ renderSignError err)
        Right (SigV4 _ _ _ hashed unhashed _ _) -> do
            assertBool
                "v4 legal-subpacket builder should include creation time in hashed subpackets"
                (SigSubPacket False (SigCreationTime creation) `elem` hashed)
            assertBool
                "v4 legal-subpacket builder should include v4 issuer fingerprint in hashed subpackets"
                ( SigSubPacket
                    False
                    (IssuerFingerprint IssuerFingerprintV4 signerFp)
                    `elem` hashed
                )
            assertBool
                "v4 legal-subpacket builder should include issuer key ID only in unhashed subpackets"
                (SigSubPacket False (Issuer issuerKeyId) `elem` unhashed)
        Right other ->
            assertFailure
                ( "v4 legal-subpacket builder should generate SigV4, got "
                    ++ show other
                )

    (_, edSigningKey) <- loadDeterministicEd25519Signer
    let v6Salt = SignatureSalt (BL.replicate 32 0x17)
        v6Builder = sigBuilderInitV6 @'PKA.Ed25519 BinarySig SHA512 v6Salt
        v6WithHashed =
            addHashedSubs
                ( listToLegalSubs
                    [ LegalSigCreationTime creation
                    , LegalIssuerFingerprintV6 signerFp
                    ]
                )
                v6Builder
        v6Final = addUnhashedSubs (listToLegalSubs []) v6WithHashed

    case signDataWithEd25519V6Builder
        v6Final
        edSigningKey
        "typed legal subpacket payload" of
        Left err ->
            assertFailure
                ("v6 legal-subpacket builder failed: " ++ renderSignError err)
        Right (SigV6 _ _ _ _ hashed unhashed _ _) -> do
            assertBool
                "v6 legal-subpacket builder should include creation time in hashed subpackets"
                (SigSubPacket False (SigCreationTime creation) `elem` hashed)
            assertBool
                "v6 legal-subpacket builder should include v6 issuer fingerprint in hashed subpackets"
                ( SigSubPacket
                    False
                    (IssuerFingerprint IssuerFingerprintV6 signerFp)
                    `elem` hashed
                )
            assertEqual
                "v6 legal-subpacket builder should keep unhashed set empty for typed legal set used here"
                []
                unhashed
        Right other ->
            assertFailure
                ( "v6 legal-subpacket builder should generate SigV6, got "
                    ++ show other
                )

testTemporaryKeyValidityRespectsLatestSelfSignature :: Assertion
testTemporaryKeyValidityRespectsLatestSelfSignature = do
    (signer, signingKey) <- loadUnencryptedRsaSigner
    let uidText = "temporary-validity@example.org"
        uid = UserId uidText
        keyCreated = _timestamp signer
        longValidityCertTime = addTimestampSeconds keyCreated 10
        temporaryValidityCertTime = addTimestampSeconds keyCreated 20
        validCheckTime = timestampToUTCTime (addTimestampSeconds keyCreated 25)
        expiredCheckTime = timestampToUTCTime (addTimestampSeconds keyCreated 200)
        preExpirySignatureTime = addTimestampSeconds keyCreated 25
        postExpirySignatureTime = addTimestampSeconds keyCreated 40
        payload = "temporary validity signer timeline payload"
    longValidityCert <-
        signCertificationAt
            signer
            signingKey
            uid
            longValidityCertTime
            [SigSubPacket False (KeyExpirationTime 1000)]
    temporaryValidityCert <-
        signCertificationAt
            signer
            signingKey
            uid
            temporaryValidityCertTime
            [SigSubPacket False (KeyExpirationTime 30)]
    preExpirySignature <-
        signBinaryMessageWithRSAAt
            signer
            signingKey
            preExpirySignatureTime
            payload
    postExpirySignature <-
        signBinaryMessageWithRSAAt
            signer
            signingKey
            postExpirySignatureTime
            payload
    let tk :: TK 'PublicTK =
            TK
                { _tkPrimaryKey = KeyPktPublicPrimary signer
                , _tkRevs = []
                , _tkUIDs = [(uidText, [longValidityCert, temporaryValidityCert])]
                , _tkUAts = []
                , _tkSubs = []
                }
        keyring = mkTestKeyring [tk]
    assertBool
        "latest effective self-signature should keep key valid before temporary expiration"
        (isTKTimeValid validCheckTime tk)
    assertBool
        "latest effective self-signature should expire key at the temporary validity boundary"
        (not (isTKTimeValid expiredCheckTime tk))
    assertSingleSignerFingerprint
        "pre-expiry signatures should still verify"
        (fingerprint signer)
        (verifyTimelinePackets keyring payload preExpirySignature)
    assertSingleFailureContainsTimeline
        "post-expiry signatures should be rejected"
        "signing key was not valid at the signature creation time"
        (verifyTimelinePackets keyring payload postExpirySignature)

testTemporaryKeyValidityRejectsSelfSignatureGaps :: Assertion
testTemporaryKeyValidityRejectsSelfSignatureGaps = do
    (signer, signingKey) <- loadUnencryptedRsaSigner
    let uidText = "temporary-validity-gap@example.org"
        uid = UserId uidText
        keyCreated = _timestamp signer
        firstCertTime = addTimestampSeconds keyCreated 10
        secondCertTime = addTimestampSeconds keyCreated 30
        gapCheckTime = timestampToUTCTime (addTimestampSeconds keyCreated 25)
        renewedCheckTime = timestampToUTCTime (addTimestampSeconds keyCreated 35)
        gapSignatureTime = addTimestampSeconds keyCreated 25
        renewedSignatureTime = addTimestampSeconds keyCreated 35
        payload = "temporary validity gap signer timeline payload"
    firstCertification <-
        signCertificationAt
            signer
            signingKey
            uid
            firstCertTime
            [ SigSubPacket False (KeyExpirationTime 1000)
            , SigSubPacket False (SigExpirationTime 10)
            ]
    secondCertification <-
        signCertificationAt
            signer
            signingKey
            uid
            secondCertTime
            [SigSubPacket False (KeyExpirationTime 1000)]
    gapSignature <-
        signBinaryMessageWithRSAAt
            signer
            signingKey
            gapSignatureTime
            payload
    renewedSignature <-
        signBinaryMessageWithRSAAt
            signer
            signingKey
            renewedSignatureTime
            payload
    let tk :: TK 'PublicTK =
            TK
                { _tkPrimaryKey = KeyPktPublicPrimary signer
                , _tkRevs = []
                , _tkUIDs = [(uidText, [firstCertification, secondCertification])]
                , _tkUAts = []
                , _tkSubs = []
                }
        keyring = mkTestKeyring [tk]
    assertBool
        "a gap with no effective self-signature should make the key temporarily invalid"
        (not (isTKTimeValid gapCheckTime tk))
    assertBool
        "a later self-signature should restore validity once it becomes effective"
        (isTKTimeValid renewedCheckTime tk)
    assertSingleFailureContainsTimeline
        "signatures made during a self-signature gap should be rejected"
        "signing key was not valid at the signature creation time"
        (verifyTimelinePackets keyring payload gapSignature)
    assertSingleSignerFingerprint
        "signatures made after a later self-signature becomes effective should verify"
        (fingerprint signer)
        (verifyTimelinePackets keyring payload renewedSignature)

testTemporaryKeyValidityRejectsPreCertificationGap :: Assertion
testTemporaryKeyValidityRejectsPreCertificationGap = do
    (signer, signingKey) <- loadUnencryptedRsaSigner
    let uidText = "temporary-validity-pre-cert-gap@example.org"
        uid = UserId uidText
        keyCreated = _timestamp signer
        certificationTime = addTimestampSeconds keyCreated 20
        invalidCheckTime = timestampToUTCTime (addTimestampSeconds keyCreated 10)
        validCheckTime = timestampToUTCTime (addTimestampSeconds keyCreated 25)
        invalidSignatureTime = addTimestampSeconds keyCreated 10
        validSignatureTime = addTimestampSeconds keyCreated 25
        payload =
            "temporary validity pre-certification gap signer timeline payload"
    certification <-
        signCertificationAt
            signer
            signingKey
            uid
            certificationTime
            [SigSubPacket False (KeyExpirationTime 1000)]
    invalidSignature <-
        signBinaryMessageWithRSAAt
            signer
            signingKey
            invalidSignatureTime
            payload
    validSignature <-
        signBinaryMessageWithRSAAt
            signer
            signingKey
            validSignatureTime
            payload
    let tk =
            TK
                (KeyPktPublicPrimary signer)
                []
                [(uidText, [certification])]
                []
                []
        keyring = mkTestKeyring [tk]
    assertBool
        "a key should be invalid before its first self-signature becomes effective"
        (not (isTKTimeValid invalidCheckTime tk))
    assertBool
        "a key should become valid once its first self-signature becomes effective"
        (isTKTimeValid validCheckTime tk)
    assertSingleFailureContainsTimeline
        "signatures made before the first self-signature should be rejected"
        "signing key was not valid at the signature creation time"
        (verifyTimelinePackets keyring payload invalidSignature)
    assertSingleSignerFingerprint
        "signatures made after the first self-signature becomes effective should verify"
        (fingerprint signer)
        (verifyTimelinePackets keyring payload validSignature)

testTemporaryKeyValidityFollowsTemporarySelfRevocation
    :: Assertion
testTemporaryKeyValidityFollowsTemporarySelfRevocation = do
    (signer, signingKey) <- loadUnencryptedRsaSigner
    let uidText = "temporary-validity-self-revocation@example.org"
        uid = UserId uidText
        keyCreated = _timestamp signer
        certificationTime = addTimestampSeconds keyCreated 10
        revocationTime = addTimestampSeconds keyCreated 20
        revokedCheckTime = timestampToUTCTime (addTimestampSeconds keyCreated 25)
        restoredCheckTime = timestampToUTCTime (addTimestampSeconds keyCreated 35)
        revokedSignatureTime = addTimestampSeconds keyCreated 25
        restoredSignatureTime = addTimestampSeconds keyCreated 35
        payload = "temporary validity self-revocation signer timeline payload"
    certification <-
        signCertificationAt
            signer
            signingKey
            uid
            certificationTime
            [SigSubPacket False (KeyExpirationTime 1000)]
    temporaryRevocation <-
        signCertificationRevocationAt
            signer
            signingKey
            uid
            revocationTime
            [SigSubPacket False (SigExpirationTime 10)]
    revokedSignature <-
        signBinaryMessageWithRSAAt
            signer
            signingKey
            revokedSignatureTime
            payload
    restoredSignature <-
        signBinaryMessageWithRSAAt
            signer
            signingKey
            restoredSignatureTime
            payload
    let tk :: TK 'PublicTK =
            TK
                { _tkPrimaryKey = KeyPktPublicPrimary signer
                , _tkRevs = []
                , _tkUIDs = [(uidText, [certification, temporaryRevocation])]
                , _tkUAts = []
                , _tkSubs = []
                }
        keyring = mkTestKeyring [tk]
    assertBool
        "a temporary self-revocation should disable signing while it is effective"
        (not (isTKTimeValid revokedCheckTime tk))
    assertBool
        "a self-certification should become valid again once its temporary revocation expires"
        (isTKTimeValid restoredCheckTime tk)
    assertSingleFailureContainsTimeline
        "signatures made during a temporary self-revocation should be rejected"
        "signing key was not valid at the signature creation time"
        (verifyTimelinePackets keyring payload revokedSignature)
    assertSingleSignerFingerprint
        "signatures made after a temporary self-revocation expires should verify"
        (fingerprint signer)
        (verifyTimelinePackets keyring payload restoredSignature)

testTemporaryKeyValidityDoesNotReviveOlderSelfSignatures
    :: Assertion
testTemporaryKeyValidityDoesNotReviveOlderSelfSignatures = do
    (signer, signingKey) <- loadUnencryptedRsaSigner
    let uidText = "temporary-validity-no-revival@example.org"
        uid = UserId uidText
        keyCreated = _timestamp signer
        firstCertTime = addTimestampSeconds keyCreated 10
        secondCertTime = addTimestampSeconds keyCreated 20
        invalidCheckTime = timestampToUTCTime (addTimestampSeconds keyCreated 30)
        invalidSignatureTime = addTimestampSeconds keyCreated 30
        payload = "temporary validity no revival signer timeline payload"
    firstCertification <-
        signCertificationAt
            signer
            signingKey
            uid
            firstCertTime
            [SigSubPacket False (KeyExpirationTime 1000)]
    secondCertification <-
        signCertificationAt
            signer
            signingKey
            uid
            secondCertTime
            [ SigSubPacket False (KeyExpirationTime 1000)
            , SigSubPacket False (SigExpirationTime 5)
            ]
    invalidSignature <-
        signBinaryMessageWithRSAAt
            signer
            signingKey
            invalidSignatureTime
            payload
    let tk :: TK 'PublicTK =
            TK
                { _tkPrimaryKey = KeyPktPublicPrimary signer
                , _tkRevs = []
                , _tkUIDs = [(uidText, [firstCertification, secondCertification])]
                , _tkUAts = []
                , _tkSubs = []
                }
        keyring = mkTestKeyring [tk]
    assertBool
        "an expired newer self-signature should not revive an older certification"
        (not (isTKTimeValid invalidCheckTime tk))
    assertSingleFailureContainsTimeline
        "signatures after a newer self-signature expires should be rejected until re-certified"
        "signing key was not valid at the signature creation time"
        (verifyTimelinePackets keyring payload invalidSignature)

testUidRetiredRevocationIsHistorical :: Assertion
testUidRetiredRevocationIsHistorical = do
    (signer, signingKey) <- loadUnencryptedRsaSigner
    let uidText = "retired-uid@example.org"
        uid = UserId uidText
        keyCreated = _timestamp signer
        certificationTime = addTimestampSeconds keyCreated 10
        revocationTime = addTimestampSeconds keyCreated 20
    certification <-
        signCertificationAt signer signingKey uid certificationTime []
    retirementRevocation <-
        signCertificationRevocationAt
            signer
            signingKey
            uid
            revocationTime
            [ SigSubPacket
                False
                (ReasonForRevocation UserIdInfoNoLongerValid "")
            ]
    let tk :: TK 'PublicTK =
            TK
                { _tkPrimaryKey = KeyPktPublicPrimary signer
                , _tkRevs = []
                , _tkUIDs = [(uidText, [certification, retirementRevocation])]
                , _tkUAts = []
                , _tkSubs = []
                }
        verifyAt ts =
            verifyTKWith
                (verifySigWith defaultVerificationPolicy (verifyAgainstKeys [tk]))
                (Just (timestampToUTCTime ts))
                tk
    beforeRetirement <-
        case verifyAt (addTimestampSeconds keyCreated 15) of
            Left err ->
                assertFailure
                    ( "uid-retired pre-revocation verification failed: "
                        ++ renderVerificationError err
                    )
                    >> fail "expected verified transferable key before uid retirement"
            Right verifiedTK -> pure verifiedTK
    afterRetirement <-
        case verifyAt (addTimestampSeconds keyCreated 25) of
            Left err ->
                assertFailure
                    ( "uid-retired post-revocation verification failed: "
                        ++ renderVerificationError err
                    )
                    >> fail "expected verified transferable key after uid retirement"
            Right verifiedTK -> pure verifiedTK
    assertEqual
        "uid-retired revocation should preserve the UID before it becomes effective"
        1
        (length (_tkUIDs beforeRetirement))
    assertEqual
        "uid-retired revocation should retire the UID once effective"
        0
        (length (_tkUIDs afterRetirement))

testThirdPartyCertificationDoesNotAffectKeyValidityWindow
    :: Assertion
testThirdPartyCertificationDoesNotAffectKeyValidityWindow = do
    (targetSigner, _) <- loadUnencryptedRsaSigner
    (thirdPartySigner, thirdPartySigningKey) <-
        loadDeterministicEd25519Signer
    let uidText = "third-party-validity@example.org"
        uid = UserId uidText
        keyCreated = _timestamp targetSigner
        certificationTime = addTimestampSeconds keyCreated 10
        validityCheckTime = timestampToUTCTime (addTimestampSeconds keyCreated 200)
    thirdPartyCertification <-
        signCertificationWithEd25519At
            targetSigner
            thirdPartySigner
            thirdPartySigningKey
            uid
            certificationTime
            [SigSubPacket False (KeyExpirationTime 30)]
    let targetTK :: TK 'PublicTK =
            TK
                { _tkPrimaryKey = KeyPktPublicPrimary targetSigner
                , _tkRevs = []
                , _tkUIDs = [(uidText, [thirdPartyCertification])]
                , _tkUAts = []
                , _tkSubs = []
                }
        certifierTK =
            TK
                { _tkPrimaryKey = KeyPktPublicPrimary thirdPartySigner
                , _tkRevs = []
                , _tkUIDs = []
                , _tkUAts = []
                , _tkSubs = []
                }
        verifyAt =
            verifyTKWith
                ( verifySigWith
                    defaultVerificationPolicy
                    (verifyAgainstKeys [targetTK, certifierTK])
                )
                (Just validityCheckTime)
                targetTK
    verifiedTK <-
        case verifyAt of
            Left err ->
                assertFailure
                    ( "third-party certification verification failed: "
                        ++ renderVerificationError err
                    )
                    >> fail "expected verified transferable key"
            Right tk -> pure tk
    assertBool
        "third-party certifications must not define the primary key validity window"
        (isTKTimeValid validityCheckTime verifiedTK)

testCertificationRevocationOnlyRemovesMatchingSigner :: Assertion
testCertificationRevocationOnlyRemovesMatchingSigner = do
    (targetSigner, targetSigningKey) <- loadUnencryptedRsaSigner
    (thirdPartySigner, thirdPartySigningKey) <-
        loadDeterministicEd25519Signer
    let uidText = "cert-revocation-scope@example.org"
        uid = UserId uidText
        keyCreated = _timestamp targetSigner
        selfCertificationTime = addTimestampSeconds keyCreated 10
        thirdPartyCertificationTime = addTimestampSeconds keyCreated 12
        thirdPartyRevocationTime = addTimestampSeconds keyCreated 20
        beforeRevocationTime = timestampToUTCTime (addTimestampSeconds keyCreated 15)
        afterRevocationTime = timestampToUTCTime (addTimestampSeconds keyCreated 25)
    selfCertification <-
        signCertificationAt
            targetSigner
            targetSigningKey
            uid
            selfCertificationTime
            []
    thirdPartyCertification <-
        signCertificationWithEd25519At
            targetSigner
            thirdPartySigner
            thirdPartySigningKey
            uid
            thirdPartyCertificationTime
            []
    thirdPartyRevocation <-
        signCertificationRevocationWithEd25519At
            targetSigner
            thirdPartySigner
            thirdPartySigningKey
            uid
            thirdPartyRevocationTime
            []
    let targetTK :: TK 'PublicTK =
            TK
                { _tkPrimaryKey = KeyPktPublicPrimary targetSigner
                , _tkRevs = []
                , _tkUIDs =
                    [
                        ( uidText
                        ,
                            [ selfCertification
                            , thirdPartyCertification
                            , thirdPartyRevocation
                            ]
                        )
                    ]
                , _tkUAts = []
                , _tkSubs = []
                }
        certifierTK =
            TK
                { _tkPrimaryKey = KeyPktPublicPrimary thirdPartySigner
                , _tkRevs = []
                , _tkUIDs = []
                , _tkUAts = []
                , _tkSubs = []
                }
        verifyAt ts =
            verifyTKWith
                ( verifySigWith
                    defaultVerificationPolicy
                    (verifyAgainstKeys [targetTK, certifierTK])
                )
                (Just ts)
                targetTK
    beforeRevocation <-
        case verifyAt beforeRevocationTime of
            Left err ->
                assertFailure
                    ( "pre-revocation certification verification failed: "
                        ++ renderVerificationError err
                    )
                    >> fail
                        "expected verified transferable key before certification revocation"
            Right tk -> pure tk
    afterRevocation <-
        case verifyAt afterRevocationTime of
            Left err ->
                assertFailure
                    ( "post-revocation certification verification failed: "
                        ++ renderVerificationError err
                    )
                    >> fail
                        "expected verified transferable key after certification revocation"
            Right tk -> pure tk
    let beforeSigs =
            maybe
                []
                snd
                (find ((== uidText) . fst) (_tkUIDs beforeRevocation))
        afterSigs =
            maybe
                []
                snd
                (find ((== uidText) . fst) (_tkUIDs afterRevocation))
    assertEqual
        "certification revocations should not apply before they become effective"
        [selfCertification, thirdPartyCertification]
        beforeSigs
    assertEqual
        "a certification revocation should remove only certifications from the same signer"
        [selfCertification]
        afterSigs

testPreferencesAtTimestamp :: Assertion
testPreferencesAtTimestamp = do
    (signer, signingKey) <- loadUnencryptedRsaSigner
    let uid = UserId "prefs@example.org"
        UserId uidText = uid
        t1 = addTimestampSeconds (_timestamp signer) 1
        t2 = addTimestampSeconds t1 100
        t3 = addTimestampSeconds t2 100
        queryDuring = addTimestampSeconds t2 1
        queryAfterRevocation = addTimestampSeconds t3 1

    initialCertification <-
        signCertificationAt
            signer
            signingKey
            uid
            t1
            [SigSubPacket False (PreferredHashAlgorithms [SHA256])]
    updatedCertification <-
        signCertificationAt
            signer
            signingKey
            uid
            t2
            [SigSubPacket False (PreferredHashAlgorithms [SHA512])]
    certificationRevocation <-
        signCertificationRevocationAt signer signingKey uid t3 []

    let tk :: TK 'PublicTK =
            TK
                { _tkPrimaryKey = KeyPktPublicPrimary signer
                , _tkRevs = []
                , _tkUIDs =
                    [
                        ( uidText
                        ,
                            [ initialCertification
                            , updatedCertification
                            , certificationRevocation
                            ]
                        )
                    ]
                , _tkUAts = []
                , _tkSubs = []
                }

    assertEqual
        "key preferences at timestamp should use the latest active self-certification"
        (Just [PreferredHashAlgorithms [SHA512]])
        (effectiveKeyPreferencesAtTimestamp queryDuring tk)
    assertEqual
        "UID preferences at timestamp should use the latest active self-certification"
        (Just [PreferredHashAlgorithms [SHA512]])
        (effectiveUIDPreferencesAtTimestamp queryDuring uidText tk)
    assertEqual
        "revoked UID certifications should not provide effective UID preferences"
        Nothing
        ( effectiveUIDPreferencesAtTimestamp
            queryAfterRevocation
            uidText
            tk
        )
    assertEqual
        "key preferences should become unavailable when no active self-certification remains"
        Nothing
        (effectiveKeyPreferencesAtTimestamp queryAfterRevocation tk)

testChangePrivateKeyPassphraseLegacy :: Assertion
testChangePrivateKeyPassphraseLegacy = do
    passphrase <- readPKIPassphrase
    packets <-
        DC.runConduitRes $
            CB.sourceFile "tests/data/aes256-sha512.seckey"
                DC..| conduitGet get
                DC..| CL.consume
    (pkp, ska) <-
        case packets of
            (SecretKeyPkt pkpayload skaddendum : _) -> pure (pkpayload, skaddendum)
            _ ->
                assertFailure
                    "aes256-sha512.seckey did not begin with a secret key packet"
                    >> fail "expected secret key packet"
    originalDecrypted <-
        case decryptPrivateKey (pkp, ska) passphrase of
            Left err ->
                assertFailure ("decrypting original legacy key failed: " ++ err)
                    >> fail "decrypting original legacy key failed"
            Right x -> pure x
    originalSKey <-
        case originalDecrypted of
            SUUnencrypted skey _ -> pure skey
            _ ->
                assertFailure
                    "original legacy key should decrypt to unencrypted secret material"
                    >> fail "expected unencrypted secret key"
    changed <-
        case changePrivateKeyPassphrase
            (pkp, ska)
            passphrase
            (Salt "12345678")
            (IV "1234567890ABCDEF")
            "changed-pki-password" of
            Left err ->
                assertFailure
                    ( "legacy passphrase change should preserve the existing protection envelope, got: "
                        ++ err
                    )
                    >> fail "legacy passphrase change failed"
            Right skaddendum -> pure skaddendum
    originalIterCount <-
        case ska of
            SUSSHA1 AES256 (IteratedSalted SHA512 _ iter) _ _ -> pure iter
            _ ->
                assertFailure
                    "legacy key fixture should use SUSSHA1/AES256/IteratedSalted SHA512"
                    >> fail "expected legacy key fixture"
    case changed of
        SUSSHA1 AES256 (IteratedSalted SHA512 _ iter) _ encryptedPayload -> do
            assertEqual
                "legacy passphrase change should preserve the S2K iteration count"
                originalIterCount
                iter
            assertBool
                "legacy passphrase change should emit encrypted payload"
                (not (BL.null encryptedPayload))
        _ ->
            assertFailure
                "legacy passphrase change should preserve the SUSSHA1/AES256 envelope"
    decrypted <-
        case decryptPrivateKey (pkp, changed) "changed-pki-password" of
            Left err ->
                assertFailure
                    ("re-decrypting changed legacy key failed: " ++ err)
                    >> fail "re-decrypting changed legacy key failed"
            Right x -> pure x
    case decrypted of
        SUUnencrypted skey _ ->
            assertEqual
                "legacy passphrase change should preserve secret key material"
                originalSKey
                skey
        _ ->
            assertFailure
                "legacy passphrase change should decrypt back to unencrypted secret material"

testChangePrivateKeyPassphraseV6 :: Assertion
testChangePrivateKeyPassphraseV6 = do
    oldPassphrase <- readPKIPassphrase
    armors <- loadArmor "v6-encrypted-secret.pgp.aa"
    armor <-
        case armors of
            (a : _) -> pure a
            [] ->
                assertFailure
                    "v6-encrypted-secret.pgp.aa should contain one armored payload"
                    >> fail "expected one armored payload"
    let packets = parsePkts (armorPayload armor)
    (pkp, ska) <-
        case packets of
            (SecretKeyPkt pkpayload skaddendum : _) -> pure (pkpayload, skaddendum)
            _ ->
                assertFailure
                    "v6-encrypted-secret.pgp.aa did not begin with a secret key packet"
                    >> fail "expected secret key packet"
    let newPassphrase = "changed-pki-password"
    originalDecrypted <-
        case decryptPrivateKey (pkp, ska) oldPassphrase of
            Left err ->
                assertFailure ("decrypting original v6 key failed: " ++ err)
                    >> fail "decrypting original v6 key failed"
            Right x -> pure x
    originalSKey <-
        case originalDecrypted of
            SUUnencrypted skey _ -> pure skey
            _ ->
                assertFailure
                    "original v6 key should decrypt to unencrypted secret material"
                    >> fail "expected unencrypted secret key"
    let changedResult =
            changePrivateKeyPassphrase
                (pkp, ska)
                oldPassphrase
                (Salt "1234567890ABCDEF")
                (IV "1234567890ABCDE")
                newPassphrase
    changed <-
        case changedResult of
            Left err ->
                assertFailure ("changing v6 key passphrase failed: " ++ err)
                    >> pure ska
            Right skaddendum -> pure skaddendum
    case changed of
        SUSAEAD AES256 OCB (Argon2 _ t p em) _ encryptedPayload -> do
            assertEqual
                "changed v6 key addendum should use expected Argon2 t parameter"
                1
                t
            assertEqual
                "changed v6 key addendum should use expected Argon2 p parameter"
                4
                p
            assertEqual
                "changed v6 key addendum should use expected Argon2 encoded memory parameter"
                15
                em
            assertBool
                "changed v6 key addendum should contain encrypted key material"
                (not (BL.null encryptedPayload))
        _ ->
            assertFailure
                "changed v6 key addendum should be encrypted with SUSAEAD"
    let decryptedResult = decryptPrivateKey (pkp, changed) newPassphrase
    decrypted <-
        case decryptedResult of
            Left err ->
                assertFailure
                    ("decryption with changed v6 passphrase failed: " ++ err)
                    >> fail "decryption with changed v6 passphrase failed"
            Right x -> pure x
    case decrypted of
        SUUnencrypted skey _ ->
            assertEqual
                "changing a v6 key passphrase should preserve secret key material"
                originalSKey
                skey
        _ ->
            assertFailure
                "changed v6 key should decrypt with the new passphrase"

testPolicySignatureContextValidation :: Assertion
testPolicySignatureContextValidation = do
    let pkSigV4PK = SigV4 KeyRevocationSig RSA SHA512 [] [] 0 (MPI 0 :| [])
        pkSigV4Direct = SigV4 SignatureDirectlyOnAKey RSA SHA512 [] [] 0 (MPI 0 :| [])
        pkSigV4Binding = SigV4 SubkeyBindingSig RSA SHA512 [] [] 0 (MPI 0 :| [])
        pkSigV6PK =
            SigV6
                KeyRevocationSig
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x11))
                []
                []
                0
                (MPI 0 :| [])
        pkSigV6Direct =
            SigV6
                SignatureDirectlyOnAKey
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x12))
                []
                []
                0
                (MPI 0 :| [])
        pkSigV6Binding =
            SigV6
                SubkeyBindingSig
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x13))
                []
                []
                0
                (MPI 0 :| [])
        skSigV4Binding = SigV4 SubkeyBindingSig RSA SHA512 [] [] 0 (MPI 0 :| [])
        skSigV4Revocation = SigV4 SubkeyRevocationSig RSA SHA512 [] [] 0 (MPI 0 :| [])
        skSigV4Direct = SigV4 SignatureDirectlyOnAKey RSA SHA512 [] [] 0 (MPI 0 :| [])
        skSigV6Binding =
            SigV6
                SubkeyBindingSig
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x14))
                []
                []
                0
                (MPI 0 :| [])
        skSigV6Revocation =
            SigV6
                SubkeyRevocationSig
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x15))
                []
                []
                0
                (MPI 0 :| [])
        skSigV6Direct =
            SigV6
                SignatureDirectlyOnAKey
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x16))
                []
                []
                0
                (MPI 0 :| [])
        uidSigV4Generic = SigV4 GenericCert RSA SHA512 [] [] 0 (MPI 0 :| [])
        uidSigV4Persona = SigV4 PersonaCert RSA SHA512 [] [] 0 (MPI 0 :| [])
        uidSigV4Casual = SigV4 CasualCert RSA SHA512 [] [] 0 (MPI 0 :| [])
        uidSigV4Positive = SigV4 PositiveCert RSA SHA512 [] [] 0 (MPI 0 :| [])
        uidSigV4CertRev = SigV4 CertRevocationSig RSA SHA512 [] [] 0 (MPI 0 :| [])
        uidSigV4Binding = SigV4 SubkeyBindingSig RSA SHA512 [] [] 0 (MPI 0 :| [])
        uidSigV6Generic =
            SigV6
                GenericCert
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x17))
                []
                []
                0
                (MPI 0 :| [])
        uidSigV6Persona =
            SigV6
                PersonaCert
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x18))
                []
                []
                0
                (MPI 0 :| [])
        uidSigV6Casual =
            SigV6
                CasualCert
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x19))
                []
                []
                0
                (MPI 0 :| [])
        uidSigV6Positive =
            SigV6
                PositiveCert
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x1a))
                []
                []
                0
                (MPI 0 :| [])
        uidSigV6CertRev =
            SigV6
                CertRevocationSig
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x1b))
                []
                []
                0
                (MPI 0 :| [])
        uidSigV6Binding =
            SigV6
                SubkeyBindingSig
                EdDSA
                SHA512
                (SignatureSalt (BL.replicate 32 0x1c))
                []
                []
                0
                (MPI 0 :| [])
    assertTrue
        "KeyRevocationSig allowed on primary key"
        (isAllowedPrimaryKeySig pkSigV4PK)
    assertTrue
        "SignatureDirectlyOnAKey allowed on primary key"
        (isAllowedPrimaryKeySig pkSigV4Direct)
    assertFalse
        "SubkeyBindingSig not allowed on primary key"
        (isAllowedPrimaryKeySig pkSigV4Binding)
    assertTrue
        "v6 KeyRevocationSig allowed on primary key"
        (isAllowedPrimaryKeySig pkSigV6PK)
    assertTrue
        "v6 SignatureDirectlyOnAKey allowed on primary key"
        (isAllowedPrimaryKeySig pkSigV6Direct)
    assertFalse
        "v6 SubkeyBindingSig not allowed on primary key"
        (isAllowedPrimaryKeySig pkSigV6Binding)
    assertTrue
        "SubkeyBindingSig allowed on subkey"
        (isAllowedSubkeySig skSigV4Binding)
    assertTrue
        "SubkeyRevocationSig allowed on subkey"
        (isAllowedSubkeySig skSigV4Revocation)
    assertFalse
        "SignatureDirectlyOnAKey not allowed on subkey"
        (isAllowedSubkeySig skSigV4Direct)
    assertTrue
        "v6 SubkeyBindingSig allowed on subkey"
        (isAllowedSubkeySig skSigV6Binding)
    assertTrue
        "v6 SubkeyRevocationSig allowed on subkey"
        (isAllowedSubkeySig skSigV6Revocation)
    assertFalse
        "v6 SignatureDirectlyOnAKey not allowed on subkey"
        (isAllowedSubkeySig skSigV6Direct)
    assertTrue
        "GenericCert allowed on UID"
        (isAllowedUIDSig uidSigV4Generic)
    assertTrue
        "PersonaCert allowed on UID"
        (isAllowedUIDSig uidSigV4Persona)
    assertTrue
        "CasualCert allowed on UID"
        (isAllowedUIDSig uidSigV4Casual)
    assertTrue
        "PositiveCert allowed on UID"
        (isAllowedUIDSig uidSigV4Positive)
    assertTrue
        "CertRevocationSig allowed on UID"
        (isAllowedUIDSig uidSigV4CertRev)
    assertFalse
        "SubkeyBindingSig not allowed on UID"
        (isAllowedUIDSig uidSigV4Binding)
    assertTrue
        "v6 GenericCert allowed on UID"
        (isAllowedUIDSig uidSigV6Generic)
    assertTrue
        "v6 PersonaCert allowed on UID"
        (isAllowedUIDSig uidSigV6Persona)
    assertTrue
        "v6 CasualCert allowed on UID"
        (isAllowedUIDSig uidSigV6Casual)
    assertTrue
        "v6 PositiveCert allowed on UID"
        (isAllowedUIDSig uidSigV6Positive)
    assertTrue
        "v6 CertRevocationSig allowed on UID"
        (isAllowedUIDSig uidSigV6CertRev)
    assertFalse
        "v6 SubkeyBindingSig not allowed on UID"
        (isAllowedUIDSig uidSigV6Binding)

testVerifySigWithV6RevocationRejectsLegacyIssuerKeyID
    :: Assertion
testVerifySigWithV6RevocationRejectsLegacyIssuerKeyID = do
    (signer, _) <- loadUnencryptedRsaSigner
    issuerKeyId <-
        case eightOctetKeyID signer of
            Left err ->
                assertFailure ("failed to derive RSA issuer key id: " ++ err)
                    >> fail "expected issuer key id"
            Right i -> pure i
    let sigPayload =
            SigV6
                KeyRevocationSig
                RSA
                SHA256
                (SignatureSalt (BL.replicate 16 0))
                [SigSubPacket False (Issuer issuerKeyId)]
                []
                0
                (MPI 0 :| [])
        verifyFn _ _ _ = Right (Verification signer sigPayload [])
        result =
            verifySigWith
                defaultVerificationPolicy
                verifyFn
                (SignaturePkt sigPayload)
                emptyPSC {lastPrimaryKey = PublicKeyPkt signer}
                Nothing
    case result of
        Left err ->
            assertBool
                "v6 revocation verification should reject legacy Issuer key-id subpackets"
                ( "Issuer Key ID subpacket is prohibited in v6 signatures"
                    `isInfixOf` renderVerificationError err
                )
        Right _ ->
            assertFailure
                "Expected v6 revocation verification to reject legacy Issuer key-id subpacket"

testVerifySigWithV6RevocationRejectsLegacyIssuerKeyIDInUnhashed
    :: Assertion
testVerifySigWithV6RevocationRejectsLegacyIssuerKeyIDInUnhashed = do
    (signer, _) <- loadUnencryptedRsaSigner
    issuerKeyId <-
        case eightOctetKeyID signer of
            Left err ->
                assertFailure ("failed to derive RSA issuer key id: " ++ err)
                    >> fail "expected issuer key id"
            Right i -> pure i
    let sigPayload =
            SigV6
                KeyRevocationSig
                RSA
                SHA256
                (SignatureSalt (BL.replicate 16 0))
                []
                [SigSubPacket False (Issuer issuerKeyId)]
                0
                (MPI 0 :| [])
        verifyFn _ _ _ = Right (Verification signer sigPayload [])
        result =
            verifySigWith
                defaultVerificationPolicy
                verifyFn
                (SignaturePkt sigPayload)
                emptyPSC {lastPrimaryKey = PublicKeyPkt signer}
                Nothing
    case result of
        Left err ->
            assertBool
                "v6 revocation verification should reject legacy Issuer key-id subpackets in unhashed area"
                ( "Issuer Key ID subpacket is prohibited in v6 signatures"
                    `isInfixOf` renderVerificationError err
                )
        Right _ ->
            assertFailure
                "Expected v6 revocation verification to reject legacy Issuer key-id subpacket in unhashed area"

testVerifySigWithV6RevocationAcceptsMatchingIssuerFingerprint
    :: Assertion
testVerifySigWithV6RevocationAcceptsMatchingIssuerFingerprint = do
    (signer, _) <- loadUnencryptedRsaSigner
    let sigPayload =
            SigV6
                KeyRevocationSig
                RSA
                SHA256
                (SignatureSalt (BL.replicate 16 0))
                [ SigSubPacket
                    False
                    (IssuerFingerprint IssuerFingerprintV6 (fingerprint signer))
                ]
                []
                0
                (MPI 0 :| [])
        verifyFn _ _ _ = Right (Verification signer sigPayload [])
        result =
            verifySigWith
                defaultVerificationPolicy
                verifyFn
                (SignaturePkt sigPayload)
                emptyPSC {lastPrimaryKey = PublicKeyPkt signer}
                Nothing
    case result of
        Left err ->
            assertFailure
                ( "Expected matching IssuerFingerprint to verify for v6 revocation signature, got: "
                    ++ renderVerificationError err
                )
        Right _ -> pure ()

testV6SignerConstructorRejectsV4Key :: Assertion
testV6SignerConstructorRejectsV4Key = do
    (signer, signingKey) <- loadDeterministicEd25519Signer
    case asV6PKPayload signer of
        Left _ -> pure ()
        Right signerV6 ->
            seq (mkEd25519SignerV6 signerV6 signingKey) $
                assertFailure
                    "asV6PKPayload should reject v4 Ed25519 key payloads"
    (rsaSigner, rsaSigningKey) <- loadUnencryptedRsaSigner
    case asV6PKPayload rsaSigner of
        Left _ -> pure ()
        Right signerV6 ->
            seq (mkRSASignerV6 signerV6 rsaSigningKey) $
                assertFailure "asV6PKPayload should reject v4 RSA key payloads"

testGetSecretKeyHandlesV4X25519ECDHPubkey :: Assertion
testGetSecretKeyHandlesV4X25519ECDHPubkey = do
    let pkp =
            PKPayload
                V4
                (ThirtyTwoBitTimeStamp 0)
                0
                X25519
                ( ECDHPubKey
                    ( EdDSAPubKey
                        EdSigningCurve25519
                        ( PrefixedNativeEPoint
                            (EPoint (os2ip (B.cons 0x40 (B.replicate 32 0x01))))
                        )
                    )
                    SHA256
                    AES128
                )
        encodedSecret = runPut (put (MPI 42))
    case runGetOrFail (getSecretKey pkp) encodedSecret of
        Left (_, _, err) ->
            assertFailure
                ( "getSecretKey should parse v4 X25519 secret key material: "
                    ++ err
                )
        Right (_, _, ECDHPrivateKey (ECDSA_PrivateKey prv)) ->
            assertEqual
                "getSecretKey should preserve X25519 private scalar"
                42
                (ECDSA.private_d prv)
        Right (_, _, other) ->
            assertFailure
                ("unexpected parsed secret key type: " ++ show other)

testV4Ed25519SecretKeyRoundTripPreservesLeadingZeroByte
    :: Assertion
testV4Ed25519SecretKeyRoundTripPreservesLeadingZeroByte = do
    let secretBytes = B.pack (0 : replicate 31 1)
        pkt =
            SecretKeyPkt
                ( PKPayload
                    V4
                    (ThirtyTwoBitTimeStamp 0)
                    0
                    EdDSA
                    ( EdDSAPubKey
                        EdSigningCurve25519
                        ( PrefixedNativeEPoint
                            (EPoint (os2ip (B.cons 0x40 (B.replicate 32 0x01))))
                        )
                    )
                )
                (SUUnencrypted (EdDSAPrivateKey EdSigningCurve25519 secretBytes) 0)
    case runGetOrFail (get :: Get Pkt) (runPut (put pkt)) of
        Left (_, _, err) ->
            assertFailure
                ("v4 Ed25519 secret key should round-trip: " ++ err)
        Right (_, _, parsedPkt) ->
            case parsedPkt of
                SecretKeyPkt
                    _
                    (SUUnencrypted (EdDSAPrivateKey EdSigningCurve25519 parsedBytes) _) ->
                        assertEqual
                            "v4 Ed25519 secret-key round-trip should preserve MPI-encoded bytes"
                            secretBytes
                            parsedBytes
                _ ->
                    assertFailure
                        ("unexpected parsed packet shape: " ++ show parsedPkt)

testV4Ed448SecretKeyRoundTripPreservesLeadingZeroByte
    :: Assertion
testV4Ed448SecretKeyRoundTripPreservesLeadingZeroByte = do
    let secretBytes = B.pack (0 : replicate 56 2)
        pkp =
            PKPayload
                V4
                (ThirtyTwoBitTimeStamp 0)
                0
                EdDSA
                ( EdDSAPubKey
                    EdSigningCurve448
                    ( PrefixedNativeEPoint
                        (EPoint (os2ip (B.cons 0x40 (B.replicate 57 0x02))))
                    )
                )
        encodedSecret = runPut (put (MPI (os2ip secretBytes)))
    case runGetOrFail (getSecretKey pkp) encodedSecret of
        Left (_, _, err) ->
            assertFailure
                ( "v4 Ed448 secret key should parse with preserved padding: "
                    ++ err
                )
        Right (_, _, parsedSecret) ->
            assertEqual
                "v4 Ed448 secret-key parsing should restore the curve-width byte string"
                (EdDSAPrivateKey EdSigningCurve448 secretBytes)
                parsedSecret

testMkUnencryptedSKAddendumComputesLegacyChecksum :: Assertion
testMkUnencryptedSKAddendumComputesLegacyChecksum = do
    packets <-
        DC.runConduitRes $
            CB.sourceFile "tests/data/unencrypted.seckey"
                DC..| conduitGet get
                DC..| CL.consume
    case packets of
        (SecretKeyPkt pkp (SUUnencrypted sk _) : _) ->
            case mkUnencryptedSKAddendum pkp sk of
                Left err ->
                    assertFailure
                        ("mkUnencryptedSKAddendum should succeed for fixture key: " ++ err)
                Right (SUUnencrypted _ actualChecksum) -> do
                    skPayload <-
                        case putSKeyForPKPayload pkp sk of
                            Left err ->
                                assertFailure
                                    ( "failed to serialize secret key payload for checksum expectation: "
                                        ++ err
                                    )
                                    >> fail "expected serializable secret key payload"
                            Right payload -> pure payload
                    let expectedChecksum =
                            fromIntegral
                                ( BL.foldl'
                                    (\acc octet -> (acc + fromIntegral octet) `mod` (65536 :: Integer))
                                    0
                                    (runPut skPayload)
                                    :: Integer
                                )
                    assertEqual
                        "mkUnencryptedSKAddendum should use OpenPGP 16-bit checksum over serialized key material"
                        expectedChecksum
                        actualChecksum
                Right other ->
                    assertFailure ("unexpected addendum constructor: " ++ show other)
        _ ->
            assertFailure
                "unencrypted.seckey did not begin with an unencrypted secret key packet"

testMkUnencryptedSKAddendumUsesV6ChecksumConvention :: Assertion
testMkUnencryptedSKAddendumUsesV6ChecksumConvention = do
    (pkp, rsaPrivateKey) <- loadUnencryptedRsaSignerV6
    case mkUnencryptedSKAddendum
        pkp
        (RSAPrivateKey (RSA_PrivateKey rsaPrivateKey)) of
        Left err ->
            assertFailure
                ("mkUnencryptedSKAddendum should support v6 key payloads: " ++ err)
        Right (SUUnencrypted _ checksum) ->
            assertEqual
                "v6 unencrypted addendum checksum should be zero"
                0
                checksum
        Right other ->
            assertFailure ("unexpected addendum constructor: " ++ show other)

testReinterpretUnknownSKeyForPKPayloadDecodesEdDSA :: Assertion
testReinterpretUnknownSKeyForPKPayloadDecodesEdDSA = do
    let secretBytes = B.pack (0 : replicate 31 1)
        pkp =
            PKPayload
                V4
                (ThirtyTwoBitTimeStamp 0)
                0
                EdDSA
                ( EdDSAPubKey
                    EdSigningCurve25519
                    ( PrefixedNativeEPoint
                        (EPoint (os2ip (B.cons 0x40 (B.replicate 32 0x01))))
                    )
                )
        unknown = UnknownSKey (runPut (put (MPI (os2ip secretBytes))))
    case reinterpretUnknownSKeyForPKPayload pkp unknown of
        Left err ->
            assertFailure
                ( "reinterpretUnknownSKeyForPKPayload should decode Ed25519 key: "
                    ++ err
                )
        Right skey ->
            assertEqual
                "reinterpretUnknownSKeyForPKPayload should return typed EdDSA secret key"
                (EdDSAPrivateKey EdSigningCurve25519 secretBytes)
                skey

testFromPrimaryKeyPktToSomeTKRejectsSubkey :: Assertion
testFromPrimaryKeyPktToSomeTKRejectsSubkey = do
    packets <-
        DC.runConduitRes $
            CB.sourceFile "tests/data/unencrypted.seckey"
                DC..| conduitGet get
                DC..| CL.consume
    case packets of
        (SecretKeyPkt pkp _ : _) ->
            case fromPrimaryKeyPktToSomeTK (PublicSubkeyPkt pkp) of
                Left err ->
                    assertBool
                        "fromPrimaryKeyPktToSomeTK should report non-primary packet tags"
                        ("expected primary key packet" `isInfixOf` err)
                Right _ ->
                    assertFailure
                        "fromPrimaryKeyPktToSomeTK should reject subkey packets"
        _ ->
            assertFailure
                "unencrypted.seckey did not begin with a secret key packet"

testHighLevelDecryptSecretKeyLegacy :: Assertion
testHighLevelDecryptSecretKeyLegacy = do
    passphrase <- readPKIPassphrase
    packets <-
        DC.runConduitRes $
            CB.sourceFile "tests/data/aes256-sha512.seckey"
                DC..| conduitGet get
                DC..| CL.consume
    (SecretKey pkp ska) <-
        case packets of
            (SecretKeyPkt pkpayload skaddendum : _) -> pure (SecretKey pkpayload skaddendum)
            _ ->
                assertFailure
                    "aes256-sha512.seckey did not begin with a secret key packet"
                    >> fail "expected secret key packet"
    skey <-
        case decryptSecretKey (SecretKey pkp ska) (Passphrase passphrase) of
            Left err ->
                assertFailure
                    ("high-level decrypt of legacy key failed: " ++ show err)
                    >> fail "high-level decrypt failed"
            Right x -> pure x
    originalSKey <-
        case decryptPrivateKey
            (pkp, ska)
            (unPassphrase (Passphrase passphrase)) of
            Right (SUUnencrypted skey' _) -> pure skey'
            _ -> fail "expected unencrypted secret key"
    assertEqual
        "high-level decrypt should preserve secret key material"
        originalSKey
        skey

testHighLevelDecryptSecretKeyV6 :: Assertion
testHighLevelDecryptSecretKeyV6 = do
    oldPassphrase <- readPKIPassphrase
    armors <- loadArmor "v6-encrypted-secret.pgp.aa"
    armor <-
        case armors of
            (a : _) -> pure a
            [] ->
                assertFailure
                    "v6-encrypted-secret.pgp.aa should contain one armored payload"
                    >> fail "expected one armored payload"
    let packets = parsePkts (armorPayload armor)
    SecretKey pkp ska <-
        case packets of
            (SecretKeyPkt pkpayload skaddendum : _) -> pure (SecretKey pkpayload skaddendum)
            _ ->
                assertFailure
                    "v6-encrypted-secret.pgp.aa did not begin with a secret key packet"
                    >> fail "expected secret key packet"
    skey <-
        case decryptSecretKey (SecretKey pkp ska) (Passphrase oldPassphrase) of
            Left err ->
                assertFailure
                    ("high-level decrypt of v6 key failed: " ++ show err)
                    >> fail "high-level decrypt failed"
            Right x -> pure x
    originalSKey <-
        case decryptPrivateKey
            (pkp, ska)
            (unPassphrase (Passphrase oldPassphrase)) of
            Right (SUUnencrypted skey' _) -> pure skey'
            _ -> fail "expected unencrypted secret key"
    assertEqual
        "high-level decrypt should preserve v6 secret key material"
        originalSKey
        skey

testHighLevelReencryptSecretKeyLegacy :: Assertion
testHighLevelReencryptSecretKeyLegacy = do
    passphrase <- readPKIPassphrase
    packets <-
        DC.runConduitRes $
            CB.sourceFile "tests/data/aes256-sha512.seckey"
                DC..| conduitGet get
                DC..| CL.consume
    SecretKey pkp ska <-
        case packets of
            (SecretKeyPkt pkpayload skaddendum : _) -> pure (SecretKey pkpayload skaddendum)
            _ ->
                assertFailure
                    "aes256-sha512.seckey did not begin with a secret key packet"
                    >> fail "expected secret key packet"
    let salt = Salt "12345678"
        iv = IV "1234567890ABCDEF"
        opts =
            SecretKeyEncryptOptions
                { skeoPolicy = defaultPolicy
                , skeoGenerateSaltAndIV = False
                , skeoSalt = Just salt
                , skeoIV = Just iv
                }
    result <-
        reencryptSecretKey
            (SecretKey pkp ska)
            (Passphrase passphrase)
            (Passphrase "changed-pki-password")
            opts
    changed <-
        case result of
            Left err ->
                assertFailure
                    ( "high-level legacy passphrase change failed: "
                        ++ show err
                    )
                    >> fail "high-level passphrase change failed"
            Right sk' -> pure sk'
    decrypted <-
        case decryptSecretKey changed (Passphrase "changed-pki-password") of
            Left err ->
                assertFailure
                    ("decryption with changed legacy passphrase failed: " ++ show err)
                    >> fail "decryption with changed legacy passphrase failed"
            Right x -> pure x
    originalSKey <-
        case decryptPrivateKey
            (pkp, ska)
            (unPassphrase (Passphrase passphrase)) of
            Right (SUUnencrypted skey' _) -> pure skey'
            _ -> fail "expected unencrypted secret key"
    assertEqual
        "high-level legacy passphrase change should preserve secret key material"
        originalSKey
        decrypted
    case decryptSecretKey changed (Passphrase passphrase) of
        Right _ ->
            assertFailure
                "decryption with old legacy passphrase should fail after passphrase change"
        Left _ -> pure ()

testHighLevelReencryptSecretKeyV6 :: Assertion
testHighLevelReencryptSecretKeyV6 = do
    oldPassphrase <- readPKIPassphrase
    armors <- loadArmor "v6-encrypted-secret.pgp.aa"
    armor <-
        case armors of
            (a : _) -> pure a
            [] ->
                assertFailure
                    "v6-encrypted-secret.pgp.aa should contain one armored payload"
                    >> fail "expected one armored payload"
    let packets = parsePkts (armorPayload armor)
    SecretKey pkp ska <-
        case packets of
            (SecretKeyPkt pkpayload skaddendum : _) -> pure (SecretKey pkpayload skaddendum)
            _ ->
                assertFailure
                    "v6-encrypted-secret.pgp.aa did not begin with a secret key packet"
                    >> fail "expected secret key packet"
    result <-
        changeSecretKeyPassphrase
            (SecretKey pkp ska)
            (Passphrase oldPassphrase)
            (Passphrase "changed-pki-password")
    changed <-
        case result of
            Left err ->
                assertFailure
                    ( "high-level v6 passphrase change failed: "
                        ++ show err
                    )
                    >> fail "high-level v6 passphrase change failed"
            Right sk' -> pure sk'
    decrypted <-
        case decryptSecretKey changed (Passphrase "changed-pki-password") of
            Left err ->
                assertFailure
                    ("decryption with changed v6 passphrase failed: " ++ show err)
                    >> fail "decryption with changed v6 passphrase failed"
            Right x -> pure x
    originalSKey <-
        case decryptPrivateKey
            (pkp, ska)
            (unPassphrase (Passphrase oldPassphrase)) of
            Right (SUUnencrypted skey' _) -> pure skey'
            _ -> fail "expected unencrypted secret key"
    assertEqual
        "high-level v6 passphrase change should preserve secret key material"
        originalSKey
        decrypted
    case decryptSecretKey changed (Passphrase oldPassphrase) of
        Right _ ->
            assertFailure
                "decryption with old v6 passphrase should fail after passphrase change"
        Left _ -> pure ()

testHighLevelReencryptDeterministic :: Assertion
testHighLevelReencryptDeterministic = do
    passphrase <- readPKIPassphrase
    packets <-
        DC.runConduitRes $
            CB.sourceFile "tests/data/aes256-sha512.seckey"
                DC..| conduitGet get
                DC..| CL.consume
    SecretKey pkp ska <-
        case packets of
            (SecretKeyPkt pkpayload skaddendum : _) -> pure (SecretKey pkpayload skaddendum)
            _ ->
                assertFailure
                    "aes256-sha512.seckey did not begin with a secret key packet"
                    >> fail "expected secret key packet"
    let salt = Salt "12345678"
        iv = IV "1234567890ABCDEF"
        opts =
            SecretKeyEncryptOptions
                { skeoPolicy = defaultPolicy
                , skeoGenerateSaltAndIV = False
                , skeoSalt = Just salt
                , skeoIV = Just iv
                }
    result1 <-
        reencryptSecretKey
            (SecretKey pkp ska)
            (Passphrase passphrase)
            (Passphrase passphrase)
            opts
    changed1 <-
        case result1 of
            Left err ->
                assertFailure
                    ( "deterministic re-encrypt #1 failed: "
                        ++ show err
                    )
                    >> fail "deterministic re-encrypt #1 failed"
            Right sk' -> pure sk'
    result2 <-
        reencryptSecretKey
            (SecretKey pkp ska)
            (Passphrase passphrase)
            (Passphrase passphrase)
            opts
    changed2 <-
        case result2 of
            Left err ->
                assertFailure
                    ( "deterministic re-encrypt #2 failed: "
                        ++ show err
                    )
                    >> fail "deterministic re-encrypt #2 failed"
            Right sk' -> pure sk'
    assertEqual
        "deterministic salt/IV should produce identical re-encrypted keys"
        (_secretKeySKAddendum changed1)
        (_secretKeySKAddendum changed2)
