packages feed

hOpenPGP 3.0.2.2 → 3.1

raw patch · 26 files changed

+35249/−27945 lines, 26 files

Files

Codec/Encryption/OpenPGP/Arbitrary.hs view
@@ -2,379 +2,404 @@ -- Copyright © 2014-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).- {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}  module Codec.Encryption.OpenPGP.Arbitrary-  (-  ) where+    (+    ) where -import Codec.Encryption.OpenPGP.Types import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) import Network.URI (nullURI, parseURI) import Test.QuickCheck-  ( Arbitrary(..)-  , Gen-  , choose-  , elements-  , frequency-  , getPositive-  , listOf1-  , oneof-  , sized-  , suchThat-  , vector-  )+    ( Arbitrary (..)+    , Gen+    , choose+    , elements+    , frequency+    , getPositive+    , listOf1+    , oneof+    , sized+    , suchThat+    , vector+    ) import Test.QuickCheck.Instances () +import Codec.Encryption.OpenPGP.Types+ instance Arbitrary (PKESK 'PKESKV3) where-  arbitrary = do-    eoki <- arbitrary-    pka <- arbitrary-    mpis <--      case pka of-        RSA -> (\mpi -> mpi NE.:| []) <$> arbitrary-        DeprecatedRSAEncryptOnly -> (\mpi -> mpi NE.:| []) <$> arbitrary-        ElgamalEncryptOnly -> do-          mpi1 <- arbitrary-          mpi2 <- arbitrary-          pure (mpi1 NE.:| [mpi2])-        ForbiddenElgamal -> do-          mpi1 <- arbitrary-          mpi2 <- arbitrary-          pure (mpi1 NE.:| [mpi2])-        ECDH -> do-          mpi1 <- arbitrary-          mpi2 <- arbitrary-          pure (mpi1 NE.:| [mpi2])-        _ -> arbitrary-    pure (PKESK3Packet 3 eoki pka mpis)+    arbitrary = do+        eoki <- arbitrary+        pka <- arbitrary+        mpis <-+            case pka of+                RSA -> (\mpi -> mpi NE.:| []) <$> arbitrary+                DeprecatedRSAEncryptOnly -> (\mpi -> mpi NE.:| []) <$> arbitrary+                ElgamalEncryptOnly -> do+                    mpi1 <- arbitrary+                    mpi2 <- arbitrary+                    pure (mpi1 NE.:| [mpi2])+                ForbiddenElgamal -> do+                    mpi1 <- arbitrary+                    mpi2 <- arbitrary+                    pure (mpi1 NE.:| [mpi2])+                ECDH -> do+                    mpi1 <- arbitrary+                    mpi2 <- arbitrary+                    pure (mpi1 NE.:| [mpi2])+                _ -> arbitrary+        pure (PKESK3Packet 3 eoki pka mpis)  instance Arbitrary (PKESK 'PKESKV6) where-  arbitrary = do-    rid <--      oneof-        [ pure BL.empty-        , BL.pack <$> vector 20-        , BL.pack . (4 :) <$> vector 20-        , BL.pack <$> vector 32-        , BL.pack . (6 :) <$> vector 32-        ]-    pka <- arbitrary-    esk <- BL.pack <$> listOf1 arbitrary-    pure (PKESK6Packet rid pka esk)+    arbitrary = do+        rid <-+            oneof+                [ pure BL.empty+                , BL.pack <$> vector 20+                , BL.pack . (4 :) <$> vector 20+                , BL.pack <$> vector 32+                , BL.pack . (6 :) <$> vector 32+                ]+        pka <- arbitrary+        esk <- BL.pack <$> listOf1 arbitrary+        pure (PKESK6Packet rid pka esk)  instance Arbitrary (SKESK 'SKESKV4) where-  arbitrary = do-    sa <- elements [AES128, AES192, AES256]-    s2k <- arbitrarySKESKv4S2K-    esk <- oneof [pure Nothing, Just . BL.pack <$> listOf1 arbitrary]-    pure (SKESK4Packet sa s2k esk)+    arbitrary = do+        sa <- elements [AES128, AES192, AES256]+        s2k <- arbitrarySKESKv4S2K+        esk <- oneof [pure Nothing, Just . BL.pack <$> listOf1 arbitrary]+        pure (SKESK4Packet sa s2k esk)  instance Arbitrary (SKESK 'SKESKV6) where-  arbitrary = do-    sa <- elements [AES128, AES192, AES256]-    aead <- elements [EAX, OCB, GCM]-    s2k <- arbitrarySKESKv6S2K-    iv <- BL.pack <$> vector 16-    esk <- BL.pack <$> listOf1 arbitrary-    tag <- BL.pack <$> vector 16-    pure (SKESK6Packet sa aead s2k iv esk tag)+    arbitrary = do+        sa <- elements [AES128, AES192, AES256]+        aead <- elements [EAX, OCB, GCM]+        s2k <- arbitrarySKESKv6S2K+        iv <- BL.pack <$> vector 16+        esk <- BL.pack <$> listOf1 arbitrary+        tag <- BL.pack <$> vector 16+        pure (SKESK6Packet sa aead s2k iv esk tag)  arbitrarySKESKv4S2K :: Gen S2K arbitrarySKESKv4S2K =-  oneof-    [ Simple <$> elements supportedSKESKHashAlgorithms-    , Salted <$> elements supportedSKESKHashAlgorithms <*> (Salt8 . B.pack <$> vector 8)-    ]+    oneof+        [ Simple <$> elements supportedSKESKHashAlgorithms+        , Salted+            <$> elements supportedSKESKHashAlgorithms+            <*> (Salt8 . B.pack <$> vector 8)+        ]  arbitrarySKESKv6S2K :: Gen S2K arbitrarySKESKv6S2K =-  Argon2 <$>-  (Salt16 . B.pack <$> vector 16) <*>-  choose (1, 4) <*>-  choose (1, 4) <*>-  choose (3, 31)+    Argon2+        <$> (Salt16 . B.pack <$> vector 16)+        <*> choose (1, 4)+        <*> choose (1, 4)+        <*> choose (3, 31)  supportedSKESKHashAlgorithms :: [HashAlgorithm] supportedSKESKHashAlgorithms = [SHA1, SHA256, SHA384, SHA512]  instance Arbitrary Signature where-  arbitrary = fmap Signature arbitrary+    arbitrary = fmap Signature arbitrary  instance Arbitrary UserId where-  arbitrary = fmap UserId arbitrary+    arbitrary = fmap UserId arbitrary  -- instance Arbitrary SignaturePayload where-  arbitrary = frequency [(2, three), (3, four), (1, other)]-    where-      three = do-        st <- arbitrary-        w32 <- arbitrary-        eoki <- arbitrary-        pka <- arbitrary-        ha <- arbitrary-        w16 <- arbitrary-        SigV3 st w32 eoki pka ha w16 <$> arbitrary-      four = do-        st <- arbitrary-        pka <- arbitrary-        ha <- arbitrary-        has <- arbitrary-        uhas <- arbitrary-        w16 <- arbitrary-        SigV4 st pka ha has uhas w16 <$> arbitrary-      other = do-        v <- oneof [pure 5, choose (7, maxBound)]-        SigVOther v <$> arbitrary+    arbitrary = frequency [(2, three), (3, four), (1, other)]+      where+        three = do+            st <- arbitrary+            w32 <- arbitrary+            eoki <- arbitrary+            pka <- arbitrary+            ha <- arbitrary+            w16 <- arbitrary+            SigV3 st w32 eoki pka ha w16 <$> arbitrary+        four = do+            st <- arbitrary+            pka <- arbitrary+            ha <- arbitrary+            has <- arbitrary+            uhas <- arbitrary+            w16 <- arbitrary+            SigV4 st pka ha has uhas w16 <$> arbitrary+        other = do+            v <- oneof [pure 5, choose (7, maxBound)]+            SigVOther v <$> arbitrary  instance Arbitrary SigSubPacket where-  arbitrary = do-    crit <- arbitrary-    SigSubPacket crit <$> arbitrary+    arbitrary = do+        crit <- arbitrary+        SigSubPacket crit <$> arbitrary  instance Arbitrary SigSubPacketPayload where-  arbitrary =-    sized $ \n ->-      oneof-        ([ sct-         , set-         , ec-         , ts-         , re-         , ket-         , psa-         , rk-         , i-         , nd-         , phas-         , pcas-         , ksps-         , pks-         , puid-         , purl-         , kfs-         , suid-         , rfr-         , fs-         , st-         , udss-         , oss-         , ifp-         ] ++-         [es n | n > 0])-    where-      sct = fmap SigCreationTime arbitrary-      set = fmap SigExpirationTime arbitrary-      ec = fmap ExportableCertification arbitrary-      ts =-        arbitrary >>= \tl -> arbitrary >>= \ta -> return (TrustSignature tl ta)-      re = fmap RegularExpression arbitrary-      ket = fmap KeyExpirationTime arbitrary-      psa = fmap PreferredSymmetricAlgorithms arbitrary-      rk =-        arbitrary >>= \rcs ->-          arbitrary >>= \pka ->-            fmap (RevocationKey rcs pka . Fingerprint . BL.pack) (vector 20)-      i = fmap Issuer arbitrary-      nd =-        arbitrary >>= \nfs ->-          arbitrary >>= \nn ->-            arbitrary >>= \nv -> return (NotationData nfs nn nv)-      phas = fmap PreferredHashAlgorithms arbitrary-      pcas = fmap PreferredCompressionAlgorithms arbitrary-      ksps = fmap KeyServerPreferences arbitrary-      pks = fmap PreferredKeyServer arbitrary-      puid = fmap PrimaryUserId arbitrary-      purl = fmap (PolicyURL . URL . fromMaybe nullURI . parseURI) arbitrary-      kfs = fmap KeyFlags arbitrary-      suid = fmap SignersUserId arbitrary-      rfr =-        arbitrary >>= \rc ->-          arbitrary >>= \rr -> return (ReasonForRevocation rc rr)-      fs = fmap Features arbitrary-      st =-        arbitrary >>= \pka ->-          arbitrary >>= \ha ->-            arbitrary >>= \sh -> return (SignatureTarget pka ha sh)-      es _ = pure (EmbeddedSignature (SigVOther 5 BL.empty))-      ifp =-        elements [IssuerFingerprintV4, IssuerFingerprintV6] >>= \v ->-          fmap-            (IssuerFingerprint v)-            (if v == IssuerFingerprintV6-               then fmap (Fingerprint . BL.pack) (vector 32)-               else fmap (Fingerprint . BL.pack) (vector 20))-      udss =-        choose (100, 110) >>= \a ->-          arbitrary >>= \b -> return (UserDefinedSigSub a b)-      oss =-        suchThat arbitrary isOtherSigSubType >>= \a ->-          arbitrary >>= \b -> return (OtherSigSub a b)-      isOtherSigSubType a =-        a <= 127 &&-        a `notElem`-        [ 2-        , 3-        , 4-        , 5-        , 6-        , 7-        , 9-        , 11-        , 12-        , 16-        , 20-        , 21-        , 22-        , 23-        , 24-        , 25-        , 26-        , 27-        , 28-        , 29-        , 30-        , 31-        , 32-        , 33-        ] &&-        (a < 100 || a > 110)+    arbitrary =+        sized $ \n ->+            oneof+                ( [ sct+                  , set+                  , ec+                  , ts+                  , re+                  , ket+                  , psa+                  , rk+                  , i+                  , nd+                  , phas+                  , pcas+                  , ksps+                  , pks+                  , puid+                  , purl+                  , kfs+                  , suid+                  , rfr+                  , fs+                  , st+                  , udss+                  , oss+                  , ifp+                  , irfp+                  , pacs+                  ]+                    ++ [es n | n > 0]+                )+      where+        sct = fmap SigCreationTime arbitrary+        set = fmap SigExpirationTime arbitrary+        ec = fmap ExportableCertification arbitrary+        ts =+            arbitrary >>= \tl -> arbitrary >>= \ta -> return (TrustSignature tl ta)+        re = fmap RegularExpression arbitrary+        ket = fmap KeyExpirationTime arbitrary+        psa = fmap PreferredSymmetricAlgorithms arbitrary+        rk =+            arbitrary >>= \rcs ->+                arbitrary >>= \pka ->+                    fmap (RevocationKey rcs pka . Fingerprint . BL.pack) (vector 20)+        i = fmap Issuer arbitrary+        nd =+            arbitrary >>= \nfs ->+                arbitrary >>= \nn ->+                    arbitrary >>= \nv -> return (NotationData nfs nn nv)+        phas = fmap PreferredHashAlgorithms arbitrary+        pcas = fmap PreferredCompressionAlgorithms arbitrary+        ksps = fmap KeyServerPreferences arbitrary+        pks = fmap PreferredKeyServer arbitrary+        puid = fmap PrimaryUserId arbitrary+        purl =+            fmap (PolicyURL . URL . fromMaybe nullURI . parseURI) arbitrary+        kfs = fmap KeyFlags arbitrary+        suid = fmap SignersUserId arbitrary+        rfr =+            arbitrary >>= \rc ->+                arbitrary >>= \rr -> return (ReasonForRevocation rc rr)+        fs = fmap Features arbitrary+        st =+            arbitrary >>= \pka ->+                arbitrary >>= \ha ->+                    arbitrary >>= \sh -> return (SignatureTarget pka ha sh)+        es _ = pure (EmbeddedSignature (SigVOther 5 BL.empty))+        ifp =+            elements [IssuerFingerprintV4, IssuerFingerprintV6] >>= \v ->+                fmap+                    (IssuerFingerprint v)+                    ( if v == IssuerFingerprintV6+                        then fmap (Fingerprint . BL.pack) (vector 32)+                        else fmap (Fingerprint . BL.pack) (vector 20)+                    )+        irfp =+            elements [IssuerFingerprintV4, IssuerFingerprintV6] >>= \v ->+                fmap+                    (IntendedRecipient v)+                    ( if v == IssuerFingerprintV6+                        then fmap (Fingerprint . BL.pack) (vector 32)+                        else fmap (Fingerprint . BL.pack) (vector 20)+                    )+        pacs = fmap PreferredAEADCiphersuites arbitrary+        udss =+            choose (100, 110) >>= \a ->+                arbitrary >>= \b -> return (UserDefinedSigSub a b)+        oss =+            suchThat arbitrary isOtherSigSubType >>= \a ->+                arbitrary >>= \b -> return (OtherSigSub a b)+        isOtherSigSubType a =+            a <= 127+                && a+                    `notElem` [ 2+                              , 3+                              , 4+                              , 5+                              , 6+                              , 7+                              , 9+                              , 11+                              , 12+                              , 16+                              , 20+                              , 21+                              , 22+                              , 23+                              , 24+                              , 25+                              , 26+                              , 27+                              , 28+                              , 29+                              , 30+                              , 31+                              , 32+                              , 33+                              , 35+                              , 39+                              ]+                && (a < 100 || a > 110)  -- instance Arbitrary PubKeyAlgorithm where-  arbitrary = elements [RSA, DSA, ECDH, ECDSA, DH, EdDSA]+    arbitrary = elements [RSA, DSA, ECDH, ECDSA, DH, EdDSA]  instance Arbitrary EightOctetKeyId where-  arbitrary = fmap (EightOctetKeyId . BL.pack) (vector 8)+    arbitrary = fmap (EightOctetKeyId . BL.pack) (vector 8)  instance Arbitrary Fingerprint where-  arbitrary =-    oneof-      [ fmap (Fingerprint . BL.pack) (vector 16) -- v3-      , fmap (Fingerprint . BL.pack) (vector 20) -- v4-      , fmap (Fingerprint . BL.pack) (vector 32) -- v6-      ]+    arbitrary =+        oneof+            [ fmap (Fingerprint . BL.pack) (vector 16) -- v3+            , fmap (Fingerprint . BL.pack) (vector 20) -- v4+            , fmap (Fingerprint . BL.pack) (vector 32) -- v6+            ]  instance Arbitrary MPI where-  arbitrary = fmap (MPI . getPositive) arbitrary+    arbitrary = fmap (MPI . getPositive) arbitrary  instance Arbitrary SigType where-  arbitrary =-    elements-      [ BinarySig-      , CanonicalTextSig-      , StandaloneSig-      , GenericCert-      , PersonaCert-      , CasualCert-      , PositiveCert-      , SubkeyBindingSig-      , PrimaryKeyBindingSig-      , SignatureDirectlyOnAKey-      , KeyRevocationSig-      , SubkeyRevocationSig-      , CertRevocationSig-      , TimestampSig-      , ThirdPartyConfirmationSig-      ]+    arbitrary =+        elements+            [ BinarySig+            , CanonicalTextSig+            , StandaloneSig+            , GenericCert+            , PersonaCert+            , CasualCert+            , PositiveCert+            , SubkeyBindingSig+            , PrimaryKeyBindingSig+            , SignatureDirectlyOnAKey+            , KeyRevocationSig+            , SubkeyRevocationSig+            , CertRevocationSig+            , TimestampSig+            , ThirdPartyConfirmationSig+            ]  instance Arbitrary HashAlgorithm where-  arbitrary =-    elements-      [ DeprecatedMD5-      , SHA1-      , RIPEMD160-      , SHA256-      , SHA384-      , SHA512-      , SHA224-      , SHA3_256-      , SHA3_512-      ]+    arbitrary =+        elements+            [ DeprecatedMD5+            , SHA1+            , RIPEMD160+            , SHA256+            , SHA384+            , SHA512+            , SHA224+            , SHA3_256+            , SHA3_512+            ]  instance Arbitrary SymmetricAlgorithm where-  arbitrary =-    elements-      [ Plaintext-      , IDEA-      , TripleDES-      , CAST5-      , Blowfish-      , ReservedSAFER-      , ReservedDES-      , AES128-      , AES192-      , AES256-      , Twofish-      , Camellia128-      , Camellia192-      , Camellia256-      ]+    arbitrary =+        elements+            [ Plaintext+            , IDEA+            , TripleDES+            , CAST5+            , Blowfish+            , ReservedSAFER+            , ReservedDES+            , AES128+            , AES192+            , AES256+            , Twofish+            , Camellia128+            , Camellia192+            , Camellia256+            ] +instance Arbitrary AEADAlgorithm where+    arbitrary = elements [EAX, OCB, GCM]+ instance Arbitrary RevocationClass where-  arbitrary = frequency [(9, srk), (1, rco)]-    where-      srk = return SensitiveRK-      rco = fmap mkRevocationClass (choose (2, 6))+    arbitrary = frequency [(9, srk), (1, rco)]+      where+        srk = return SensitiveRK+        rco = fmap mkRevocationClass (choose (2, 6))  instance Arbitrary NotationFlag where-  arbitrary = frequency [(9, hr), (1, onf)]-    where-      hr = return HumanReadable-      onf = fmap mkNotationFlag (choose (1, 15))+    arbitrary = frequency [(9, hr), (1, onf)]+      where+        hr = return HumanReadable+        onf = fmap mkNotationFlag (choose (1, 15))  instance Arbitrary CompressionAlgorithm where-  arbitrary = elements [Uncompressed, ZIP, ZLIB, BZip2]+    arbitrary = elements [Uncompressed, ZIP, ZLIB, BZip2]  instance Arbitrary KSPFlag where-  arbitrary = frequency [(9, nm), (1, kspo)]-    where-      nm = return NoModify-      kspo = fmap KSPOther (choose (2, 63))+    arbitrary = frequency [(9, nm), (1, kspo)]+      where+        nm = return NoModify+        kspo = fmap KSPOther (choose (2, 63))  instance Arbitrary KeyFlag where-  arbitrary =-    elements-      [ GroupKey-      , AuthKey-      , SplitKey-      , EncryptStorageKey-      , EncryptCommunicationsKey-      , SignDataKey-      , CertifyKeysKey-      ]+    arbitrary =+        elements+            [ GroupKey+            , AuthKey+            , SplitKey+            , EncryptStorageKey+            , EncryptCommunicationsKey+            , SignDataKey+            , CertifyKeysKey+            ]  instance Arbitrary RevocationCode where-  arbitrary =-    elements-      [ NoReason-      , KeySuperseded-      , KeyMaterialCompromised-      , KeyRetiredAndNoLongerUsed-      , UserIdInfoNoLongerValid-      ]+    arbitrary =+        elements+            [ NoReason+            , KeySuperseded+            , KeyMaterialCompromised+            , KeyRetiredAndNoLongerUsed+            , UserIdInfoNoLongerValid+            ]  instance Arbitrary FeatureFlag where-  arbitrary = frequency [(8, seipdV1), (1, seipdV2), (1, fo)]-    where-      seipdV1 = return FeatureSEIPDv1-      seipdV2 = return FeatureSEIPDv2-      fo = fmap FeatureOther (suchThat (choose (0, 63)) (`notElem` [4, 7]))+    arbitrary = frequency [(8, seipdV1), (1, seipdV2), (1, fo)]+      where+        seipdV1 = return FeatureSEIPDv1+        seipdV2 = return FeatureSEIPDv2+        fo =+            fmap FeatureOther (suchThat (choose (0, 63)) (`notElem` [4, 7]))  instance Arbitrary ThirtyTwoBitTimeStamp where-  arbitrary = fmap ThirtyTwoBitTimeStamp arbitrary+    arbitrary = fmap ThirtyTwoBitTimeStamp arbitrary  instance Arbitrary ThirtyTwoBitDuration where-  arbitrary = fmap ThirtyTwoBitDuration arbitrary+    arbitrary = fmap ThirtyTwoBitDuration arbitrary  instance Arbitrary NotationName where-  arbitrary = fmap NotationName arbitrary+    arbitrary = fmap NotationName arbitrary  instance Arbitrary NotationValue where-  arbitrary = fmap NotationValue arbitrary+    arbitrary = fmap NotationValue arbitrary++instance Arbitrary Padding where+    arbitrary = fmap Padding arbitrary
Codec/Encryption/OpenPGP/Encrypt.hs view
@@ -2,2418 +2,2935 @@ -- Copyright © 2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).--{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeApplications #-}--module Codec.Encryption.OpenPGP.Encrypt-  ( PKESKEncryptError(..)-  , RecipientCapabilityNegotiationMode(..)-  , RecipientCapabilityError(..)-  , renderRecipientCapabilityError-  , RecipientCapabilities(..)-  , recipientCapabilitiesFromSubpacketPayloads-  , recipientCapabilitySupportsEncryption-  , RecipientTargetRejectionReason(..)-  , RecipientEncryptionTargetRejected(..)-  , RecipientEncryptionTargetsReport(..)-  , recipientEncryptionTargetsReportFromTKAtTimestamp-  , recipientEncryptionTargetsReportFromTK-  , recipientEncryptionTargetFromTKAtTimestamp-  , recipientEncryptionTargetFromTKAtTimestampWithPolicy-  , recipientEncryptionTargetsFromTKAtTimestamp-  , recipientEncryptionTargetFromTK-  , recipientEncryptionTargetFromTKWithPolicy-  , recipientEncryptionTargetsFromTK-  , RecipientTargetSelectionPolicy(..)-  , PassphraseSKESKVersionPolicy(..)-  , PassphraseEncryptRequest(..)-  , encryptPassphraseWithPolicy-  , PKESKVersionPolicy(..)-  , RecipientPKESKVersionStrategy(..)-  , RecipientPKESKVersionStrategyW(..)-  , SomeRecipientPKESKVersionStrategyW(..)-  , RecipientPKESKVersionSelector-  , RecipientPKESKVersionSelectorTyped-  , EncryptCompatibilityProfile(..)-  , EncryptCompatibilityProfileW(..)-  , SomeEncryptCompatibilityProfileW(..)-  , RecipientEncryptionTarget(..)-  , recipientEncryptionTarget-  , recipientEncryptionTargetWithStrategy-  , recipientEncryptionTargetWithCapabilities-  , recipientEncryptionTargetWithStrategyTyped-  , recipientVersionStrategyForProfile-  , recipientVersionStrategyForProfileTyped-  , RecipientPayloadShape(..)-  , defaultRecipientPayloadShape-  , SEIPDVersion(..)-  , RecipientEncryptResult(..)-  , RecipientEncryptRequest(..)-  , RecipientEncryptRequestOverrides(..)-  , encryptForRecipients-  , encryptForRecipientsLegacy-  , encryptForRecipientsWithCapabilityNegotiation-  , PKESKV3SessionMaterial-  , PKESKV6RawSessionMaterial-  , PKESKSessionMaterial-  , pkeskSessionAlgorithm-  , pkeskSessionKey-  , mkPKESKSessionMaterial-  , mkPKESKV3SessionMaterial-  , mkPKESKV6RawSessionMaterial-  , pkeskV3SessionMaterial-  , pkeskV6RawSessionMaterial-  , encodeOpenPGPSessionMaterial-  , generateSessionKeyMaterial-  , canonicalizePKESKRecipientId-  , canonicalizePKESKPacketRecipientIds-  , buildPKESKv3PayloadForRecipient-  , buildPKESKv3PktForRecipient-  , buildPKESKPayloadForRecipient-  , buildPKESKPktForRecipient-  , buildPKESKPktsForRecipientTargetsWithSelector-  , buildPKESKPktsForRecipientTargetsWithSelectorTyped-  , encryptSEIPDv2Payload-  , encryptSEIPDv1Payload-  , encryptSEIPDv2WithSKESK-  , encryptSEIPDv2WithSKESKBlock-  , encryptSEIPDv2LiteralDataWithSKESK-  , composeMessageWithSEIPDv2-  ) where--import Codec.Encryption.OpenPGP.BlockCipher (CipherError, renderCipherError, keySize, withSymmetricCipher)-import Codec.Encryption.OpenPGP.CFB-  ( OpenPGPCFBModeW(..)-  , encryptOpenPGPCfbRaw-  , mdcTrailerForSEIPDv1-  )-import Codec.Encryption.OpenPGP.Internal.HOBlockCipher (HOBlockCipher(..))-import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)-import Codec.Encryption.OpenPGP.Internal (leftPadTo, point2MBS)-import Codec.Encryption.OpenPGP.Internal.CryptoAES (withAESCipher)-import Codec.Encryption.OpenPGP.Internal.CryptoECDH-  ( normalizeMontgomeryPublic-  , buildECDHKDFParam-  , deriveECDHKek-  )-import Codec.Encryption.OpenPGP.Internal.CryptoSEIPDv2-  ( aeadModeAndNonceSizeForSEIPDv2-  , deriveSKESK6KEK-  , encryptSKESK6SessionKey-  , seipdv2SymmetricKeySize-  )-import Codec.Encryption.OpenPGP.Policy-  ( PKESKVersionPolicy(..)-  , OpenPGPRFC(..)-  , MessageEncryptionPolicy-  , policyForRFC-  , policyMessageEncryption-  , messageDefaultSymmetricAlgorithm-  , messageSEIPDv2SymmetricAlgorithms-  , messageDefaultAEADAlgorithm-  , messageDefaultChunkSize-  , messageSEIPDv2SaltOctets-  , defaultPKESKVersionPolicy-  )-import Codec.Encryption.OpenPGP.Expirations-  ( effectiveKeyPreferencesAtTimestamp-  , isPKTimeValidWithSelfSignatures-  , keyStateAt-  , keyStateValid-  , signatureEffectiveAt-  )-import Codec.Encryption.OpenPGP.Ontology (isSubkeyBindingSig, isSubkeyRevocation)-import Codec.Encryption.OpenPGP.SignatureQualities (sigCT, signatureHashedSubpacketsKnown)-import Codec.Encryption.OpenPGP.Serialize ()-import Codec.Encryption.OpenPGP.S2K (renderS2KError, string2Key)-import Codec.Encryption.OpenPGP.Types-import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as BTypes-import Codec.Encryption.OpenPGP.Internal.RFC7253OCB (encryptWithOCBRFC7253)-import Control.Applicative ((<|>))-import Control.Lens ((.~), ix)-import Control.Monad (when)-import Data.List (find, foldl', maximumBy)-import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)-import Data.Ord (comparing)-import Data.Time.Clock (UTCTime)-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import qualified "crypton" Crypto.Cipher.Types as CCT-import qualified Crypto.Error as CE-import qualified Crypto.Hash.Algorithms as CHAlg-import Crypto.KDF.HKDF (expand, extract)-import Crypto.Number.Serialize (i2osp, os2ip)-import qualified Crypto.PubKey.Curve25519 as C25519-import qualified Crypto.PubKey.Curve448 as C448-import qualified Crypto.PubKey.ECC.DH as ECCDH-import qualified Crypto.PubKey.ECC.ECDSA as ECDSA-import qualified Crypto.PubKey.ECC.Generate as ECCGen-import qualified Crypto.PubKey.RSA.PKCS15 as RSA15-import Crypto.Random.Types (MonadRandom, getRandomBytes)-import Data.Binary (put)-import qualified Data.ByteArray as BA-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import Data.Bits ((.&.), shiftL, shiftR, xor)-import Data.Binary.Put (putWord64be, runPut)-import Data.Bifunctor (first)-import Data.List.NonEmpty (NonEmpty(..))-import qualified Data.Set as Set-import Data.Word (Word8, Word16, Word64)-import Data.Int (Int64)---- | Typed failures from one-pass signature packet construction.-data OPSBuildError-  = OPSBuildMissingIssuerKeyId-  | OPSBuildMissingIssuerFingerprint-  | OPSBuildFingerprintWrongLength Int64-  | OPSBuildUnsupportedSigVersion PacketVersion-  deriving (Eq, Show)--renderOPSBuildError :: OPSBuildError -> String-renderOPSBuildError OPSBuildMissingIssuerKeyId =-  "cannot build OPS3 packet from v4 signature without issuer metadata"-renderOPSBuildError OPSBuildMissingIssuerFingerprint =-  "cannot build OPS6 packet from v6 signature without issuer fingerprint"-renderOPSBuildError (OPSBuildFingerprintWrongLength n) =-  "cannot build OPS6 packet: issuer fingerprint must be 32 octets, got " ++ show n-renderOPSBuildError (OPSBuildUnsupportedSigVersion v) =-  "cannot build one-pass signature packet for unsupported signature version " ++ show v---- | Typed failures surfaced by encrypt-side PKESK and SEIPD-v2 helpers.-data PKESKEncryptError-  = UnsupportedSessionKeyAlgorithm SymmetricAlgorithm String-  | InvalidSessionKeyLength SymmetricAlgorithm Int Int-  | InvalidRecipientIdentifier String-  | UnsupportedRecipientAlgorithm PubKeyAlgorithm-  | InvalidRecipientKeyMaterial PubKeyAlgorithm String-  | RecipientKdfFailure PubKeyAlgorithm String-  | RecipientKeyWrapFailure PubKeyAlgorithm String-  | RecipientCapabilitySelectionFailure RecipientCapabilityError-  | PayloadBuildFailure String-  | NoRecipientsProvided-  deriving (Eq, Show)--renderPKESKEncryptError :: PKESKEncryptError -> String-renderPKESKEncryptError (UnsupportedSessionKeyAlgorithm algo reason) =-  "unsupported session key algorithm " ++ show algo ++ ": " ++ reason-renderPKESKEncryptError (InvalidSessionKeyLength algo expected actual) =-  "invalid session key length for " ++ show algo ++ ": expected " ++ show expected ++ ", got " ++ show actual-renderPKESKEncryptError (InvalidRecipientIdentifier reason) =-  "invalid recipient identifier: " ++ reason-renderPKESKEncryptError (UnsupportedRecipientAlgorithm algo) =-  "unsupported recipient public-key algorithm: " ++ show algo-renderPKESKEncryptError (InvalidRecipientKeyMaterial algo reason) =-  "invalid recipient key material for " ++ show algo ++ ": " ++ reason-renderPKESKEncryptError (RecipientKdfFailure algo reason) =-  "KDF failure for recipient algorithm " ++ show algo ++ ": " ++ reason-renderPKESKEncryptError (RecipientKeyWrapFailure algo reason) =-  "key wrap failure for recipient algorithm " ++ show algo ++ ": " ++ reason-renderPKESKEncryptError (RecipientCapabilitySelectionFailure err) =-  renderRecipientCapabilityError err-renderPKESKEncryptError (PayloadBuildFailure reason) =-  "payload build failure: " ++ reason-renderPKESKEncryptError NoRecipientsProvided =-  "no recipients provided"--data RecipientCapabilityNegotiationMode-  = RecipientCapabilityNegotiationOff-  | RecipientCapabilityNegotiationOn-  deriving (Eq, Show)--data RecipientCapabilityError-  = RecipientCapabilityMissingEncryptionFlags SomePKPayload (Set.Set KeyFlag)-  | RecipientCapabilityNoEncryptableKeyMaterialInTK-  | RecipientCapabilityMissingSEIPDv1Support [SomePKPayload]-  | RecipientCapabilityMissingSEIPDv2Support [SomePKPayload]-  | RecipientCapabilityNoCommonSymmetricAlgorithms [SymmetricAlgorithm]-  | RecipientCapabilityNoCommonAEADAlgorithms [AEADAlgorithm]-  deriving (Eq, Show)--renderRecipientCapabilityError :: RecipientCapabilityError -> String-renderRecipientCapabilityError (RecipientCapabilityMissingEncryptionFlags recipient flags) =-  "recipient " ++ show (_keyVersion recipient, _pkalgo recipient) ++-  " does not advertise encryption-capable key flags; observed flags: " ++-  show (Set.toList flags)-renderRecipientCapabilityError RecipientCapabilityNoEncryptableKeyMaterialInTK =-  "no encryption-capable primary key or subkey was found in transferable key material"-renderRecipientCapabilityError (RecipientCapabilityMissingSEIPDv1Support recipients) =-  "recipient set does not advertise SEIPDv1 (MDC) support: " ++-  show (map (\r -> (_keyVersion r, _pkalgo r)) recipients)-renderRecipientCapabilityError (RecipientCapabilityMissingSEIPDv2Support recipients) =-  "recipient set does not advertise SEIPDv2 support: " ++-  show (map (\r -> (_keyVersion r, _pkalgo r)) recipients)-renderRecipientCapabilityError (RecipientCapabilityNoCommonSymmetricAlgorithms syms) =-  "no common recipient-supported symmetric algorithms: " ++ show syms-renderRecipientCapabilityError (RecipientCapabilityNoCommonAEADAlgorithms aeads) =-  "no common recipient-supported AEAD algorithms: " ++ show aeads--data RecipientCapabilities =-  RecipientCapabilities-    { recipientCapabilityKeyVersion :: KeyVersion-    , recipientCapabilityPublicKeyAlgorithm :: PubKeyAlgorithm-    , recipientCapabilityKeyFlags :: Set.Set KeyFlag-    , recipientCapabilityFeatures :: Set.Set FeatureFlag-    , recipientCapabilityPreferredSymmetricAlgorithms :: [SymmetricAlgorithm]-    , recipientCapabilityPreferredAEADAlgorithms :: [AEADAlgorithm]-    }-  deriving (Eq, Show)--data RecipientTargetRejectionReason-  = RecipientTargetUnsupportedAlgorithm PubKeyAlgorithm-  | RecipientTargetMissingEncryptionFlags SomePKPayload (Set.Set KeyFlag)-  | RecipientTargetRevoked SomePKPayload-  | RecipientTargetNotValidAtTimestamp SomePKPayload ThirtyTwoBitTimeStamp-  deriving (Eq, Show)--data RecipientEncryptionTargetRejected =-  RecipientEncryptionTargetRejected-    { recipientEncryptionTargetRejectedKey :: SomePKPayload-    , recipientEncryptionTargetRejectedCapabilities :: Maybe RecipientCapabilities-    , recipientEncryptionTargetRejectedReason :: RecipientTargetRejectionReason-    }-  deriving (Eq, Show)--data RecipientEncryptionTargetsReport =-  RecipientEncryptionTargetsReport-    { recipientEncryptionTargetsAccepted :: [RecipientEncryptionTarget]-    , recipientEncryptionTargetsRejected :: [RecipientEncryptionTargetRejected]-    }-  deriving (Eq, Show)---- | Extract encrypt-relevant recipient capabilities from effective--- self-signature subpackets.------ RFC 9580 preferred AEAD ciphersuites are currently carried through--- 'OtherSigSub' type 39 and decoded into AEAD preferences here.-recipientCapabilitiesFromSubpacketPayloads ::-     SomePKPayload-  -> [SigSubPacketPayload]-  -> RecipientCapabilities-recipientCapabilitiesFromSubpacketPayloads recipient payloads =-  foldl' step (emptyRecipientCapabilities recipient) payloads-  where-    preferredAEADCiphersuitesSubpacketType :: Word8-    preferredAEADCiphersuitesSubpacketType = 39--    step caps payload =-      case payload of-        KeyFlags flags ->-          caps-            { recipientCapabilityKeyFlags =-                recipientCapabilityKeyFlags caps `Set.union` flags-            }-        Features features ->-          caps-            { recipientCapabilityFeatures =-                recipientCapabilityFeatures caps `Set.union` features-            }-        PreferredSymmetricAlgorithms syms ->-          caps-            { recipientCapabilityPreferredSymmetricAlgorithms =-                recipientCapabilityPreferredSymmetricAlgorithms caps ++ syms-            }-        OtherSigSub subpacketType rawPayload-          | subpacketType == preferredAEADCiphersuitesSubpacketType ->-              caps-                { recipientCapabilityPreferredAEADAlgorithms =-                    recipientCapabilityPreferredAEADAlgorithms caps ++-                    preferredAEADAlgorithmsFromCiphersuites rawPayload-                }-        _ -> caps--    emptyRecipientCapabilities key =-      RecipientCapabilities-        { recipientCapabilityKeyVersion = _keyVersion key-        , recipientCapabilityPublicKeyAlgorithm = _pkalgo key-        , recipientCapabilityKeyFlags = Set.empty-        , recipientCapabilityFeatures = Set.empty-        , recipientCapabilityPreferredSymmetricAlgorithms = []-        , recipientCapabilityPreferredAEADAlgorithms = []-        }--    preferredAEADAlgorithmsFromCiphersuites :: BL.ByteString -> [AEADAlgorithm]-    preferredAEADAlgorithmsFromCiphersuites =-      dedupePreservingOrder . parsePairs . BL.unpack-      where-        parsePairs (_symAlgo:aeadAlgo:rest) =-          (toFVal aeadAlgo :: AEADAlgorithm) : parsePairs rest-        parsePairs _ = []--        dedupePreservingOrder = foldl' addIfMissing []-        addIfMissing acc x-          | x `elem` acc = acc-          | otherwise = acc ++ [x]--recipientCapabilitySupportsEncryption :: RecipientCapabilities -> Bool-recipientCapabilitySupportsEncryption caps =-  let flags = recipientCapabilityKeyFlags caps-   in Set.null flags ||-      Set.member EncryptStorageKey flags ||-      Set.member EncryptCommunicationsKey flags--recipientCapabilityAdvertisesSEIPDv1Support :: RecipientCapabilities -> Bool-recipientCapabilityAdvertisesSEIPDv1Support caps =-  let features = recipientCapabilityFeatures caps-   in Set.null features || Set.member FeatureSEIPDv1 features--recipientCapabilityAdvertisesSEIPDv2Support :: RecipientCapabilities -> Bool-recipientCapabilityAdvertisesSEIPDv2Support caps =-  recipientCapabilityAdvertisesSEIPDv1Support caps &&-  Set.member FeatureSEIPDv2 (recipientCapabilityFeatures caps)--recipientEncryptionTargetFromTKAtTimestamp ::-     ThirtyTwoBitTimeStamp-  -> TKUnknown-  -> Either RecipientCapabilityError RecipientEncryptionTarget-recipientEncryptionTargetFromTKAtTimestamp timestamp tk =-  recipientEncryptionTargetFromTKAtTimestampWithPolicy-    RecipientTargetSelectionFirstValid-    timestamp-    tk--data RecipientTargetSelectionPolicy-  = RecipientTargetSelectionFirstValid-  | RecipientTargetSelectionPreferPrimary-  | RecipientTargetSelectionPreferSubkey-  | RecipientTargetSelectionPreferNewestCreationTime-  deriving (Eq, Show)--recipientEncryptionTargetFromTKAtTimestampWithPolicy ::-     RecipientTargetSelectionPolicy-  -> ThirtyTwoBitTimeStamp-  -> TKUnknown-  -> Either RecipientCapabilityError RecipientEncryptionTarget-recipientEncryptionTargetFromTKAtTimestampWithPolicy policy timestamp tk =-  case chooseRecipientTarget policy tk acceptedTargets of-    Just target -> Right target-    Nothing -> Left RecipientCapabilityNoEncryptableKeyMaterialInTK-  where-    acceptedTargets =-      recipientEncryptionTargetsAccepted-        (recipientEncryptionTargetsReportFromTKAtTimestamp timestamp tk)--recipientEncryptionTargetFromTK :: TK 'PublicTK -> Either RecipientCapabilityError RecipientEncryptionTarget-recipientEncryptionTargetFromTK tk =-  recipientEncryptionTargetFromTKAtTimestampWithPolicy-    RecipientTargetSelectionFirstValid-    (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))-    (tkToUnknown tk)--recipientEncryptionTargetFromTKWithPolicy ::-     RecipientTargetSelectionPolicy-  -> TK 'PublicTK-  -> Either RecipientCapabilityError RecipientEncryptionTarget-recipientEncryptionTargetFromTKWithPolicy policy tk =-  recipientEncryptionTargetFromTKAtTimestampWithPolicy-    policy-    (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))-    (tkToUnknown tk)--recipientEncryptionTargetsFromTKAtTimestamp ::-     ThirtyTwoBitTimeStamp-  -> TKUnknown-  -> [RecipientEncryptionTarget]-recipientEncryptionTargetsFromTKAtTimestamp timestamp tk =-  recipientEncryptionTargetsAccepted (recipientEncryptionTargetsReportFromTKAtTimestamp timestamp tk)--recipientEncryptionTargetsReportFromTKAtTimestamp ::-     ThirtyTwoBitTimeStamp-  -> TKUnknown-  -> RecipientEncryptionTargetsReport-recipientEncryptionTargetsReportFromTKAtTimestamp timestamp tk =-  foldr classifyCandidate emptyReport (subkeyCandidates ++ [primaryCandidate])-  where-    emptyReport = RecipientEncryptionTargetsReport [] []-    primaryCandidate = fst (_tkuKey tk)-    primaryPreferencePayloads =-      fromMaybe [] (effectiveKeyPreferencesAtTimestamp timestamp tk)-    subkeyCandidates =-      mapMaybe-        (\(pkt, _) ->-           case pkt of-             PublicSubkeyPkt pkp -> Just pkp-             SecretSubkeyPkt pkp _ -> Just pkp-             _ -> Nothing)-        (_tkuSubs tk)-    classifyCandidate key report =-      let caps =-            recipientCapabilitiesFromSubpacketPayloads-              key-              (primaryPreferencePayloads ++ subkeyBindingCapabilityPayloads timestamp tk key)-          keyStateRejection = recipientValidityRejectionReason timestamp tk key-       in case keyStateRejection of-            Just rejectionReason ->-             report-               { recipientEncryptionTargetsRejected =-                   RecipientEncryptionTargetRejected-                     { recipientEncryptionTargetRejectedKey = key-                     , recipientEncryptionTargetRejectedCapabilities = Just caps-                     , recipientEncryptionTargetRejectedReason = rejectionReason-                     } :-                   recipientEncryptionTargetsRejected report-               }-            Nothing ->-             if not (supportsPKESKRecipientAlgorithm key)-               then-                 report-                   { recipientEncryptionTargetsRejected =-                       RecipientEncryptionTargetRejected-                         { recipientEncryptionTargetRejectedKey = key-                         , recipientEncryptionTargetRejectedCapabilities = Just caps-                         , recipientEncryptionTargetRejectedReason =-                             RecipientTargetUnsupportedAlgorithm (_pkalgo key)-                         } :-                       recipientEncryptionTargetsRejected report-                   }-               else-                 if recipientCapabilitySupportsEncryption caps-                   then-                     report-                       { recipientEncryptionTargetsAccepted =-                           recipientEncryptionTargetWithCapabilities key caps :-                           recipientEncryptionTargetsAccepted report-                       }-                   else-                     report-                       { recipientEncryptionTargetsRejected =-                           RecipientEncryptionTargetRejected-                             { recipientEncryptionTargetRejectedKey = key-                             , recipientEncryptionTargetRejectedCapabilities = Just caps-                             , recipientEncryptionTargetRejectedReason =-                                 RecipientTargetMissingEncryptionFlags key (recipientCapabilityKeyFlags caps)-                             } :-                           recipientEncryptionTargetsRejected report-                       }--recipientEncryptionTargetsFromTK :: TK 'PublicTK -> [RecipientEncryptionTarget]-recipientEncryptionTargetsFromTK tk =-  recipientEncryptionTargetsFromTKAtTimestamp-    (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))-    (tkToUnknown tk)--recipientEncryptionTargetsReportFromTK :: TK 'PublicTK -> RecipientEncryptionTargetsReport-recipientEncryptionTargetsReportFromTK tk =-  recipientEncryptionTargetsReportFromTKAtTimestamp-    (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))-    (tkToUnknown tk)--subkeyBindingCapabilityPayloads ::-     ThirtyTwoBitTimeStamp-  -> TKUnknown-  -> SomePKPayload-  -> [SigSubPacketPayload]-subkeyBindingCapabilityPayloads timestamp tk recipient =-  maybe [] latestEffectiveBindingPayloads matchingSubkey-  where-    matchingSubkey =-      find-        (\(pkt, _) ->-           case pkt of-             PublicSubkeyPkt pkp -> fingerprint pkp == fingerprint recipient-             SecretSubkeyPkt pkp _ -> fingerprint pkp == fingerprint recipient-             _ -> False)-        (_tkuSubs tk)-    latestEffectiveBindingPayloads (_, sigs) =-      maybe [] signaturePayloadsFromSignature (latestEffectiveSubkeyBindingSignature timestamp sigs)--latestEffectiveSubkeyBindingSignature ::-     ThirtyTwoBitTimeStamp-  -> [SignaturePayload]-  -> Maybe SignaturePayload-latestEffectiveSubkeyBindingSignature timestamp sigs =-  case filter (isEffectiveSubkeyBindingSignature timestamp) sigs of-    [] -> Nothing-    candidates -> Just (maximumBy (comparing signatureCreationTimestamp) candidates)--isEffectiveSubkeyBindingSignature ::-     ThirtyTwoBitTimeStamp-  -> SignaturePayload-  -> Bool-isEffectiveSubkeyBindingSignature timestamp sig =-  isSubkeyBindingSig sig &&-  maybe False-    (\created ->-       let tsValue = toInteger (unThirtyTwoBitTimeStamp timestamp)-           createdValue = toInteger (unThirtyTwoBitTimeStamp created)-        in createdValue <= tsValue &&-           maybe True-             (\duration ->-                if unThirtyTwoBitDuration duration == 0-                  then True-                  else tsValue < createdValue + toInteger (unThirtyTwoBitDuration duration))-             (signatureExpirationDuration sig))-    (sigCT sig)--signatureCreationTimestamp :: SignaturePayload -> ThirtyTwoBitTimeStamp-signatureCreationTimestamp sig =-  fromMaybe (ThirtyTwoBitTimeStamp 0) (sigCT sig)--signatureExpirationDuration :: SignaturePayload -> Maybe ThirtyTwoBitDuration-signatureExpirationDuration sig =-  case signatureHashedSubpacketsKnown sig of-    Just hashed ->-      foldr-        (\subpacket acc ->-           case subpacket of-             SigSubPacket _ (SigExpirationTime duration) -> Just duration-             _ -> acc)-        Nothing-        hashed-    Nothing -> Nothing--signaturePayloadsFromSignature :: SignaturePayload -> [SigSubPacketPayload]-signaturePayloadsFromSignature sig =-  case signatureHashedSubpacketsKnown sig of-    Just hashed -> map (\(SigSubPacket _ payload) -> payload) hashed-    Nothing -> []--recipientValidityRejectionReason ::-     ThirtyTwoBitTimeStamp-  -> TKUnknown-  -> SomePKPayload-  -> Maybe RecipientTargetRejectionReason-recipientValidityRejectionReason timestamp tk key-  | fingerprint key == fingerprint (fst (_tkuKey tk)) =-      if keyStateValid (keyStateAt (timestampToUTC timestamp) tk)-        then Nothing-        else Just (RecipientTargetNotValidAtTimestamp key timestamp)-  | otherwise =-      case findMatchingSubkeySignatures tk key of-        Nothing -> Nothing-        Just sigs-          | subkeyRevokedAtTimestamp timestamp sigs ->-              Just (RecipientTargetRevoked key)-          | isPKTimeValidWithSelfSignatures (timestampToUTC timestamp) key sigs ->-              Nothing-          | otherwise ->-              Just (RecipientTargetNotValidAtTimestamp key timestamp)--findMatchingSubkeySignatures :: TKUnknown -> SomePKPayload -> Maybe [SignaturePayload]-findMatchingSubkeySignatures tk recipient =-  snd <$>-  find-    (\(pkt, _) ->-       case pkt of-         PublicSubkeyPkt pkp -> fingerprint pkp == fingerprint recipient-         SecretSubkeyPkt pkp _ -> fingerprint pkp == fingerprint recipient-         _ -> False)-    (_tkuSubs tk)--subkeyRevokedAtTimestamp :: ThirtyTwoBitTimeStamp -> [SignaturePayload] -> Bool-subkeyRevokedAtTimestamp timestamp =-  any (\sig -> isSubkeyRevocation sig && signatureEffectiveAt (timestampToUTC timestamp) sig)--timestampToUTC :: ThirtyTwoBitTimeStamp -> UTCTime-timestampToUTC =-  posixSecondsToUTCTime . realToFrac . unThirtyTwoBitTimeStamp--supportsPKESKRecipientAlgorithm :: SomePKPayload -> Bool-supportsPKESKRecipientAlgorithm recipient =-  case _pkalgo recipient of-    RSA -> True-    DeprecatedRSAEncryptOnly -> True-    ECDH -> True-    X25519 -> True-    X448 -> True-    _ -> False--chooseRecipientTarget ::-     RecipientTargetSelectionPolicy-  -> TKUnknown-  -> [RecipientEncryptionTarget]-  -> Maybe RecipientEncryptionTarget-chooseRecipientTarget policy tk targets =-  case policy of-    RecipientTargetSelectionFirstValid -> listToMaybe targets-    RecipientTargetSelectionPreferPrimary ->-      listToMaybe (filter (isPrimaryTarget tk) targets) <|> listToMaybe targets-    RecipientTargetSelectionPreferSubkey ->-      listToMaybe (filter (not . isPrimaryTarget tk) targets) <|> listToMaybe targets-    RecipientTargetSelectionPreferNewestCreationTime ->-      case targets of-        [] -> Nothing-        (target:rest) ->-          Just-            (foldl'-               (\best candidate ->-                  if _timestamp (recipientEncryptionTargetKey candidate) >-                     _timestamp (recipientEncryptionTargetKey best)-                    then candidate-                    else best)-               target-               rest)-  where-    isPrimaryTarget currentTK target =-      fingerprint (recipientEncryptionTargetKey target) ==-      fingerprint (fst (_tkuKey currentTK))---- | Session-key bundle for PKESK/SKESK packet construction.-newtype PKESKV3SessionMaterial =-  PKESKV3SessionMaterial-    { unPKESKV3SessionMaterial :: B.ByteString-    }-  deriving (Eq, Show)--newtype PKESKV6RawSessionMaterial =-  PKESKV6RawSessionMaterial-    { unPKESKV6RawSessionMaterial :: B.ByteString-    }-  deriving (Eq, Show)--data PKESKSessionMaterial =-  PKESKSessionMaterial-    { pkeskSessionAlgorithm :: SymmetricAlgorithm-    , pkeskSessionKey :: SessionKey-    , pkeskEncodedSessionMaterial :: B.ByteString-    }-  deriving (Eq, Show)--mkPKESKSessionMaterial ::-     SymmetricAlgorithm-  -> SessionKey-  -> Either PKESKEncryptError PKESKSessionMaterial-mkPKESKSessionMaterial symalgo sessionKey = do-  v3Material <- mkPKESKV3SessionMaterial symalgo sessionKey-  _v6Material <- mkPKESKV6RawSessionMaterial symalgo sessionKey-  pure-    PKESKSessionMaterial-      { pkeskSessionAlgorithm = symalgo-      , pkeskSessionKey = sessionKey-      , pkeskEncodedSessionMaterial = unPKESKV3SessionMaterial v3Material-      }--mkPKESKV3SessionMaterial ::-     SymmetricAlgorithm-  -> SessionKey-  -> Either PKESKEncryptError PKESKV3SessionMaterial-mkPKESKV3SessionMaterial symalgo sessionKey = do-  keyBytes <- validatedSessionKeyBytes symalgo sessionKey-  pure $-    PKESKV3SessionMaterial-      (B.singleton (fromFVal symalgo) <> keyBytes <> checksum16Bytes keyBytes)--mkPKESKV6RawSessionMaterial ::-     SymmetricAlgorithm-  -> SessionKey-  -> Either PKESKEncryptError PKESKV6RawSessionMaterial-mkPKESKV6RawSessionMaterial symalgo sessionKey =-  PKESKV6RawSessionMaterial <$> validatedSessionKeyBytes symalgo sessionKey--pkeskV3SessionMaterial :: PKESKSessionMaterial -> PKESKV3SessionMaterial-pkeskV3SessionMaterial =-  PKESKV3SessionMaterial . pkeskEncodedSessionMaterial--pkeskV6RawSessionMaterial :: PKESKSessionMaterial -> PKESKV6RawSessionMaterial-pkeskV6RawSessionMaterial =-  PKESKV6RawSessionMaterial . unSessionKey . pkeskSessionKey--validatedSessionKeyBytes ::-     SymmetricAlgorithm-  -> SessionKey-  -> Either PKESKEncryptError B.ByteString-validatedSessionKeyBytes symalgo (SessionKey sessionKey) = do-  keyLen <--    first-      (UnsupportedSessionKeyAlgorithm symalgo . renderCipherError)-      (keySize symalgo)-  let actualLen = B.length sessionKey-  if actualLen /= keyLen-    then Left (InvalidSessionKeyLength symalgo keyLen actualLen)-    else Right sessionKey--data RecipientPKESKVersionStrategy-  = RecipientPreferV6-  | RecipientForceV3Interop-  deriving (Eq, Show)--data RecipientPKESKVersionStrategyW (strategy :: RecipientPKESKVersionStrategy) where-  RecipientPreferV6W :: RecipientPKESKVersionStrategyW 'RecipientPreferV6-  RecipientForceV3InteropW :: RecipientPKESKVersionStrategyW 'RecipientForceV3Interop--data SomeRecipientPKESKVersionStrategyW where-  SomeRecipientPKESKVersionStrategyW ::-       RecipientPKESKVersionStrategyW strategy-    -> SomeRecipientPKESKVersionStrategyW--type RecipientPKESKVersionSelector =-  SomePKPayload -> Either PKESKEncryptError RecipientPKESKVersionStrategy--type RecipientPKESKVersionSelectorTyped =-  SomePKPayload -> Either PKESKEncryptError SomeRecipientPKESKVersionStrategyW--data EncryptCompatibilityProfile-  = EncryptStrictDefault-  | EncryptInteropLegacy-  deriving (Eq, Show)--data EncryptCompatibilityProfileW (profile :: EncryptCompatibilityProfile) where-  EncryptStrictDefaultW :: EncryptCompatibilityProfileW 'EncryptStrictDefault-  EncryptInteropLegacyW :: EncryptCompatibilityProfileW 'EncryptInteropLegacy--data SomeEncryptCompatibilityProfileW where-  SomeEncryptCompatibilityProfileW ::-       EncryptCompatibilityProfileW profile-    -> SomeEncryptCompatibilityProfileW--data SEIPDVersion-  = SEIPDv1-  | SEIPDv2-  deriving (Eq, Show)--type family PayloadVersionForProfile (profile :: EncryptCompatibilityProfile) :: SEIPDVersion where-  PayloadVersionForProfile 'EncryptStrictDefault = 'SEIPDv2-  PayloadVersionForProfile 'EncryptInteropLegacy = 'SEIPDv1--type family ProfileForPayloadVersion (version :: SEIPDVersion) :: EncryptCompatibilityProfile where-  ProfileForPayloadVersion 'SEIPDv1 = 'EncryptInteropLegacy-  ProfileForPayloadVersion 'SEIPDv2 = 'EncryptStrictDefault--data RecipientEncryptionTarget =-  RecipientEncryptionTarget-    { -- | Recipient key packet selected for PKESK wrapping.-      recipientEncryptionTargetKey :: SomePKPayload-      -- | Optional explicit PKESK version strategy hint.-      --   When absent, profile defaults and auto-detection apply.-    , recipientEncryptionTargetStrategy :: Maybe RecipientPKESKVersionStrategy-      -- | Optional recipient capability hints used by negotiation-enabled-      --   encryption to choose common symmetric/AEAD algorithms.-    , recipientEncryptionTargetCapabilities :: Maybe RecipientCapabilities-    }-  deriving (Eq, Show)--recipientEncryptionTarget :: SomePKPayload -> RecipientEncryptionTarget-recipientEncryptionTarget recipient =-  RecipientEncryptionTarget recipient Nothing Nothing--recipientEncryptionTargetWithStrategy :: SomePKPayload -> RecipientPKESKVersionStrategy -> RecipientEncryptionTarget-recipientEncryptionTargetWithStrategy recipient strategy =-  RecipientEncryptionTarget recipient (Just strategy) Nothing--recipientEncryptionTargetWithCapabilities ::-     SomePKPayload-  -> RecipientCapabilities-  -> RecipientEncryptionTarget-recipientEncryptionTargetWithCapabilities recipient capabilities =-  RecipientEncryptionTarget recipient Nothing (Just capabilities)--recipientEncryptionTargetWithStrategyTyped :: SomePKPayload-  -> RecipientPKESKVersionStrategyW strategy-  -> RecipientEncryptionTarget-recipientEncryptionTargetWithStrategyTyped recipient strategyW =-  recipientEncryptionTargetWithStrategy recipient (demoteRecipientStrategy strategyW)--recipientVersionStrategyForProfile ::-     EncryptCompatibilityProfile-  -> RecipientEncryptionTarget-  -> Either PKESKEncryptError RecipientPKESKVersionStrategy-recipientVersionStrategyForProfile profile target =-  case promoteEncryptCompatibilityProfile profile of-    SomeEncryptCompatibilityProfileW profileW ->-      demoteSomeRecipientStrategy <$>-      recipientVersionStrategyForProfileTyped profileW target--recipientVersionStrategyForProfileTyped ::-     EncryptCompatibilityProfileW profile-  -> RecipientEncryptionTarget-  -> Either PKESKEncryptError SomeRecipientPKESKVersionStrategyW-recipientVersionStrategyForProfileTyped profile target =-  Right $-    case recipientEncryptionTargetStrategy target of-      Just strategy ->-        promoteRecipientStrategy strategy-      Nothing ->-        case profile of-          EncryptStrictDefaultW ->-            autoDetectRecipientVersionStrategy-              (recipientEncryptionTargetKey target)-          EncryptInteropLegacyW ->-            SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW--profileForPayloadVersionW ::-     RecipientEncryptRequestOverrides version-  -> EncryptCompatibilityProfileW (ProfileForPayloadVersion version)-profileForPayloadVersionW overrides =-  case overrides of-    RecipientEncryptRequestSEIPDv2Overrides {} -> EncryptStrictDefaultW-    RecipientEncryptRequestSEIPDv1Overrides {} -> EncryptInteropLegacyW--autoDetectRecipientVersionStrategy :: SomePKPayload-  -> SomeRecipientPKESKVersionStrategyW-autoDetectRecipientVersionStrategy recipient-  | _keyVersion recipient == V6 =-      SomeRecipientPKESKVersionStrategyW RecipientPreferV6W-  | _pkalgo recipient `elem` [X25519, X448] =-      SomeRecipientPKESKVersionStrategyW RecipientPreferV6W-  | otherwise =-      SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW--data RecipientPayloadShape =-  RecipientPayloadShape-    { recipientPayloadDataType :: DataType-    , recipientPayloadFileName :: FileName-    , recipientPayloadTimestamp :: ThirtyTwoBitTimeStamp-    , recipientPayloadUseOnePassSignatures :: Bool-    , recipientPayloadSignatures :: [SignaturePayload]-    }-  deriving (Eq, Show)--data PassphraseSKESKVersionPolicy-  = PassphraseSKESKPreferV6-  | PassphraseSKESKForceV4Interop-  deriving (Eq, Show)--data PassphraseEncryptRequest =-  PassphraseEncryptRequest-    { passphraseEncryptVersionPolicy :: PassphraseSKESKVersionPolicy-    , passphraseEncryptSymmetricAlgorithm :: SymmetricAlgorithm-    , passphraseEncryptS2K :: S2K-    , passphraseEncryptPassphrase :: BL.ByteString-    , passphraseEncryptPayload :: B.ByteString-    , passphraseEncryptSEIPDv1IVOverride :: Maybe IV-    , passphraseEncryptSEIPDv2AEADOverride :: Maybe AEADAlgorithm-    , passphraseEncryptSEIPDv2ChunkSizeOverride :: Maybe Word8-    , passphraseEncryptSEIPDv2SaltOverride :: Maybe Salt-    }-  deriving (Eq, Show)--encryptPassphraseWithPolicy ::-     MonadRandom m-  => PassphraseEncryptRequest-  -> m (Either String [Pkt])-encryptPassphraseWithPolicy request =-  case passphraseEncryptVersionPolicy request of-    PassphraseSKESKForceV4Interop ->-      encryptSEIPDv1WithSKESK-        (passphraseEncryptSymmetricAlgorithm request)-        (passphraseEncryptS2K request)-        (passphraseEncryptSEIPDv1IVOverride request)-        (passphraseEncryptPassphrase request)-        (passphraseEncryptPayload request)-    PassphraseSKESKPreferV6 -> do-      let messagePolicy = policyMessageEncryption (policyForRFC RFC9580)-          aead =-            fromMaybe-              (messageDefaultAEADAlgorithm messagePolicy)-              (passphraseEncryptSEIPDv2AEADOverride request)-          chunkSize =-            fromMaybe-              (messageDefaultChunkSize messagePolicy)-              (passphraseEncryptSEIPDv2ChunkSizeOverride request)-      salt <--        maybe-          (Salt <$> getRandomBytes (messageSEIPDv2SaltOctets messagePolicy))-          pure-          (passphraseEncryptSEIPDv2SaltOverride request)-      pure $-        encryptSEIPDv2WithSKESK-          (passphraseEncryptSymmetricAlgorithm request)-          aead-          chunkSize-          salt-          (passphraseEncryptS2K request)-          (passphraseEncryptPassphrase request)-          (passphraseEncryptPayload request)--defaultRecipientPayloadShape :: RecipientPayloadShape-defaultRecipientPayloadShape =-  RecipientPayloadShape-    { recipientPayloadDataType = BinaryData-    , recipientPayloadFileName = BL.empty-    , recipientPayloadTimestamp = 0-    , recipientPayloadUseOnePassSignatures = False-    , recipientPayloadSignatures = []-    }--data RecipientEncryptResult =-  RecipientEncryptResult-    { recipientEncryptPackets :: [Pkt]-    , recipientEncryptSessionMaterial :: PKESKSessionMaterial-    }-  deriving (Eq, Show)--data RecipientEncryptRequestOverrides (v :: SEIPDVersion) where-  RecipientEncryptRequestSEIPDv1Overrides ::-    { recipientEncryptRequestIVOverride :: Maybe IV-    } -> RecipientEncryptRequestOverrides 'SEIPDv1-  -- | For SEIPDv2 requests:-  --   - when AEAD override is 'Nothing', encrypt-side capability negotiation-  --     selects a common recipient-supported AEAD algorithm (if enabled).-  --   - when AEAD override is 'Just', the explicit AEAD wins.-  RecipientEncryptRequestSEIPDv2Overrides ::-    { recipientEncryptRequestAEADOverride :: Maybe AEADAlgorithm-    , recipientEncryptRequestChunkSizeOverride :: Maybe Word8-    , recipientEncryptRequestSaltOverride :: Maybe Salt-    } -> RecipientEncryptRequestOverrides 'SEIPDv2--data RecipientEncryptRequest (v :: SEIPDVersion) =-  RecipientEncryptRequest-    { -- | Recipient encryption targets. At least one target is required.-      recipientEncryptRequestTargets :: [RecipientEncryptionTarget]-    , recipientEncryptRequestPayloadShape :: RecipientPayloadShape-    , recipientEncryptRequestPayload :: B.ByteString-      -- | Explicit symmetric algorithm override. When 'Nothing', the selected-      --   mode (negotiated or legacy) determines algorithm selection.-    , recipientEncryptRequestSymmetricOverride :: Maybe SymmetricAlgorithm-    , recipientEncryptRequestOverrides :: RecipientEncryptRequestOverrides v-    }--deriving instance Eq (RecipientEncryptRequestOverrides v)-deriving instance Show (RecipientEncryptRequestOverrides v)-deriving instance Eq (RecipientEncryptRequest v)-deriving instance Show (RecipientEncryptRequest v)---- | Encode the RFC 9580 PKESK/SKESK session-key material:---   one-octet algorithm ID, raw session key, then 16-bit checksum.-encodeOpenPGPSessionMaterial ::-     SymmetricAlgorithm -> SessionKey -> Either PKESKEncryptError B.ByteString-encodeOpenPGPSessionMaterial symalgo sessionKey =-  unPKESKV3SessionMaterial <$> mkPKESKV3SessionMaterial symalgo sessionKey---- | Generate a fresh session key and return both raw and encoded forms.-generateSessionKeyMaterial ::-     MonadRandom m-  => SymmetricAlgorithm-  -> m (Either PKESKEncryptError PKESKSessionMaterial)-generateSessionKeyMaterial symalgo =-  case keySize symalgo of-    Left err -> pure (Left (UnsupportedSessionKeyAlgorithm symalgo (renderCipherError err)))-    Right keyLen -> do-      sessionKeyBytes <- getRandomBytes keyLen-      let sessionKey = SessionKey sessionKeyBytes-      pure (mkPKESKSessionMaterial symalgo sessionKey)--canonicalizePKESKRecipientId ::-     PKESKPayload -> Either PKESKEncryptError PKESKPayload-canonicalizePKESKRecipientId payload =-  case payload of-    PKESKPayloadV6Packet payloadV6 ->-      PKESKPayloadV6Packet <$> canonicalizePKESKRecipientIdV6 payloadV6-    _ -> Right payload--canonicalizePKESKRecipientIdV6 ::-     PKESKPayloadV6 -> Either PKESKEncryptError PKESKPayloadV6-canonicalizePKESKRecipientIdV6 (PKESKPayloadV6 rid pka esk) =-  (\normalizedRid -> PKESKPayloadV6 normalizedRid pka esk) <$>-  canonicalizeRecipientKeyIdentifier rid--canonicalizeRecipientKeyIdentifier ::-     BL.ByteString -> Either PKESKEncryptError BL.ByteString-canonicalizeRecipientKeyIdentifier rid-  | BL.length rid == 20 || BL.length rid == 32 = Right rid-  | BL.length rid == 21 && BL.head rid == 0x04 = Right (BL.tail rid)-  | BL.length rid == 33 && BL.head rid == 0x06 = Right (BL.tail rid)-  | otherwise =-      Left-        (InvalidRecipientIdentifier-           ("unsupported PKESK recipient identifier length/prefix: " ++-            show (BL.length rid)))--canonicalizePKESKPacketRecipientIds ::-     [Pkt] -> Either PKESKEncryptError [Pkt]-canonicalizePKESKPacketRecipientIds =-  mapM-    (\pkt ->-       case pkt of-         PKESKPkt payload -> fmap PKESKPkt (canonicalizePKESKRecipientId payload)-         _ -> Right pkt)---- | Build a v6 PKESK payload for one recipient key according to the selected version policy.-buildPKESKPayloadForRecipient ::-     MonadRandom m-  => PKESKVersionPolicy-  -> SomePKPayload-  -> PKESKSessionMaterial-  -> m (Either PKESKEncryptError PKESKPayload)-buildPKESKPayloadForRecipient policy recipient material =-  case policy of-    ForceV3Interop ->-      buildPKESKv3PayloadForRecipient recipient (pkeskV3SessionMaterial material)-    PreferV6 ->-      case _pkalgo recipient of-        RSA -> fmap (fmap PKESKPayloadV6Packet) (buildRsaPKESKv6 recipient material)-        ECDH -> fmap (fmap PKESKPayloadV6Packet) (buildECDHPKESKv6 recipient material)-        X25519 ->-          fmap-            (fmap PKESKPayloadV6Packet)-            (buildX25519PKESKv6 recipient (pkeskV6RawSessionMaterial material))-        X448 ->-          fmap-            (fmap PKESKPayloadV6Packet)-            (buildX448PKESKv6 recipient (pkeskV6RawSessionMaterial material))-        pka -> pure (Left (UnsupportedRecipientAlgorithm pka))----- | Build a PKESK packet for one recipient key according to the selected version policy.-buildPKESKPktForRecipient ::-     MonadRandom m-  => PKESKVersionPolicy-  -> SomePKPayload-  -> PKESKSessionMaterial-  -> m (Either PKESKEncryptError Pkt)-buildPKESKPktForRecipient policy recipient material =-  fmap-    (fmap PKESKPkt)-    (buildPKESKPayloadForRecipient policy recipient material)----- | Build a legacy PKESKv3 payload for v4/v3 RSA recipient interop.-buildPKESKv3PayloadForRecipient ::-     MonadRandom m-  => SomePKPayload-  -> PKESKV3SessionMaterial-  -> m (Either PKESKEncryptError PKESKPayload)-buildPKESKv3PayloadForRecipient recipient material =-  fmap (fmap PKESKPayloadV3Packet) (buildPKESKv3PayloadForRecipientTyped recipient material)--buildPKESKv3PayloadForRecipientTyped ::-     MonadRandom m-  => SomePKPayload-  -> PKESKV3SessionMaterial-  -> m (Either PKESKEncryptError PKESKPayloadV3)-buildPKESKv3PayloadForRecipientTyped recipient material =-  case _pkalgo recipient of-    RSA -> buildRsaPKESKv3 recipient material-    DeprecatedRSAEncryptOnly -> buildRsaPKESKv3 recipient material-    ECDH -> buildECDHPKESKv3 recipient material-    pka -> pure (Left (UnsupportedRecipientAlgorithm pka))---- | Build a legacy PKESKv3 packet for v4/v3 RSA recipient interop.-buildPKESKv3PktForRecipient ::-     MonadRandom m-  => SomePKPayload-  -> PKESKV3SessionMaterial-  -> m (Either PKESKEncryptError Pkt)-buildPKESKv3PktForRecipient recipient material =-  fmap (fmap PKESKPkt) (buildPKESKv3PayloadForRecipient recipient material)---- | Build PKESK packets for all recipients with a single shared session key.--buildPKESKPktsForRecipientTargetsWithSelector ::-     MonadRandom m-  => (RecipientEncryptionTarget -> Either PKESKEncryptError RecipientPKESKVersionStrategy)-  -> [RecipientEncryptionTarget]-  -> PKESKSessionMaterial-  -> m (Either PKESKEncryptError [Pkt])-buildPKESKPktsForRecipientTargetsWithSelector selector targets material-  = buildPKESKPktsForRecipientTargetsWithSelectorTyped-      (\target ->-         promoteRecipientStrategy <$> selector target)-      targets-      material--buildPKESKPktsForRecipientTargetsWithSelectorTyped ::-     MonadRandom m-  => (RecipientEncryptionTarget -> Either PKESKEncryptError SomeRecipientPKESKVersionStrategyW)-  -> [RecipientEncryptionTarget]-  -> PKESKSessionMaterial-  -> m (Either PKESKEncryptError [Pkt])-buildPKESKPktsForRecipientTargetsWithSelectorTyped selector targets material-  | null targets = pure (Left NoRecipientsProvided)-  | otherwise =-      case preparePKESKVersionedMaterial material of-        Left err -> pure (Left err)-        Right (v3Material, v6RawMaterial) -> do-          pkeskResults <--            mapM-              (\target ->-                 case selector target of-                   Left err -> pure (Left err)-                   Right (SomeRecipientPKESKVersionStrategyW RecipientPreferV6W) ->-                     buildPKESKPktForRecipientWithPreparedPayload-                       RecipientPreferV6W-                       (recipientEncryptionTargetKey target)-                       (RecipientPreferV6Payload material v6RawMaterial)-                   Right (SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW) ->-                     buildPKESKPktForRecipientWithPreparedPayload-                       RecipientForceV3InteropW-                       (recipientEncryptionTargetKey target)-                       (RecipientForceV3Payload v3Material))-              targets-          pure (sequence pkeskResults >>= canonicalizePKESKPacketRecipientIds)--preparePKESKVersionedMaterial ::-     PKESKSessionMaterial-  -> Either PKESKEncryptError (PKESKV3SessionMaterial, PKESKV6RawSessionMaterial)-preparePKESKVersionedMaterial material = do-  v3Material <--    mkPKESKV3SessionMaterial-      (pkeskSessionAlgorithm material)-      (pkeskSessionKey material)-  v6RawMaterial <--    mkPKESKV6RawSessionMaterial-      (pkeskSessionAlgorithm material)-      (pkeskSessionKey material)-  pure (v3Material, v6RawMaterial)--data RecipientPKESKRequestPayload (strategy :: RecipientPKESKVersionStrategy) where-  RecipientForceV3Payload ::-       PKESKV3SessionMaterial-    -> RecipientPKESKRequestPayload 'RecipientForceV3Interop-  RecipientPreferV6Payload ::-       PKESKSessionMaterial-    -> PKESKV6RawSessionMaterial-    -> RecipientPKESKRequestPayload 'RecipientPreferV6--buildPKESKPktForRecipientWithPreparedPayload ::-     MonadRandom m-  => RecipientPKESKVersionStrategyW strategy-  -> SomePKPayload-  -> RecipientPKESKRequestPayload strategy-  -> m (Either PKESKEncryptError Pkt)-buildPKESKPktForRecipientWithPreparedPayload strategy recipient payload =-  fmap fmapPKESKPkt payloadResult-  where-    fmapPKESKPkt = fmap PKESKPkt-    payloadResult =-      case (strategy, payload) of-        (RecipientForceV3InteropW, RecipientForceV3Payload v3Material) ->-          buildPKESKv3PayloadForRecipient recipient v3Material-        (RecipientPreferV6W, RecipientPreferV6Payload material v6RawMaterial) ->-          case _pkalgo recipient of-            RSA ->-              fmap (fmap PKESKPayloadV6Packet) (buildRsaPKESKv6 recipient material)-            ECDH ->-              fmap (fmap PKESKPayloadV6Packet) (buildECDHPKESKv6 recipient material)-            X25519 ->-              fmap-                (fmap PKESKPayloadV6Packet)-                (buildX25519PKESKv6 recipient v6RawMaterial)-            X448 ->-              fmap-                (fmap PKESKPayloadV6Packet)-                (buildX448PKESKv6 recipient v6RawMaterial)-            pka ->-              pure (Left (UnsupportedRecipientAlgorithm pka))---- | Encrypt for recipient targets with capability negotiation enabled.------ By default this negotiates a common symmetric and (for SEIPDv2) AEAD--- algorithm from recipient capabilities when available. Explicit request--- overrides still take precedence.-encryptForRecipients ::-     MonadRandom m-  => RecipientEncryptRequest v-  -> m (Either PKESKEncryptError RecipientEncryptResult)-encryptForRecipients =-  encryptForRecipientsWithCapabilityNegotiation RecipientCapabilityNegotiationOn---- | Encrypt for recipient targets without recipient capability negotiation.------ This preserves legacy behavior by using policy defaults unless request--- overrides are provided.-encryptForRecipientsLegacy ::-     MonadRandom m-  => RecipientEncryptRequest v-  -> m (Either PKESKEncryptError RecipientEncryptResult)-encryptForRecipientsLegacy =-  encryptForRecipientsWithCapabilityNegotiation RecipientCapabilityNegotiationOff---- | Encrypt for recipient targets with an explicit capability-negotiation mode.------ When negotiation is on, symmetric and AEAD selection use the common--- intersection of recipient preferences constrained by the active policy.--- When off, policy defaults are used.-encryptForRecipientsWithCapabilityNegotiation ::-     MonadRandom m-  => RecipientCapabilityNegotiationMode-  -> RecipientEncryptRequest v-  -> m (Either PKESKEncryptError RecipientEncryptResult)-encryptForRecipientsWithCapabilityNegotiation negotiationMode request-  | null targets = pure (Left NoRecipientsProvided)-  | otherwise =-      case selectSymmetricAlgorithm negotiationMode request messagePolicy targets of-        Left err -> pure (Left err)-        Right symalgo -> do-          sessionMaterialResult <- generateSessionKeyMaterial symalgo-          case sessionMaterialResult of-            Left err -> pure (Left err)-            Right sessionMaterial -> do-              pkeskResult <--                buildPKESKPktsForRecipientTargetsWithSelectorTyped-                  (recipientVersionStrategyForProfileTyped profileW)-                  targets-                  sessionMaterial-              case pkeskResult of-                Left err -> pure (Left err)-                Right pkeskPkts -> do-                  payloadResult <- case recipientEncryptRequestOverrides request of-                    RecipientEncryptRequestSEIPDv2Overrides-                      { recipientEncryptRequestAEADOverride = aeadOverride-                      , recipientEncryptRequestChunkSizeOverride = chunkSizeOverride-                      , recipientEncryptRequestSaltOverride = saltOverride-                      } ->-                        case recipientsMissingSEIPDv2Support targets of-                          [] -> do-                            case selectAEADAlgorithm negotiationMode messagePolicy targets aeadOverride of-                              Left err -> pure (Left err)-                              Right aead -> do-                                salt <- maybe (Salt <$> getRandomBytes 32) pure saltOverride-                                let chunkSize =-                                      maybe-                                        (messageDefaultChunkSize messagePolicy)-                                        id-                                        chunkSizeOverride-                                pure $-                                  buildEncryptedPacketSequenceWithShape-                                    symalgo-                                    aead-                                    chunkSize-                                    (recipientEncryptRequestPayloadShape request)-                                    salt-                                    (pkeskSessionKey sessionMaterial)-                                    pkeskPkts-                                    (recipientEncryptRequestPayload request)-                          _missingSEIPDv2 ->-                            case recipientsMissingSEIPDv1Support targets of-                              [] ->-                                buildSEIPDv1PayloadWithIV-                                  symalgo-                                  sessionMaterial-                                  pkeskPkts-                                  Nothing-                              missingSEIPDv1 ->-                                pure-                                  (Left-                                     (RecipientCapabilitySelectionFailure-                                        (RecipientCapabilityMissingSEIPDv1Support missingSEIPDv1)))-                    RecipientEncryptRequestSEIPDv1Overrides-                      { recipientEncryptRequestIVOverride = ivOverride } ->-                        case recipientsMissingSEIPDv1Support targets of-                          [] ->-                            buildSEIPDv1PayloadWithIV-                              symalgo-                              sessionMaterial-                              pkeskPkts-                              ivOverride-                          missingSEIPDv1 ->-                            pure-                              (Left-                                 (RecipientCapabilitySelectionFailure-                                    (RecipientCapabilityMissingSEIPDv1Support missingSEIPDv1)))-                  pure $-                    fmap-                      (\pkts ->-                         RecipientEncryptResult-                           { recipientEncryptPackets = pkts-                           , recipientEncryptSessionMaterial = sessionMaterial-                           })-                      payloadResult-  where-    targets = recipientEncryptRequestTargets request-    profileW =-      profileForPayloadVersionW (recipientEncryptRequestOverrides request)-    messagePolicy =-      case profileW of-        EncryptStrictDefaultW ->-          policyMessageEncryption (policyForRFC RFC9580)-        EncryptInteropLegacyW ->-          policyMessageEncryption (policyForRFC RFC4880)--    buildSEIPDv1PayloadWithIV ::-         MonadRandom m-      => SymmetricAlgorithm-      -> PKESKSessionMaterial-      -> [Pkt]-      -> Maybe IV-      -> m (Either PKESKEncryptError [Pkt])-    buildSEIPDv1PayloadWithIV symalgo sessionMaterial pkeskPkts ivOverride = do-      ivResult <--        case ivOverride of-          Just iv -> pure (Right iv)-          Nothing ->-            let keyBytes = unSessionKey (pkeskSessionKey sessionMaterial)-             in case withSymmetricCipher symalgo keyBytes (\c -> Right (blockSize c)) of-                  Left err -> pure (Left (PayloadBuildFailure (renderCipherError err)))-                  Right n -> fmap (Right . IV) (getRandomBytes n)-      case ivResult of-        Left err -> pure (Left err)-        Right iv ->-          pure $-            buildEncryptedPacketSequenceWithShapeSEIPDv1-              symalgo-              iv-              (recipientEncryptRequestPayloadShape request)-              (pkeskSessionKey sessionMaterial)-              pkeskPkts-              (recipientEncryptRequestPayload request)--    recipientsMissingSEIPDv1Support :: [RecipientEncryptionTarget] -> [SomePKPayload]-    recipientsMissingSEIPDv1Support =-      map recipientEncryptionTargetKey .-      filter (not . targetAdvertisesSEIPDv1Support)--    recipientsMissingSEIPDv2Support :: [RecipientEncryptionTarget] -> [SomePKPayload]-    recipientsMissingSEIPDv2Support =-      map recipientEncryptionTargetKey .-      filter (not . targetAdvertisesSEIPDv2Support)--    targetAdvertisesSEIPDv1Support :: RecipientEncryptionTarget -> Bool-    targetAdvertisesSEIPDv1Support target =-      case recipientEncryptionTargetCapabilities target of-        Nothing -> True-        Just caps -> recipientCapabilityAdvertisesSEIPDv1Support caps--    targetAdvertisesSEIPDv2Support :: RecipientEncryptionTarget -> Bool-    targetAdvertisesSEIPDv2Support target =-      case recipientEncryptionTargetCapabilities target of-        Nothing -> True-        Just caps -> recipientCapabilityAdvertisesSEIPDv2Support caps--selectSymmetricAlgorithm ::-     RecipientCapabilityNegotiationMode-  -> RecipientEncryptRequest v-  -> MessageEncryptionPolicy-  -> [RecipientEncryptionTarget]-  -> Either PKESKEncryptError SymmetricAlgorithm-selectSymmetricAlgorithm negotiationMode request messagePolicy targets =-  case recipientEncryptRequestSymmetricOverride request of-    Just override -> Right override-    Nothing ->-      case negotiationMode of-        RecipientCapabilityNegotiationOff ->-          Right (messageDefaultSymmetricAlgorithm messagePolicy)-        RecipientCapabilityNegotiationOn ->-          negotiateSymmetricAlgorithm messagePolicy targets--selectAEADAlgorithm ::-     RecipientCapabilityNegotiationMode-  -> MessageEncryptionPolicy-  -> [RecipientEncryptionTarget]-  -> Maybe AEADAlgorithm-  -> Either PKESKEncryptError AEADAlgorithm-selectAEADAlgorithm negotiationMode messagePolicy targets override =-  case override of-    Just explicit -> Right explicit-    Nothing ->-      case negotiationMode of-        RecipientCapabilityNegotiationOff ->-          Right (messageDefaultAEADAlgorithm messagePolicy)-        RecipientCapabilityNegotiationOn ->-          negotiateAEADAlgorithm messagePolicy targets--negotiateSymmetricAlgorithm ::-     MessageEncryptionPolicy-  -> [RecipientEncryptionTarget]-  -> Either PKESKEncryptError SymmetricAlgorithm-negotiateSymmetricAlgorithm messagePolicy targets =-  chooseCommonAlgorithm-    policyOrder-    recipientChoices-    (RecipientCapabilityNoCommonSymmetricAlgorithms (concat recipientChoices))-  where-    policyOrder =-      case messageSEIPDv2SymmetricAlgorithms messagePolicy of-        [] -> [messageDefaultSymmetricAlgorithm messagePolicy]-        syms -> syms-    recipientChoices = map choicesForTarget targets-    choicesForTarget target =-      case recipientEncryptionTargetCapabilities target of-        Just caps ->-          let preferred = recipientCapabilityPreferredSymmetricAlgorithms caps-              allowed = [alg | alg <- policyOrder, alg `elem` preferred]-           in if null allowed-                then policyOrder-                else allowed-        Nothing -> policyOrder--negotiateAEADAlgorithm ::-     MessageEncryptionPolicy-  -> [RecipientEncryptionTarget]-  -> Either PKESKEncryptError AEADAlgorithm-negotiateAEADAlgorithm messagePolicy targets =-  chooseCommonAlgorithm-    policyOrder-    recipientChoices-    (RecipientCapabilityNoCommonAEADAlgorithms (concat recipientChoices))-  where-    policyOrder = foldl' addIfMissing [] (messageDefaultAEADAlgorithm messagePolicy : [OCB, EAX, GCM])-    recipientChoices = map choicesForTarget targets-    choicesForTarget target =-      case recipientEncryptionTargetCapabilities target of-        Just caps ->-          let preferred = recipientCapabilityPreferredAEADAlgorithms caps-              allowed = [alg | alg <- policyOrder, alg `elem` preferred]-           in if null allowed-                then policyOrder-                else allowed-        Nothing -> policyOrder-    addIfMissing acc x-      | x `elem` acc = acc-      | otherwise = acc ++ [x]--chooseCommonAlgorithm ::-     Eq a-  => [a]-  -> [[a]]-  -> RecipientCapabilityError-  -> Either PKESKEncryptError a-chooseCommonAlgorithm policyOrder recipientChoices err =-  case recipientChoices of-    [] -> Left (RecipientCapabilitySelectionFailure err)-    (firstChoices:restChoices) ->-      let common = foldl' intersectOrdered firstChoices restChoices-          orderedCommon = [alg | alg <- policyOrder, alg `elem` common]-       in case orderedCommon of-            (selected:_) -> Right selected-            [] -> Left (RecipientCapabilitySelectionFailure err)-  where-    intersectOrdered as bs = [a | a <- as, a `elem` bs]--promoteRecipientStrategy ::-     RecipientPKESKVersionStrategy-  -> SomeRecipientPKESKVersionStrategyW-promoteRecipientStrategy RecipientPreferV6 =-  SomeRecipientPKESKVersionStrategyW RecipientPreferV6W-promoteRecipientStrategy RecipientForceV3Interop =-  SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW--demoteRecipientStrategy ::-     RecipientPKESKVersionStrategyW strategy-  -> RecipientPKESKVersionStrategy-demoteRecipientStrategy RecipientPreferV6W = RecipientPreferV6-demoteRecipientStrategy RecipientForceV3InteropW = RecipientForceV3Interop--demoteSomeRecipientStrategy ::-     SomeRecipientPKESKVersionStrategyW-  -> RecipientPKESKVersionStrategy-demoteSomeRecipientStrategy (SomeRecipientPKESKVersionStrategyW strategyW) =-  demoteRecipientStrategy strategyW--promoteEncryptCompatibilityProfile ::-     EncryptCompatibilityProfile-  -> SomeEncryptCompatibilityProfileW-promoteEncryptCompatibilityProfile EncryptStrictDefault =-  SomeEncryptCompatibilityProfileW EncryptStrictDefaultW-promoteEncryptCompatibilityProfile EncryptInteropLegacy =-  SomeEncryptCompatibilityProfileW EncryptInteropLegacyW---- | High-level encrypt-side helper for public-key recipient encryption.------ Returns a complete packet sequence:--- @[PKESK ..., SEIPD2 ...]@.----------buildEncryptedPacketSequence ::-     SymmetricAlgorithm-  -> AEADAlgorithm-  -> Word8-  -> RecipientPayloadShape-  -> Salt-  -> SessionKey-  -> [Pkt]-  -> B.ByteString-  -> Either String [Pkt]-buildEncryptedPacketSequence symalgo aead chunkSize payloadShape salt sessionKey pkesks payload =-  first renderPKESKEncryptError-    (buildEncryptedPacketSequenceWithShape symalgo aead chunkSize payloadShape salt sessionKey pkesks payload)--buildEncryptedPacketSequenceWithShape ::-     SymmetricAlgorithm-  -> AEADAlgorithm-  -> Word8-  -> RecipientPayloadShape-  -> Salt-  -> SessionKey-  -> [Pkt]-  -> B.ByteString-  -> Either PKESKEncryptError [Pkt]-buildEncryptedPacketSequenceWithShape symalgo aead chunkSize payloadShape salt sessionKey pkesks payload = do-  onePassSignatures <- first (PayloadBuildFailure . renderOPSBuildError) (buildOnePassSignaturePackets payloadShape)-  let signatures = recipientPayloadSignatures payloadShape-      literalBlock =-        Block-          (onePassSignatures ++-           [ LiteralDataPkt-               (recipientPayloadDataType payloadShape)-               (recipientPayloadFileName payloadShape)-               (recipientPayloadTimestamp payloadShape)-               (BL.fromStrict payload)-           ] ++-           map SignaturePkt signatures)-  ciphertext <--    first PayloadBuildFailure $-    encryptSEIPDv2Payload-      symalgo-      aead-      chunkSize-      salt-      sessionKey-      (BL.toStrict (runPut (put literalBlock)))-  Right-    (pkesks ++-     [SymEncIntegrityProtectedDataPkt (SEIPD2 symalgo aead chunkSize salt (BL.fromStrict ciphertext))])---- | Encrypt a plaintext block with OpenPGP CFB + MDC to produce a SEIPDv1 ciphertext.-encryptSEIPDv1Payload ::-     SymmetricAlgorithm-  -> IV-  -> SessionKey-  -> B.ByteString  -- ^ inner packet block plaintext-  -> Either String B.ByteString-encryptSEIPDv1Payload symalgo iv (SessionKey keyBytes) plaintext =-  let cleartextWithMDC = plaintext <> mdcTrailerForSEIPDv1 iv plaintext-  in first-       renderCipherError-       (encryptOpenPGPCfbRaw OpenPGPCFBNoResyncW symalgo iv cleartextWithMDC keyBytes)---- | Build a complete RFC 4880-conformant packet sequence using SEIPDv1 (CFB + MDC).-buildEncryptedPacketSequenceWithShapeSEIPDv1 ::-     SymmetricAlgorithm-  -> IV-  -> RecipientPayloadShape-  -> SessionKey-  -> [Pkt]-  -> B.ByteString-  -> Either PKESKEncryptError [Pkt]-buildEncryptedPacketSequenceWithShapeSEIPDv1 symalgo iv payloadShape sessionKey pkesks payload = do-  onePassSignatures <- first (PayloadBuildFailure . renderOPSBuildError) (buildOnePassSignaturePackets payloadShape)-  let signatures = recipientPayloadSignatures payloadShape-      literalBlock =-        Block-          (onePassSignatures ++-           [ LiteralDataPkt-               (recipientPayloadDataType payloadShape)-               (recipientPayloadFileName payloadShape)-               (recipientPayloadTimestamp payloadShape)-               (BL.fromStrict payload)-           ] ++-           map SignaturePkt signatures)-  ciphertext <--    first PayloadBuildFailure $-    encryptSEIPDv1Payload symalgo iv sessionKey (BL.toStrict (runPut (put literalBlock)))-  Right-    (pkesks ++-     [SymEncIntegrityProtectedDataPkt (SEIPD1 1 (BL.fromStrict ciphertext))])--buildOnePassSignaturePackets :: RecipientPayloadShape -> Either OPSBuildError [Pkt]-buildOnePassSignaturePackets payloadShape-  | not (recipientPayloadUseOnePassSignatures payloadShape) = Right []-  | null signatures = Right []-  | otherwise =-      fmap (map OnePassSignaturePkt) $-      sequence (zipWith buildOnePassSignature nestedFlags (reverse signatures))-  where-    signatures = recipientPayloadSignatures payloadShape-    nestedFlags = replicate (length signatures - 1) True ++ [False]--data OnePassSignatureBuildCase where-  OnePassSignatureBuildCaseV3 ::-       SignaturePayloadV 'SigPayloadV3 -> OnePassSignatureBuildCase-  OnePassSignatureBuildCaseV4 ::-       SignaturePayloadV 'SigPayloadV4 -> OnePassSignatureBuildCase-  OnePassSignatureBuildCaseV6 ::-       SignaturePayloadV 'SigPayloadV6 -> OnePassSignatureBuildCase-  OnePassSignatureBuildCaseOther ::-       PacketVersion -> OnePassSignatureBuildCase--onePassSignatureBuildCase :: SignaturePayload -> OnePassSignatureBuildCase-onePassSignatureBuildCase sig =-  case toSomeSignaturePayload sig of-    SomeSignaturePayload (payload@SigPayloadV3Data {}) ->-      OnePassSignatureBuildCaseV3 payload-    SomeSignaturePayload (payload@SigPayloadV4Data {}) ->-      OnePassSignatureBuildCaseV4 payload-    SomeSignaturePayload (payload@SigPayloadV6Data {}) ->-      OnePassSignatureBuildCaseV6 payload-    SomeSignaturePayload (SigPayloadOtherData version _) ->-      OnePassSignatureBuildCaseOther version--buildOnePassSignature :: NestedFlag -> SignaturePayload -> Either OPSBuildError OnePassSignaturePayload-buildOnePassSignature nestedFlag sig =-  case onePassSignatureBuildCase sig of-    OnePassSignatureBuildCaseV3 (SigPayloadV3Data sigType _ issuerKeyId pubkeyAlgo hashAlgo _ _) ->-      Right-        (OPSPayloadV3Packet-           (OPSPayloadV3 3 sigType hashAlgo pubkeyAlgo issuerKeyId nestedFlag))-    OnePassSignatureBuildCaseV4 (SigPayloadV4Data sigType pubkeyAlgo hashAlgo hashedSubpackets unhashedSubpackets _ _) ->-      case signatureIssuerKeyId hashedSubpackets unhashedSubpackets of-        Just issuerKeyId ->-          Right-            (OPSPayloadV3Packet-               (OPSPayloadV3 3 sigType hashAlgo pubkeyAlgo issuerKeyId nestedFlag))-        Nothing ->-          Left OPSBuildMissingIssuerKeyId-    OnePassSignatureBuildCaseV6 (SigPayloadV6Data sigType pubkeyAlgo hashAlgo salt hashedSubpackets unhashedSubpackets _ _) ->-      case signatureIssuerFingerprint (BTypes.issuerFingerprintVersionToPacketVersion BTypes.IssuerFingerprintV6) hashedSubpackets unhashedSubpackets of-        Just signerFingerprint-          | BL.length signerFingerprint == 32 ->-              Right-                (OPSPayloadV6Packet-                   (OPSPayloadV6 sigType hashAlgo pubkeyAlgo salt signerFingerprint nestedFlag))-          | otherwise ->-              Left (OPSBuildFingerprintWrongLength (BL.length signerFingerprint))-        Nothing ->-          Left OPSBuildMissingIssuerFingerprint-    OnePassSignatureBuildCaseOther version ->-      Left (OPSBuildUnsupportedSigVersion version)--signatureIssuerKeyId :: [SigSubPacket] -> [SigSubPacket] -> Maybe EightOctetKeyId-signatureIssuerKeyId hashedSubpackets unhashedSubpackets =-  case findIssuerKeyId hashedSubpackets of-    Just issuerKeyId -> Just issuerKeyId-    Nothing ->-      case findIssuerKeyId unhashedSubpackets of-        Just issuerKeyId -> Just issuerKeyId-        Nothing ->-          case signatureIssuerFingerprint (BTypes.issuerFingerprintVersionToPacketVersion BTypes.IssuerFingerprintV4) hashedSubpackets unhashedSubpackets of-            Just issuerFingerprintBytes ->-              if BL.length issuerFingerprintBytes >= 8-                    then-                      Just-                        (EightOctetKeyId-                           (BL.drop (BL.length issuerFingerprintBytes - 8) issuerFingerprintBytes))-                    else Nothing-            Nothing -> Nothing--signatureIssuerFingerprint ::-     PacketVersion -> [SigSubPacket] -> [SigSubPacket] -> Maybe BL.ByteString-signatureIssuerFingerprint expectedVersion hashedSubpackets unhashedSubpackets =-  unFingerprint <$> findIssuerFingerprint expectedVersion hashedSubpackets unhashedSubpackets--findIssuerKeyId :: [SigSubPacket] -> Maybe EightOctetKeyId-findIssuerKeyId subpackets =-  case find isIssuerKeyIdSubpacket subpackets of-    Just (SigSubPacket _ (Issuer issuerKeyId)) -> Just issuerKeyId-    _ -> Nothing--findIssuerFingerprint ::-     PacketVersion -> [SigSubPacket] -> [SigSubPacket] -> Maybe Fingerprint-findIssuerFingerprint expectedVersion hashedSubpackets unhashedSubpackets =-  case findIssuerFingerprintIn expectedVersion hashedSubpackets of-    Just issuerFingerprint -> Just issuerFingerprint-    Nothing -> findIssuerFingerprintIn expectedVersion unhashedSubpackets--findIssuerFingerprintIn :: PacketVersion -> [SigSubPacket] -> Maybe Fingerprint-findIssuerFingerprintIn expectedVersion subpackets =-  case find (isIssuerFingerprintSubpacket expectedVersion) subpackets of-    Just (SigSubPacket _ (IssuerFingerprint _ issuerFingerprint)) -> Just issuerFingerprint-    _ -> Nothing--isIssuerKeyIdSubpacket :: SigSubPacket -> Bool-isIssuerKeyIdSubpacket (SigSubPacket _ (Issuer _)) = True-isIssuerKeyIdSubpacket _ = False--isIssuerFingerprintSubpacket :: PacketVersion -> SigSubPacket -> Bool-isIssuerFingerprintSubpacket expectedVersion (SigSubPacket _ (IssuerFingerprint version _)) =-  BTypes.issuerFingerprintVersionToPacketVersion version == expectedVersion-isIssuerFingerprintSubpacket _ _ = False--buildRsaPKESKv6 ::-     MonadRandom m-  => SomePKPayload-  -> PKESKSessionMaterial-  -> m (Either PKESKEncryptError PKESKPayloadV6)-buildRsaPKESKv6 recipient material =-  case _pubkey recipient of-    RSAPubKey (RSA_PublicKey publicKey) -> do-      encrypted <- RSA15.encrypt publicKey (pkeskEncodedSessionMaterial material)-      pure $-        fmap-          (\esk ->-             let mpiEsk = runPut (put (MPI (os2ip esk)))-              in PKESKPayloadV6 (recipientKeyIdentifier recipient) RSA mpiEsk)-          (first (RecipientKeyWrapFailure RSA . show) encrypted)-    _ ->-      pure-        (Left-           (InvalidRecipientKeyMaterial-              RSA-              "recipient PKPayload does not contain an RSA public key"))--buildRsaPKESKv3 ::-     MonadRandom m-  => SomePKPayload-  -> PKESKV3SessionMaterial-  -> m (Either PKESKEncryptError PKESKPayloadV3)-buildRsaPKESKv3 recipient material =-  case _pubkey recipient of-    RSAPubKey (RSA_PublicKey publicKey) ->-      case eightOctetKeyID recipient of-        Left err ->-          pure-            (Left-              (InvalidRecipientKeyMaterial-                 (_pkalgo recipient)-                 ("failed to derive PKESKv3 recipient key ID: " ++ err)))-        Right eoki -> do-          encrypted <- RSA15.encrypt publicKey (unPKESKV3SessionMaterial material)-          pure $-            fmap-              (\esk ->-                PKESKPayloadV3-                  3-                  eoki-                  (_pkalgo recipient)-                  (MPI (os2ip esk) :| []))-              (first (RecipientKeyWrapFailure (_pkalgo recipient) . show) encrypted)-    _ ->-      pure-        (Left-           (InvalidRecipientKeyMaterial-              (_pkalgo recipient)-              "recipient PKPayload does not contain an RSA public key"))--buildECDHPKESKv3 ::-     MonadRandom m-  => SomePKPayload-  -> PKESKV3SessionMaterial-  -> m (Either PKESKEncryptError PKESKPayloadV3)-buildECDHPKESKv3 recipient material =-  case _pubkey recipient of-    ECDHPubKey ecdhPub kdfHA kdfSA ->-      case eightOctetKeyID recipient of-        Left err ->-          pure-           (Left-              (InvalidRecipientKeyMaterial-                 ECDH-                 ("failed to derive PKESKv3 recipient key ID: " ++ err)))-        Right eoki ->-          case ecdhPub of-           ECDSAPubKey (ECDSA_PublicKey recipientPub) -> do-             (ephemeralPub, ephemeralPriv) <- ECCGen.generate (ECDSA.public_curve recipientPub)-             case point2MBS (ECDSA.public_q ephemeralPub) of-               Nothing ->-                 pure-                   (Left-                      (InvalidRecipientKeyMaterial-                         ECDH-                         "failed to serialize ECDH ephemeral point"))-               Just ephemeralBytes ->-                 pure $-                 buildEcdhV3Payload-                   recipient-                   eoki-                   ECDH-                   ecdhPub-                   kdfHA-                   kdfSA-                   ephemeralBytes-                   (BA.convert-                      (ECCDH.getShared-                         (ECDSA.public_curve recipientPub)-                         (ECDSA.private_d ephemeralPriv)-                         (ECDSA.public_q recipientPub)) ::-                    B.ByteString)-                   material-           EdDSAPubKey Ed25519 recipientPoint -> do-             ephSecretRaw <- getRandomBytes 32-             pure $-               do recipientPublicBytes <- normalizeX25519Public (edPointBytes recipientPoint)-                  ephSecret <--                    first (RecipientKeyWrapFailure ECDH . show) .-                    CE.eitherCryptoError $-                    C25519.secretKey (leftPadTo 32 ephSecretRaw)-                  recipientPub <--                    first (RecipientKeyWrapFailure ECDH . show) .-                    CE.eitherCryptoError $-                    C25519.publicKey recipientPublicBytes-                  let ephPublicBytes =-                        B.cons 0x40 (BA.convert (C25519.toPublic ephSecret) :: B.ByteString)-                      sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-                  buildEcdhV3Payload-                    recipient-                    eoki-                    ECDH-                    ecdhPub-                    kdfHA-                    kdfSA-                    ephPublicBytes-                    sharedSecret-                    material-           _ ->-             pure-               (Left-                  (InvalidRecipientKeyMaterial-                     ECDH-                     "recipient ECDH public key is not RFC6637-compatible"))-    _ ->-      pure-        (Left-           (InvalidRecipientKeyMaterial-             ECDH-             "recipient PKPayload does not contain ECDH public key material"))--buildECDHPKESKv6 ::-     MonadRandom m-  => SomePKPayload-  -> PKESKSessionMaterial-  -> m (Either PKESKEncryptError PKESKPayloadV6)-buildECDHPKESKv6 recipient material =-  case _pubkey recipient of-    ECDHPubKey ecdhPub kdfHA kdfSA ->-      case ecdhPub of-        ECDSAPubKey (ECDSA_PublicKey recipientPub) -> do-          (ephemeralPub, ephemeralPriv) <- ECCGen.generate (ECDSA.public_curve recipientPub)-          case point2MBS (ECDSA.public_q ephemeralPub) of-            Nothing ->-              pure-                (Left-                   (InvalidRecipientKeyMaterial-                      ECDH-                      "failed to serialize ECDH ephemeral point"))-            Just ephemeralBytes ->-              pure $-              buildEcdhV6Esk-                recipient-                ECDH-                ecdhPub-                kdfHA-                kdfSA-                ephemeralBytes-                (BA.convert-                   (ECCDH.getShared-                      (ECDSA.public_curve recipientPub)-                      (ECDSA.private_d ephemeralPriv)-                      (ECDSA.public_q recipientPub)) ::-                 B.ByteString)-                material-        EdDSAPubKey Ed25519 recipientPoint -> do-          ephSecretRaw <- getRandomBytes 32-          pure $-            do recipientPublicBytes <- normalizeX25519Public (edPointBytes recipientPoint)-               ephSecret <--                 first (RecipientKeyWrapFailure ECDH . show) .-                 CE.eitherCryptoError $-                 C25519.secretKey (leftPadTo 32 ephSecretRaw)-               recipientPub <--                 first (RecipientKeyWrapFailure ECDH . show) .-                 CE.eitherCryptoError $-                 C25519.publicKey recipientPublicBytes-               let ephPublicBytes = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-                   sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-               buildEcdhV6Esk recipient ECDH ecdhPub kdfHA kdfSA ephPublicBytes sharedSecret material-        EdDSAPubKey Ed448 recipientPoint -> do-          ephSecretRaw <- getRandomBytes 56-          pure $-            do recipientPublicBytes <- normalizeX448Public (edPointBytes recipientPoint)-               ephSecret <--                 first (RecipientKeyWrapFailure ECDH . show) .-                 CE.eitherCryptoError $-                 C448.secretKey (leftPadTo 56 ephSecretRaw)-               recipientPub <--                 first (RecipientKeyWrapFailure ECDH . show) .-                 CE.eitherCryptoError $-                 C448.publicKey recipientPublicBytes-               let ephPublicBytes = BA.convert (C448.toPublic ephSecret) :: B.ByteString-                   sharedSecret = BA.convert (C448.dh recipientPub ephSecret) :: B.ByteString-               buildEcdhV6Esk recipient ECDH ecdhPub kdfHA kdfSA ephPublicBytes sharedSecret material-        _ ->-          pure-            (Left-               (InvalidRecipientKeyMaterial-                  ECDH-                  "recipient ECDH public key is not ECDSA/X25519/X448-compatible"))-    _ ->-      pure-        (Left-           (InvalidRecipientKeyMaterial-              ECDH-              "recipient PKPayload does not contain ECDH public key material"))--buildX25519PKESKv6 ::-     MonadRandom m-  => SomePKPayload-  -> PKESKV6RawSessionMaterial-  -> m (Either PKESKEncryptError PKESKPayloadV6)-buildX25519PKESKv6 recipient material = do-  ephSecretRaw <- getRandomBytes 32-  pure $-    do recipientPublic <- extractX25519RecipientPublic recipient-       ephSecret <--         first (RecipientKeyWrapFailure X25519 . show) .-         CE.eitherCryptoError $-         C25519.secretKey (leftPadTo 32 ephSecretRaw)-       recipientPub <--         first (RecipientKeyWrapFailure X25519 . show) .-         CE.eitherCryptoError $-         C25519.publicKey recipientPublic-       let ephPublicBytes = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-           sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-           kek = deriveX25519Kek ephPublicBytes recipientPublic sharedSecret-       wrapped <--         first (RecipientKeyWrapFailure X25519) .-         aesKeyWrapRFC3394 AES128 kek $-         unPKESKV6RawSessionMaterial material-       esk <- encodeV6X25519Esk ephPublicBytes wrapped-       Right (PKESKPayloadV6 (recipientKeyIdentifier recipient) X25519 (BL.fromStrict esk))--buildX448PKESKv6 ::-     MonadRandom m-  => SomePKPayload-  -> PKESKV6RawSessionMaterial-  -> m (Either PKESKEncryptError PKESKPayloadV6)-buildX448PKESKv6 recipient material = do-  ephSecretRaw <- getRandomBytes 56-  pure $-    do recipientPublic <- extractX448RecipientPublic recipient-       ephSecret <--         first (RecipientKeyWrapFailure X448 . show) .-         CE.eitherCryptoError $-         C448.secretKey (leftPadTo 56 ephSecretRaw)-       recipientPub <--         first (RecipientKeyWrapFailure X448 . show) .-         CE.eitherCryptoError $-         C448.publicKey recipientPublic-       let ephPublicBytes = BA.convert (C448.toPublic ephSecret) :: B.ByteString-           sharedSecret = BA.convert (C448.dh recipientPub ephSecret) :: B.ByteString-           kek = deriveX448Kek ephPublicBytes recipientPublic sharedSecret-       wrapped <--         first (RecipientKeyWrapFailure X448) .-         aesKeyWrapRFC3394 AES256 kek $-         unPKESKV6RawSessionMaterial material-       esk <- encodeV6X448Esk ephPublicBytes wrapped-       Right (PKESKPayloadV6 (recipientKeyIdentifier recipient) X448 (BL.fromStrict esk))--buildEcdhV6Esk :: SomePKPayload-  -> PubKeyAlgorithm-  -> PKey-  -> HashAlgorithm-  -> SymmetricAlgorithm-  -> B.ByteString-  -> B.ByteString-  -> PKESKSessionMaterial-  -> Either PKESKEncryptError PKESKPayloadV6-buildEcdhV6Esk recipient pka ecdhPub kdfHA kdfSA ephemeralBytes sharedSecret material = do-  kdfParam <--    first (RecipientKdfFailure pka) $-    buildECDHKDFParam recipient pka ecdhPub kdfHA kdfSA-  kek <- first (RecipientKdfFailure pka) $ deriveECDHKek kdfHA kdfSA sharedSecret kdfParam-  wrapped <--    first (RecipientKeyWrapFailure pka) .-    aesKeyWrapRFC3394 kdfSA kek $-    padToMultipleOf8 (pkeskEncodedSessionMaterial material)-  esk <- encodeV6EcdhEsk ephemeralBytes wrapped-  Right (PKESKPayloadV6 (recipientKeyIdentifier recipient) pka (BL.fromStrict esk))--buildEcdhV3Payload :: SomePKPayload-  -> EightOctetKeyId-  -> PubKeyAlgorithm-  -> PKey-  -> HashAlgorithm-  -> SymmetricAlgorithm-  -> B.ByteString-  -> B.ByteString-  -> PKESKV3SessionMaterial-  -> Either PKESKEncryptError PKESKPayloadV3-buildEcdhV3Payload recipient eoki pka ecdhPub kdfHA kdfSA ephemeralBytes sharedSecret material = do-  kdfParam <--    first (RecipientKdfFailure pka) $-    buildECDHKDFParam recipient pka ecdhPub kdfHA kdfSA-  kek <- first (RecipientKdfFailure pka) $ deriveECDHKek kdfHA kdfSA sharedSecret kdfParam-  wrapped <--    first (RecipientKeyWrapFailure pka) .-    aesKeyWrapRFC3394 kdfSA kek $-    padToMultipleOf8 (unPKESKV3SessionMaterial material)-  Right-    (PKESKPayloadV3-       3-       eoki-       pka-       (MPI (os2ip ephemeralBytes) :| [MPI (os2ip wrapped)]))--recipientKeyIdentifier :: SomePKPayload -> BL.ByteString-recipientKeyIdentifier = unFingerprint . fingerprint--encodeV6EcdhEsk :: B.ByteString -> B.ByteString -> Either PKESKEncryptError B.ByteString-encodeV6EcdhEsk ephemeral wrapped = do-  let ephLen = B.length ephemeral-  if ephLen > 255-    then Left (RecipientKeyWrapFailure ECDH "ephemeral key encoding is too large")-    else Right (B.singleton (fromIntegral ephLen) <> ephemeral <> wrapped)--encodeV6X25519Esk :: B.ByteString -> B.ByteString -> Either PKESKEncryptError B.ByteString-encodeV6X25519Esk ephemeral wrapped-  | B.length ephemeral /= 32 =-      Left (RecipientKeyWrapFailure X25519 "X25519 ephemeral key must be exactly 32 octets")-  | B.length wrapped > 255 =-      Left (RecipientKeyWrapFailure X25519 "wrapped session key encoding is too large")-  | otherwise =-      Right (ephemeral <> B.singleton (fromIntegral (B.length wrapped)) <> wrapped)--encodeV6X448Esk :: B.ByteString -> B.ByteString -> Either PKESKEncryptError B.ByteString-encodeV6X448Esk ephemeral wrapped-  | B.length ephemeral /= 56 =-      Left (RecipientKeyWrapFailure X448 "X448 ephemeral key must be exactly 56 octets")-  | B.length wrapped > 255 =-      Left (RecipientKeyWrapFailure X448 "wrapped session key encoding is too large")-  | otherwise =-      Right (ephemeral <> B.singleton (fromIntegral (B.length wrapped)) <> wrapped)--extractX25519RecipientPublic :: SomePKPayload -> Either PKESKEncryptError B.ByteString-extractX25519RecipientPublic recipient =-  case _pubkey recipient of-    EdDSAPubKey Ed25519 point ->-      normalizeX25519Public (edPointBytes point)-    ECDHPubKey (EdDSAPubKey Ed25519 point) _ _ ->-      normalizeX25519Public (edPointBytes point)-    other ->-      Left-        (InvalidRecipientKeyMaterial-           X25519-           ("expected X25519-compatible recipient key, got " ++ show other))--extractX448RecipientPublic :: SomePKPayload -> Either PKESKEncryptError B.ByteString-extractX448RecipientPublic recipient =-  case _pubkey recipient of-    EdDSAPubKey Ed448 point ->-      normalizeX448Public (edPointBytes point)-    ECDHPubKey (EdDSAPubKey Ed448 point) _ _ ->-      normalizeX448Public (edPointBytes point)-    other ->-      Left-        (InvalidRecipientKeyMaterial-           X448-           ("expected X448-compatible recipient key, got " ++ show other))--normalizeX25519Public :: B.ByteString -> Either PKESKEncryptError B.ByteString-normalizeX25519Public =-  first (InvalidRecipientKeyMaterial X25519) .-  normalizeMontgomeryPublic-    32-    "invalid X25519 public key length/prefix: "--normalizeX448Public :: B.ByteString -> Either PKESKEncryptError B.ByteString-normalizeX448Public =-  first (InvalidRecipientKeyMaterial X448) .-  normalizeMontgomeryPublic-    56-    "invalid X448 public key length/prefix: "--edPointBytes :: EdPoint -> B.ByteString-edPointBytes (PrefixedNativeEPoint (EPoint x)) = i2osp x-edPointBytes (NativeEPoint (EPoint x)) = i2osp x--deriveX25519Kek :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString-deriveX25519Kek ephemeralPublic recipientPublic sharedSecret =-  let ikm = ephemeralPublic <> recipientPublic <> sharedSecret-      prk = extract @CHAlg.SHA256 B.empty ikm-      info = "OpenPGP X25519" :: B.ByteString-   in expand @CHAlg.SHA256 prk info 16--deriveX448Kek :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString-deriveX448Kek ephemeralPublic recipientPublic sharedSecret =-  let ikm = ephemeralPublic <> recipientPublic <> sharedSecret-      prk = extract @CHAlg.SHA512 B.empty ikm-      info = "OpenPGP X448" :: B.ByteString-   in expand @CHAlg.SHA512 prk info 32--padToMultipleOf8 :: B.ByteString -> B.ByteString-padToMultipleOf8 bs-  | padLen == 0 = bs-  | otherwise = bs <> B.replicate padLen (fromIntegral padLen)-  where-    rem8 = B.length bs `mod` 8-    padLen = if rem8 == 0 then 0 else 8 - rem8--checksum16 :: B.ByteString -> Word16-checksum16 =-  fromIntegral .-  B.foldl' (\acc octet -> (acc + fromIntegral octet) `mod` (65536 :: Integer)) 0--checksum16Bytes :: B.ByteString -> B.ByteString-checksum16Bytes bs =-  B.pack-    [ fromIntegral ((chk `shiftR` 8) .&. 0xff)-    , fromIntegral (chk .&. 0xff)-    ]-  where-    chk = checksum16 bs--aesKeyWrapRFC3394 ::-     SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString-aesKeyWrapRFC3394 sa kek plain =-  withAESCipher "ECDH PKESK currently supports AES KEK algorithms only" sa kek wrapWithCipher-  where-    wrapWithCipher :: CCT.BlockCipher cipher => cipher -> Either String B.ByteString-    wrapWithCipher cipher = do-      if B.length plain < 16 || B.length plain `mod` 8 /= 0-        then Left "ECDH key wrap input must be at least 16 octets and a multiple of 8"-        else Right ()-      let rs = chunksOf8 plain-      if length rs < 2-        then Left "ECDH key wrap input must contain at least two 64-bit blocks"-        else Right ()-      (aFinal, rFinal) <- wrapRounds cipher (B.replicate 8 0xA6) rs-      Right (aFinal <> B.concat rFinal)-    wrapRounds :: CCT.BlockCipher cipher => cipher -> B.ByteString -> [B.ByteString] -> Either String (B.ByteString, [B.ByteString])-    wrapRounds cipher aInit rsInit = goJ 0 aInit rsInit-      where-        n = length rsInit-        goJ j a rs-          | j > 5 = Right (a, rs)-          | otherwise = do-              (a', rs') <- goI 1 a rs-              goJ (j + 1) a' rs'-          where-            goI i curA curRs-              | i > n = Right (curA, curRs)-              | otherwise = do-                  let t = fromIntegral (n * j + i) :: Word64-                      rI = curRs !! (i - 1)-                      block = CCT.ecbEncrypt cipher (curA <> rI)-                      (msb, lsb) = B.splitAt 8 block-                      aNext = xorBS msb (encodeWord64be t)-                      rsNext = (ix (i - 1) .~ lsb) curRs-                  goI (i + 1) aNext rsNext--chunksOf8 :: B.ByteString -> [B.ByteString]-chunksOf8 bs-  | B.null bs = []-  | otherwise =-      let (h, t) = B.splitAt 8 bs-       in h : chunksOf8 t--xorBS :: B.ByteString -> B.ByteString -> B.ByteString-xorBS a b = B.pack (B.zipWith xor a b)--encryptSEIPDv1WithSKESK ::-     MonadRandom m-  => SymmetricAlgorithm-  -> S2K-  -> Maybe IV-  -> BL.ByteString-  -> B.ByteString-  -> m (Either String [Pkt])-encryptSEIPDv1WithSKESK symalgo s2k ivOverride passphrase literalPayload = do-  let eSessionKey = do-        keyLen <- symKeySize symalgo-        first renderS2KError (string2Key s2k keyLen passphrase)-  case eSessionKey of-    Left err -> pure (Left err)-    Right sessionKeyMaterial ->-      case-        first-          renderCipherError-          (withSymmetricCipher symalgo sessionKeyMaterial (pure . blockSize)) of-        Left err -> pure (Left err)-        Right ivLength -> do-          ivBytes <--            maybe-              (getRandomBytes ivLength)-              (pure . unIV)-              ivOverride-          let iv = IV ivBytes-          let sessionKey = SessionKey sessionKeyMaterial-          case encryptSEIPDv1Payload symalgo iv sessionKey literalPayload of-            Left err -> pure (Left err)-            Right encrypted ->-              pure-                (Right-                   [ SKESKPkt-                       (SKESKPayloadV4Packet-                          (SKESKPayloadV4 symalgo s2k Nothing))-                   , SymEncIntegrityProtectedDataPkt-                       (SEIPD1 1 (BL.fromStrict encrypted))-                   ])--encryptSEIPDv2WithSKESK ::-     SymmetricAlgorithm-  -> AEADAlgorithm-  -> Word8-  -> Salt-  -> S2K-  -> BL.ByteString-  -> B.ByteString-  -> Either String [Pkt]-encryptSEIPDv2WithSKESK symalgo aead chunkSize salt s2k passphrase literalPayload = do-  keyLen <- symKeySize symalgo-  sessionKeyMaterial <- first renderS2KError (string2Key s2k keyLen passphrase)-  (_, nonceSize) <--    aeadModeAndNonceSizeForSEIPDv2-      "unsupported AEAD algorithm for SKESK v6 encrypt"-      aead-  when (B.length (unSalt salt) < nonceSize) $-    Left "SEIPD v2 salt is too short to derive the SKESK v6 IV"-  let skeskIV = B.take nonceSize (unSalt salt)-  kek <- deriveSKESK6KEK symalgo aead sessionKeyMaterial-  (wrappedSessionKey, skeskTag) <--    encryptSKESK6SessionKey symalgo aead kek skeskIV sessionKeyMaterial-  let sessionKey = SessionKey sessionKeyMaterial-  encrypted <- encryptSEIPDv2Payload symalgo aead chunkSize salt sessionKey literalPayload-  return-    [ SKESKPkt-        (SKESKPayloadV6Packet-           (SKESKPayloadV6-           symalgo-           aead-           s2k-           (BL.fromStrict skeskIV)-           (BL.fromStrict wrappedSessionKey)-           (BL.fromStrict skeskTag)))-    , SymEncIntegrityProtectedDataPkt (SEIPD2 symalgo aead chunkSize salt (BL.fromStrict encrypted))-    ]--encryptSEIPDv2WithSKESKBlock ::-     SymmetricAlgorithm-  -> AEADAlgorithm-  -> Word8-  -> Salt-  -> S2K-  -> BL.ByteString-  -> Block Pkt-  -> Either String [Pkt]-encryptSEIPDv2WithSKESKBlock symalgo aead chunkSize salt s2k passphrase packetBlock =-  encryptSEIPDv2WithSKESK-    symalgo-    aead-    chunkSize-    salt-    s2k-    passphrase-    (BL.toStrict (runPut (put packetBlock)))--encryptSEIPDv2LiteralDataWithSKESK ::-     SymmetricAlgorithm-  -> AEADAlgorithm-  -> Word8-  -> Salt-  -> S2K-  -> BL.ByteString-  -> B.ByteString-  -> Either String [Pkt]-encryptSEIPDv2LiteralDataWithSKESK symalgo aead chunkSize salt s2k passphrase payload =-  encryptSEIPDv2WithSKESKBlock-    symalgo-    aead-    chunkSize-    salt-    s2k-    passphrase-    (Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) (BL.fromStrict payload)])--encryptSEIPDv2Payload ::-     SymmetricAlgorithm-  -> AEADAlgorithm-  -> Word8-  -> Salt-  -> SessionKey-  -> B.ByteString-  -> Either String B.ByteString-encryptSEIPDv2Payload symalgo aead chunkSize salt (SessionKey sessionKey) plaintext = do-  (mode, nonceSize) <- aeadModeAndNonceSize aead-  keyLen <- symKeySize symalgo-  let outputLen = keyLen + nonceSize - 8-      info = B.pack [0xd2, 2, fromFVal symalgo, fromFVal aead, chunkSize]-      prk = extract @CHAlg.SHA256 (unSalt salt) sessionKey-      okm = expand @CHAlg.SHA256 prk info outputLen :: B.ByteString-      messageKey = B.take keyLen okm-      noncePrefix = B.take (nonceSize - 8) (B.drop keyLen okm)-  withAESCipher-    "SEIPD v2 encrypt currently supports AES-128/192/256 only"-    symalgo-    messageKey-    (encryptChunks mode info chunkSize noncePrefix plaintext)--encryptChunks ::-     CCT.BlockCipher cipher-  => CCT.AEADMode-  -> B.ByteString-  -> Word8-  -> B.ByteString-  -> B.ByteString-  -> cipher-  -> Either String B.ByteString-encryptChunks mode info chunkSize noncePrefix plaintext cipher = go 0 plaintext [] 0-  where-    chunkLen = 1 `shiftL` (fromIntegral chunkSize + 6)-    go idx remaining acc totalPlain-      | B.null remaining = do-        (finalTag, finalCipher) <--          if mode == CCT.AEAD_OCB-            then-              encryptWithOCBRFC7253-                cipher-                (noncePrefix <> encodeWord64be idx)-                (info <> encodeWord64be (fromIntegral totalPlain))-                B.empty-            else do-              aead <- initAEAD idx-              let (tag, out) =-                    CCT.aeadSimpleEncrypt-                      aead-                      (info <> encodeWord64be (fromIntegral totalPlain))-                      B.empty-                      16-              Right (tag, out)-        if B.null finalCipher-          then return (B.concat (reverse acc) <> authTagToBS finalTag)-          else Left "expected empty ciphertext for final SEIPD v2 tag"-      | otherwise = do-        let (chunkPlain, rest) = B.splitAt chunkLen remaining-        (tag, chunkCipher) <--          if mode == CCT.AEAD_OCB-            then-              encryptWithOCBRFC7253-                cipher-                (noncePrefix <> encodeWord64be idx)-                info-                chunkPlain-            else do-              aead <- initAEAD idx-              pure (CCT.aeadSimpleEncrypt aead info chunkPlain 16)-        let chunkOut = chunkCipher <> authTagToBS tag-        go-          (idx + 1)-          rest-          (chunkOut : acc)-          (totalPlain + B.length chunkPlain)--    initAEAD idx =-      first show . CE.eitherCryptoError $-      CCT.aeadInit mode cipher (noncePrefix <> encodeWord64be idx)--aeadModeAndNonceSize :: AEADAlgorithm -> Either String (CCT.AEADMode, Int)-aeadModeAndNonceSize =-  aeadModeAndNonceSizeForSEIPDv2-    "unsupported AEAD algorithm for SEIPD v2 encrypt"--symKeySize :: SymmetricAlgorithm -> Either String Int-symKeySize =-  seipdv2SymmetricKeySize-    "unsupported symmetric algorithm for SEIPD v2 encrypt"--authTagToBS :: CCT.AuthTag -> B.ByteString-authTagToBS = BA.convert . CCT.unAuthTag--encodeWord64be :: Word64 -> B.ByteString-encodeWord64be = BL.toStrict . runPut . putWord64be---- | Compose a complete AEAD-encrypted message with optional literal data and signature.--- Returns a packet list (SKESK, SEIPD v2, optional signature) ready for serialization.------ Example: @composeMessageWithSEIPDv2 AES256 OCB 6 (Salt 32 bytes)---            (SimpleS2K SHA256) passphrase payload Nothing@--- returns @[SKESK v6, SEIPD v2, <ciphertext>]@------ If the signature is provided, it will be included in the encrypted payload.-composeMessageWithSEIPDv2 ::-     SymmetricAlgorithm-  -> AEADAlgorithm-  -> Word8-  -> Salt-  -> S2K-  -> BL.ByteString-  -> B.ByteString-  -> Maybe [Pkt]-  -> Either String [Pkt]-composeMessageWithSEIPDv2 symalgo aead chunkSize salt s2k passphrase payload mSigs = do-  let packets = case mSigs of-        Nothing -> [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) (BL.fromStrict payload)]-        Just sigs -> LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) (BL.fromStrict payload) : sigs-      blockPayload = Block packets-  encryptSEIPDv2WithSKESKBlock symalgo aead chunkSize salt s2k passphrase blockPayload+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Codec.Encryption.OpenPGP.Encrypt+    ( PKESKEncryptError (..)+    , RecipientCapabilityNegotiationMode (..)+    , RecipientCapabilityError (..)+    , renderRecipientCapabilityError+    , RecipientCapabilities (..)+    , recipientCapabilitiesFromSubpacketPayloads+    , recipientCapabilitySupportsEncryption+    , RecipientTargetRejectionReason (..)+    , RecipientEncryptionTargetRejected (..)+    , RecipientEncryptionTargetsReport (..)+    , recipientEncryptionTargetsReportFromTKAtTimestamp+    , recipientEncryptionTargetsReportFromTK+    , recipientEncryptionTargetFromTKAtTimestamp+    , recipientEncryptionTargetFromTKAtTimestampWithPolicy+    , recipientEncryptionTargetsFromTKAtTimestamp+    , recipientEncryptionTargetFromTK+    , recipientEncryptionTargetFromTKWithPolicy+    , recipientEncryptionTargetsFromTK+    , RecipientTargetSelectionPolicy (..)+    , PassphraseSKESKVersionPolicy (..)+    , PassphraseEncryptRequest (..)+    , encryptPassphraseWithPolicy+    , PKESKVersionPolicy (..)+    , RecipientPKESKVersionStrategy (..)+    , RecipientPKESKVersionStrategyW (..)+    , SomeRecipientPKESKVersionStrategyW (..)+    , RecipientPKESKVersionSelector+    , RecipientPKESKVersionSelectorTyped+    , EncryptCompatibilityProfile (..)+    , EncryptCompatibilityProfileW (..)+    , SomeEncryptCompatibilityProfileW (..)+    , RecipientEncryptionTarget (..)+    , recipientEncryptionTarget+    , recipientEncryptionTargetWithStrategy+    , recipientEncryptionTargetWithCapabilities+    , recipientEncryptionTargetWithStrategyTyped+    , recipientVersionStrategyForProfile+    , recipientVersionStrategyForProfileTyped+    , RecipientPayloadShape (..)+    , defaultRecipientPayloadShape+    , SEIPDVersion (..)+    , RecipientEncryptResult (..)+    , RecipientEncryptRequest (..)+    , RecipientEncryptRequestOverrides (..)+    , encryptForRecipients+    , encryptForRecipientsLegacy+    , encryptForRecipientsWithCapabilityNegotiation+    , PKESKV3SessionMaterial+    , PKESKV6RawSessionMaterial+    , PKESKSessionMaterial+    , pkeskSessionAlgorithm+    , pkeskSessionKey+    , mkPKESKSessionMaterial+    , mkPKESKV3SessionMaterial+    , mkPKESKV6RawSessionMaterial+    , pkeskV3SessionMaterial+    , pkeskV6RawSessionMaterial+    , encodeOpenPGPSessionMaterial+    , generateSessionKeyMaterial+    , canonicalizePKESKRecipientId+    , canonicalizePKESKPacketRecipientIds+    , buildPKESKv3PayloadForRecipient+    , buildPKESKv3PktForRecipient+    , buildPKESKPayloadForRecipient+    , buildPKESKPktForRecipient+    , buildPKESKPktsForRecipientTargetsWithSelector+    , buildPKESKPktsForRecipientTargetsWithSelectorTyped+    , encryptSEIPDv2Payload+    , encryptSEIPDv1Payload+    , encryptSEIPDv2WithSKESK+    , encryptSEIPDv2WithSKESKBlock+    , encryptSEIPDv2LiteralDataWithSKESK+    , composeMessageWithSEIPDv2+    ) where++import Control.Applicative ((<|>))+import Control.Lens (ix, (.~))+import Control.Monad (when)+import qualified Crypto.Error as CE+import qualified Crypto.Hash.Algorithms as CHAlg+import Crypto.KDF.HKDF (expand, extract)+import Crypto.Number.Serialize (i2osp, os2ip)+import qualified Crypto.PubKey.Curve25519 as C25519+import qualified Crypto.PubKey.Curve448 as C448+import qualified Crypto.PubKey.ECC.DH as ECCDH+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.ECC.Generate as ECCGen+import qualified Crypto.PubKey.RSA.PKCS15 as RSA15+import Crypto.Random.Types (MonadRandom, getRandomBytes)+import Data.Bifunctor (first)+import Data.Binary (put)+import Data.Binary.Put (putWord64be, runPut)+import Data.Bits (shiftL, shiftR, xor, (.&.))+import qualified Data.ByteArray as BA+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Int (Int64)+import Data.List (find, foldl', maximumBy)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)+import Data.Ord (comparing)+import qualified Data.Set as Set+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Word (Word16, Word64, Word8)+import qualified "crypton" Crypto.Cipher.Types as CCT++import Codec.Encryption.OpenPGP.BlockCipher+    ( CipherError+    , keySize+    , renderCipherError+    , withSymmetricCipher+    )+import Codec.Encryption.OpenPGP.CFB+    ( OpenPGPCFBModeW (..)+    , encryptOpenPGPCfbRaw+    , mdcTrailerForSEIPDv1+    )+import Codec.Encryption.OpenPGP.Expirations+    ( effectiveKeyPreferencesAtTimestamp+    , isPKTimeValidWithSelfSignatures+    , keyStateAt+    , keyStateValid+    , signatureEffectiveAt+    )+import Codec.Encryption.OpenPGP.Fingerprint+    ( eightOctetKeyID+    , fingerprint+    )+import Codec.Encryption.OpenPGP.Internal (leftPadTo, point2MBS)+import Codec.Encryption.OpenPGP.Internal.CryptoAES+    ( withAESCipher+    )+import Codec.Encryption.OpenPGP.Internal.CryptoECDH+    ( buildECDHKDFParam+    , deriveECDHKek+    , normalizeMontgomeryPublic+    )+import Codec.Encryption.OpenPGP.Internal.CryptoSEIPDv2+    ( aeadModeAndNonceSizeForSEIPDv2+    , deriveSKESK6KEK+    , encryptSKESK6SessionKey+    , seipdv2SymmetricKeySize+    )+import Codec.Encryption.OpenPGP.Internal.HOBlockCipher+    ( HOBlockCipher (..)+    )+import Codec.Encryption.OpenPGP.Internal.RFC7253OCB+    ( encryptWithOCBRFC7253+    )+import Codec.Encryption.OpenPGP.Ontology+    ( isSubkeyBindingSig+    , isSubkeyRevocation+    )+import Codec.Encryption.OpenPGP.Policy+    ( MessageEncryptionPolicy+    , OpenPGPRFC (..)+    , PKESKVersionPolicy (..)+    , defaultPKESKVersionPolicy+    , messageDefaultAEADAlgorithm+    , messageDefaultChunkSize+    , messageDefaultSymmetricAlgorithm+    , messageSEIPDv2SaltOctets+    , messageSEIPDv2SymmetricAlgorithms+    , policyForRFC+    , policyMessageEncryption+    )+import Codec.Encryption.OpenPGP.S2K (renderS2KError, string2Key)+import Codec.Encryption.OpenPGP.Serialize ()+import Codec.Encryption.OpenPGP.SignatureQualities+    ( sigCT+    , signatureHashedSubpacketsKnown+    )+import Codec.Encryption.OpenPGP.Types+import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as BTypes++-- | Typed failures from one-pass signature packet construction.+data OPSBuildError+    = OPSBuildMissingIssuerKeyId+    | OPSBuildMissingIssuerFingerprint+    | OPSBuildFingerprintWrongLength Int64+    | OPSBuildUnsupportedSigVersion PacketVersion+    deriving (Eq, Show)++renderOPSBuildError :: OPSBuildError -> String+renderOPSBuildError OPSBuildMissingIssuerKeyId =+    "cannot build OPS3 packet from v4 signature without issuer metadata"+renderOPSBuildError OPSBuildMissingIssuerFingerprint =+    "cannot build OPS6 packet from v6 signature without issuer fingerprint"+renderOPSBuildError (OPSBuildFingerprintWrongLength n) =+    "cannot build OPS6 packet: issuer fingerprint must be 32 octets, got "+        ++ show n+renderOPSBuildError (OPSBuildUnsupportedSigVersion v) =+    "cannot build one-pass signature packet for unsupported signature version "+        ++ show v++-- | Typed failures surfaced by encrypt-side PKESK and SEIPD-v2 helpers.+data PKESKEncryptError+    = UnsupportedSessionKeyAlgorithm SymmetricAlgorithm String+    | InvalidSessionKeyLength SymmetricAlgorithm Int Int+    | InvalidRecipientIdentifier String+    | UnsupportedRecipientAlgorithm PubKeyAlgorithm+    | InvalidRecipientKeyMaterial PubKeyAlgorithm String+    | RecipientKdfFailure PubKeyAlgorithm String+    | RecipientKeyWrapFailure PubKeyAlgorithm String+    | RecipientCapabilitySelectionFailure RecipientCapabilityError+    | PayloadBuildFailure String+    | NoRecipientsProvided+    deriving (Eq, Show)++renderPKESKEncryptError :: PKESKEncryptError -> String+renderPKESKEncryptError (UnsupportedSessionKeyAlgorithm algo reason) =+    "unsupported session key algorithm "+        ++ show algo+        ++ ": "+        ++ reason+renderPKESKEncryptError (InvalidSessionKeyLength algo expected actual) =+    "invalid session key length for "+        ++ show algo+        ++ ": expected "+        ++ show expected+        ++ ", got "+        ++ show actual+renderPKESKEncryptError (InvalidRecipientIdentifier reason) =+    "invalid recipient identifier: " ++ reason+renderPKESKEncryptError (UnsupportedRecipientAlgorithm algo) =+    "unsupported recipient public-key algorithm: " ++ show algo+renderPKESKEncryptError (InvalidRecipientKeyMaterial algo reason) =+    "invalid recipient key material for "+        ++ show algo+        ++ ": "+        ++ reason+renderPKESKEncryptError (RecipientKdfFailure algo reason) =+    "KDF failure for recipient algorithm "+        ++ show algo+        ++ ": "+        ++ reason+renderPKESKEncryptError (RecipientKeyWrapFailure algo reason) =+    "key wrap failure for recipient algorithm "+        ++ show algo+        ++ ": "+        ++ reason+renderPKESKEncryptError (RecipientCapabilitySelectionFailure err) =+    renderRecipientCapabilityError err+renderPKESKEncryptError (PayloadBuildFailure reason) =+    "payload build failure: " ++ reason+renderPKESKEncryptError NoRecipientsProvided =+    "no recipients provided"++data RecipientCapabilityNegotiationMode+    = RecipientCapabilityNegotiationOff+    | RecipientCapabilityNegotiationOn+    deriving (Eq, Show)++data RecipientCapabilityError+    = RecipientCapabilityMissingEncryptionFlags+        SomePKPayload+        (Set.Set KeyFlag)+    | RecipientCapabilityNoEncryptableKeyMaterialInTK+    | RecipientCapabilityMissingSEIPDv1Support [SomePKPayload]+    | RecipientCapabilityMissingSEIPDv2Support [SomePKPayload]+    | RecipientCapabilityNoCommonSymmetricAlgorithms+        [SymmetricAlgorithm]+    | RecipientCapabilityNoCommonAEADAlgorithms [AEADAlgorithm]+    deriving (Eq, Show)++renderRecipientCapabilityError+    :: RecipientCapabilityError -> String+renderRecipientCapabilityError (RecipientCapabilityMissingEncryptionFlags recipient flags) =+    "recipient "+        ++ show (_keyVersion recipient, _pkalgo recipient)+        ++ " does not advertise encryption-capable key flags; observed flags: "+        ++ show (Set.toList flags)+renderRecipientCapabilityError RecipientCapabilityNoEncryptableKeyMaterialInTK =+    "no encryption-capable primary key or subkey was found in transferable key material"+renderRecipientCapabilityError (RecipientCapabilityMissingSEIPDv1Support recipients) =+    "recipient set does not advertise SEIPDv1 (MDC) support: "+        ++ show (map (\r -> (_keyVersion r, _pkalgo r)) recipients)+renderRecipientCapabilityError (RecipientCapabilityMissingSEIPDv2Support recipients) =+    "recipient set does not advertise SEIPDv2 support: "+        ++ show (map (\r -> (_keyVersion r, _pkalgo r)) recipients)+renderRecipientCapabilityError (RecipientCapabilityNoCommonSymmetricAlgorithms syms) =+    "no common recipient-supported symmetric algorithms: "+        ++ show syms+renderRecipientCapabilityError (RecipientCapabilityNoCommonAEADAlgorithms aeads) =+    "no common recipient-supported AEAD algorithms: " ++ show aeads++data RecipientCapabilities+    = RecipientCapabilities+    { recipientCapabilityKeyVersion :: KeyVersion+    , recipientCapabilityPublicKeyAlgorithm :: PubKeyAlgorithm+    , recipientCapabilityKeyFlags :: Set.Set KeyFlag+    , recipientCapabilityFeatures :: Set.Set FeatureFlag+    , recipientCapabilityPreferredSymmetricAlgorithms+        :: [SymmetricAlgorithm]+    , recipientCapabilityPreferredAEADAlgorithms :: [AEADAlgorithm]+    }+    deriving (Eq, Show)++data RecipientTargetRejectionReason+    = RecipientTargetUnsupportedAlgorithm PubKeyAlgorithm+    | RecipientTargetMissingEncryptionFlags+        SomePKPayload+        (Set.Set KeyFlag)+    | RecipientTargetRevoked SomePKPayload+    | RecipientTargetNotValidAtTimestamp+        SomePKPayload+        ThirtyTwoBitTimeStamp+    deriving (Eq, Show)++data RecipientEncryptionTargetRejected+    = RecipientEncryptionTargetRejected+    { recipientEncryptionTargetRejectedKey :: SomePKPayload+    , recipientEncryptionTargetRejectedCapabilities+        :: Maybe RecipientCapabilities+    , recipientEncryptionTargetRejectedReason+        :: RecipientTargetRejectionReason+    }+    deriving (Eq, Show)++data RecipientEncryptionTargetsReport+    = RecipientEncryptionTargetsReport+    { recipientEncryptionTargetsAccepted :: [RecipientEncryptionTarget]+    , recipientEncryptionTargetsRejected+        :: [RecipientEncryptionTargetRejected]+    }+    deriving (Eq, Show)++{- | Extract encrypt-relevant recipient capabilities from effective+self-signature subpackets.++RFC 9580 preferred AEAD ciphersuites are currently carried through+'OtherSigSub' type 39 and decoded into AEAD preferences here.+-}+recipientCapabilitiesFromSubpacketPayloads+    :: SomePKPayload+    -> [SigSubPacketPayload]+    -> RecipientCapabilities+recipientCapabilitiesFromSubpacketPayloads recipient payloads =+    foldl' step (emptyRecipientCapabilities recipient) payloads+  where+    preferredAEADCiphersuitesSubpacketType :: Word8+    preferredAEADCiphersuitesSubpacketType = 39++    step caps payload =+        case payload of+            KeyFlags flags ->+                caps+                    { recipientCapabilityKeyFlags =+                        recipientCapabilityKeyFlags caps `Set.union` flags+                    }+            Features features ->+                caps+                    { recipientCapabilityFeatures =+                        recipientCapabilityFeatures caps `Set.union` features+                    }+            PreferredSymmetricAlgorithms syms ->+                caps+                    { recipientCapabilityPreferredSymmetricAlgorithms =+                        recipientCapabilityPreferredSymmetricAlgorithms caps ++ syms+                    }+            PreferredAEADCiphersuites ciphersuites ->+                caps+                    { recipientCapabilityPreferredAEADAlgorithms =+                        recipientCapabilityPreferredAEADAlgorithms caps+                            ++ preferredAEADAlgorithmsFromCiphersuitePairs ciphersuites+                    }+            OtherSigSub subpacketType rawPayload+                | subpacketType == preferredAEADCiphersuitesSubpacketType ->+                    caps+                        { recipientCapabilityPreferredAEADAlgorithms =+                            recipientCapabilityPreferredAEADAlgorithms caps+                                ++ preferredAEADAlgorithmsFromCiphersuites rawPayload+                        }+            _ -> caps++    emptyRecipientCapabilities key =+        RecipientCapabilities+            { recipientCapabilityKeyVersion = _keyVersion key+            , recipientCapabilityPublicKeyAlgorithm = _pkalgo key+            , recipientCapabilityKeyFlags = Set.empty+            , recipientCapabilityFeatures = Set.empty+            , recipientCapabilityPreferredSymmetricAlgorithms = []+            , recipientCapabilityPreferredAEADAlgorithms = []+            }++    preferredAEADAlgorithmsFromCiphersuites+        :: BL.ByteString -> [AEADAlgorithm]+    preferredAEADAlgorithmsFromCiphersuites =+        dedupePreservingOrder . parsePairs . BL.unpack+      where+        parsePairs (_symAlgo : aeadAlgo : rest) =+            (toFVal aeadAlgo :: AEADAlgorithm) : parsePairs rest+        parsePairs _ = []++        dedupePreservingOrder = foldl' addIfMissing []+        addIfMissing acc x+            | x `elem` acc = acc+            | otherwise = acc ++ [x]++    preferredAEADAlgorithmsFromCiphersuitePairs+        :: [(SymmetricAlgorithm, AEADAlgorithm)] -> [AEADAlgorithm]+    preferredAEADAlgorithmsFromCiphersuitePairs =+        dedupePreservingOrder . map snd+      where+        dedupePreservingOrder = foldl' addIfMissing []+        addIfMissing acc x+            | x `elem` acc = acc+            | otherwise = acc ++ [x]++recipientCapabilitySupportsEncryption+    :: RecipientCapabilities -> Bool+recipientCapabilitySupportsEncryption caps =+    let flags = recipientCapabilityKeyFlags caps+     in Set.null flags+            || Set.member EncryptStorageKey flags+            || Set.member EncryptCommunicationsKey flags++recipientCapabilityAdvertisesSEIPDv1Support+    :: RecipientCapabilities -> Bool+recipientCapabilityAdvertisesSEIPDv1Support caps =+    let features = recipientCapabilityFeatures caps+     in Set.null features || Set.member FeatureSEIPDv1 features++recipientCapabilityAdvertisesSEIPDv2Support+    :: RecipientCapabilities -> Bool+recipientCapabilityAdvertisesSEIPDv2Support caps =+    recipientCapabilityAdvertisesSEIPDv1Support caps+        && Set.member FeatureSEIPDv2 (recipientCapabilityFeatures caps)++recipientEncryptionTargetFromTKAtTimestamp+    :: ThirtyTwoBitTimeStamp+    -> TKUnknown+    -> Either RecipientCapabilityError RecipientEncryptionTarget+recipientEncryptionTargetFromTKAtTimestamp timestamp tk =+    recipientEncryptionTargetFromTKAtTimestampWithPolicy+        RecipientTargetSelectionFirstValid+        timestamp+        tk++data RecipientTargetSelectionPolicy+    = RecipientTargetSelectionFirstValid+    | RecipientTargetSelectionPreferPrimary+    | RecipientTargetSelectionPreferSubkey+    | RecipientTargetSelectionPreferNewestCreationTime+    deriving (Eq, Show)++recipientEncryptionTargetFromTKAtTimestampWithPolicy+    :: RecipientTargetSelectionPolicy+    -> ThirtyTwoBitTimeStamp+    -> TKUnknown+    -> Either RecipientCapabilityError RecipientEncryptionTarget+recipientEncryptionTargetFromTKAtTimestampWithPolicy policy timestamp tk =+    case chooseRecipientTarget policy tk acceptedTargets of+        Just target -> Right target+        Nothing -> Left RecipientCapabilityNoEncryptableKeyMaterialInTK+  where+    acceptedTargets =+        recipientEncryptionTargetsAccepted+            (recipientEncryptionTargetsReportFromTKAtTimestamp timestamp tk)++recipientEncryptionTargetFromTK+    :: TK 'PublicTK+    -> Either RecipientCapabilityError RecipientEncryptionTarget+recipientEncryptionTargetFromTK tk =+    recipientEncryptionTargetFromTKAtTimestampWithPolicy+        RecipientTargetSelectionFirstValid+        (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))+        (tkToUnknown tk)++recipientEncryptionTargetFromTKWithPolicy+    :: RecipientTargetSelectionPolicy+    -> TK 'PublicTK+    -> Either RecipientCapabilityError RecipientEncryptionTarget+recipientEncryptionTargetFromTKWithPolicy policy tk =+    recipientEncryptionTargetFromTKAtTimestampWithPolicy+        policy+        (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))+        (tkToUnknown tk)++recipientEncryptionTargetsFromTKAtTimestamp+    :: ThirtyTwoBitTimeStamp+    -> TKUnknown+    -> [RecipientEncryptionTarget]+recipientEncryptionTargetsFromTKAtTimestamp timestamp tk =+    recipientEncryptionTargetsAccepted+        (recipientEncryptionTargetsReportFromTKAtTimestamp timestamp tk)++recipientEncryptionTargetsReportFromTKAtTimestamp+    :: ThirtyTwoBitTimeStamp+    -> TKUnknown+    -> RecipientEncryptionTargetsReport+recipientEncryptionTargetsReportFromTKAtTimestamp timestamp tk =+    foldr+        classifyCandidate+        emptyReport+        (subkeyCandidates ++ [primaryCandidate])+  where+    emptyReport = RecipientEncryptionTargetsReport [] []+    primaryCandidate = fst (_tkuKey tk)+    primaryPreferencePayloads =+        fromMaybe [] (effectiveKeyPreferencesAtTimestamp timestamp tk)+    subkeyCandidates =+        mapMaybe+            ( \(pkt, _) ->+                case pkt of+                    PublicSubkeyPkt pkp -> Just pkp+                    SecretSubkeyPkt pkp _ -> Just pkp+                    _ -> Nothing+            )+            (_tkuSubs tk)+    classifyCandidate key report =+        let caps =+                recipientCapabilitiesFromSubpacketPayloads+                    key+                    ( primaryPreferencePayloads+                        ++ subkeyBindingCapabilityPayloads timestamp tk key+                    )+            keyStateRejection = recipientValidityRejectionReason timestamp tk key+         in case keyStateRejection of+                Just rejectionReason ->+                    report+                        { recipientEncryptionTargetsRejected =+                            RecipientEncryptionTargetRejected+                                { recipientEncryptionTargetRejectedKey = key+                                , recipientEncryptionTargetRejectedCapabilities = Just caps+                                , recipientEncryptionTargetRejectedReason = rejectionReason+                                }+                                : recipientEncryptionTargetsRejected report+                        }+                Nothing ->+                    if not (supportsPKESKRecipientAlgorithm key)+                        then+                            report+                                { recipientEncryptionTargetsRejected =+                                    RecipientEncryptionTargetRejected+                                        { recipientEncryptionTargetRejectedKey = key+                                        , recipientEncryptionTargetRejectedCapabilities = Just caps+                                        , recipientEncryptionTargetRejectedReason =+                                            RecipientTargetUnsupportedAlgorithm (_pkalgo key)+                                        }+                                        : recipientEncryptionTargetsRejected report+                                }+                        else+                            if recipientCapabilitySupportsEncryption caps+                                then+                                    report+                                        { recipientEncryptionTargetsAccepted =+                                            recipientEncryptionTargetWithCapabilities key caps+                                                : recipientEncryptionTargetsAccepted report+                                        }+                                else+                                    report+                                        { recipientEncryptionTargetsRejected =+                                            RecipientEncryptionTargetRejected+                                                { recipientEncryptionTargetRejectedKey = key+                                                , recipientEncryptionTargetRejectedCapabilities = Just caps+                                                , recipientEncryptionTargetRejectedReason =+                                                    RecipientTargetMissingEncryptionFlags+                                                        key+                                                        (recipientCapabilityKeyFlags caps)+                                                }+                                                : recipientEncryptionTargetsRejected report+                                        }++recipientEncryptionTargetsFromTK+    :: TK 'PublicTK -> [RecipientEncryptionTarget]+recipientEncryptionTargetsFromTK tk =+    recipientEncryptionTargetsFromTKAtTimestamp+        (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))+        (tkToUnknown tk)++recipientEncryptionTargetsReportFromTK+    :: TK 'PublicTK -> RecipientEncryptionTargetsReport+recipientEncryptionTargetsReportFromTK tk =+    recipientEncryptionTargetsReportFromTKAtTimestamp+        (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))+        (tkToUnknown tk)++subkeyBindingCapabilityPayloads+    :: ThirtyTwoBitTimeStamp+    -> TKUnknown+    -> SomePKPayload+    -> [SigSubPacketPayload]+subkeyBindingCapabilityPayloads timestamp tk recipient =+    maybe [] latestEffectiveBindingPayloads matchingSubkey+  where+    matchingSubkey =+        find+            ( \(pkt, _) ->+                case pkt of+                    PublicSubkeyPkt pkp -> fingerprint pkp == fingerprint recipient+                    SecretSubkeyPkt pkp _ -> fingerprint pkp == fingerprint recipient+                    _ -> False+            )+            (_tkuSubs tk)+    latestEffectiveBindingPayloads (_, sigs) =+        maybe+            []+            signaturePayloadsFromSignature+            (latestEffectiveSubkeyBindingSignature timestamp sigs)++latestEffectiveSubkeyBindingSignature+    :: ThirtyTwoBitTimeStamp+    -> [SignaturePayload]+    -> Maybe SignaturePayload+latestEffectiveSubkeyBindingSignature timestamp sigs =+    case filter (isEffectiveSubkeyBindingSignature timestamp) sigs of+        [] -> Nothing+        candidates ->+            Just+                (maximumBy (comparing signatureCreationTimestamp) candidates)++isEffectiveSubkeyBindingSignature+    :: ThirtyTwoBitTimeStamp+    -> SignaturePayload+    -> Bool+isEffectiveSubkeyBindingSignature timestamp sig =+    isSubkeyBindingSig sig+        && maybe+            False+            ( \created ->+                let tsValue = toInteger (unThirtyTwoBitTimeStamp timestamp)+                    createdValue = toInteger (unThirtyTwoBitTimeStamp created)+                 in createdValue <= tsValue+                        && maybe+                            True+                            ( \duration ->+                                if unThirtyTwoBitDuration duration == 0+                                    then True+                                    else+                                        tsValue+                                            < createdValue + toInteger (unThirtyTwoBitDuration duration)+                            )+                            (signatureExpirationDuration sig)+            )+            (sigCT sig)++signatureCreationTimestamp+    :: SignaturePayload -> ThirtyTwoBitTimeStamp+signatureCreationTimestamp sig =+    fromMaybe (ThirtyTwoBitTimeStamp 0) (sigCT sig)++signatureExpirationDuration+    :: SignaturePayload -> Maybe ThirtyTwoBitDuration+signatureExpirationDuration sig =+    case signatureHashedSubpacketsKnown sig of+        Just hashed ->+            foldr+                ( \subpacket acc ->+                    case subpacket of+                        SigSubPacket _ (SigExpirationTime duration) -> Just duration+                        _ -> acc+                )+                Nothing+                hashed+        Nothing -> Nothing++signaturePayloadsFromSignature+    :: SignaturePayload -> [SigSubPacketPayload]+signaturePayloadsFromSignature sig =+    case signatureHashedSubpacketsKnown sig of+        Just hashed -> map (\(SigSubPacket _ payload) -> payload) hashed+        Nothing -> []++recipientValidityRejectionReason+    :: ThirtyTwoBitTimeStamp+    -> TKUnknown+    -> SomePKPayload+    -> Maybe RecipientTargetRejectionReason+recipientValidityRejectionReason timestamp tk key+    | fingerprint key == fingerprint (fst (_tkuKey tk)) =+        if keyStateValid (keyStateAt (timestampToUTC timestamp) tk)+            then Nothing+            else Just (RecipientTargetNotValidAtTimestamp key timestamp)+    | otherwise =+        case findMatchingSubkeySignatures tk key of+            Nothing -> Nothing+            Just sigs+                | subkeyRevokedAtTimestamp timestamp sigs ->+                    Just (RecipientTargetRevoked key)+                | isPKTimeValidWithSelfSignatures+                    (timestampToUTC timestamp)+                    key+                    sigs ->+                    Nothing+                | otherwise ->+                    Just (RecipientTargetNotValidAtTimestamp key timestamp)++findMatchingSubkeySignatures+    :: TKUnknown -> SomePKPayload -> Maybe [SignaturePayload]+findMatchingSubkeySignatures tk recipient =+    snd+        <$> find+            ( \(pkt, _) ->+                case pkt of+                    PublicSubkeyPkt pkp -> fingerprint pkp == fingerprint recipient+                    SecretSubkeyPkt pkp _ -> fingerprint pkp == fingerprint recipient+                    _ -> False+            )+            (_tkuSubs tk)++subkeyRevokedAtTimestamp+    :: ThirtyTwoBitTimeStamp -> [SignaturePayload] -> Bool+subkeyRevokedAtTimestamp timestamp =+    any+        ( \sig ->+            isSubkeyRevocation sig+                && signatureEffectiveAt (timestampToUTC timestamp) sig+        )++timestampToUTC :: ThirtyTwoBitTimeStamp -> UTCTime+timestampToUTC =+    posixSecondsToUTCTime . realToFrac . unThirtyTwoBitTimeStamp++supportsPKESKRecipientAlgorithm :: SomePKPayload -> Bool+supportsPKESKRecipientAlgorithm recipient =+    case _pkalgo recipient of+        RSA -> True+        DeprecatedRSAEncryptOnly -> True+        ECDH -> True+        X25519 -> True+        X448 -> True+        _ -> False++chooseRecipientTarget+    :: RecipientTargetSelectionPolicy+    -> TKUnknown+    -> [RecipientEncryptionTarget]+    -> Maybe RecipientEncryptionTarget+chooseRecipientTarget policy tk targets =+    case policy of+        RecipientTargetSelectionFirstValid -> listToMaybe targets+        RecipientTargetSelectionPreferPrimary ->+            listToMaybe (filter (isPrimaryTarget tk) targets)+                <|> listToMaybe targets+        RecipientTargetSelectionPreferSubkey ->+            listToMaybe (filter (not . isPrimaryTarget tk) targets)+                <|> listToMaybe targets+        RecipientTargetSelectionPreferNewestCreationTime ->+            case targets of+                [] -> Nothing+                (target : rest) ->+                    Just+                        ( foldl'+                            ( \best candidate ->+                                if _timestamp (recipientEncryptionTargetKey candidate)+                                    > _timestamp (recipientEncryptionTargetKey best)+                                    then candidate+                                    else best+                            )+                            target+                            rest+                        )+  where+    isPrimaryTarget currentTK target =+        fingerprint (recipientEncryptionTargetKey target)+            == fingerprint (fst (_tkuKey currentTK))++-- | Session-key bundle for PKESK/SKESK packet construction.+newtype PKESKV3SessionMaterial+    = PKESKV3SessionMaterial+    { unPKESKV3SessionMaterial :: B.ByteString+    }+    deriving (Eq, Show)++newtype PKESKV6RawSessionMaterial+    = PKESKV6RawSessionMaterial+    { unPKESKV6RawSessionMaterial :: B.ByteString+    }+    deriving (Eq, Show)++data PKESKSessionMaterial+    = PKESKSessionMaterial+    { pkeskSessionAlgorithm :: SymmetricAlgorithm+    , pkeskSessionKey :: SessionKey+    , pkeskEncodedSessionMaterial :: B.ByteString+    }+    deriving (Eq, Show)++mkPKESKSessionMaterial+    :: SymmetricAlgorithm+    -> SessionKey+    -> Either PKESKEncryptError PKESKSessionMaterial+mkPKESKSessionMaterial symalgo sessionKey = do+    v3Material <- mkPKESKV3SessionMaterial symalgo sessionKey+    _v6Material <- mkPKESKV6RawSessionMaterial symalgo sessionKey+    pure+        PKESKSessionMaterial+            { pkeskSessionAlgorithm = symalgo+            , pkeskSessionKey = sessionKey+            , pkeskEncodedSessionMaterial = unPKESKV3SessionMaterial v3Material+            }++mkPKESKV3SessionMaterial+    :: SymmetricAlgorithm+    -> SessionKey+    -> Either PKESKEncryptError PKESKV3SessionMaterial+mkPKESKV3SessionMaterial symalgo sessionKey = do+    keyBytes <- validatedSessionKeyBytes symalgo sessionKey+    pure $+        PKESKV3SessionMaterial+            ( B.singleton (fromFVal symalgo)+                <> keyBytes+                <> checksum16Bytes keyBytes+            )++mkPKESKV6RawSessionMaterial+    :: SymmetricAlgorithm+    -> SessionKey+    -> Either PKESKEncryptError PKESKV6RawSessionMaterial+mkPKESKV6RawSessionMaterial symalgo sessionKey =+    PKESKV6RawSessionMaterial+        <$> validatedSessionKeyBytes symalgo sessionKey++pkeskV3SessionMaterial+    :: PKESKSessionMaterial -> PKESKV3SessionMaterial+pkeskV3SessionMaterial =+    PKESKV3SessionMaterial . pkeskEncodedSessionMaterial++pkeskV6RawSessionMaterial+    :: PKESKSessionMaterial -> PKESKV6RawSessionMaterial+pkeskV6RawSessionMaterial =+    PKESKV6RawSessionMaterial . unSessionKey . pkeskSessionKey++validatedSessionKeyBytes+    :: SymmetricAlgorithm+    -> SessionKey+    -> Either PKESKEncryptError B.ByteString+validatedSessionKeyBytes symalgo (SessionKey sessionKey) = do+    keyLen <-+        first+            (UnsupportedSessionKeyAlgorithm symalgo . renderCipherError)+            (keySize symalgo)+    let actualLen = B.length sessionKey+    if actualLen /= keyLen+        then Left (InvalidSessionKeyLength symalgo keyLen actualLen)+        else Right sessionKey++data RecipientPKESKVersionStrategy+    = RecipientPreferV6+    | RecipientForceV3Interop+    deriving (Eq, Show)++data+    RecipientPKESKVersionStrategyW+        (strategy :: RecipientPKESKVersionStrategy)+    where+    RecipientPreferV6W+        :: RecipientPKESKVersionStrategyW 'RecipientPreferV6+    RecipientForceV3InteropW+        :: RecipientPKESKVersionStrategyW 'RecipientForceV3Interop++data SomeRecipientPKESKVersionStrategyW where+    SomeRecipientPKESKVersionStrategyW+        :: RecipientPKESKVersionStrategyW strategy+        -> SomeRecipientPKESKVersionStrategyW++type RecipientPKESKVersionSelector =+    SomePKPayload+    -> Either PKESKEncryptError RecipientPKESKVersionStrategy++type RecipientPKESKVersionSelectorTyped =+    SomePKPayload+    -> Either PKESKEncryptError SomeRecipientPKESKVersionStrategyW++data EncryptCompatibilityProfile+    = EncryptStrictDefault+    | EncryptInteropLegacy+    deriving (Eq, Show)++data+    EncryptCompatibilityProfileW+        (profile :: EncryptCompatibilityProfile)+    where+    EncryptStrictDefaultW+        :: EncryptCompatibilityProfileW 'EncryptStrictDefault+    EncryptInteropLegacyW+        :: EncryptCompatibilityProfileW 'EncryptInteropLegacy++data SomeEncryptCompatibilityProfileW where+    SomeEncryptCompatibilityProfileW+        :: EncryptCompatibilityProfileW profile+        -> SomeEncryptCompatibilityProfileW++data SEIPDVersion+    = SEIPDv1+    | SEIPDv2+    deriving (Eq, Show)++type family+    PayloadVersionForProfile (profile :: EncryptCompatibilityProfile)+        :: SEIPDVersion+    where+    PayloadVersionForProfile 'EncryptStrictDefault = 'SEIPDv2+    PayloadVersionForProfile 'EncryptInteropLegacy = 'SEIPDv1++type family+    ProfileForPayloadVersion (version :: SEIPDVersion)+        :: EncryptCompatibilityProfile+    where+    ProfileForPayloadVersion 'SEIPDv1 = 'EncryptInteropLegacy+    ProfileForPayloadVersion 'SEIPDv2 = 'EncryptStrictDefault++data RecipientEncryptionTarget+    = RecipientEncryptionTarget+    { recipientEncryptionTargetKey :: SomePKPayload+    -- ^ Recipient key packet selected for PKESK wrapping.+    , recipientEncryptionTargetStrategy+        :: Maybe RecipientPKESKVersionStrategy+    {- ^ Optional explicit PKESK version strategy hint.+    When absent, profile defaults and auto-detection apply.+    -}+    , recipientEncryptionTargetCapabilities+        :: Maybe RecipientCapabilities+    {- ^ Optional recipient capability hints used by negotiation-enabled+    encryption to choose common symmetric/AEAD algorithms.+    -}+    }+    deriving (Eq, Show)++recipientEncryptionTarget+    :: SomePKPayload -> RecipientEncryptionTarget+recipientEncryptionTarget recipient =+    RecipientEncryptionTarget recipient Nothing Nothing++recipientEncryptionTargetWithStrategy+    :: SomePKPayload+    -> RecipientPKESKVersionStrategy+    -> RecipientEncryptionTarget+recipientEncryptionTargetWithStrategy recipient strategy =+    RecipientEncryptionTarget recipient (Just strategy) Nothing++recipientEncryptionTargetWithCapabilities+    :: SomePKPayload+    -> RecipientCapabilities+    -> RecipientEncryptionTarget+recipientEncryptionTargetWithCapabilities recipient capabilities =+    RecipientEncryptionTarget recipient Nothing (Just capabilities)++recipientEncryptionTargetWithStrategyTyped+    :: SomePKPayload+    -> RecipientPKESKVersionStrategyW strategy+    -> RecipientEncryptionTarget+recipientEncryptionTargetWithStrategyTyped recipient strategyW =+    recipientEncryptionTargetWithStrategy+        recipient+        (demoteRecipientStrategy strategyW)++recipientVersionStrategyForProfile+    :: EncryptCompatibilityProfile+    -> RecipientEncryptionTarget+    -> Either PKESKEncryptError RecipientPKESKVersionStrategy+recipientVersionStrategyForProfile profile target =+    case promoteEncryptCompatibilityProfile profile of+        SomeEncryptCompatibilityProfileW profileW ->+            demoteSomeRecipientStrategy+                <$> recipientVersionStrategyForProfileTyped profileW target++recipientVersionStrategyForProfileTyped+    :: EncryptCompatibilityProfileW profile+    -> RecipientEncryptionTarget+    -> Either PKESKEncryptError SomeRecipientPKESKVersionStrategyW+recipientVersionStrategyForProfileTyped profile target =+    Right $+        case recipientEncryptionTargetStrategy target of+            Just strategy ->+                promoteRecipientStrategy strategy+            Nothing ->+                case profile of+                    EncryptStrictDefaultW ->+                        autoDetectRecipientVersionStrategy+                            (recipientEncryptionTargetKey target)+                    EncryptInteropLegacyW ->+                        SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW++profileForPayloadVersionW+    :: RecipientEncryptRequestOverrides version+    -> EncryptCompatibilityProfileW (ProfileForPayloadVersion version)+profileForPayloadVersionW overrides =+    case overrides of+        RecipientEncryptRequestSEIPDv2Overrides {} -> EncryptStrictDefaultW+        RecipientEncryptRequestSEIPDv1Overrides {} -> EncryptInteropLegacyW++autoDetectRecipientVersionStrategy+    :: SomePKPayload+    -> SomeRecipientPKESKVersionStrategyW+autoDetectRecipientVersionStrategy recipient+    | _keyVersion recipient == V6 =+        SomeRecipientPKESKVersionStrategyW RecipientPreferV6W+    | _pkalgo recipient `elem` [X25519, X448] =+        SomeRecipientPKESKVersionStrategyW RecipientPreferV6W+    | otherwise =+        SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW++data RecipientPayloadShape+    = RecipientPayloadShape+    { recipientPayloadDataType :: LiteralDataType+    , recipientPayloadFileName :: FileName+    , recipientPayloadTimestamp :: ThirtyTwoBitTimeStamp+    , recipientPayloadUseOnePassSignatures :: Bool+    , recipientPayloadSignatures :: [SignaturePayload]+    }+    deriving (Eq, Show)++data PassphraseSKESKVersionPolicy+    = PassphraseSKESKPreferV6+    | PassphraseSKESKForceV4Interop+    deriving (Eq, Show)++data PassphraseEncryptRequest+    = PassphraseEncryptRequest+    { passphraseEncryptVersionPolicy :: PassphraseSKESKVersionPolicy+    , passphraseEncryptSymmetricAlgorithm :: SymmetricAlgorithm+    , passphraseEncryptS2K :: S2K+    , passphraseEncryptPassphrase :: BL.ByteString+    , passphraseEncryptPayload :: B.ByteString+    , passphraseEncryptSEIPDv1IVOverride :: Maybe IV+    , passphraseEncryptSEIPDv2AEADOverride :: Maybe AEADAlgorithm+    , passphraseEncryptSEIPDv2ChunkSizeOverride :: Maybe Word8+    , passphraseEncryptSEIPDv2SaltOverride :: Maybe Salt+    }+    deriving (Eq, Show)++encryptPassphraseWithPolicy+    :: MonadRandom m+    => PassphraseEncryptRequest+    -> m (Either String [Pkt])+encryptPassphraseWithPolicy request =+    case passphraseEncryptVersionPolicy request of+        PassphraseSKESKForceV4Interop ->+            encryptSEIPDv1WithSKESK+                (passphraseEncryptSymmetricAlgorithm request)+                (passphraseEncryptS2K request)+                (passphraseEncryptSEIPDv1IVOverride request)+                (passphraseEncryptPassphrase request)+                (passphraseEncryptPayload request)+        PassphraseSKESKPreferV6 -> do+            let messagePolicy = policyMessageEncryption (policyForRFC RFC9580)+                aead =+                    fromMaybe+                        (messageDefaultAEADAlgorithm messagePolicy)+                        (passphraseEncryptSEIPDv2AEADOverride request)+                chunkSize =+                    fromMaybe+                        (messageDefaultChunkSize messagePolicy)+                        (passphraseEncryptSEIPDv2ChunkSizeOverride request)+            salt <-+                maybe+                    (Salt <$> getRandomBytes (messageSEIPDv2SaltOctets messagePolicy))+                    pure+                    (passphraseEncryptSEIPDv2SaltOverride request)+            pure $+                encryptSEIPDv2WithSKESK+                    (passphraseEncryptSymmetricAlgorithm request)+                    aead+                    chunkSize+                    salt+                    (passphraseEncryptS2K request)+                    (passphraseEncryptPassphrase request)+                    (passphraseEncryptPayload request)++defaultRecipientPayloadShape :: RecipientPayloadShape+defaultRecipientPayloadShape =+    RecipientPayloadShape+        { recipientPayloadDataType = BinaryData+        , recipientPayloadFileName = BL.empty+        , recipientPayloadTimestamp = 0+        , recipientPayloadUseOnePassSignatures = False+        , recipientPayloadSignatures = []+        }++data RecipientEncryptResult+    = RecipientEncryptResult+    { recipientEncryptPackets :: [Pkt]+    , recipientEncryptSessionMaterial :: PKESKSessionMaterial+    }+    deriving (Eq, Show)++data RecipientEncryptRequestOverrides (v :: SEIPDVersion) where+    RecipientEncryptRequestSEIPDv1Overrides+        :: { recipientEncryptRequestIVOverride :: Maybe IV+           }+        -> RecipientEncryptRequestOverrides 'SEIPDv1+    {- | For SEIPDv2 requests:+    - when AEAD override is 'Nothing', encrypt-side capability negotiation+    selects a common recipient-supported AEAD algorithm (if enabled).+    - when AEAD override is 'Just', the explicit AEAD wins.+    -}+    RecipientEncryptRequestSEIPDv2Overrides+        :: { recipientEncryptRequestAEADOverride :: Maybe AEADAlgorithm+           , recipientEncryptRequestChunkSizeOverride :: Maybe Word8+           , recipientEncryptRequestSaltOverride :: Maybe Salt+           }+        -> RecipientEncryptRequestOverrides 'SEIPDv2++data RecipientEncryptRequest (v :: SEIPDVersion)+    = RecipientEncryptRequest+    { recipientEncryptRequestTargets :: [RecipientEncryptionTarget]+    -- ^ Recipient encryption targets. At least one target is required.+    , recipientEncryptRequestPayloadShape :: RecipientPayloadShape+    , recipientEncryptRequestPayload :: B.ByteString+    , recipientEncryptRequestSymmetricOverride+        :: Maybe SymmetricAlgorithm+    {- ^ Explicit symmetric algorithm override. When 'Nothing', the selected+    mode (negotiated or legacy) determines algorithm selection.+    -}+    , recipientEncryptRequestOverrides+        :: RecipientEncryptRequestOverrides v+    }++deriving instance Eq (RecipientEncryptRequestOverrides v)+deriving instance Show (RecipientEncryptRequestOverrides v)+deriving instance Eq (RecipientEncryptRequest v)+deriving instance Show (RecipientEncryptRequest v)++{- | Encode the RFC 9580 PKESK/SKESK session-key material:+  one-octet algorithm ID, raw session key, then 16-bit checksum.+-}+encodeOpenPGPSessionMaterial+    :: SymmetricAlgorithm+    -> SessionKey+    -> Either PKESKEncryptError B.ByteString+encodeOpenPGPSessionMaterial symalgo sessionKey =+    unPKESKV3SessionMaterial+        <$> mkPKESKV3SessionMaterial symalgo sessionKey++-- | Generate a fresh session key and return both raw and encoded forms.+generateSessionKeyMaterial+    :: MonadRandom m+    => SymmetricAlgorithm+    -> m (Either PKESKEncryptError PKESKSessionMaterial)+generateSessionKeyMaterial symalgo =+    case keySize symalgo of+        Left err ->+            pure+                ( Left+                    (UnsupportedSessionKeyAlgorithm symalgo (renderCipherError err))+                )+        Right keyLen -> do+            sessionKeyBytes <- getRandomBytes keyLen+            let sessionKey = SessionKey sessionKeyBytes+            pure (mkPKESKSessionMaterial symalgo sessionKey)++canonicalizePKESKRecipientId+    :: PKESKPayload -> Either PKESKEncryptError PKESKPayload+canonicalizePKESKRecipientId payload =+    case payload of+        PKESKPayloadV6Packet payloadV6 ->+            PKESKPayloadV6Packet <$> canonicalizePKESKRecipientIdV6 payloadV6+        _ -> Right payload++canonicalizePKESKRecipientIdV6+    :: PKESKPayloadV6 -> Either PKESKEncryptError PKESKPayloadV6+canonicalizePKESKRecipientIdV6 (PKESKPayloadV6 rid pka esk) =+    (\normalizedRid -> PKESKPayloadV6 normalizedRid pka esk)+        <$> canonicalizeRecipientKeyIdentifier rid++canonicalizeRecipientKeyIdentifier+    :: BL.ByteString -> Either PKESKEncryptError BL.ByteString+canonicalizeRecipientKeyIdentifier rid+    | BL.length rid == 20 || BL.length rid == 32 = Right rid+    | BL.length rid == 21 && BL.head rid == 0x04 =+        Right (BL.tail rid)+    | BL.length rid == 33 && BL.head rid == 0x06 =+        Right (BL.tail rid)+    | otherwise =+        Left+            ( InvalidRecipientIdentifier+                ( "unsupported PKESK recipient identifier length/prefix: "+                    ++ show (BL.length rid)+                )+            )++canonicalizePKESKPacketRecipientIds+    :: [Pkt] -> Either PKESKEncryptError [Pkt]+canonicalizePKESKPacketRecipientIds =+    mapM+        ( \pkt ->+            case pkt of+                PKESKPkt payload -> fmap PKESKPkt (canonicalizePKESKRecipientId payload)+                _ -> Right pkt+        )++-- | Build a v6 PKESK payload for one recipient key according to the selected version policy.+buildPKESKPayloadForRecipient+    :: MonadRandom m+    => PKESKVersionPolicy+    -> SomePKPayload+    -> PKESKSessionMaterial+    -> m (Either PKESKEncryptError PKESKPayload)+buildPKESKPayloadForRecipient policy recipient material =+    case policy of+        ForceV3Interop ->+            buildPKESKv3PayloadForRecipient+                recipient+                (pkeskV3SessionMaterial material)+        PreferV6 ->+            case _pkalgo recipient of+                RSA ->+                    fmap+                        (fmap PKESKPayloadV6Packet)+                        (buildRsaPKESKv6 recipient material)+                ECDH ->+                    fmap+                        (fmap PKESKPayloadV6Packet)+                        (buildECDHPKESKv6 recipient material)+                X25519 ->+                    fmap+                        (fmap PKESKPayloadV6Packet)+                        (buildX25519PKESKv6 recipient (pkeskV6RawSessionMaterial material))+                X448 ->+                    fmap+                        (fmap PKESKPayloadV6Packet)+                        (buildX448PKESKv6 recipient (pkeskV6RawSessionMaterial material))+                pka -> pure (Left (UnsupportedRecipientAlgorithm pka))++-- | Build a PKESK packet for one recipient key according to the selected version policy.+buildPKESKPktForRecipient+    :: MonadRandom m+    => PKESKVersionPolicy+    -> SomePKPayload+    -> PKESKSessionMaterial+    -> m (Either PKESKEncryptError Pkt)+buildPKESKPktForRecipient policy recipient material =+    fmap+        (fmap PKESKPkt)+        (buildPKESKPayloadForRecipient policy recipient material)++-- | Build a legacy PKESKv3 payload for v4/v3 RSA recipient interop.+buildPKESKv3PayloadForRecipient+    :: MonadRandom m+    => SomePKPayload+    -> PKESKV3SessionMaterial+    -> m (Either PKESKEncryptError PKESKPayload)+buildPKESKv3PayloadForRecipient recipient material =+    fmap+        (fmap PKESKPayloadV3Packet)+        (buildPKESKv3PayloadForRecipientTyped recipient material)++buildPKESKv3PayloadForRecipientTyped+    :: MonadRandom m+    => SomePKPayload+    -> PKESKV3SessionMaterial+    -> m (Either PKESKEncryptError PKESKPayloadV3)+buildPKESKv3PayloadForRecipientTyped recipient material =+    case _pkalgo recipient of+        RSA -> buildRsaPKESKv3 recipient material+        DeprecatedRSAEncryptOnly -> buildRsaPKESKv3 recipient material+        ECDH -> buildECDHPKESKv3 recipient material+        pka -> pure (Left (UnsupportedRecipientAlgorithm pka))++-- | Build a legacy PKESKv3 packet for v4/v3 RSA recipient interop.+buildPKESKv3PktForRecipient+    :: MonadRandom m+    => SomePKPayload+    -> PKESKV3SessionMaterial+    -> m (Either PKESKEncryptError Pkt)+buildPKESKv3PktForRecipient recipient material =+    fmap+        (fmap PKESKPkt)+        (buildPKESKv3PayloadForRecipient recipient material)++-- | Build PKESK packets for all recipients with a single shared session key.+buildPKESKPktsForRecipientTargetsWithSelector+    :: MonadRandom m+    => ( RecipientEncryptionTarget+         -> Either PKESKEncryptError RecipientPKESKVersionStrategy+       )+    -> [RecipientEncryptionTarget]+    -> PKESKSessionMaterial+    -> m (Either PKESKEncryptError [Pkt])+buildPKESKPktsForRecipientTargetsWithSelector selector targets material =+    buildPKESKPktsForRecipientTargetsWithSelectorTyped+        ( \target ->+            promoteRecipientStrategy <$> selector target+        )+        targets+        material++buildPKESKPktsForRecipientTargetsWithSelectorTyped+    :: MonadRandom m+    => ( RecipientEncryptionTarget+         -> Either PKESKEncryptError SomeRecipientPKESKVersionStrategyW+       )+    -> [RecipientEncryptionTarget]+    -> PKESKSessionMaterial+    -> m (Either PKESKEncryptError [Pkt])+buildPKESKPktsForRecipientTargetsWithSelectorTyped selector targets material+    | null targets = pure (Left NoRecipientsProvided)+    | otherwise =+        case preparePKESKVersionedMaterial material of+            Left err -> pure (Left err)+            Right (v3Material, v6RawMaterial) -> do+                pkeskResults <-+                    mapM+                        ( \target ->+                            case selector target of+                                Left err -> pure (Left err)+                                Right (SomeRecipientPKESKVersionStrategyW RecipientPreferV6W) ->+                                    buildPKESKPktForRecipientWithPreparedPayload+                                        RecipientPreferV6W+                                        (recipientEncryptionTargetKey target)+                                        (RecipientPreferV6Payload material v6RawMaterial)+                                Right+                                    (SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW) ->+                                        buildPKESKPktForRecipientWithPreparedPayload+                                            RecipientForceV3InteropW+                                            (recipientEncryptionTargetKey target)+                                            (RecipientForceV3Payload v3Material)+                        )+                        targets+                pure+                    (sequence pkeskResults >>= canonicalizePKESKPacketRecipientIds)++preparePKESKVersionedMaterial+    :: PKESKSessionMaterial+    -> Either+        PKESKEncryptError+        (PKESKV3SessionMaterial, PKESKV6RawSessionMaterial)+preparePKESKVersionedMaterial material = do+    v3Material <-+        mkPKESKV3SessionMaterial+            (pkeskSessionAlgorithm material)+            (pkeskSessionKey material)+    v6RawMaterial <-+        mkPKESKV6RawSessionMaterial+            (pkeskSessionAlgorithm material)+            (pkeskSessionKey material)+    pure (v3Material, v6RawMaterial)++data+    RecipientPKESKRequestPayload+        (strategy :: RecipientPKESKVersionStrategy)+    where+    RecipientForceV3Payload+        :: PKESKV3SessionMaterial+        -> RecipientPKESKRequestPayload 'RecipientForceV3Interop+    RecipientPreferV6Payload+        :: PKESKSessionMaterial+        -> PKESKV6RawSessionMaterial+        -> RecipientPKESKRequestPayload 'RecipientPreferV6++buildPKESKPktForRecipientWithPreparedPayload+    :: MonadRandom m+    => RecipientPKESKVersionStrategyW strategy+    -> SomePKPayload+    -> RecipientPKESKRequestPayload strategy+    -> m (Either PKESKEncryptError Pkt)+buildPKESKPktForRecipientWithPreparedPayload strategy recipient payload =+    fmap fmapPKESKPkt payloadResult+  where+    fmapPKESKPkt = fmap PKESKPkt+    payloadResult =+        case (strategy, payload) of+            (RecipientForceV3InteropW, RecipientForceV3Payload v3Material) ->+                buildPKESKv3PayloadForRecipient recipient v3Material+            ( RecipientPreferV6W+                , RecipientPreferV6Payload material v6RawMaterial+                ) ->+                    case _pkalgo recipient of+                        RSA ->+                            fmap+                                (fmap PKESKPayloadV6Packet)+                                (buildRsaPKESKv6 recipient material)+                        ECDH ->+                            fmap+                                (fmap PKESKPayloadV6Packet)+                                (buildECDHPKESKv6 recipient material)+                        X25519 ->+                            fmap+                                (fmap PKESKPayloadV6Packet)+                                (buildX25519PKESKv6 recipient v6RawMaterial)+                        X448 ->+                            fmap+                                (fmap PKESKPayloadV6Packet)+                                (buildX448PKESKv6 recipient v6RawMaterial)+                        pka ->+                            pure (Left (UnsupportedRecipientAlgorithm pka))++{- | Encrypt for recipient targets with capability negotiation enabled.++By default this negotiates a common symmetric and (for SEIPDv2) AEAD+algorithm from recipient capabilities when available. Explicit request+overrides still take precedence.+-}+encryptForRecipients+    :: MonadRandom m+    => RecipientEncryptRequest v+    -> m (Either PKESKEncryptError RecipientEncryptResult)+encryptForRecipients =+    encryptForRecipientsWithCapabilityNegotiation+        RecipientCapabilityNegotiationOn++{- | Encrypt for recipient targets without recipient capability negotiation.++This preserves legacy behavior by using policy defaults unless request+overrides are provided.+-}+encryptForRecipientsLegacy+    :: MonadRandom m+    => RecipientEncryptRequest v+    -> m (Either PKESKEncryptError RecipientEncryptResult)+encryptForRecipientsLegacy =+    encryptForRecipientsWithCapabilityNegotiation+        RecipientCapabilityNegotiationOff++{- | Encrypt for recipient targets with an explicit capability-negotiation mode.++When negotiation is on, symmetric and AEAD selection use the common+intersection of recipient preferences constrained by the active policy.+When off, policy defaults are used.+-}+encryptForRecipientsWithCapabilityNegotiation+    :: MonadRandom m+    => RecipientCapabilityNegotiationMode+    -> RecipientEncryptRequest v+    -> m (Either PKESKEncryptError RecipientEncryptResult)+encryptForRecipientsWithCapabilityNegotiation negotiationMode request+    | null targets = pure (Left NoRecipientsProvided)+    | otherwise =+        case selectSymmetricAlgorithm+            negotiationMode+            request+            messagePolicy+            targets of+            Left err -> pure (Left err)+            Right symalgo -> do+                sessionMaterialResult <- generateSessionKeyMaterial symalgo+                case sessionMaterialResult of+                    Left err -> pure (Left err)+                    Right sessionMaterial -> do+                        pkeskResult <-+                            buildPKESKPktsForRecipientTargetsWithSelectorTyped+                                (recipientVersionStrategyForProfileTyped profileW)+                                targets+                                sessionMaterial+                        case pkeskResult of+                            Left err -> pure (Left err)+                            Right pkeskPkts -> do+                                payloadResult <- case recipientEncryptRequestOverrides request of+                                    RecipientEncryptRequestSEIPDv2Overrides+                                        { recipientEncryptRequestAEADOverride = aeadOverride+                                        , recipientEncryptRequestChunkSizeOverride = chunkSizeOverride+                                        , recipientEncryptRequestSaltOverride = saltOverride+                                        } ->+                                            case recipientsMissingSEIPDv2Support targets of+                                                [] -> do+                                                    case selectAEADAlgorithm+                                                        negotiationMode+                                                        messagePolicy+                                                        targets+                                                        aeadOverride of+                                                        Left err -> pure (Left err)+                                                        Right aead -> do+                                                            salt <- maybe (Salt <$> getRandomBytes 32) pure saltOverride+                                                            let chunkSize =+                                                                    maybe+                                                                        (messageDefaultChunkSize messagePolicy)+                                                                        id+                                                                        chunkSizeOverride+                                                            pure $+                                                                buildEncryptedPacketSequenceWithShape+                                                                    symalgo+                                                                    aead+                                                                    chunkSize+                                                                    (recipientEncryptRequestPayloadShape request)+                                                                    salt+                                                                    (pkeskSessionKey sessionMaterial)+                                                                    pkeskPkts+                                                                    (recipientEncryptRequestPayload request)+                                                _missingSEIPDv2 ->+                                                    case recipientsMissingSEIPDv1Support targets of+                                                        [] ->+                                                            buildSEIPDv1PayloadWithIV+                                                                symalgo+                                                                sessionMaterial+                                                                pkeskPkts+                                                                Nothing+                                                        missingSEIPDv1 ->+                                                            pure+                                                                ( Left+                                                                    ( RecipientCapabilitySelectionFailure+                                                                        (RecipientCapabilityMissingSEIPDv1Support missingSEIPDv1)+                                                                    )+                                                                )+                                    RecipientEncryptRequestSEIPDv1Overrides+                                        { recipientEncryptRequestIVOverride = ivOverride+                                        } ->+                                            case recipientsMissingSEIPDv1Support targets of+                                                [] ->+                                                    buildSEIPDv1PayloadWithIV+                                                        symalgo+                                                        sessionMaterial+                                                        pkeskPkts+                                                        ivOverride+                                                missingSEIPDv1 ->+                                                    pure+                                                        ( Left+                                                            ( RecipientCapabilitySelectionFailure+                                                                (RecipientCapabilityMissingSEIPDv1Support missingSEIPDv1)+                                                            )+                                                        )+                                pure $+                                    fmap+                                        ( \pkts ->+                                            RecipientEncryptResult+                                                { recipientEncryptPackets = pkts+                                                , recipientEncryptSessionMaterial = sessionMaterial+                                                }+                                        )+                                        payloadResult+  where+    targets = recipientEncryptRequestTargets request+    profileW =+        profileForPayloadVersionW+            (recipientEncryptRequestOverrides request)+    messagePolicy =+        case profileW of+            EncryptStrictDefaultW ->+                policyMessageEncryption (policyForRFC RFC9580)+            EncryptInteropLegacyW ->+                policyMessageEncryption (policyForRFC RFC4880)++    buildSEIPDv1PayloadWithIV+        :: MonadRandom m+        => SymmetricAlgorithm+        -> PKESKSessionMaterial+        -> [Pkt]+        -> Maybe IV+        -> m (Either PKESKEncryptError [Pkt])+    buildSEIPDv1PayloadWithIV symalgo sessionMaterial pkeskPkts ivOverride = do+        ivResult <-+            case ivOverride of+                Just iv -> pure (Right iv)+                Nothing ->+                    let keyBytes = unSessionKey (pkeskSessionKey sessionMaterial)+                     in case withSymmetricCipher symalgo keyBytes (\c -> Right (blockSize c)) of+                            Left err -> pure (Left (PayloadBuildFailure (renderCipherError err)))+                            Right n -> fmap (Right . IV) (getRandomBytes n)+        case ivResult of+            Left err -> pure (Left err)+            Right iv ->+                pure $+                    buildEncryptedPacketSequenceWithShapeSEIPDv1+                        symalgo+                        iv+                        (recipientEncryptRequestPayloadShape request)+                        (pkeskSessionKey sessionMaterial)+                        pkeskPkts+                        (recipientEncryptRequestPayload request)++    recipientsMissingSEIPDv1Support+        :: [RecipientEncryptionTarget] -> [SomePKPayload]+    recipientsMissingSEIPDv1Support =+        map recipientEncryptionTargetKey+            . filter (not . targetAdvertisesSEIPDv1Support)++    recipientsMissingSEIPDv2Support+        :: [RecipientEncryptionTarget] -> [SomePKPayload]+    recipientsMissingSEIPDv2Support =+        map recipientEncryptionTargetKey+            . filter (not . targetAdvertisesSEIPDv2Support)++    targetAdvertisesSEIPDv1Support+        :: RecipientEncryptionTarget -> Bool+    targetAdvertisesSEIPDv1Support target =+        case recipientEncryptionTargetCapabilities target of+            Nothing -> True+            Just caps -> recipientCapabilityAdvertisesSEIPDv1Support caps++    targetAdvertisesSEIPDv2Support+        :: RecipientEncryptionTarget -> Bool+    targetAdvertisesSEIPDv2Support target =+        case recipientEncryptionTargetCapabilities target of+            Nothing -> True+            Just caps -> recipientCapabilityAdvertisesSEIPDv2Support caps++selectSymmetricAlgorithm+    :: RecipientCapabilityNegotiationMode+    -> RecipientEncryptRequest v+    -> MessageEncryptionPolicy+    -> [RecipientEncryptionTarget]+    -> Either PKESKEncryptError SymmetricAlgorithm+selectSymmetricAlgorithm negotiationMode request messagePolicy targets =+    case recipientEncryptRequestSymmetricOverride request of+        Just override -> Right override+        Nothing ->+            case negotiationMode of+                RecipientCapabilityNegotiationOff ->+                    Right (messageDefaultSymmetricAlgorithm messagePolicy)+                RecipientCapabilityNegotiationOn ->+                    negotiateSymmetricAlgorithm messagePolicy targets++selectAEADAlgorithm+    :: RecipientCapabilityNegotiationMode+    -> MessageEncryptionPolicy+    -> [RecipientEncryptionTarget]+    -> Maybe AEADAlgorithm+    -> Either PKESKEncryptError AEADAlgorithm+selectAEADAlgorithm negotiationMode messagePolicy targets override =+    case override of+        Just explicit -> Right explicit+        Nothing ->+            case negotiationMode of+                RecipientCapabilityNegotiationOff ->+                    Right (messageDefaultAEADAlgorithm messagePolicy)+                RecipientCapabilityNegotiationOn ->+                    negotiateAEADAlgorithm messagePolicy targets++negotiateSymmetricAlgorithm+    :: MessageEncryptionPolicy+    -> [RecipientEncryptionTarget]+    -> Either PKESKEncryptError SymmetricAlgorithm+negotiateSymmetricAlgorithm messagePolicy targets =+    chooseCommonAlgorithm+        policyOrder+        recipientChoices+        ( RecipientCapabilityNoCommonSymmetricAlgorithms+            (concat recipientChoices)+        )+  where+    policyOrder =+        case messageSEIPDv2SymmetricAlgorithms messagePolicy of+            [] -> [messageDefaultSymmetricAlgorithm messagePolicy]+            syms -> syms+    recipientChoices = map choicesForTarget targets+    choicesForTarget target =+        case recipientEncryptionTargetCapabilities target of+            Just caps ->+                let preferred = recipientCapabilityPreferredSymmetricAlgorithms caps+                    allowed = [alg | alg <- policyOrder, alg `elem` preferred]+                 in if null allowed+                        then policyOrder+                        else allowed+            Nothing -> policyOrder++negotiateAEADAlgorithm+    :: MessageEncryptionPolicy+    -> [RecipientEncryptionTarget]+    -> Either PKESKEncryptError AEADAlgorithm+negotiateAEADAlgorithm messagePolicy targets =+    chooseCommonAlgorithm+        policyOrder+        recipientChoices+        ( RecipientCapabilityNoCommonAEADAlgorithms+            (concat recipientChoices)+        )+  where+    policyOrder =+        foldl'+            addIfMissing+            []+            (messageDefaultAEADAlgorithm messagePolicy : [OCB, EAX, GCM])+    recipientChoices = map choicesForTarget targets+    choicesForTarget target =+        case recipientEncryptionTargetCapabilities target of+            Just caps ->+                let preferred = recipientCapabilityPreferredAEADAlgorithms caps+                    allowed = [alg | alg <- policyOrder, alg `elem` preferred]+                 in if null allowed+                        then policyOrder+                        else allowed+            Nothing -> policyOrder+    addIfMissing acc x+        | x `elem` acc = acc+        | otherwise = acc ++ [x]++chooseCommonAlgorithm+    :: Eq a+    => [a]+    -> [[a]]+    -> RecipientCapabilityError+    -> Either PKESKEncryptError a+chooseCommonAlgorithm policyOrder recipientChoices err =+    case recipientChoices of+        [] -> Left (RecipientCapabilitySelectionFailure err)+        (firstChoices : restChoices) ->+            let common = foldl' intersectOrdered firstChoices restChoices+                orderedCommon = [alg | alg <- policyOrder, alg `elem` common]+             in case orderedCommon of+                    (selected : _) -> Right selected+                    [] -> Left (RecipientCapabilitySelectionFailure err)+  where+    intersectOrdered as bs = [a | a <- as, a `elem` bs]++promoteRecipientStrategy+    :: RecipientPKESKVersionStrategy+    -> SomeRecipientPKESKVersionStrategyW+promoteRecipientStrategy RecipientPreferV6 =+    SomeRecipientPKESKVersionStrategyW RecipientPreferV6W+promoteRecipientStrategy RecipientForceV3Interop =+    SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW++demoteRecipientStrategy+    :: RecipientPKESKVersionStrategyW strategy+    -> RecipientPKESKVersionStrategy+demoteRecipientStrategy RecipientPreferV6W = RecipientPreferV6+demoteRecipientStrategy RecipientForceV3InteropW = RecipientForceV3Interop++demoteSomeRecipientStrategy+    :: SomeRecipientPKESKVersionStrategyW+    -> RecipientPKESKVersionStrategy+demoteSomeRecipientStrategy (SomeRecipientPKESKVersionStrategyW strategyW) =+    demoteRecipientStrategy strategyW++promoteEncryptCompatibilityProfile+    :: EncryptCompatibilityProfile+    -> SomeEncryptCompatibilityProfileW+promoteEncryptCompatibilityProfile EncryptStrictDefault =+    SomeEncryptCompatibilityProfileW EncryptStrictDefaultW+promoteEncryptCompatibilityProfile EncryptInteropLegacy =+    SomeEncryptCompatibilityProfileW EncryptInteropLegacyW++{- | High-level encrypt-side helper for public-key recipient encryption.++Returns a complete packet sequence:+@[PKESK ..., SEIPD2 ...]@.+-}+buildEncryptedPacketSequence+    :: SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> RecipientPayloadShape+    -> Salt+    -> SessionKey+    -> [Pkt]+    -> B.ByteString+    -> Either String [Pkt]+buildEncryptedPacketSequence symalgo aead chunkSize payloadShape salt sessionKey pkesks payload =+    first+        renderPKESKEncryptError+        ( buildEncryptedPacketSequenceWithShape+            symalgo+            aead+            chunkSize+            payloadShape+            salt+            sessionKey+            pkesks+            payload+        )++buildEncryptedPacketSequenceWithShape+    :: SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> RecipientPayloadShape+    -> Salt+    -> SessionKey+    -> [Pkt]+    -> B.ByteString+    -> Either PKESKEncryptError [Pkt]+buildEncryptedPacketSequenceWithShape symalgo aead chunkSize payloadShape salt sessionKey pkesks payload = do+    onePassSignatures <-+        first+            (PayloadBuildFailure . renderOPSBuildError)+            (buildOnePassSignaturePackets payloadShape)+    let signatures = recipientPayloadSignatures payloadShape+        literalBlock =+            Block+                ( onePassSignatures+                    ++ [ LiteralDataPkt+                            (recipientPayloadDataType payloadShape)+                            (recipientPayloadFileName payloadShape)+                            (recipientPayloadTimestamp payloadShape)+                            (BL.fromStrict payload)+                       ]+                    ++ map SignaturePkt signatures+                )+    ciphertext <-+        first PayloadBuildFailure $+            encryptSEIPDv2Payload+                symalgo+                aead+                chunkSize+                salt+                sessionKey+                (BL.toStrict (runPut (put literalBlock)))+    Right+        ( pkesks+            ++ [ SymEncIntegrityProtectedDataPkt+                    (SEIPD2 symalgo aead chunkSize salt (BL.fromStrict ciphertext))+               ]+        )++-- | Encrypt a plaintext block with OpenPGP CFB + MDC to produce a SEIPDv1 ciphertext.+encryptSEIPDv1Payload+    :: SymmetricAlgorithm+    -> IV+    -> SessionKey+    -> B.ByteString+    -- ^ inner packet block plaintext+    -> Either String B.ByteString+encryptSEIPDv1Payload symalgo iv (SessionKey keyBytes) plaintext =+    let cleartextWithMDC = plaintext <> mdcTrailerForSEIPDv1 iv plaintext+     in first+            renderCipherError+            ( encryptOpenPGPCfbRaw+                OpenPGPCFBNoResyncW+                symalgo+                iv+                cleartextWithMDC+                keyBytes+            )++-- | Build a complete RFC 4880-conformant packet sequence using SEIPDv1 (CFB + MDC).+buildEncryptedPacketSequenceWithShapeSEIPDv1+    :: SymmetricAlgorithm+    -> IV+    -> RecipientPayloadShape+    -> SessionKey+    -> [Pkt]+    -> B.ByteString+    -> Either PKESKEncryptError [Pkt]+buildEncryptedPacketSequenceWithShapeSEIPDv1 symalgo iv payloadShape sessionKey pkesks payload = do+    onePassSignatures <-+        first+            (PayloadBuildFailure . renderOPSBuildError)+            (buildOnePassSignaturePackets payloadShape)+    let signatures = recipientPayloadSignatures payloadShape+        literalBlock =+            Block+                ( onePassSignatures+                    ++ [ LiteralDataPkt+                            (recipientPayloadDataType payloadShape)+                            (recipientPayloadFileName payloadShape)+                            (recipientPayloadTimestamp payloadShape)+                            (BL.fromStrict payload)+                       ]+                    ++ map SignaturePkt signatures+                )+    ciphertext <-+        first PayloadBuildFailure $+            encryptSEIPDv1Payload+                symalgo+                iv+                sessionKey+                (BL.toStrict (runPut (put literalBlock)))+    Right+        ( pkesks+            ++ [ SymEncIntegrityProtectedDataPkt+                    (SEIPD1 1 (BL.fromStrict ciphertext))+               ]+        )++buildOnePassSignaturePackets+    :: RecipientPayloadShape -> Either OPSBuildError [Pkt]+buildOnePassSignaturePackets payloadShape+    | not (recipientPayloadUseOnePassSignatures payloadShape) =+        Right []+    | null signatures = Right []+    | otherwise =+        fmap (map OnePassSignaturePkt) $+            sequence+                (zipWith buildOnePassSignature nestedFlags (reverse signatures))+  where+    signatures = recipientPayloadSignatures payloadShape+    nestedFlags = replicate (length signatures - 1) True ++ [False]++data OnePassSignatureBuildCase where+    OnePassSignatureBuildCaseV3+        :: SignaturePayloadV 'SigPayloadV3 -> OnePassSignatureBuildCase+    OnePassSignatureBuildCaseV4+        :: SignaturePayloadV 'SigPayloadV4 -> OnePassSignatureBuildCase+    OnePassSignatureBuildCaseV6+        :: SignaturePayloadV 'SigPayloadV6 -> OnePassSignatureBuildCase+    OnePassSignatureBuildCaseOther+        :: PacketVersion -> OnePassSignatureBuildCase++onePassSignatureBuildCase+    :: SignaturePayload -> OnePassSignatureBuildCase+onePassSignatureBuildCase sig =+    case toSomeSignaturePayload sig of+        SomeSignaturePayload (payload@SigPayloadV3Data {}) ->+            OnePassSignatureBuildCaseV3 payload+        SomeSignaturePayload (payload@SigPayloadV4Data {}) ->+            OnePassSignatureBuildCaseV4 payload+        SomeSignaturePayload (payload@SigPayloadV6Data {}) ->+            OnePassSignatureBuildCaseV6 payload+        SomeSignaturePayload (SigPayloadOtherData version _) ->+            OnePassSignatureBuildCaseOther version++buildOnePassSignature+    :: NestedFlag+    -> SignaturePayload+    -> Either OPSBuildError OnePassSignaturePayload+buildOnePassSignature nestedFlag sig =+    case onePassSignatureBuildCase sig of+        OnePassSignatureBuildCaseV3+            (SigPayloadV3Data sigType _ issuerKeyId pubkeyAlgo hashAlgo _ _) ->+                Right+                    ( OPSPayloadV3Packet+                        (OPSPayloadV3 3 sigType hashAlgo pubkeyAlgo issuerKeyId nestedFlag)+                    )+        OnePassSignatureBuildCaseV4+            ( SigPayloadV4Data+                    sigType+                    pubkeyAlgo+                    hashAlgo+                    hashedSubpackets+                    unhashedSubpackets+                    _+                    _+                ) ->+                case signatureIssuerKeyId hashedSubpackets unhashedSubpackets of+                    Just issuerKeyId ->+                        Right+                            ( OPSPayloadV3Packet+                                (OPSPayloadV3 3 sigType hashAlgo pubkeyAlgo issuerKeyId nestedFlag)+                            )+                    Nothing ->+                        Left OPSBuildMissingIssuerKeyId+        OnePassSignatureBuildCaseV6+            ( SigPayloadV6Data+                    sigType+                    pubkeyAlgo+                    hashAlgo+                    salt+                    hashedSubpackets+                    unhashedSubpackets+                    _+                    _+                ) ->+                case signatureIssuerFingerprint+                    ( BTypes.issuerFingerprintVersionToPacketVersion+                        BTypes.IssuerFingerprintV6+                    )+                    hashedSubpackets+                    unhashedSubpackets of+                    Just signerFingerprint+                        | BL.length signerFingerprint == 32 ->+                            Right+                                ( OPSPayloadV6Packet+                                    ( OPSPayloadV6+                                        sigType+                                        hashAlgo+                                        pubkeyAlgo+                                        salt+                                        signerFingerprint+                                        nestedFlag+                                    )+                                )+                        | otherwise ->+                            Left+                                (OPSBuildFingerprintWrongLength (BL.length signerFingerprint))+                    Nothing ->+                        Left OPSBuildMissingIssuerFingerprint+        OnePassSignatureBuildCaseOther version ->+            Left (OPSBuildUnsupportedSigVersion version)++signatureIssuerKeyId+    :: [SigSubPacket] -> [SigSubPacket] -> Maybe EightOctetKeyId+signatureIssuerKeyId hashedSubpackets unhashedSubpackets =+    case findIssuerKeyId hashedSubpackets of+        Just issuerKeyId -> Just issuerKeyId+        Nothing ->+            case findIssuerKeyId unhashedSubpackets of+                Just issuerKeyId -> Just issuerKeyId+                Nothing ->+                    case signatureIssuerFingerprint+                        ( BTypes.issuerFingerprintVersionToPacketVersion+                            BTypes.IssuerFingerprintV4+                        )+                        hashedSubpackets+                        unhashedSubpackets of+                        Just issuerFingerprintBytes ->+                            if BL.length issuerFingerprintBytes >= 8+                                then+                                    Just+                                        ( EightOctetKeyId+                                            ( BL.drop+                                                (BL.length issuerFingerprintBytes - 8)+                                                issuerFingerprintBytes+                                            )+                                        )+                                else Nothing+                        Nothing -> Nothing++signatureIssuerFingerprint+    :: PacketVersion+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> Maybe BL.ByteString+signatureIssuerFingerprint expectedVersion hashedSubpackets unhashedSubpackets =+    unFingerprint+        <$> findIssuerFingerprint+            expectedVersion+            hashedSubpackets+            unhashedSubpackets++findIssuerKeyId :: [SigSubPacket] -> Maybe EightOctetKeyId+findIssuerKeyId subpackets =+    case find isIssuerKeyIdSubpacket subpackets of+        Just (SigSubPacket _ (Issuer issuerKeyId)) -> Just issuerKeyId+        _ -> Nothing++findIssuerFingerprint+    :: PacketVersion+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> Maybe Fingerprint+findIssuerFingerprint expectedVersion hashedSubpackets unhashedSubpackets =+    case findIssuerFingerprintIn expectedVersion hashedSubpackets of+        Just issuerFingerprint -> Just issuerFingerprint+        Nothing -> findIssuerFingerprintIn expectedVersion unhashedSubpackets++findIssuerFingerprintIn+    :: PacketVersion -> [SigSubPacket] -> Maybe Fingerprint+findIssuerFingerprintIn expectedVersion subpackets =+    case find (isIssuerFingerprintSubpacket expectedVersion) subpackets of+        Just (SigSubPacket _ (IssuerFingerprint _ issuerFingerprint)) -> Just issuerFingerprint+        _ -> Nothing++isIssuerKeyIdSubpacket :: SigSubPacket -> Bool+isIssuerKeyIdSubpacket (SigSubPacket _ (Issuer _)) = True+isIssuerKeyIdSubpacket _ = False++isIssuerFingerprintSubpacket+    :: PacketVersion -> SigSubPacket -> Bool+isIssuerFingerprintSubpacket expectedVersion (SigSubPacket _ (IssuerFingerprint version _)) =+    BTypes.issuerFingerprintVersionToPacketVersion version+        == expectedVersion+isIssuerFingerprintSubpacket _ _ = False++buildRsaPKESKv6+    :: MonadRandom m+    => SomePKPayload+    -> PKESKSessionMaterial+    -> m (Either PKESKEncryptError PKESKPayloadV6)+buildRsaPKESKv6 recipient material =+    case _pubkey recipient of+        RSAPubKey (RSA_PublicKey publicKey) -> do+            encrypted <-+                RSA15.encrypt publicKey (pkeskEncodedSessionMaterial material)+            pure $+                fmap+                    ( \esk ->+                        let mpiEsk = runPut (put (MPI (os2ip esk)))+                         in PKESKPayloadV6 (recipientKeyIdentifier recipient) RSA mpiEsk+                    )+                    (first (RecipientKeyWrapFailure RSA . show) encrypted)+        _ ->+            pure+                ( Left+                    ( InvalidRecipientKeyMaterial+                        RSA+                        "recipient PKPayload does not contain an RSA public key"+                    )+                )++buildRsaPKESKv3+    :: MonadRandom m+    => SomePKPayload+    -> PKESKV3SessionMaterial+    -> m (Either PKESKEncryptError PKESKPayloadV3)+buildRsaPKESKv3 recipient material =+    case _pubkey recipient of+        RSAPubKey (RSA_PublicKey publicKey) ->+            case eightOctetKeyID recipient of+                Left err ->+                    pure+                        ( Left+                            ( InvalidRecipientKeyMaterial+                                (_pkalgo recipient)+                                ("failed to derive PKESKv3 recipient key ID: " ++ err)+                            )+                        )+                Right eoki -> do+                    encrypted <-+                        RSA15.encrypt publicKey (unPKESKV3SessionMaterial material)+                    pure $+                        fmap+                            ( \esk ->+                                PKESKPayloadV3+                                    3+                                    eoki+                                    (_pkalgo recipient)+                                    (MPI (os2ip esk) :| [])+                            )+                            ( first+                                (RecipientKeyWrapFailure (_pkalgo recipient) . show)+                                encrypted+                            )+        _ ->+            pure+                ( Left+                    ( InvalidRecipientKeyMaterial+                        (_pkalgo recipient)+                        "recipient PKPayload does not contain an RSA public key"+                    )+                )++buildECDHPKESKv3+    :: MonadRandom m+    => SomePKPayload+    -> PKESKV3SessionMaterial+    -> m (Either PKESKEncryptError PKESKPayloadV3)+buildECDHPKESKv3 recipient material =+    case _pubkey recipient of+        ECDHPubKey ecdhPub kdfHA kdfSA ->+            case eightOctetKeyID recipient of+                Left err ->+                    pure+                        ( Left+                            ( InvalidRecipientKeyMaterial+                                ECDH+                                ("failed to derive PKESKv3 recipient key ID: " ++ err)+                            )+                        )+                Right eoki ->+                    case ecdhPub of+                        ECDSAPubKey (ECDSA_PublicKey recipientPub) -> do+                            (ephemeralPub, ephemeralPriv) <-+                                ECCGen.generate (ECDSA.public_curve recipientPub)+                            case point2MBS (ECDSA.public_q ephemeralPub) of+                                Nothing ->+                                    pure+                                        ( Left+                                            ( InvalidRecipientKeyMaterial+                                                ECDH+                                                "failed to serialize ECDH ephemeral point"+                                            )+                                        )+                                Just ephemeralBytes ->+                                    pure $+                                        buildEcdhV3Payload+                                            recipient+                                            eoki+                                            ECDH+                                            ecdhPub+                                            kdfHA+                                            kdfSA+                                            ephemeralBytes+                                            ( BA.convert+                                                ( ECCDH.getShared+                                                    (ECDSA.public_curve recipientPub)+                                                    (ECDSA.private_d ephemeralPriv)+                                                    (ECDSA.public_q recipientPub)+                                                )+                                                :: B.ByteString+                                            )+                                            material+                        EdDSAPubKey EdSigningCurve25519 recipientPoint -> do+                            ephSecretRaw <- getRandomBytes 32+                            pure $+                                do+                                    recipientPublicBytes <-+                                        normalizeX25519Public (edPointBytes recipientPoint)+                                    ephSecret <-+                                        first (RecipientKeyWrapFailure ECDH . show)+                                            . CE.eitherCryptoError+                                            $ C25519.secretKey (leftPadTo 32 ephSecretRaw)+                                    recipientPub <-+                                        first (RecipientKeyWrapFailure ECDH . show)+                                            . CE.eitherCryptoError+                                            $ C25519.publicKey recipientPublicBytes+                                    let ephPublicBytes =+                                            B.cons+                                                0x40+                                                (BA.convert (C25519.toPublic ephSecret) :: B.ByteString)+                                        sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+                                    buildEcdhV3Payload+                                        recipient+                                        eoki+                                        ECDH+                                        ecdhPub+                                        kdfHA+                                        kdfSA+                                        ephPublicBytes+                                        sharedSecret+                                        material+                        _ ->+                            pure+                                ( Left+                                    ( InvalidRecipientKeyMaterial+                                        ECDH+                                        "recipient ECDH public key is not RFC6637-compatible"+                                    )+                                )+        _ ->+            pure+                ( Left+                    ( InvalidRecipientKeyMaterial+                        ECDH+                        "recipient PKPayload does not contain ECDH public key material"+                    )+                )++buildECDHPKESKv6+    :: MonadRandom m+    => SomePKPayload+    -> PKESKSessionMaterial+    -> m (Either PKESKEncryptError PKESKPayloadV6)+buildECDHPKESKv6 recipient material =+    case _pubkey recipient of+        ECDHPubKey ecdhPub kdfHA kdfSA ->+            case ecdhPub of+                ECDSAPubKey (ECDSA_PublicKey recipientPub) -> do+                    (ephemeralPub, ephemeralPriv) <-+                        ECCGen.generate (ECDSA.public_curve recipientPub)+                    case point2MBS (ECDSA.public_q ephemeralPub) of+                        Nothing ->+                            pure+                                ( Left+                                    ( InvalidRecipientKeyMaterial+                                        ECDH+                                        "failed to serialize ECDH ephemeral point"+                                    )+                                )+                        Just ephemeralBytes ->+                            pure $+                                buildEcdhV6Esk+                                    recipient+                                    ECDH+                                    ecdhPub+                                    kdfHA+                                    kdfSA+                                    ephemeralBytes+                                    ( BA.convert+                                        ( ECCDH.getShared+                                            (ECDSA.public_curve recipientPub)+                                            (ECDSA.private_d ephemeralPriv)+                                            (ECDSA.public_q recipientPub)+                                        )+                                        :: B.ByteString+                                    )+                                    material+                EdDSAPubKey EdSigningCurve25519 recipientPoint -> do+                    ephSecretRaw <- getRandomBytes 32+                    pure $+                        do+                            recipientPublicBytes <-+                                normalizeX25519Public (edPointBytes recipientPoint)+                            ephSecret <-+                                first (RecipientKeyWrapFailure ECDH . show)+                                    . CE.eitherCryptoError+                                    $ C25519.secretKey (leftPadTo 32 ephSecretRaw)+                            recipientPub <-+                                first (RecipientKeyWrapFailure ECDH . show)+                                    . CE.eitherCryptoError+                                    $ C25519.publicKey recipientPublicBytes+                            let ephPublicBytes = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+                                sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+                            buildEcdhV6Esk+                                recipient+                                ECDH+                                ecdhPub+                                kdfHA+                                kdfSA+                                ephPublicBytes+                                sharedSecret+                                material+                EdDSAPubKey EdSigningCurve448 recipientPoint -> do+                    ephSecretRaw <- getRandomBytes 56+                    pure $+                        do+                            recipientPublicBytes <-+                                normalizeX448Public (edPointBytes recipientPoint)+                            ephSecret <-+                                first (RecipientKeyWrapFailure ECDH . show)+                                    . CE.eitherCryptoError+                                    $ C448.secretKey (leftPadTo 56 ephSecretRaw)+                            recipientPub <-+                                first (RecipientKeyWrapFailure ECDH . show)+                                    . CE.eitherCryptoError+                                    $ C448.publicKey recipientPublicBytes+                            let ephPublicBytes = BA.convert (C448.toPublic ephSecret) :: B.ByteString+                                sharedSecret = BA.convert (C448.dh recipientPub ephSecret) :: B.ByteString+                            buildEcdhV6Esk+                                recipient+                                ECDH+                                ecdhPub+                                kdfHA+                                kdfSA+                                ephPublicBytes+                                sharedSecret+                                material+                _ ->+                    pure+                        ( Left+                            ( InvalidRecipientKeyMaterial+                                ECDH+                                "recipient ECDH public key is not ECDSA/X25519/X448-compatible"+                            )+                        )+        _ ->+            pure+                ( Left+                    ( InvalidRecipientKeyMaterial+                        ECDH+                        "recipient PKPayload does not contain ECDH public key material"+                    )+                )++buildX25519PKESKv6+    :: MonadRandom m+    => SomePKPayload+    -> PKESKV6RawSessionMaterial+    -> m (Either PKESKEncryptError PKESKPayloadV6)+buildX25519PKESKv6 recipient material = do+    ephSecretRaw <- getRandomBytes 32+    pure $+        do+            recipientPublic <- extractX25519RecipientPublic recipient+            ephSecret <-+                first (RecipientKeyWrapFailure X25519 . show)+                    . CE.eitherCryptoError+                    $ C25519.secretKey (leftPadTo 32 ephSecretRaw)+            recipientPub <-+                first (RecipientKeyWrapFailure X25519 . show)+                    . CE.eitherCryptoError+                    $ C25519.publicKey recipientPublic+            let ephPublicBytes = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+                sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+                kek = deriveX25519Kek ephPublicBytes recipientPublic sharedSecret+            wrapped <-+                first (RecipientKeyWrapFailure X25519)+                    . aesKeyWrapRFC3394 AES128 kek+                    $ unPKESKV6RawSessionMaterial material+            esk <- encodeV6X25519Esk ephPublicBytes wrapped+            Right+                ( PKESKPayloadV6+                    (recipientKeyIdentifier recipient)+                    X25519+                    (BL.fromStrict esk)+                )++buildX448PKESKv6+    :: MonadRandom m+    => SomePKPayload+    -> PKESKV6RawSessionMaterial+    -> m (Either PKESKEncryptError PKESKPayloadV6)+buildX448PKESKv6 recipient material = do+    ephSecretRaw <- getRandomBytes 56+    pure $+        do+            recipientPublic <- extractX448RecipientPublic recipient+            ephSecret <-+                first (RecipientKeyWrapFailure X448 . show)+                    . CE.eitherCryptoError+                    $ C448.secretKey (leftPadTo 56 ephSecretRaw)+            recipientPub <-+                first (RecipientKeyWrapFailure X448 . show)+                    . CE.eitherCryptoError+                    $ C448.publicKey recipientPublic+            let ephPublicBytes = BA.convert (C448.toPublic ephSecret) :: B.ByteString+                sharedSecret = BA.convert (C448.dh recipientPub ephSecret) :: B.ByteString+                kek = deriveX448Kek ephPublicBytes recipientPublic sharedSecret+            wrapped <-+                first (RecipientKeyWrapFailure X448)+                    . aesKeyWrapRFC3394 AES256 kek+                    $ unPKESKV6RawSessionMaterial material+            esk <- encodeV6X448Esk ephPublicBytes wrapped+            Right+                ( PKESKPayloadV6+                    (recipientKeyIdentifier recipient)+                    X448+                    (BL.fromStrict esk)+                )++buildEcdhV6Esk+    :: SomePKPayload+    -> PubKeyAlgorithm+    -> PKey+    -> HashAlgorithm+    -> SymmetricAlgorithm+    -> B.ByteString+    -> B.ByteString+    -> PKESKSessionMaterial+    -> Either PKESKEncryptError PKESKPayloadV6+buildEcdhV6Esk recipient pka ecdhPub kdfHA kdfSA ephemeralBytes sharedSecret material = do+    kdfParam <-+        first (RecipientKdfFailure pka) $+            buildECDHKDFParam recipient pka ecdhPub kdfHA kdfSA+    kek <-+        first (RecipientKdfFailure pka) $+            deriveECDHKek kdfHA kdfSA sharedSecret kdfParam+    wrapped <-+        first (RecipientKeyWrapFailure pka)+            . aesKeyWrapRFC3394 kdfSA kek+            $ padToMultipleOf8 (pkeskEncodedSessionMaterial material)+    esk <- encodeV6EcdhEsk ephemeralBytes wrapped+    Right+        ( PKESKPayloadV6+            (recipientKeyIdentifier recipient)+            pka+            (BL.fromStrict esk)+        )++buildEcdhV3Payload+    :: SomePKPayload+    -> EightOctetKeyId+    -> PubKeyAlgorithm+    -> PKey+    -> HashAlgorithm+    -> SymmetricAlgorithm+    -> B.ByteString+    -> B.ByteString+    -> PKESKV3SessionMaterial+    -> Either PKESKEncryptError PKESKPayloadV3+buildEcdhV3Payload recipient eoki pka ecdhPub kdfHA kdfSA ephemeralBytes sharedSecret material = do+    kdfParam <-+        first (RecipientKdfFailure pka) $+            buildECDHKDFParam recipient pka ecdhPub kdfHA kdfSA+    kek <-+        first (RecipientKdfFailure pka) $+            deriveECDHKek kdfHA kdfSA sharedSecret kdfParam+    wrapped <-+        first (RecipientKeyWrapFailure pka)+            . aesKeyWrapRFC3394 kdfSA kek+            $ padToMultipleOf8 (unPKESKV3SessionMaterial material)+    Right+        ( PKESKPayloadV3+            3+            eoki+            pka+            (MPI (os2ip ephemeralBytes) :| [MPI (os2ip wrapped)])+        )++recipientKeyIdentifier :: SomePKPayload -> BL.ByteString+recipientKeyIdentifier = unFingerprint . fingerprint++encodeV6EcdhEsk+    :: B.ByteString+    -> B.ByteString+    -> Either PKESKEncryptError B.ByteString+encodeV6EcdhEsk ephemeral wrapped = do+    let ephLen = B.length ephemeral+    if ephLen > 255+        then+            Left+                ( RecipientKeyWrapFailure+                    ECDH+                    "ephemeral key encoding is too large"+                )+        else+            Right (B.singleton (fromIntegral ephLen) <> ephemeral <> wrapped)++encodeV6X25519Esk+    :: B.ByteString+    -> B.ByteString+    -> Either PKESKEncryptError B.ByteString+encodeV6X25519Esk ephemeral wrapped+    | B.length ephemeral /= 32 =+        Left+            ( RecipientKeyWrapFailure+                X25519+                "X25519 ephemeral key must be exactly 32 octets"+            )+    | B.length wrapped > 255 =+        Left+            ( RecipientKeyWrapFailure+                X25519+                "wrapped session key encoding is too large"+            )+    | otherwise =+        Right+            ( ephemeral+                <> B.singleton (fromIntegral (B.length wrapped))+                <> wrapped+            )++encodeV6X448Esk+    :: B.ByteString+    -> B.ByteString+    -> Either PKESKEncryptError B.ByteString+encodeV6X448Esk ephemeral wrapped+    | B.length ephemeral /= 56 =+        Left+            ( RecipientKeyWrapFailure+                X448+                "X448 ephemeral key must be exactly 56 octets"+            )+    | B.length wrapped > 255 =+        Left+            ( RecipientKeyWrapFailure+                X448+                "wrapped session key encoding is too large"+            )+    | otherwise =+        Right+            ( ephemeral+                <> B.singleton (fromIntegral (B.length wrapped))+                <> wrapped+            )++extractX25519RecipientPublic+    :: SomePKPayload -> Either PKESKEncryptError B.ByteString+extractX25519RecipientPublic recipient =+    case _pubkey recipient of+        EdDSAPubKey EdSigningCurve25519 point ->+            normalizeX25519Public (edPointBytes point)+        ECDHPubKey (EdDSAPubKey EdSigningCurve25519 point) _ _ ->+            normalizeX25519Public (edPointBytes point)+        other ->+            Left+                ( InvalidRecipientKeyMaterial+                    X25519+                    ("expected X25519-compatible recipient key, got " ++ show other)+                )++extractX448RecipientPublic+    :: SomePKPayload -> Either PKESKEncryptError B.ByteString+extractX448RecipientPublic recipient =+    case _pubkey recipient of+        EdDSAPubKey EdSigningCurve448 point ->+            normalizeX448Public (edPointBytes point)+        ECDHPubKey (EdDSAPubKey EdSigningCurve448 point) _ _ ->+            normalizeX448Public (edPointBytes point)+        other ->+            Left+                ( InvalidRecipientKeyMaterial+                    X448+                    ("expected X448-compatible recipient key, got " ++ show other)+                )++normalizeX25519Public+    :: B.ByteString -> Either PKESKEncryptError B.ByteString+normalizeX25519Public =+    first (InvalidRecipientKeyMaterial X25519)+        . normalizeMontgomeryPublic+            32+            "invalid X25519 public key length/prefix: "++normalizeX448Public+    :: B.ByteString -> Either PKESKEncryptError B.ByteString+normalizeX448Public =+    first (InvalidRecipientKeyMaterial X448)+        . normalizeMontgomeryPublic+            56+            "invalid X448 public key length/prefix: "++edPointBytes :: EdPoint -> B.ByteString+edPointBytes (PrefixedNativeEPoint (EPoint x)) = i2osp x+edPointBytes (NativeEPoint (EPoint x)) = i2osp x++deriveX25519Kek+    :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString+deriveX25519Kek ephemeralPublic recipientPublic sharedSecret =+    let ikm = ephemeralPublic <> recipientPublic <> sharedSecret+        prk = extract @CHAlg.SHA256 B.empty ikm+        info = "OpenPGP X25519" :: B.ByteString+     in expand @CHAlg.SHA256 prk info 16++deriveX448Kek+    :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString+deriveX448Kek ephemeralPublic recipientPublic sharedSecret =+    let ikm = ephemeralPublic <> recipientPublic <> sharedSecret+        prk = extract @CHAlg.SHA512 B.empty ikm+        info = "OpenPGP X448" :: B.ByteString+     in expand @CHAlg.SHA512 prk info 32++padToMultipleOf8 :: B.ByteString -> B.ByteString+padToMultipleOf8 bs+    | padLen == 0 = bs+    | otherwise = bs <> B.replicate padLen (fromIntegral padLen)+  where+    rem8 = B.length bs `mod` 8+    padLen = if rem8 == 0 then 0 else 8 - rem8++checksum16 :: B.ByteString -> Word16+checksum16 =+    fromIntegral+        . B.foldl'+            (\acc octet -> (acc + fromIntegral octet) `mod` (65536 :: Integer))+            0++checksum16Bytes :: B.ByteString -> B.ByteString+checksum16Bytes bs =+    B.pack+        [ fromIntegral ((chk `shiftR` 8) .&. 0xff)+        , fromIntegral (chk .&. 0xff)+        ]+  where+    chk = checksum16 bs++aesKeyWrapRFC3394+    :: SymmetricAlgorithm+    -> B.ByteString+    -> B.ByteString+    -> Either String B.ByteString+aesKeyWrapRFC3394 sa kek plain =+    withAESCipher+        "ECDH PKESK currently supports AES KEK algorithms only"+        sa+        kek+        wrapWithCipher+  where+    wrapWithCipher+        :: CCT.BlockCipher cipher => cipher -> Either String B.ByteString+    wrapWithCipher cipher = do+        if B.length plain < 16 || B.length plain `mod` 8 /= 0+            then+                Left+                    "ECDH key wrap input must be at least 16 octets and a multiple of 8"+            else Right ()+        let rs = chunksOf8 plain+        if length rs < 2+            then+                Left+                    "ECDH key wrap input must contain at least two 64-bit blocks"+            else Right ()+        (aFinal, rFinal) <- wrapRounds cipher (B.replicate 8 0xA6) rs+        Right (aFinal <> B.concat rFinal)+    wrapRounds+        :: CCT.BlockCipher cipher+        => cipher+        -> B.ByteString+        -> [B.ByteString]+        -> Either String (B.ByteString, [B.ByteString])+    wrapRounds cipher aInit rsInit = goJ 0 aInit rsInit+      where+        n = length rsInit+        goJ j a rs+            | j > 5 = Right (a, rs)+            | otherwise = do+                (a', rs') <- goI 1 a rs+                goJ (j + 1) a' rs'+          where+            goI i curA curRs+                | i > n = Right (curA, curRs)+                | otherwise = do+                    let t = fromIntegral (n * j + i) :: Word64+                        rI = curRs !! (i - 1)+                        block = CCT.ecbEncrypt cipher (curA <> rI)+                        (msb, lsb) = B.splitAt 8 block+                        aNext = xorBS msb (encodeWord64be t)+                        rsNext = (ix (i - 1) .~ lsb) curRs+                    goI (i + 1) aNext rsNext++chunksOf8 :: B.ByteString -> [B.ByteString]+chunksOf8 bs+    | B.null bs = []+    | otherwise =+        let (h, t) = B.splitAt 8 bs+         in h : chunksOf8 t++xorBS :: B.ByteString -> B.ByteString -> B.ByteString+xorBS a b = B.pack (B.zipWith xor a b)++encryptSEIPDv1WithSKESK+    :: MonadRandom m+    => SymmetricAlgorithm+    -> S2K+    -> Maybe IV+    -> BL.ByteString+    -> B.ByteString+    -> m (Either String [Pkt])+encryptSEIPDv1WithSKESK symalgo s2k ivOverride passphrase literalPayload = do+    let eSessionKey = do+            keyLen <- symKeySize symalgo+            first renderS2KError (string2Key s2k keyLen passphrase)+    case eSessionKey of+        Left err -> pure (Left err)+        Right sessionKeyMaterial ->+            case first+                renderCipherError+                (withSymmetricCipher symalgo sessionKeyMaterial (pure . blockSize)) of+                Left err -> pure (Left err)+                Right ivLength -> do+                    ivBytes <-+                        maybe+                            (getRandomBytes ivLength)+                            (pure . unIV)+                            ivOverride+                    let iv = IV ivBytes+                    let sessionKey = SessionKey sessionKeyMaterial+                    case encryptSEIPDv1Payload symalgo iv sessionKey literalPayload of+                        Left err -> pure (Left err)+                        Right encrypted ->+                            pure+                                ( Right+                                    [ SKESKPkt+                                        ( SKESKPayloadV4Packet+                                            (SKESKPayloadV4 symalgo s2k Nothing)+                                        )+                                    , SymEncIntegrityProtectedDataPkt+                                        (SEIPD1 1 (BL.fromStrict encrypted))+                                    ]+                                )++encryptSEIPDv2WithSKESK+    :: SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> Salt+    -> S2K+    -> BL.ByteString+    -> B.ByteString+    -> Either String [Pkt]+encryptSEIPDv2WithSKESK symalgo aead chunkSize salt s2k passphrase literalPayload = do+    keyLen <- symKeySize symalgo+    sessionKeyMaterial <-+        first renderS2KError (string2Key s2k keyLen passphrase)+    (_, nonceSize) <-+        aeadModeAndNonceSizeForSEIPDv2+            "unsupported AEAD algorithm for SKESK v6 encrypt"+            aead+    when (B.length (unSalt salt) < nonceSize) $+        Left "SEIPD v2 salt is too short to derive the SKESK v6 IV"+    let skeskIV = B.take nonceSize (unSalt salt)+    kek <- deriveSKESK6KEK symalgo aead sessionKeyMaterial+    (wrappedSessionKey, skeskTag) <-+        encryptSKESK6SessionKey+            symalgo+            aead+            kek+            skeskIV+            sessionKeyMaterial+    let sessionKey = SessionKey sessionKeyMaterial+    encrypted <-+        encryptSEIPDv2Payload+            symalgo+            aead+            chunkSize+            salt+            sessionKey+            literalPayload+    return+        [ SKESKPkt+            ( SKESKPayloadV6Packet+                ( SKESKPayloadV6+                    symalgo+                    aead+                    s2k+                    (BL.fromStrict skeskIV)+                    (BL.fromStrict wrappedSessionKey)+                    (BL.fromStrict skeskTag)+                )+            )+        , SymEncIntegrityProtectedDataPkt+            (SEIPD2 symalgo aead chunkSize salt (BL.fromStrict encrypted))+        ]++encryptSEIPDv2WithSKESKBlock+    :: SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> Salt+    -> S2K+    -> BL.ByteString+    -> Block Pkt+    -> Either String [Pkt]+encryptSEIPDv2WithSKESKBlock symalgo aead chunkSize salt s2k passphrase packetBlock =+    encryptSEIPDv2WithSKESK+        symalgo+        aead+        chunkSize+        salt+        s2k+        passphrase+        (BL.toStrict (runPut (put packetBlock)))++encryptSEIPDv2LiteralDataWithSKESK+    :: SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> Salt+    -> S2K+    -> BL.ByteString+    -> B.ByteString+    -> Either String [Pkt]+encryptSEIPDv2LiteralDataWithSKESK symalgo aead chunkSize salt s2k passphrase payload =+    encryptSEIPDv2WithSKESKBlock+        symalgo+        aead+        chunkSize+        salt+        s2k+        passphrase+        ( Block+            [ LiteralDataPkt+                BinaryData+                BL.empty+                (ThirtyTwoBitTimeStamp 0)+                (BL.fromStrict payload)+            ]+        )++encryptSEIPDv2Payload+    :: SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> Salt+    -> SessionKey+    -> B.ByteString+    -> Either String B.ByteString+encryptSEIPDv2Payload symalgo aead chunkSize salt (SessionKey sessionKey) plaintext = do+    (mode, nonceSize) <- aeadModeAndNonceSize aead+    keyLen <- symKeySize symalgo+    let outputLen = keyLen + nonceSize - 8+        info = B.pack [0xd2, 2, fromFVal symalgo, fromFVal aead, chunkSize]+        prk = extract @CHAlg.SHA256 (unSalt salt) sessionKey+        okm = expand @CHAlg.SHA256 prk info outputLen :: B.ByteString+        messageKey = B.take keyLen okm+        noncePrefix = B.take (nonceSize - 8) (B.drop keyLen okm)+    withAESCipher+        "SEIPD v2 encrypt currently supports AES-128/192/256 only"+        symalgo+        messageKey+        (encryptChunks mode info chunkSize noncePrefix plaintext)++encryptChunks+    :: CCT.BlockCipher cipher+    => CCT.AEADMode+    -> B.ByteString+    -> Word8+    -> B.ByteString+    -> B.ByteString+    -> cipher+    -> Either String B.ByteString+encryptChunks mode info chunkSize noncePrefix plaintext cipher = go 0 plaintext [] 0+  where+    chunkLen = 1 `shiftL` (fromIntegral chunkSize + 6)+    go idx remaining acc totalPlain+        | B.null remaining = do+            (finalTag, finalCipher) <-+                if mode == CCT.AEAD_OCB+                    then+                        encryptWithOCBRFC7253+                            cipher+                            (noncePrefix <> encodeWord64be idx)+                            (info <> encodeWord64be (fromIntegral totalPlain))+                            B.empty+                    else do+                        aead <- initAEAD idx+                        let (tag, out) =+                                CCT.aeadSimpleEncrypt+                                    aead+                                    (info <> encodeWord64be (fromIntegral totalPlain))+                                    B.empty+                                    16+                        Right (tag, out)+            if B.null finalCipher+                then return (B.concat (reverse acc) <> authTagToBS finalTag)+                else Left "expected empty ciphertext for final SEIPD v2 tag"+        | otherwise = do+            let (chunkPlain, rest) = B.splitAt chunkLen remaining+            (tag, chunkCipher) <-+                if mode == CCT.AEAD_OCB+                    then+                        encryptWithOCBRFC7253+                            cipher+                            (noncePrefix <> encodeWord64be idx)+                            info+                            chunkPlain+                    else do+                        aead <- initAEAD idx+                        pure (CCT.aeadSimpleEncrypt aead info chunkPlain 16)+            let chunkOut = chunkCipher <> authTagToBS tag+            go+                (idx + 1)+                rest+                (chunkOut : acc)+                (totalPlain + B.length chunkPlain)++    initAEAD idx =+        first show . CE.eitherCryptoError $+            CCT.aeadInit mode cipher (noncePrefix <> encodeWord64be idx)++aeadModeAndNonceSize+    :: AEADAlgorithm -> Either String (CCT.AEADMode, Int)+aeadModeAndNonceSize =+    aeadModeAndNonceSizeForSEIPDv2+        "unsupported AEAD algorithm for SEIPD v2 encrypt"++symKeySize :: SymmetricAlgorithm -> Either String Int+symKeySize =+    seipdv2SymmetricKeySize+        "unsupported symmetric algorithm for SEIPD v2 encrypt"++authTagToBS :: CCT.AuthTag -> B.ByteString+authTagToBS = BA.convert . CCT.unAuthTag++encodeWord64be :: Word64 -> B.ByteString+encodeWord64be = BL.toStrict . runPut . putWord64be++{- | Compose a complete AEAD-encrypted message with optional literal data and signature.+Returns a packet list (SKESK, SEIPD v2, optional signature) ready for serialization.++Example: @composeMessageWithSEIPDv2 AES256 OCB 6 (Salt 32 bytes)+           (SimpleS2K SHA256) passphrase payload Nothing@+returns @[SKESK v6, SEIPD v2, <ciphertext>]@++If the signature is provided, it will be included in the encrypted payload.+-}+composeMessageWithSEIPDv2+    :: SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> Salt+    -> S2K+    -> BL.ByteString+    -> B.ByteString+    -> Maybe [Pkt]+    -> Either String [Pkt]+composeMessageWithSEIPDv2 symalgo aead chunkSize salt s2k passphrase payload mSigs = do+    let packets = case mSigs of+            Nothing ->+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    (BL.fromStrict payload)+                ]+            Just sigs ->+                LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    (BL.fromStrict payload)+                    : sigs+        blockPayload = Block packets+    encryptSEIPDv2WithSKESKBlock+        symalgo+        aead+        chunkSize+        salt+        s2k+        passphrase+        blockPayload
Codec/Encryption/OpenPGP/Internal.hs view
@@ -2,35 +2,33 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).- {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}  module Codec.Encryption.OpenPGP.Internal-  ( countBits-  , PktStreamContext(..)-  , issuer-  , issuerFP-  , emptyPSC-  , leftPadTo-  , pubkeyToMPIs-  , multiplicativeInverse-  , curveoidBSToCurve-  , curveToCurveoidBS-  , point2MBS-  , curveoidBSToEdSigningCurve-  , edSigningCurveToCurveoidBS-  , curve2Curve-  , curveFromCurve-  ) where+    ( countBits+    , PktStreamContext (..)+    , issuer+    , issuerFP+    , emptyPSC+    , leftPadTo+    , pubkeyToMPIs+    , multiplicativeInverse+    , curveoidBSToCurve+    , curveToCurveoidBS+    , point2MBS+    , curveoidBSToEdSigningCurve+    , edSigningCurveToCurveoidBS+    , curve2Curve+    , curveFromCurve+    ) where  import Crypto.Number.Serialize (i2osp, os2ip) import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.ECC.Types as ECCT import qualified Crypto.PubKey.RSA as RSA- import Data.Bits (testBit) import qualified Data.ByteString as B import Data.ByteString.Lazy (ByteString)@@ -38,24 +36,28 @@ import Data.List (find) import Data.Word (Word16, Word8) -import Codec.Encryption.OpenPGP.Ontology (isIssuerSSP, isSigCreationTime)+import Codec.Encryption.OpenPGP.Ontology+    ( isIssuerSSP+    , isSigCreationTime+    ) import Codec.Encryption.OpenPGP.Types  countBits :: ByteString -> Word16 countBits bs-  | BL.null bs = 0-  | otherwise =-    fromIntegral (BL.length bs * 8) - fromIntegral (go (BL.head bs) 7)+    | BL.null bs = 0+    | otherwise =+        fromIntegral (BL.length bs * 8)+            - fromIntegral (go (BL.head bs) 7)   where     go :: Word8 -> Int -> Word8     go _ 0 = 7     go n b =-      if testBit n b-        then 7 - fromIntegral b-        else go n (b - 1)+        if testBit n b+            then 7 - fromIntegral b+            else go n (b - 1) -data PktStreamContext =-  PktStreamContext+data PktStreamContext+    = PktStreamContext     { lastLD :: Pkt     , lastUIDorUAt :: Pkt     , lastSig :: Pkt@@ -65,47 +67,50 @@  emptyPSC :: PktStreamContext emptyPSC =-  PktStreamContext-    (OtherPacketPkt 0 "lastLD placeholder")-    (OtherPacketPkt 0 "lastUIDorUAt placeholder")-    (OtherPacketPkt 0 "lastSig placeholder")-    (OtherPacketPkt 0 "lastPrimaryKey placeholder")-    (OtherPacketPkt 0 "lastSubkey placeholder")+    PktStreamContext+        (OtherPacketPkt 0 "lastLD placeholder")+        (OtherPacketPkt 0 "lastUIDorUAt placeholder")+        (OtherPacketPkt 0 "lastSig placeholder")+        (OtherPacketPkt 0 "lastPrimaryKey placeholder")+        (OtherPacketPkt 0 "lastSubkey placeholder")  leftPadTo :: Int -> B.ByteString -> B.ByteString leftPadTo targetLen bs-  | B.length bs >= targetLen = bs-  | otherwise = B.replicate (targetLen - B.length bs) 0 <> bs+    | B.length bs >= targetLen = bs+    | otherwise = B.replicate (targetLen - B.length bs) 0 <> bs  issuer :: Pkt -> Maybe EightOctetKeyId issuer pkt =-  case fromPktIssuerExtractionCase pkt of-    Just extractionCase ->-      find isIssuerSSP (unhashedSubpackets extractionCase) >>= issuerFromSubpacket-    Nothing -> Nothing+    case fromPktIssuerExtractionCase pkt of+        Just extractionCase ->+            find isIssuerSSP (unhashedSubpackets extractionCase)+                >>= issuerFromSubpacket+        Nothing -> Nothing  issuerFP :: Pkt -> Maybe Fingerprint issuerFP pkt =-  case fromPktIssuerExtractionCase pkt of-    Just extractionCase ->-      find-        (isIssuerFingerprintFor (issuerFingerprintVersion extractionCase))-        (hashedSubpackets extractionCase) >>=-      issuerFingerprintFromSubpacket-    Nothing -> Nothing+    case fromPktIssuerExtractionCase pkt of+        Just extractionCase ->+            find+                (isIssuerFingerprintFor (issuerFingerprintVersion extractionCase))+                (hashedSubpackets extractionCase)+                >>= issuerFingerprintFromSubpacket+        Nothing -> Nothing  data IssuerExtractionCase where-  IssuerExtractionCaseV4 :: SignaturePayloadV 'SigPayloadV4 -> IssuerExtractionCase-  IssuerExtractionCaseV6 :: SignaturePayloadV 'SigPayloadV6 -> IssuerExtractionCase+    IssuerExtractionCaseV4+        :: SignaturePayloadV 'SigPayloadV4 -> IssuerExtractionCase+    IssuerExtractionCaseV6+        :: SignaturePayloadV 'SigPayloadV6 -> IssuerExtractionCase  fromPktIssuerExtractionCase :: Pkt -> Maybe IssuerExtractionCase fromPktIssuerExtractionCase pkt =-  case fromPktEitherSomeSignatureV pkt of-    Right (SomeSignatureV (SignatureV4Packet payload)) ->-      Just (IssuerExtractionCaseV4 payload)-    Right (SomeSignatureV (SignatureV6Packet payload)) ->-      Just (IssuerExtractionCaseV6 payload)-    _ -> Nothing+    case fromPktEitherSomeSignatureV pkt of+        Right (SomeSignatureV (SignatureV4Packet payload)) ->+            Just (IssuerExtractionCaseV4 payload)+        Right (SomeSignatureV (SignatureV6Packet payload)) ->+            Just (IssuerExtractionCaseV6 payload)+        _ -> Nothing  hashedSubpackets :: IssuerExtractionCase -> [SigSubPacket] hashedSubpackets (IssuerExtractionCaseV4 (SigPayloadV4Data _ _ _ hsubs _ _ _)) = hsubs@@ -115,16 +120,19 @@ unhashedSubpackets (IssuerExtractionCaseV4 (SigPayloadV4Data _ _ _ _ usubs _ _)) = usubs unhashedSubpackets (IssuerExtractionCaseV6 (SigPayloadV6Data _ _ _ _ _ usubs _ _)) = usubs -issuerFingerprintVersion :: IssuerExtractionCase -> IssuerFingerprintVersion+issuerFingerprintVersion+    :: IssuerExtractionCase -> IssuerFingerprintVersion issuerFingerprintVersion IssuerExtractionCaseV4 {} = IssuerFingerprintV4 issuerFingerprintVersion IssuerExtractionCaseV6 {} = IssuerFingerprintV6 -isIssuerFingerprintFor :: IssuerFingerprintVersion -> SigSubPacket -> Bool+isIssuerFingerprintFor+    :: IssuerFingerprintVersion -> SigSubPacket -> Bool isIssuerFingerprintFor version (SigSubPacket _ (IssuerFingerprint packetVersion _)) =-  packetVersion == version+    packetVersion == version isIssuerFingerprintFor _ _ = False -issuerFingerprintFromSubpacket :: SigSubPacket -> Maybe Fingerprint+issuerFingerprintFromSubpacket+    :: SigSubPacket -> Maybe Fingerprint issuerFingerprintFromSubpacket (SigSubPacket _ (IssuerFingerprint _ i)) = Just i issuerFingerprintFromSubpacket _ = Nothing @@ -134,28 +142,33 @@  pubkeyToMPIs :: PKey -> [MPI] pubkeyToMPIs (RSAPubKey (RSA_PublicKey k)) =-  [MPI (RSA.public_n k), MPI (RSA.public_e k)]+    [MPI (RSA.public_n k), MPI (RSA.public_e k)] pubkeyToMPIs (DSAPubKey (DSA_PublicKey k)) =-  [ pkParams DSA.params_p-  , pkParams DSA.params_q-  , pkParams DSA.params_g-  , MPI . DSA.public_y $ k-  ]+    [ pkParams DSA.params_p+    , pkParams DSA.params_q+    , pkParams DSA.params_g+    , MPI . DSA.public_y $ k+    ]   where     pkParams f = MPI . f . DSA.public_params $ k pubkeyToMPIs (ElGamalPubKey p g y) = [MPI p, MPI g, MPI y]-pubkeyToMPIs (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey _ q))) _ _) =-  [MPI (os2ip (pointToBSOrError q))]+pubkeyToMPIs+    ( ECDHPubKey+            (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey _ q)))+            _+            _+        ) =+        [MPI (os2ip (pointToBSOrError q))] pubkeyToMPIs (ECDHPubKey (EdDSAPubKey _ ep) _ _) = [MPI (edPointInteger ep)] pubkeyToMPIs (ECDSAPubKey ((ECDSA_PublicKey (ECDSA.PublicKey _ q)))) =-  [MPI (os2ip (pointToBSOrError q))]+    [MPI (os2ip (pointToBSOrError q))] pubkeyToMPIs (EdDSAPubKey _ ep) = [MPI (edPointInteger ep)]  edPointInteger :: EdPoint -> Integer edPointInteger (PrefixedNativeEPoint (EPoint x)) = x edPointInteger (NativeEPoint (EPoint x)) = x -multiplicativeInverse :: Integral a => a -> a -> a+multiplicativeInverse :: (Integral a) => a -> a -> a multiplicativeInverse _ 1 = 1 multiplicativeInverse q p = (n * q + 1) `div` p   where@@ -163,31 +176,37 @@  curveoidBSToCurve :: B.ByteString -> Either String ECCCurve curveoidBSToCurve oidbs-  | B.pack [0x2A, 0x86, 0x48, 0xCE, 0x3D, 0x03, 0x01, 0x07] == oidbs =-    Right $ NISTP256 -- ECCT.getCurveByName ECCT.SEC_p256r1-  | B.pack [0x2B, 0x81, 0x04, 0x00, 0x22] == oidbs = Right $ NISTP384 -- ECCT.getCurveByName ECCT.SEC_p384r1-  | B.pack [0x2B, 0x81, 0x04, 0x00, 0x23] == oidbs = Right $ NISTP521 -- ECCT.getCurveByName ECCT.SEC_p521r1-  | B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0x97, 0x55, 0x01, 0x05, 0x01] == oidbs =-    Right Curve25519-  | B.pack [0x2B, 0x65, 0x6F] == oidbs =-    Right Curve448-  | otherwise = Left $ concat ["unknown curve (...", show (B.unpack oidbs), ")"]+    | B.pack [0x2A, 0x86, 0x48, 0xCE, 0x3D, 0x03, 0x01, 0x07] == oidbs =+        Right $ NISTP256 -- ECCT.getCurveByName ECCT.SEC_p256r1+    | B.pack [0x2B, 0x81, 0x04, 0x00, 0x22] == oidbs =+        Right $ NISTP384 -- ECCT.getCurveByName ECCT.SEC_p384r1+    | B.pack [0x2B, 0x81, 0x04, 0x00, 0x23] == oidbs =+        Right $ NISTP521 -- ECCT.getCurveByName ECCT.SEC_p521r1+    | B.pack+        [0x2B, 0x06, 0x01, 0x04, 0x01, 0x97, 0x55, 0x01, 0x05, 0x01]+        == oidbs =+        Right Curve25519+    | B.pack [0x2B, 0x65, 0x6F] == oidbs =+        Right Curve448+    | otherwise =+        Left $ concat ["unknown curve (...", show (B.unpack oidbs), ")"]  curveToCurveoidBS :: ECCCurve -> Either String B.ByteString curveToCurveoidBS NISTP256 =-  Right $ B.pack [0x2A, 0x86, 0x48, 0xCE, 0x3D, 0x03, 0x01, 0x07]+    Right $ B.pack [0x2A, 0x86, 0x48, 0xCE, 0x3D, 0x03, 0x01, 0x07] curveToCurveoidBS NISTP384 = Right $ B.pack [0x2B, 0x81, 0x04, 0x00, 0x22] curveToCurveoidBS NISTP521 = Right $ B.pack [0x2B, 0x81, 0x04, 0x00, 0x23] curveToCurveoidBS Curve25519 =-  Right $ B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0x97, 0x55, 0x01, 0x05, 0x01]+    Right $+        B.pack+            [0x2B, 0x06, 0x01, 0x04, 0x01, 0x97, 0x55, 0x01, 0x05, 0x01] curveToCurveoidBS Curve448 = Right $ B.pack [0x2B, 0x65, 0x6F]-curveToCurveoidBS _ = Left "unknown curve"  point2MBS :: ECCT.PublicPoint -> Maybe B.ByteString point2MBS (ECCT.Point x y)-  | B.null xb || B.null yb = Nothing-  | B.length xb /= B.length yb = Nothing-  | otherwise = Just (B.concat [B.singleton 0x04, xb, yb])+    | B.null xb || B.null yb = Nothing+    | B.length xb /= B.length yb = Nothing+    | otherwise = Just (B.concat [B.singleton 0x04, xb, yb])   where     xb = i2osp x     yb = i2osp y@@ -195,29 +214,37 @@  pointToBSOrError :: ECCT.PublicPoint -> B.ByteString pointToBSOrError point =-  case point of-    ECCT.PointO -> error "OpenPGP forbids serializing the point at infinity"-    _ ->-      case point2MBS point of-        Just bs -> bs-        Nothing ->-          error-            "OpenPGP EC point serialization requires equal non-empty coordinate widths"+    case point of+        ECCT.PointO -> error "OpenPGP forbids serializing the point at infinity"+        _ ->+            case point2MBS point of+                Just bs -> bs+                Nothing ->+                    error+                        "OpenPGP EC point serialization requires equal non-empty coordinate widths" -curveoidBSToEdSigningCurve :: B.ByteString -> Either String EdSigningCurve+curveoidBSToEdSigningCurve+    :: B.ByteString -> Either String EdSigningCurve curveoidBSToEdSigningCurve oidbs-  | B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0xDA, 0x47, 0x0F, 0x01] == oidbs =-    Right Ed25519-  | B.pack [0x2B, 0x65, 0x71] == oidbs =-    Right Ed448-  | otherwise =-    Left $-    concat ["unknown Edwards signing curve (...", show (B.unpack oidbs), ")"]+    | B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0xDA, 0x47, 0x0F, 0x01]+        == oidbs =+        Right EdSigningCurve25519+    | B.pack [0x2B, 0x65, 0x71] == oidbs =+        Right EdSigningCurve448+    | otherwise =+        Left $+            concat+                [ "unknown Edwards signing curve (..."+                , show (B.unpack oidbs)+                , ")"+                ] -edSigningCurveToCurveoidBS :: EdSigningCurve -> Either String B.ByteString-edSigningCurveToCurveoidBS Ed25519 =-  Right $ B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0xDA, 0x47, 0x0F, 0x01]-edSigningCurveToCurveoidBS Ed448 = Right $ B.pack [0x2B, 0x65, 0x71]+edSigningCurveToCurveoidBS+    :: EdSigningCurve -> Either String B.ByteString+edSigningCurveToCurveoidBS EdSigningCurve25519 =+    Right $+        B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0xDA, 0x47, 0x0F, 0x01]+edSigningCurveToCurveoidBS EdSigningCurve448 = Right $ B.pack [0x2B, 0x65, 0x71]  curve2Curve :: ECCCurve -> ECCT.Curve curve2Curve NISTP256 = ECCT.getCurveByName ECCT.SEC_p256r1@@ -226,6 +253,6 @@  curveFromCurve :: ECCT.Curve -> ECCCurve curveFromCurve c-  | c == ECCT.getCurveByName ECCT.SEC_p256r1 = NISTP256-  | c == ECCT.getCurveByName ECCT.SEC_p384r1 = NISTP384-  | c == ECCT.getCurveByName ECCT.SEC_p521r1 = NISTP521+    | c == ECCT.getCurveByName ECCT.SEC_p256r1 = NISTP256+    | c == ECCT.getCurveByName ECCT.SEC_p384r1 = NISTP384+    | c == ECCT.getCurveByName ECCT.SEC_p521r1 = NISTP521
Codec/Encryption/OpenPGP/Internal/CryptoECDH.hs view
@@ -2,70 +2,84 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).- {-# LANGUAGE OverloadedStrings #-}  module Codec.Encryption.OpenPGP.Internal.CryptoECDH-  ( normalizeMontgomeryPublic-  , buildECDHKDFParam-  , deriveECDHKek-  ) where+    ( normalizeMontgomeryPublic+    , buildECDHKDFParam+    , deriveECDHKek+    ) where -import Codec.Encryption.OpenPGP.BlockCipher (keySize, renderCipherError)-import Codec.Encryption.OpenPGP.Fingerprint (fingerprint)-import Codec.Encryption.OpenPGP.Internal (curveFromCurve, curveToCurveoidBS, leftPadTo)-import Codec.Encryption.OpenPGP.Policy (ecdhKdfHashDigest)-import Codec.Encryption.OpenPGP.Types import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import Data.Bifunctor (first) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL -normalizeMontgomeryPublic ::-     Int-  -> String-  -> B.ByteString-  -> Either String B.ByteString+import Codec.Encryption.OpenPGP.BlockCipher+    ( keySize+    , renderCipherError+    )+import Codec.Encryption.OpenPGP.Fingerprint (fingerprint)+import Codec.Encryption.OpenPGP.Internal+    ( curveFromCurve+    , curveToCurveoidBS+    , leftPadTo+    )+import Codec.Encryption.OpenPGP.Policy (ecdhKdfHashDigest)+import Codec.Encryption.OpenPGP.Types++normalizeMontgomeryPublic+    :: Int+    -> String+    -> B.ByteString+    -> Either String B.ByteString normalizeMontgomeryPublic targetLen label bs-  | B.length bs == targetLen = Right bs-  | B.length bs < targetLen = Right (leftPadTo targetLen bs)-  | B.length bs == targetLen + 1 && B.head bs == 0x40 = Right (B.tail bs)-  | otherwise = Left (label ++ show (B.length bs))+    | B.length bs == targetLen = Right bs+    | B.length bs < targetLen = Right (leftPadTo targetLen bs)+    | B.length bs == targetLen + 1 && B.head bs == 0x40 =+        Right (B.tail bs)+    | otherwise = Left (label ++ show (B.length bs)) -buildECDHKDFParam ::-     SomePKPayload-  -> PubKeyAlgorithm-  -> PKey-  -> HashAlgorithm-  -> SymmetricAlgorithm-  -> Either String B.ByteString+buildECDHKDFParam+    :: SomePKPayload+    -> PubKeyAlgorithm+    -> PKey+    -> HashAlgorithm+    -> SymmetricAlgorithm+    -> Either String B.ByteString buildECDHKDFParam recipientPKP pka recipientECDHPub kdfHA kdfSA =-  (<>-   B.pack [fromFVal pka, 0x03, 0x01, fromFVal kdfHA, fromFVal kdfSA] <>-   "Anonymous Sender    " <>-   BL.toStrict (unFingerprint (fingerprint recipientPKP))) <$>-  encodedCurveOid+    ( <>+        B.pack [fromFVal pka, 0x03, 0x01, fromFVal kdfHA, fromFVal kdfSA]+            <> "Anonymous Sender    "+            <> BL.toStrict (unFingerprint (fingerprint recipientPKP))+    )+        <$> encodedCurveOid   where-    encodedCurveOid = ((\oid -> B.singleton (fromIntegral (B.length oid)) <> oid) <$>) curveOid+    encodedCurveOid =+        ((\oid -> B.singleton (fromIntegral (B.length oid)) <> oid) <$>)+            curveOid     curveOid =-      case recipientECDHPub of-        ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _)) ->-          curveToCurveoidBS (curveFromCurve curve)-        EdDSAPubKey Ed25519 _ ->-          curveToCurveoidBS Curve25519-        EdDSAPubKey Ed448 _ ->-          curveToCurveoidBS Curve448-        _ -> Left "ECDH KDF param requires ECDH recipient key"+        case recipientECDHPub of+            ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _)) ->+                curveToCurveoidBS (curveFromCurve curve)+            EdDSAPubKey EdSigningCurve25519 _ ->+                curveToCurveoidBS Curve25519+            EdDSAPubKey EdSigningCurve448 _ ->+                curveToCurveoidBS Curve448+            _ -> Left "ECDH KDF param requires ECDH recipient key" -deriveECDHKek ::-     HashAlgorithm-  -> SymmetricAlgorithm-  -> B.ByteString-  -> B.ByteString-  -> Either String B.ByteString+deriveECDHKek+    :: HashAlgorithm+    -> SymmetricAlgorithm+    -> B.ByteString+    -> B.ByteString+    -> Either String B.ByteString deriveECDHKek kdfHA kdfSA sharedSecret kdfParam = do-  digest <- ecdhKdfHashDigest kdfHA (B.pack [0, 0, 0, 1] <> sharedSecret <> kdfParam)-  kekLen <- first renderCipherError (keySize kdfSA)-  if B.length digest < kekLen-    then Left "ECDH KDF digest is shorter than required KEK length"-    else Right (B.take kekLen digest)+    digest <-+        ecdhKdfHashDigest+            kdfHA+            (B.pack [0, 0, 0, 1] <> sharedSecret <> kdfParam)+    kekLen <- first renderCipherError (keySize kdfSA)+    if B.length digest < kekLen+        then Left "ECDH KDF digest is shorter than required KEK length"+        else Right (B.take kekLen digest)
Codec/Encryption/OpenPGP/KeyInfo.hs view
@@ -4,9 +4,9 @@ -- (See the LICENSE file).  module Codec.Encryption.OpenPGP.KeyInfo-  ( pubkeySize-  , pkalgoAbbrev-  ) where+    ( pubkeySize+    , pkalgoAbbrev+    ) where  import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA@@ -21,27 +21,33 @@ pubkeySize :: PKey -> Either String Int pubkeySize (RSAPubKey (RSA_PublicKey x)) = Right (RSA.public_size x * 8) pubkeySize (DSAPubKey (DSA_PublicKey x)) =-  Right (bitcount . DSA.params_p . DSA.public_params $ x)+    Right (bitcount . DSA.params_p . DSA.public_params $ x) pubkeySize (ElGamalPubKey p _ _) = Right (bitcount p) pubkeySize (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) =-  Right (fromIntegral (ECCT.curveSizeBits curve))-pubkeySize (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) _ _) =-  Right (fromIntegral (ECCT.curveSizeBits curve))-pubkeySize (ECDHPubKey (EdDSAPubKey Ed25519 _) _ _) = Right 256-pubkeySize (ECDHPubKey (EdDSAPubKey Ed448 _) _ _) = Right 448-pubkeySize (EdDSAPubKey Ed25519 _) = Right 256-pubkeySize (EdDSAPubKey Ed448 _) = Right 448+    Right (fromIntegral (ECCT.curveSizeBits curve))+pubkeySize+    ( ECDHPubKey+            (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _)))+            _+            _+        ) =+        Right (fromIntegral (ECCT.curveSizeBits curve))+pubkeySize (ECDHPubKey (EdDSAPubKey EdSigningCurve25519 _) _ _) = Right 256+pubkeySize (ECDHPubKey (EdDSAPubKey EdSigningCurve448 _) _ _) = Right 448+pubkeySize (EdDSAPubKey EdSigningCurve25519 _) = Right 256+pubkeySize (EdDSAPubKey EdSigningCurve448 _) = Right 448 pubkeySize x = Left $ "Unable to calculate size of " ++ show x  bitcount :: Integer -> Int bitcount =-  (* 8) .-  length .-  unfoldr-    (\x ->-       if x == 0-         then Nothing-         else Just (True, x `shiftR` 8))+    (* 8)+        . length+        . unfoldr+            ( \x ->+                if x == 0+                    then Nothing+                    else Just (True, x `shiftR` 8)+            )  pkalgoAbbrev :: PubKeyAlgorithm -> String pkalgoAbbrev RSA = "rsa"
Codec/Encryption/OpenPGP/KeyringParser.hs view
@@ -2,169 +2,182 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).- {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-}  module Codec.Encryption.OpenPGP.KeyringParser-  (- -- * Parsers-    parseAChunk-  , parseAChunkEither-  , finalizeParsing-  , finalizeParsingEither-  , KeyringChunkParseError(..)-  , anyTK-  , anyTKWithWireRep-  , UidOrUat(..)-  , splitUs-  , publicTK-  , publicTKWithWireRep-  , secretTK-  , secretTKWithWireRep-  , brokenTK-  , brokenTKWithWireRep-  , pkPayload-  , pkPayloadWithWireRep-  , signature-  , signatureWithWireRep-  , signedUID-  , signedUIDWithWireRep-  , signedUAt-  , signedUAtWithWireRep-  , signedOrRevokedPubSubkey-  , signedOrRevokedPubSubkeyWithWireRep-  , brokenPubSubkey-  , brokenPubSubkeyWithWireRep-  , rawOrSignedOrRevokedSecSubkey-  , rawOrSignedOrRevokedSecSubkeyWithWireRep-  , brokenSecSubkey-  , brokenSecSubkeyWithWireRep-  , skPayload-  , skPayloadWithWireRep-  , broken-  , brokenWithWireRep- -- * Utilities-  , parseUnknownTKs- , parseTKsEither- , parseTKs- , parsePublicTKs- , parseSecretTKs- , parseTKsWithWireRep- ) where+    ( -- * Parsers+      parseAChunk+    , parseAChunkEither+    , finalizeParsing+    , finalizeParsingEither+    , KeyringChunkParseError (..)+    , anyTK+    , anyTKWithWireRep+    , UidOrUat (..)+    , splitUs+    , publicTK+    , publicTKWithWireRep+    , secretTK+    , secretTKWithWireRep+    , brokenTK+    , brokenTKWithWireRep+    , pkPayload+    , pkPayloadWithWireRep+    , signature+    , signatureWithWireRep+    , signedUID+    , signedUIDWithWireRep+    , signedUAt+    , signedUAtWithWireRep+    , signedOrRevokedPubSubkey+    , signedOrRevokedPubSubkeyWithWireRep+    , brokenPubSubkey+    , brokenPubSubkeyWithWireRep+    , rawOrSignedOrRevokedSecSubkey+    , rawOrSignedOrRevokedSecSubkeyWithWireRep+    , brokenSecSubkey+    , brokenSecSubkeyWithWireRep+    , skPayload+    , skPayloadWithWireRep+    , broken+    , brokenWithWireRep -import Control.Applicative ((<|>), many)+      -- * Utilities+    , parseUnknownTKs+    , parseTKsEither+    , parseTKs+    , parsePublicTKs+    , parseSecretTKs+    , parseTKsWithWireRep+    ) where++import Control.Applicative (many, (<|>)) import Data.Either (rights)-import Data.List (foldl')-import Data.Maybe (catMaybes, mapMaybe) import qualified Data.List.NonEmpty as NE-+import Data.Maybe (catMaybes, mapMaybe) import Data.Text (Text)+import Text.ParserCombinators.Incremental.LeftBiasedLocal+    ( Parser+    , concatMany+    , failure+    , feed+    , feedEof+    , inspect+    , satisfy+    )  import Codec.Encryption.OpenPGP.Ontology (isTrustPkt) import Codec.Encryption.OpenPGP.Policy-  ( isAllowedPrimaryKeySigType-  , isAllowedSubkeySigType-  , isAllowedUIDSigType-  )+    ( isAllowedPrimaryKeySigType+    , isAllowedSubkeySigType+    , isAllowedUIDSigType+    ) import Codec.Encryption.OpenPGP.SignatureQualities (sigType) import Codec.Encryption.OpenPGP.Types import Data.Conduit.OpenPGP.Keyring.Instances ()-import Text.ParserCombinators.Incremental.LeftBiasedLocal-  ( Parser-  , concatMany-  , failure-  , feed-  , feedEof-  , inspect-  , satisfy-  )  data KeyringChunkParseError-  = ChunkFailureBeforeInput String-  | ChunkUnexpectedFinalizationFailure-  | ChunkParserFailure String-  deriving (Eq, Show)+    = ChunkFailureBeforeInput String+    | ChunkUnexpectedFinalizationFailure+    | ChunkParserFailure String+    deriving (Eq, Show)  renderChunkParseError :: KeyringChunkParseError -> String renderChunkParseError (ChunkFailureBeforeInput msg) = msg renderChunkParseError ChunkUnexpectedFinalizationFailure =-  "Unexpected finalization failure"+    "Unexpected finalization failure" renderChunkParseError (ChunkParserFailure msg) = msg -collapseCompleted ::-     Monoid s-  => [(r, s)]-  -> ([r], s)+collapseCompleted+    :: Monoid s+    => [(r, s)]+    -> ([r], s) collapseCompleted rs =-  let (resultsRev, remainder) =-        foldl'-          (\(accResults, accRemainder) (result, rest) ->-             (result : accResults, accRemainder <> rest))-          ([], mempty)-          rs-   in (reverse resultsRev, remainder)+    let (resultsRev, remainder) =+            foldl'+                ( \(accResults, accRemainder) (result, rest) ->+                    (result : accResults, accRemainder <> rest)+                )+                ([], mempty)+                rs+     in (reverse resultsRev, remainder) -parseAChunk ::-     (Monoid s, Show s)-  => Parser s r-  -> s-  -> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))-  -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])+parseAChunk+    :: (Monoid s, Show s)+    => Parser s r+    -> s+    -> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))+    -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]) parseAChunk op a st =-  either (error . renderChunkParseError) id (parseAChunkEither op a st)+    either+        (error . renderChunkParseError)+        id+        (parseAChunkEither op a st) -parseAChunkEither ::-     (Monoid s, Show s)-   => Parser s r-   -> s-   -> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))-   -> Either-       KeyringChunkParseError-       (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])+parseAChunkEither+    :: (Monoid s, Show s)+    => Parser s r+    -> s+    -> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))+    -> Either+        KeyringChunkParseError+        (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]) parseAChunkEither _ a ([], Nothing) =-  Left (ChunkFailureBeforeInput ("Failure before " ++ show a))+    Left (ChunkFailureBeforeInput ("Failure before " ++ show a)) parseAChunkEither op a (cr, Nothing) =-  let (completed, remainder) = collapseCompleted cr-   in-  (\x -> (x, completed)) <$>-  either (Left . ChunkParserFailure) Right (inspect (feed (remainder <> a) op))+    let (completed, remainder) = collapseCompleted cr+     in (\x -> (x, completed))+            <$> either+                (Left . ChunkParserFailure)+                Right+                (inspect (feed (remainder <> a) op)) parseAChunkEither _ a (_, Just (_, p)) =-  (\x -> (x, [])) <$> either (Left . ChunkParserFailure) Right (inspect (feed a p))+    (\x -> (x, []))+        <$> either (Left . ChunkParserFailure) Right (inspect (feed a p)) -finalizeParsing ::-     Monoid s-  => ([(r, s)], Maybe (Maybe (r -> r), Parser s r))-  -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])+finalizeParsing+    :: Monoid s+    => ([(r, s)], Maybe (Maybe (r -> r), Parser s r))+    -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]) finalizeParsing st =-  either (error . renderChunkParseError) id (finalizeParsingEither st)+    either+        (error . renderChunkParseError)+        id+        (finalizeParsingEither st) -finalizeParsingEither ::-     Monoid s-   => ([(r, s)], Maybe (Maybe (r -> r), Parser s r))-   -> Either-       KeyringChunkParseError-       (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])+finalizeParsingEither+    :: Monoid s+    => ([(r, s)], Maybe (Maybe (r -> r), Parser s r))+    -> Either+        KeyringChunkParseError+        (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]) finalizeParsingEither ([], Nothing) = Left ChunkUnexpectedFinalizationFailure finalizeParsingEither (cr, Nothing) =-  let (completed, _) = collapseCompleted cr-   in Right (([], Nothing), completed)+    let (completed, _) = collapseCompleted cr+     in Right (([], Nothing), completed) finalizeParsingEither (_, Just (_, p)) =-  either (Left . ChunkParserFailure) finalizeParsingEither (inspect (feedEof p))+    either+        (Left . ChunkParserFailure)+        finalizeParsingEither+        (inspect (feedEof p))  anyTK :: Bool -> Parser [Pkt] (Maybe TKUnknown) anyTK True = publicTK True <|> secretTK True-anyTK False = publicTK False <|> secretTK False <|> brokenTK 6 <|> brokenTK 5+anyTK False =+    publicTK False <|> secretTK False <|> brokenTK 6 <|> brokenTK 5  data UidOrUat-  = I Text-  | A [UserAttrSubPacket]-  deriving (Show)+    = I Text+    | A [UserAttrSubPacket]+    deriving (Show) -splitUs ::-     [(UidOrUat, [SignaturePayload])]-  -> ([(Text, [SignaturePayload])], [([UserAttrSubPacket], [SignaturePayload])])+splitUs+    :: [(UidOrUat, [SignaturePayload])]+    -> ( [(Text, [SignaturePayload])]+       , [([UserAttrSubPacket], [SignaturePayload])]+       ) splitUs us = (is, as)   where     is = map unI (filter isI us)@@ -180,85 +193,99 @@  publicTK, secretTK :: Bool -> Parser [Pkt] (Maybe TKUnknown) publicTK intolerant = do-  pkp <- pkPayload-  pkpsigs <--    concatMany-      (signatureWithPredicate intolerant isAllowedPrimaryKeySigType)-  (uids, uats) <--    fmap splitUs (many (signedUID intolerant <|> signedUAt intolerant))-  subs <- concatMany (pubsub intolerant)-  return $ Just (TKUnknown pkp pkpsigs uids uats subs)+    pkp <- pkPayload+    pkpsigs <-+        concatMany+            (signatureWithPredicate intolerant isAllowedPrimaryKeySigType)+    (uids, uats) <-+        fmap+            splitUs+            (many (signedUID intolerant <|> signedUAt intolerant))+    subs <- concatMany (pubsub intolerant)+    return $ Just (TKUnknown pkp pkpsigs uids uats subs)   where     pubsub True = signedOrRevokedPubSubkey True     pubsub False = signedOrRevokedPubSubkey False <|> brokenPubSubkey- secretTK intolerant = do-  skp <- skPayload-  skpsigs <--    concatMany-      (signatureWithPredicate intolerant isAllowedPrimaryKeySigType)-  (uids, uats) <--    fmap splitUs (many (signedUID intolerant <|> signedUAt intolerant))-  subs <- concatMany (secsub intolerant)-  return $ Just (TKUnknown skp skpsigs uids uats subs)+    skp <- skPayload+    skpsigs <-+        concatMany+            (signatureWithPredicate intolerant isAllowedPrimaryKeySigType)+    (uids, uats) <-+        fmap+            splitUs+            (many (signedUID intolerant <|> signedUAt intolerant))+    subs <- concatMany (secsub intolerant)+    return $ Just (TKUnknown skp skpsigs uids uats subs)   where     secsub True = rawOrSignedOrRevokedSecSubkey True     secsub False = rawOrSignedOrRevokedSecSubkey False <|> brokenSecSubkey  brokenTK :: Int -> Parser [Pkt] (Maybe TKUnknown) brokenTK 6 = do-  _ <- broken 6-  _ <- many (signature False [KeyRevocationSig, SignatureDirectlyOnAKey])-  _ <- many (signedUID False <|> signedUAt False)-  _ <- concatMany (signedOrRevokedPubSubkey False <|> brokenPubSubkey)-  return Nothing+    _ <- broken 6+    _ <-+        many+            (signature False [KeyRevocationSig, SignatureDirectlyOnAKey])+    _ <- many (signedUID False <|> signedUAt False)+    _ <-+        concatMany (signedOrRevokedPubSubkey False <|> brokenPubSubkey)+    return Nothing brokenTK 5 = do-  _ <- broken 5-  _ <- many (signature False [KeyRevocationSig, SignatureDirectlyOnAKey])-  _ <- many (signedUID False <|> signedUAt False)-  _ <- concatMany (rawOrSignedOrRevokedSecSubkey False <|> brokenSecSubkey)-  return Nothing+    _ <- broken 5+    _ <-+        many+            (signature False [KeyRevocationSig, SignatureDirectlyOnAKey])+    _ <- many (signedUID False <|> signedUAt False)+    _ <-+        concatMany+            (rawOrSignedOrRevokedSecSubkey False <|> brokenSecSubkey)+    return Nothing brokenTK _ = fail "Unexpected broken packet type"  pkPayload :: Parser [Pkt] (SomePKPayload, Maybe SKAddendum) pkPayload = do-  pkpkts <- satisfy isPKP-  case pkpkts of-    [pkt] ->-      case pktToPublicKeyPkt pkt of-        Just keyPkt | keyPktRole keyPkt == KeyPktPrimary ->-          return (keyPktTKKey keyPkt)+    pkpkts <- satisfy isPKP+    case pkpkts of+        [pkt] ->+            case pktToPublicKeyPkt pkt of+                Just keyPkt+                    | keyPktRole keyPkt == KeyPktPrimary ->+                        return (keyPktTKKey keyPkt)+                _ -> failure         _ -> failure-    _ -> failure   where     isPKP [pkt] =-      case pktToPublicKeyPkt pkt of-        Just keyPkt -> keyPktRole keyPkt == KeyPktPrimary-        Nothing -> False+        case pktToPublicKeyPkt pkt of+            Just keyPkt -> keyPktRole keyPkt == KeyPktPrimary+            Nothing -> False     isPKP _ = False  signature :: Bool -> [SigType] -> Parser [Pkt] [SignaturePayload] signature intolerant rts = signatureWithPredicate intolerant (\st -> st `elem` rts) --- | RFC9580-aware signature parser that validates context using a predicate--- The predicate operates on SigType to determine if the signature is allowed--- in this context (e.g., isAllowedPrimaryKeySigType for primary keys).-signatureWithPredicate :: Bool -> (SigType -> Bool) -> Parser [Pkt] [SignaturePayload]+{- | RFC9580-aware signature parser that validates context using a predicate+The predicate operates on SigType to determine if the signature is allowed+in this context (e.g., isAllowedPrimaryKeySigType for primary keys).+-}+signatureWithPredicate+    :: Bool -> (SigType -> Bool) -> Parser [Pkt] [SignaturePayload] signatureWithPredicate intolerant predicate =-  if intolerant-    then signature'-    else signature' <|> brokensig'+    if intolerant+        then signature'+        else signature' <|> brokensig'   where     signature' = do-      spks <- satisfy (isSP intolerant)-      case spks of-        [SignaturePkt sp] ->-          return $!-          (if intolerant-             then id-             else filter isSP')-            [sp]-        _ -> failure+        spks <- satisfy (isSP intolerant)+        case spks of+            [SignaturePkt sp] ->+                return $!+                    ( if intolerant+                        then id+                        else filter isSP'+                    )+                        [sp]+            _ -> failure     brokensig' = const [] <$> broken 2     isSP True [SignaturePkt sp] = isSP' sp     isSP False [SignaturePkt _] = True@@ -267,102 +294,106 @@  signedUID :: Bool -> Parser [Pkt] (UidOrUat, [SignaturePayload]) signedUID intolerant = do-  upkts <- satisfy isUID-  case upkts of-    [UserIdPkt u] -> do-      sigs <--        concatMany-          (signatureWithPredicate intolerant isAllowedUIDSigType)-      return (I u, sigs)-    _ -> failure+    upkts <- satisfy isUID+    case upkts of+        [UserIdPkt u] -> do+            sigs <-+                concatMany+                    (signatureWithPredicate intolerant isAllowedUIDSigType)+            return (I u, sigs)+        _ -> failure   where     isUID [UserIdPkt _] = True     isUID _ = False  signedUAt :: Bool -> Parser [Pkt] (UidOrUat, [SignaturePayload]) signedUAt intolerant = do-  uapkts <- satisfy isUAt-  case uapkts of-    [UserAttributePkt us] -> do-      sigs <--        concatMany-          (signatureWithPredicate intolerant isAllowedUIDSigType)-      return (A us, sigs)-    _ -> failure+    uapkts <- satisfy isUAt+    case uapkts of+        [UserAttributePkt us] -> do+            sigs <-+                concatMany+                    (signatureWithPredicate intolerant isAllowedUIDSigType)+            return (A us, sigs)+        _ -> failure   where     isUAt [UserAttributePkt _] = True     isUAt _ = False -signedOrRevokedPubSubkey :: Bool -> Parser [Pkt] [(Pkt, [SignaturePayload])]+signedOrRevokedPubSubkey+    :: Bool -> Parser [Pkt] [(Pkt, [SignaturePayload])] signedOrRevokedPubSubkey intolerant = do-  pskpkts <- satisfy isPSKP-  case pskpkts of-    [p] -> do-      sigs <--        concatMany-          (signatureWithPredicate intolerant isAllowedSubkeySigType)-      return [(p, sigs)]-    _ -> failure+    pskpkts <- satisfy isPSKP+    case pskpkts of+        [p] -> do+            sigs <-+                concatMany+                    (signatureWithPredicate intolerant isAllowedSubkeySigType)+            return [(p, sigs)]+        _ -> failure   where     isPSKP [pkt] =-      case pktToPublicKeyPkt pkt of-        Just keyPkt -> keyPktRole keyPkt == KeyPktSubkey-        Nothing -> False+        case pktToPublicKeyPkt pkt of+            Just keyPkt -> keyPktRole keyPkt == KeyPktSubkey+            Nothing -> False     isPSKP _ = False  brokenPubSubkey :: Parser [Pkt] [(Pkt, [SignaturePayload])] brokenPubSubkey = do-  _ <- broken 14-  _ <- concatMany (signatureWithPredicate False isAllowedSubkeySigType)-  return []+    _ <- broken 14+    _ <-+        concatMany (signatureWithPredicate False isAllowedSubkeySigType)+    return [] -rawOrSignedOrRevokedSecSubkey ::-     Bool -> Parser [Pkt] [(Pkt, [SignaturePayload])]+rawOrSignedOrRevokedSecSubkey+    :: Bool -> Parser [Pkt] [(Pkt, [SignaturePayload])] rawOrSignedOrRevokedSecSubkey intolerant = do-  sskpkts <- satisfy isSSKP-  case sskpkts of-    [p] -> do-      sigs <--        concatMany-          (signatureWithPredicate intolerant isAllowedSubkeySigType)-      return [(p, sigs)]-    _ -> failure+    sskpkts <- satisfy isSSKP+    case sskpkts of+        [p] -> do+            sigs <-+                concatMany+                    (signatureWithPredicate intolerant isAllowedSubkeySigType)+            return [(p, sigs)]+        _ -> failure   where     isSSKP [pkt] =-      case pktToSecretKeyPkt pkt of-        Just keyPkt -> keyPktRole keyPkt == KeyPktSubkey-        Nothing -> False+        case pktToSecretKeyPkt pkt of+            Just keyPkt -> keyPktRole keyPkt == KeyPktSubkey+            Nothing -> False     isSSKP _ = False  brokenSecSubkey :: Parser [Pkt] [(Pkt, [SignaturePayload])] brokenSecSubkey = do-  _ <- broken 7-  _ <- concatMany (signatureWithPredicate False isAllowedSubkeySigType)-  return []+    _ <- broken 7+    _ <-+        concatMany (signatureWithPredicate False isAllowedSubkeySigType)+    return []  skPayload :: Parser [Pkt] (SomePKPayload, Maybe SKAddendum) skPayload = do-  spkts <- satisfy isSKP-  case spkts of-    [pkt] ->-      case pktToSecretKeyPkt pkt of-        Just keyPkt | keyPktRole keyPkt == KeyPktPrimary ->-          return (keyPktTKKey keyPkt)+    spkts <- satisfy isSKP+    case spkts of+        [pkt] ->+            case pktToSecretKeyPkt pkt of+                Just keyPkt+                    | keyPktRole keyPkt == KeyPktPrimary ->+                        return (keyPktTKKey keyPkt)+                _ -> failure         _ -> failure-    _ -> failure   where     isSKP [pkt] =-      case pktToSecretKeyPkt pkt of-        Just keyPkt -> keyPktRole keyPkt == KeyPktPrimary-        Nothing -> False+        case pktToSecretKeyPkt pkt of+            Just keyPkt -> keyPktRole keyPkt == KeyPktPrimary+            Nothing -> False     isSKP _ = False  broken :: Int -> Parser [Pkt] Pkt broken t = do-  bpkts <- satisfy isBroken-  case bpkts of-    [bp] -> return bp-    _ -> failure+    bpkts <- satisfy isBroken+    case bpkts of+        [bp] -> return bp+        _ -> failure   where     isBroken [BrokenPacketPkt _ a _] = t == fromIntegral a     isBroken _ = False@@ -370,309 +401,370 @@ -- | parse TKs from packets parseUnknownTKs :: Bool -> [Pkt] -> [TKUnknown] parseUnknownTKs intolerant ps =-  catMaybes $-  runIncrementalParser-    (anyTK intolerant)-    (map (: []) (filter notTrustPacket ps))+    catMaybes $+        runIncrementalParser+            (anyTK intolerant)+            (map (: []) (filter notTrustPacket ps))   where     notTrustPacket = not . isTrustPkt -parseTKsEither :: Bool -> [Pkt] -> [Either TKConversionError SomeTK]+parseTKsEither+    :: Bool -> [Pkt] -> [Either TKConversionError SomeTK] parseTKsEither intolerant =-  map fromUnknownToTKEither . parseUnknownTKs intolerant+    map fromUnknownToTKEither . parseUnknownTKs intolerant  parseTKs :: Bool -> [Pkt] -> [SomeTK] parseTKs intolerant packets = rights (parseTKsEither intolerant packets)  parsePublicTKs :: Bool -> [Pkt] -> [TK 'PublicTK] parsePublicTKs intolerant packets =-  mapMaybe someTKToPublicTK (parseTKs intolerant packets)+    mapMaybe someTKToPublicTK (parseTKs intolerant packets)  parseSecretTKs :: Bool -> [Pkt] -> [TK 'SecretTK] parseSecretTKs intolerant packets =-  mapMaybe someTKToSecretTK (parseTKs intolerant packets)+    mapMaybe someTKToSecretTK (parseTKs intolerant packets) -anyTKWithWireRep :: Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)+anyTKWithWireRep+    :: Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep) anyTKWithWireRep True = publicTKWithWireRep True <|> secretTKWithWireRep True anyTKWithWireRep False =-  publicTKWithWireRep False <|> secretTKWithWireRep False <|>-  brokenTKWithWireRep 6 <|> brokenTKWithWireRep 5+    publicTKWithWireRep False+        <|> secretTKWithWireRep False+        <|> brokenTKWithWireRep 6+        <|> brokenTKWithWireRep 5 -publicTKWithWireRep, secretTKWithWireRep ::-     Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)+publicTKWithWireRep+    , secretTKWithWireRep+        :: Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep) publicTKWithWireRep intolerant = do-  (pkp, pkps) <- pkPayloadWithWireRep-  (pkpsigs, pkpsigrefs) <--    concatMany-      (signatureWithWireRepPredicate intolerant isAllowedPrimaryKeySigType)-  uidResults <- many (signedUIDWithWireRep intolerant <|> signedUAtWithWireRep intolerant)-  subResults <- concatMany (pubsub intolerant)-  let semanticUs = fmap fst uidResults-      (uids, uats) = splitUs semanticUs-      uidrefs = concatMap snd uidResults-      subs = fmap fst subResults-      subrefs = concatMap snd subResults-      tk = TKUnknown pkp pkpsigs uids uats subs-      refs = pkps ++ pkpsigrefs ++ uidrefs ++ subrefs-  return $ Just (mkTKWithWireRep tk refs)+    (pkp, pkps) <- pkPayloadWithWireRep+    (pkpsigs, pkpsigrefs) <-+        concatMany+            ( signatureWithWireRepPredicate+                intolerant+                isAllowedPrimaryKeySigType+            )+    uidResults <-+        many+            ( signedUIDWithWireRep intolerant+                <|> signedUAtWithWireRep intolerant+            )+    subResults <- concatMany (pubsub intolerant)+    let semanticUs = fmap fst uidResults+        (uids, uats) = splitUs semanticUs+        uidrefs = concatMap snd uidResults+        subs = fmap fst subResults+        subrefs = concatMap snd subResults+        tk = TKUnknown pkp pkpsigs uids uats subs+        refs = pkps ++ pkpsigrefs ++ uidrefs ++ subrefs+    return $ Just (mkTKWithWireRep tk refs)   where     pubsub True = signedOrRevokedPubSubkeyWithWireRep True     pubsub False =-      signedOrRevokedPubSubkeyWithWireRep False <|> brokenPubSubkeyWithWireRep-+        signedOrRevokedPubSubkeyWithWireRep False+            <|> brokenPubSubkeyWithWireRep secretTKWithWireRep intolerant = do-  (skp, skps) <- skPayloadWithWireRep-  (skpsigs, skpsigrefs) <--    concatMany-      (signatureWithWireRepPredicate intolerant isAllowedPrimaryKeySigType)-  uidResults <- many (signedUIDWithWireRep intolerant <|> signedUAtWithWireRep intolerant)-  subResults <- concatMany (secsub intolerant)-  let semanticUs = fmap fst uidResults-      (uids, uats) = splitUs semanticUs-      uidrefs = concatMap snd uidResults-      subs = fmap fst subResults-      subrefs = concatMap snd subResults-      tk = TKUnknown skp skpsigs uids uats subs-      refs = skps ++ skpsigrefs ++ uidrefs ++ subrefs-  return $ Just (mkTKWithWireRep tk refs)+    (skp, skps) <- skPayloadWithWireRep+    (skpsigs, skpsigrefs) <-+        concatMany+            ( signatureWithWireRepPredicate+                intolerant+                isAllowedPrimaryKeySigType+            )+    uidResults <-+        many+            ( signedUIDWithWireRep intolerant+                <|> signedUAtWithWireRep intolerant+            )+    subResults <- concatMany (secsub intolerant)+    let semanticUs = fmap fst uidResults+        (uids, uats) = splitUs semanticUs+        uidrefs = concatMap snd uidResults+        subs = fmap fst subResults+        subrefs = concatMap snd subResults+        tk = TKUnknown skp skpsigs uids uats subs+        refs = skps ++ skpsigrefs ++ uidrefs ++ subrefs+    return $ Just (mkTKWithWireRep tk refs)   where     secsub True = rawOrSignedOrRevokedSecSubkeyWithWireRep True     secsub False =-      rawOrSignedOrRevokedSecSubkeyWithWireRep False <|> brokenSecSubkeyWithWireRep+        rawOrSignedOrRevokedSecSubkeyWithWireRep False+            <|> brokenSecSubkeyWithWireRep -brokenTKWithWireRep :: Int -> Parser [PktWithWireRep] (Maybe TKWithWireRep)+brokenTKWithWireRep+    :: Int -> Parser [PktWithWireRep] (Maybe TKWithWireRep) brokenTKWithWireRep 6 = do-  _ <- brokenWithWireRep 6-  _ <- many (signatureWithWireRepPredicate False isAllowedPrimaryKeySigType)-  _ <- many (signedUIDWithWireRep False <|> signedUAtWithWireRep False)-  _ <--    concatMany-      (signedOrRevokedPubSubkeyWithWireRep False <|> brokenPubSubkeyWithWireRep)-  return Nothing+    _ <- brokenWithWireRep 6+    _ <-+        many+            (signatureWithWireRepPredicate False isAllowedPrimaryKeySigType)+    _ <-+        many (signedUIDWithWireRep False <|> signedUAtWithWireRep False)+    _ <-+        concatMany+            ( signedOrRevokedPubSubkeyWithWireRep False+                <|> brokenPubSubkeyWithWireRep+            )+    return Nothing brokenTKWithWireRep 5 = do-  _ <- brokenWithWireRep 5-  _ <- many (signatureWithWireRepPredicate False isAllowedPrimaryKeySigType)-  _ <- many (signedUIDWithWireRep False <|> signedUAtWithWireRep False)-  _ <--    concatMany-      (rawOrSignedOrRevokedSecSubkeyWithWireRep False <|> brokenSecSubkeyWithWireRep)-  return Nothing+    _ <- brokenWithWireRep 5+    _ <-+        many+            (signatureWithWireRepPredicate False isAllowedPrimaryKeySigType)+    _ <-+        many (signedUIDWithWireRep False <|> signedUAtWithWireRep False)+    _ <-+        concatMany+            ( rawOrSignedOrRevokedSecSubkeyWithWireRep False+                <|> brokenSecSubkeyWithWireRep+            )+    return Nothing brokenTKWithWireRep _ = fail "Unexpected broken packet type" -pkPayloadWithWireRep ::-     Parser [PktWithWireRep] ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])+pkPayloadWithWireRep+    :: Parser+        [PktWithWireRep]+        ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep]) pkPayloadWithWireRep = do-  pkpkts <- satisfy isPKPWS-  case pkpkts of-    [pktWithSource] ->-      case pktToPublicKeyPkt (_pktValue pktWithSource) of-        Just keyPkt | keyPktRole keyPkt == KeyPktPrimary ->-          return (keyPktTKKey keyPkt, [pktWithSource])+    pkpkts <- satisfy isPKPWS+    case pkpkts of+        [pktWithSource] ->+            case pktToPublicKeyPkt (_pktValue pktWithSource) of+                Just keyPkt+                    | keyPktRole keyPkt == KeyPktPrimary ->+                        return (keyPktTKKey keyPkt, [pktWithSource])+                _ -> failure         _ -> failure-    _ -> failure   where     isPKPWS [pktWithSource] =-      case pktToPublicKeyPkt (_pktValue pktWithSource) of-        Just keyPkt -> keyPktRole keyPkt == KeyPktPrimary-        _ -> False+        case pktToPublicKeyPkt (_pktValue pktWithSource) of+            Just keyPkt -> keyPktRole keyPkt == KeyPktPrimary+            _ -> False     isPKPWS _ = False -signatureWithWireRep ::-     Bool-  -> [SigType]-  -> Parser [PktWithWireRep] ([SignaturePayload], [PktWithWireRep])+signatureWithWireRep+    :: Bool+    -> [SigType]+    -> Parser [PktWithWireRep] ([SignaturePayload], [PktWithWireRep]) signatureWithWireRep intolerant rts =-  signatureWithWireRepPredicate intolerant (\st -> st `elem` rts)+    signatureWithWireRepPredicate intolerant (\st -> st `elem` rts)  -- | RFC9580-aware signature parser with wire representation support-signatureWithWireRepPredicate ::-     Bool-  -> (SigType -> Bool)-  -> Parser [PktWithWireRep] ([SignaturePayload], [PktWithWireRep])+signatureWithWireRepPredicate+    :: Bool+    -> (SigType -> Bool)+    -> Parser [PktWithWireRep] ([SignaturePayload], [PktWithWireRep]) signatureWithWireRepPredicate intolerant predicate =-  if intolerant-    then signature'-    else signature' <|> brokensig'+    if intolerant+        then signature'+        else signature' <|> brokensig'   where     signature' = do-      spks <- satisfy (isSPWS intolerant)-      case spks of-        [pktWithSource] ->-          case _pktValue pktWithSource of-            SignaturePkt sp ->-              let sigs =-                    (if intolerant-                       then id-                       else filter isSP')-                      [sp]-               in return (sigs, if null sigs then [] else [pktWithSource])+        spks <- satisfy (isSPWS intolerant)+        case spks of+            [pktWithSource] ->+                case _pktValue pktWithSource of+                    SignaturePkt sp ->+                        let sigs =+                                ( if intolerant+                                    then id+                                    else filter isSP'+                                )+                                    [sp]+                         in return (sigs, if null sigs then [] else [pktWithSource])+                    _ -> failure             _ -> failure-        _ -> failure     brokensig' = const ([], []) <$> brokenWithWireRep 2     isSPWS True [pktWithSource] =-      case _pktValue pktWithSource of-        SignaturePkt sp -> isSP' sp-        _ -> False+        case _pktValue pktWithSource of+            SignaturePkt sp -> isSP' sp+            _ -> False     isSPWS False [pktWithSource] =-      case _pktValue pktWithSource of-        SignaturePkt _ -> True-        _ -> False+        case _pktValue pktWithSource of+            SignaturePkt _ -> True+            _ -> False     isSPWS _ _ = False     isSP' sigPayload = maybe False predicate (sigType sigPayload) -signedUIDWithWireRep ::-     Bool-  -> Parser [PktWithWireRep] ((UidOrUat, [SignaturePayload]), [PktWithWireRep])+signedUIDWithWireRep+    :: Bool+    -> Parser+        [PktWithWireRep]+        ((UidOrUat, [SignaturePayload]), [PktWithWireRep]) signedUIDWithWireRep intolerant = do-  upkts <- satisfy isUIDWS-  case upkts of-    [pktWithSource] ->-      case _pktValue pktWithSource of-        UserIdPkt u -> do-          (sigs, sigrefs) <--            concatMany-              (signatureWithWireRepPredicate intolerant isAllowedUIDSigType)-          return ((I u, sigs), pktWithSource : sigrefs)+    upkts <- satisfy isUIDWS+    case upkts of+        [pktWithSource] ->+            case _pktValue pktWithSource of+                UserIdPkt u -> do+                    (sigs, sigrefs) <-+                        concatMany+                            (signatureWithWireRepPredicate intolerant isAllowedUIDSigType)+                    return ((I u, sigs), pktWithSource : sigrefs)+                _ -> failure         _ -> failure-    _ -> failure   where     isUIDWS [pktWithSource] =-      case _pktValue pktWithSource of-        UserIdPkt _ -> True-        _ -> False+        case _pktValue pktWithSource of+            UserIdPkt _ -> True+            _ -> False     isUIDWS _ = False -signedUAtWithWireRep ::-     Bool-  -> Parser [PktWithWireRep] ((UidOrUat, [SignaturePayload]), [PktWithWireRep])+signedUAtWithWireRep+    :: Bool+    -> Parser+        [PktWithWireRep]+        ((UidOrUat, [SignaturePayload]), [PktWithWireRep]) signedUAtWithWireRep intolerant = do-  uapkts <- satisfy isUAtWS-  case uapkts of-    [pktWithSource] ->-      case _pktValue pktWithSource of-        UserAttributePkt us -> do-          (sigs, sigrefs) <--            concatMany-              (signatureWithWireRepPredicate intolerant isAllowedUIDSigType)-          return ((A us, sigs), pktWithSource : sigrefs)+    uapkts <- satisfy isUAtWS+    case uapkts of+        [pktWithSource] ->+            case _pktValue pktWithSource of+                UserAttributePkt us -> do+                    (sigs, sigrefs) <-+                        concatMany+                            (signatureWithWireRepPredicate intolerant isAllowedUIDSigType)+                    return ((A us, sigs), pktWithSource : sigrefs)+                _ -> failure         _ -> failure-    _ -> failure   where     isUAtWS [pktWithSource] =-      case _pktValue pktWithSource of-        UserAttributePkt _ -> True-        _ -> False+        case _pktValue pktWithSource of+            UserAttributePkt _ -> True+            _ -> False     isUAtWS _ = False -signedOrRevokedPubSubkeyWithWireRep ::-     Bool -> Parser [PktWithWireRep] [((Pkt, [SignaturePayload]), [PktWithWireRep])]+signedOrRevokedPubSubkeyWithWireRep+    :: Bool+    -> Parser+        [PktWithWireRep]+        [((Pkt, [SignaturePayload]), [PktWithWireRep])] signedOrRevokedPubSubkeyWithWireRep intolerant = do-  pskpkts <- satisfy isPSKPWS-  case pskpkts of-    [pktWithSource] -> do-      (sigs, sigrefs) <--        concatMany-          (signatureWithWireRepPredicate intolerant isAllowedSubkeySigType)-      return [((_pktValue pktWithSource, sigs), pktWithSource : sigrefs)]-    _ -> failure+    pskpkts <- satisfy isPSKPWS+    case pskpkts of+        [pktWithSource] -> do+            (sigs, sigrefs) <-+                concatMany+                    (signatureWithWireRepPredicate intolerant isAllowedSubkeySigType)+            return+                [((_pktValue pktWithSource, sigs), pktWithSource : sigrefs)]+        _ -> failure   where     isPSKPWS [pktWithSource] =-      case pktToPublicKeyPkt (_pktValue pktWithSource) of-        Just keyPkt -> keyPktRole keyPkt == KeyPktSubkey-        _ -> False+        case pktToPublicKeyPkt (_pktValue pktWithSource) of+            Just keyPkt -> keyPktRole keyPkt == KeyPktSubkey+            _ -> False     isPSKPWS _ = False -brokenPubSubkeyWithWireRep ::-     Parser [PktWithWireRep] [((Pkt, [SignaturePayload]), [PktWithWireRep])]+brokenPubSubkeyWithWireRep+    :: Parser+        [PktWithWireRep]+        [((Pkt, [SignaturePayload]), [PktWithWireRep])] brokenPubSubkeyWithWireRep = do-  _ <- brokenWithWireRep 14-  _ <- concatMany (signatureWithWireRepPredicate False isAllowedSubkeySigType)-  return []+    _ <- brokenWithWireRep 14+    _ <-+        concatMany+            (signatureWithWireRepPredicate False isAllowedSubkeySigType)+    return [] -rawOrSignedOrRevokedSecSubkeyWithWireRep ::-     Bool -> Parser [PktWithWireRep] [((Pkt, [SignaturePayload]), [PktWithWireRep])]+rawOrSignedOrRevokedSecSubkeyWithWireRep+    :: Bool+    -> Parser+        [PktWithWireRep]+        [((Pkt, [SignaturePayload]), [PktWithWireRep])] rawOrSignedOrRevokedSecSubkeyWithWireRep intolerant = do-  sskpkts <- satisfy isSSKPWS-  case sskpkts of-    [pktWithSource] -> do-      (sigs, sigrefs) <--        concatMany-          (signatureWithWireRepPredicate intolerant isAllowedSubkeySigType)-      return [((_pktValue pktWithSource, sigs), pktWithSource : sigrefs)]-    _ -> failure+    sskpkts <- satisfy isSSKPWS+    case sskpkts of+        [pktWithSource] -> do+            (sigs, sigrefs) <-+                concatMany+                    (signatureWithWireRepPredicate intolerant isAllowedSubkeySigType)+            return+                [((_pktValue pktWithSource, sigs), pktWithSource : sigrefs)]+        _ -> failure   where     isSSKPWS [pktWithSource] =-      case pktToSecretKeyPkt (_pktValue pktWithSource) of-        Just keyPkt -> keyPktRole keyPkt == KeyPktSubkey-        _ -> False+        case pktToSecretKeyPkt (_pktValue pktWithSource) of+            Just keyPkt -> keyPktRole keyPkt == KeyPktSubkey+            _ -> False     isSSKPWS _ = False -brokenSecSubkeyWithWireRep ::-     Parser [PktWithWireRep] [((Pkt, [SignaturePayload]), [PktWithWireRep])]+brokenSecSubkeyWithWireRep+    :: Parser+        [PktWithWireRep]+        [((Pkt, [SignaturePayload]), [PktWithWireRep])] brokenSecSubkeyWithWireRep = do-  _ <- brokenWithWireRep 7-  _ <- concatMany (signatureWithWireRepPredicate False isAllowedSubkeySigType)-  return []+    _ <- brokenWithWireRep 7+    _ <-+        concatMany+            (signatureWithWireRepPredicate False isAllowedSubkeySigType)+    return [] -skPayloadWithWireRep ::-     Parser [PktWithWireRep] ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])+skPayloadWithWireRep+    :: Parser+        [PktWithWireRep]+        ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep]) skPayloadWithWireRep = do-  spkts <- satisfy isSKPWS-  case spkts of-    [pktWithSource] ->-      case pktToSecretKeyPkt (_pktValue pktWithSource) of-        Just keyPkt | keyPktRole keyPkt == KeyPktPrimary ->-          return (keyPktTKKey keyPkt, [pktWithSource])+    spkts <- satisfy isSKPWS+    case spkts of+        [pktWithSource] ->+            case pktToSecretKeyPkt (_pktValue pktWithSource) of+                Just keyPkt+                    | keyPktRole keyPkt == KeyPktPrimary ->+                        return (keyPktTKKey keyPkt, [pktWithSource])+                _ -> failure         _ -> failure-    _ -> failure   where     isSKPWS [pktWithSource] =-      case pktToSecretKeyPkt (_pktValue pktWithSource) of-        Just keyPkt -> keyPktRole keyPkt == KeyPktPrimary-        _ -> False+        case pktToSecretKeyPkt (_pktValue pktWithSource) of+            Just keyPkt -> keyPktRole keyPkt == KeyPktPrimary+            _ -> False     isSKPWS _ = False -brokenWithWireRep :: Int -> Parser [PktWithWireRep] PktWithWireRep+brokenWithWireRep+    :: Int -> Parser [PktWithWireRep] PktWithWireRep brokenWithWireRep t = do-  bpkts <- satisfy isBrokenWS-  case bpkts of-    [bp] -> return bp-    _ -> failure+    bpkts <- satisfy isBrokenWS+    case bpkts of+        [bp] -> return bp+        _ -> failure   where     isBrokenWS [pktWithSource] =-      case _pktValue pktWithSource of-        BrokenPacketPkt _ a _ -> t == fromIntegral a-        _ -> False+        case _pktValue pktWithSource of+            BrokenPacketPkt _ a _ -> t == fromIntegral a+            _ -> False     isBrokenWS _ = False -parseTKsWithWireRep :: Bool -> [PktWithWireRep] -> [TKWithWireRep]+parseTKsWithWireRep+    :: Bool -> [PktWithWireRep] -> [TKWithWireRep] parseTKsWithWireRep intolerant ps =-  catMaybes $-  runIncrementalParser-    (anyTKWithWireRep intolerant)-    (map (: []) (filter notTrustPacketWithWireRep ps))+    catMaybes $+        runIncrementalParser+            (anyTKWithWireRep intolerant)+            (map (: []) (filter notTrustPacketWithWireRep ps))   where     notTrustPacketWithWireRep = not . isTrustPkt . _pktValue -runIncrementalParser ::-     (Monoid s, Show s)-  => Parser s r-  -> [s]-  -> [r]+runIncrementalParser+    :: (Monoid s, Show s)+    => Parser s r+    -> [s]+    -> [r] runIncrementalParser parser chunks = go ([], Just (Nothing, parser)) chunks   where     go st [] = snd (finalizeParsing st)-    go st (chunk:rest) =-      let (st', out) = parseAChunk parser chunk st-       in out <> go st' rest+    go st (chunk : rest) =+        let (st', out) = parseAChunk parser chunk st+         in out <> go st' rest  mkTKWithWireRep :: TKUnknown -> [PktWithWireRep] -> TKWithWireRep mkTKWithWireRep tk refs =-  case refs of-    [] -> error "mkTKWithWireRep requires at least one packet reference"-    (pktWithSource:_) ->-      TKWithWireRep-        (NE.singleton (wireRepOfPkt pktWithSource))-        (spanByteRanges (map _pktRange refs))-        refs-        tk+    case refs of+        [] ->+            error "mkTKWithWireRep requires at least one packet reference"+        (pktWithSource : _) ->+            TKWithWireRep+                (NE.singleton (wireRepOfPkt pktWithSource))+                (spanByteRanges (map _pktRange refs))+                refs+                tk
Codec/Encryption/OpenPGP/Message.hs view
@@ -2,896 +2,1082 @@ -- Copyright © 2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).--{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}--module Codec.Encryption.OpenPGP.Message-  ( Passphrase-  , mkPassphrase-  , passphraseBytes-  , EncryptedPayload-  , mkEncryptedPayload-  , encryptedPayloadBytes-  , ClearPayload-  , mkClearPayload-  , clearPayloadBytes-  , WrappedSessionMaterial-  , SigningAlgorithm(..)-  , SecretKeyFor-  , VersionedPKPayload-  , asV4PKPayload-  , asV6PKPayload-  , Signer-  , SigningCapability-  , mkRSASignerV4-  , mkRSASignerV6-  , mkEd25519SignerV4-  , mkEd25519SignerV6-  , mkEd448SignerV4-  , mkEd448SignerV6-  , MessageParseFailure(..)-  , MessageDecryptFailure(..)-  , MessageError(..)-  , SessionMaterialExposure(..)-  , EncryptMessageProfile-  , EncryptMessageOptions(..)-  , RecoveredSessionMaterial(..)-  , encryptMessage-  , decryptMessage-  , signMessage-  , signMessageWith-  , ConduitMessage.VerificationPolicy(..)-  , ConduitMessage.VerificationOptions(..)-  , ConduitMessage.defaultVerificationOptions-  , verifySignedMessage-  ) where--import Data.Bifunctor (first)-import Data.Kind (Type)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)-import qualified Crypto.Hash as CH-import qualified Crypto.PubKey.Ed25519 as Ed25519-import qualified Crypto.PubKey.Ed448 as Ed448-import qualified Crypto.PubKey.RSA.Types as RSATypes-import qualified Data.ByteArray as BA-import Crypto.Random.Types (MonadRandom, getRandomBytes)-import Data.Binary (put)-import Data.Binary.Put (runPut)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import Data.Word (Word8)--import Codec.Encryption.OpenPGP.BlockCipher (CipherError, renderCipherError, keySize, withSymmetricCipher)-import Codec.Encryption.OpenPGP.CFB-  ( OpenPGPCFBModeW(..)-  , decryptOpenPGPCfb-  , decryptPreservingNonce-  , encryptOpenPGPCfbRaw-  , mdcTrailerForSEIPDv1-  , seipdv1NonceFromIV-  , validateSEIPD1MDC-  )-import Codec.Encryption.OpenPGP.Encrypt (encryptSEIPDv2WithSKESKBlock)-import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)-import Codec.Encryption.OpenPGP.Internal.HOBlockCipher (HOBlockCipher(..))-import Codec.Encryption.OpenPGP.Internal.CryptoSEIPDv2-  ( decryptSKESK6SessionKey-  , deriveSKESK6KEK-  )-import Codec.Encryption.OpenPGP.Policy-  ( OpenPGPPolicy-  , defaultPolicy-  , deprecatedHashAlgorithms-  , messageDefaultAEADAlgorithm-  , messageDefaultChunkSize-  , messageSEIPDv2SaltOctets-  , policyGenerationDeprecations-  , policyMessageEncryption-  , supportsSEIPDv2Symmetric-  , OpenPGPRFCW(..)-  , HashAlgorithmW(..)-  )-import Codec.Encryption.OpenPGP.S2K (S2KError(..), renderS2KError, skesk2SessionKey, string2Key)-import Codec.Encryption.OpenPGP.Serialize (parsePkts)-import Codec.Encryption.OpenPGP.Signatures-  ( SignError(..)-  , VerificationError-  , signDataWithRSABuilder-  , signDataWithRSAV6Builder-  , signDataWithEd25519Builder-  , signDataWithEd25519V6Builder-  , signDataWithEd448Builder-  , signDataWithEd448V6Builder-  )-import Codec.Encryption.OpenPGP.Subpackets-  ( sigBuilderInitTyped-  , sigBuilderInitV6Typed-  , addHashedSubs-  , addUnhashedSubs-  , listToHashedSubs-  , listToUnhashedSubs-  )-import Codec.Encryption.OpenPGP.Types-import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA-import Data.Conduit.OpenPGP.Decrypt (decryptSEIPDv2Payload)-import qualified Data.Conduit.OpenPGP.Message as ConduitMessage--newtype Passphrase = Passphrase { unPassphrase :: BL.ByteString }-  deriving (Eq, Ord, Show)--newtype EncryptedPayload = EncryptedPayload { unEncryptedPayload :: BL.ByteString }-  deriving (Eq, Ord, Show)--newtype ClearPayload = ClearPayload { unClearPayload :: BL.ByteString }-  deriving (Eq, Ord, Show)--newtype WrappedSessionMaterial = WrappedSessionMaterial { unWrappedSessionMaterial :: B.ByteString }-  deriving (Eq, Ord, Show)--data SigningAlgorithm = AlgoRSA | AlgoEd25519 | AlgoEd448--type family SecretKeyFor (alg :: SigningAlgorithm) where-  SecretKeyFor 'AlgoRSA = RSATypes.PrivateKey-  SecretKeyFor 'AlgoEd25519 = Ed25519.SecretKey-  SecretKeyFor 'AlgoEd448 = Ed448.SecretKey--type family KeyVersionForSig (v :: Type) :: KeyVersion where-  KeyVersionForSig V4Sig = 'V4-  KeyVersionForSig V6Sig = 'V6--data VersionedPKPayload (v :: KeyVersion) where-  VersionedPKPayloadV4 :: PKPayload 'V4 -> VersionedPKPayload 'V4-  VersionedPKPayloadV6 :: PKPayload 'V6 -> VersionedPKPayload 'V6--asV4PKPayload :: SomePKPayload -> Either String (VersionedPKPayload 'V4)-asV4PKPayload (SomePKPayload pk@(PKPayloadV4 _ _ _)) =-  Right (VersionedPKPayloadV4 pk)-asV4PKPayload _ = Left "Expected a v4 PKPayload"--asV6PKPayload :: SomePKPayload -> Either String (VersionedPKPayload 'V6)-asV6PKPayload (SomePKPayload pk@(PKPayloadV6 _ _ _)) =-  Right (VersionedPKPayloadV6 pk)-asV6PKPayload _ = Left "Expected a v6 PKPayload"--data Signer (alg :: SigningAlgorithm) (v :: Type) where-  RSASigner :: VersionedPKPayload (KeyVersionForSig v) -> SecretKeyFor 'AlgoRSA -> Signer 'AlgoRSA v-  Ed25519Signer :: VersionedPKPayload (KeyVersionForSig v) -> SecretKeyFor 'AlgoEd25519 -> Signer 'AlgoEd25519 v-  Ed448Signer :: VersionedPKPayload (KeyVersionForSig v) -> SecretKeyFor 'AlgoEd448 -> Signer 'AlgoEd448 v--class SigningCapability (alg :: SigningAlgorithm) v-instance SigningCapability 'AlgoRSA V4Sig-instance SigningCapability 'AlgoRSA V6Sig-instance SigningCapability 'AlgoEd25519 V4Sig-instance SigningCapability 'AlgoEd25519 V6Sig-instance SigningCapability 'AlgoEd448 V4Sig-instance SigningCapability 'AlgoEd448 V6Sig--mkRSASignerV4 :: VersionedPKPayload 'V4 -> SecretKeyFor 'AlgoRSA -> Signer 'AlgoRSA V4Sig-mkRSASignerV4 = RSASigner--mkRSASignerV6 :: VersionedPKPayload 'V6 -> SecretKeyFor 'AlgoRSA -> Signer 'AlgoRSA V6Sig-mkRSASignerV6 = RSASigner--mkEd25519SignerV4 :: VersionedPKPayload 'V4 -> SecretKeyFor 'AlgoEd25519 -> Signer 'AlgoEd25519 V4Sig-mkEd25519SignerV4 = Ed25519Signer--mkEd25519SignerV6 :: VersionedPKPayload 'V6 -> SecretKeyFor 'AlgoEd25519 -> Signer 'AlgoEd25519 V6Sig-mkEd25519SignerV6 = Ed25519Signer--mkEd448SignerV4 :: VersionedPKPayload 'V4 -> SecretKeyFor 'AlgoEd448 -> Signer 'AlgoEd448 V4Sig-mkEd448SignerV4 = Ed448Signer--mkEd448SignerV6 :: VersionedPKPayload 'V6 -> SecretKeyFor 'AlgoEd448 -> Signer 'AlgoEd448 V6Sig-mkEd448SignerV6 = Ed448Signer--data MessageError-  = MessageEncryptError String-  | MessageDecryptError String-  | MessageSignError SignError-  | MessageParseError String-  | MessageParseFailureError MessageParseFailure-  | MessageDecryptFailureError MessageDecryptFailure-  deriving (Eq, Show)--newtype MessageFlow a =-  MessageFlow-    { runMessageFlow :: Either MessageError a-    }--instance Functor MessageFlow where-  fmap f (MessageFlow result) = MessageFlow (fmap f result)--instance Applicative MessageFlow where-  pure = MessageFlow . Right-  MessageFlow ff <*> MessageFlow fa = MessageFlow (ff <*> fa)--instance Monad MessageFlow where-  MessageFlow result >>= f =-    case result of-      Left err -> MessageFlow (Left err)-      Right x -> f x--messageStep :: Either MessageError a -> MessageFlow a-messageStep = MessageFlow--type MessageFlowT m = ExceptT MessageError m--runMessageFlowT :: MessageFlowT m a -> m (Either MessageError a)-runMessageFlowT = runExceptT--liftMessageFlowT :: Monad m => MessageFlow a -> MessageFlowT m a-liftMessageFlowT (MessageFlow result) =-  case result of-    Left err -> throwE err-    Right x -> pure x--data MessageParseFailure-  = MissingEncryptedMessage-  | ExpectedSKESKThenEncryptedData-  | SKESKSEIPDAlgorithmMismatch-  | UnsupportedEncryptedSKESK-  | MissingLiteralDataPacket-  | UnknownCriticalPacketType Word8-  | BrokenCriticalPacketType Word8 String-  deriving (Eq, Show)--data MessageDecryptFailure-  = SessionMaterialDerivationFailed S2KError-  | PayloadDecryptFailed String-  deriving (Eq, Show)--data ParsedEncryptedPayloadKind-  = LegacySEDPayloadKind-  | LegacySEIPDv1PayloadKind-  | SEIPDv2PayloadKind--data EncryptedPreludeKind-  = LegacyEncryptedPreludeKind-  | SEIPDv2EncryptedPreludeKind--data SessionMaterialExposure-  = DoNotExposeSessionMaterial-  | ExposeSessionMaterial-  deriving (Eq, Show)--data EncryptMessageProfile-  = RFC4880Message-  | RFC9580Message--data EncryptMessageOptions (p :: EncryptMessageProfile) where-  RFC4880EncryptMessageOptions ::-       { rfc4880EncryptMessageExposure :: SessionMaterialExposure-       , rfc4880EncryptMessageSymmetricAlgorithm :: SymmetricAlgorithm-       , rfc4880EncryptMessageS2K :: S2K-       , rfc4880EncryptMessageIV :: IV-       }-    -> EncryptMessageOptions 'RFC4880Message-  RFC9580EncryptMessageOptions ::-       { rfc9580EncryptMessageExposure :: SessionMaterialExposure-       , rfc9580EncryptMessageSymmetricAlgorithm :: SymmetricAlgorithm-       , rfc9580EncryptMessageS2K :: S2K-       , rfc9580EncryptMessageIV :: IV-       }-    -> EncryptMessageOptions 'RFC9580Message--deriving instance Eq (EncryptMessageOptions p)-deriving instance Show (EncryptMessageOptions p)--data RecoveredSessionMaterial =-  RecoveredSessionMaterial-    { recoveredSessionAlgorithm :: SymmetricAlgorithm-    , recoveredSessionKey :: SessionKey-    }-  deriving (Eq, Show)--renderMessageParseFailure :: MessageParseFailure -> String-renderMessageParseFailure MissingEncryptedMessage =-  "Could not parse encrypted OpenPGP message"-renderMessageParseFailure ExpectedSKESKThenEncryptedData =-  "Expected an SKESK packet followed by symmetrically encrypted data or SEIPD v2 data"-renderMessageParseFailure SKESKSEIPDAlgorithmMismatch =-  "SKESK and SEIPD v2 algorithms do not match"-renderMessageParseFailure UnsupportedEncryptedSKESK =-  "Cannot decrypt SKESK packets with encrypted session keys"-renderMessageParseFailure MissingLiteralDataPacket =-  "Decrypted message does not contain a literal data packet"-renderMessageParseFailure (UnknownCriticalPacketType t) =-  "Unknown critical packet type: " ++ show t-renderMessageParseFailure (BrokenCriticalPacketType t err) =-  "Broken critical packet type " ++ show t ++ ": " ++ err--renderMessageDecryptFailure :: MessageDecryptFailure -> String-renderMessageDecryptFailure (SessionMaterialDerivationFailed err) = renderS2KError err-renderMessageDecryptFailure (PayloadDecryptFailed err) = err--mkPassphrase :: BL.ByteString -> Passphrase-mkPassphrase = Passphrase--passphraseBytes :: Passphrase -> BL.ByteString-passphraseBytes = unPassphrase--mkEncryptedPayload :: BL.ByteString -> EncryptedPayload-mkEncryptedPayload = EncryptedPayload--mkClearPayload :: BL.ByteString -> ClearPayload-mkClearPayload = ClearPayload--clearPayloadBytes :: ClearPayload -> BL.ByteString-clearPayloadBytes = unClearPayload--encryptedPayloadBytes :: EncryptedPayload -> BL.ByteString-encryptedPayloadBytes = unEncryptedPayload--firstLeft :: (e -> e') -> Either e a -> Either e' a-firstLeft f = either (Left . f) Right---- | Lift a parse failure step into the unified MessageError channel-parseStep :: Either MessageParseFailure a -> MessageFlow a-parseStep = messageStep . firstLeft MessageParseFailureError---- | Lift a decrypt failure step into the unified MessageError channel-decryptStep :: Either MessageDecryptFailure a -> MessageFlow a-decryptStep = messageStep . firstLeft MessageDecryptFailureError---- | Lift a string encrypt error step into the unified MessageError channel-encryptStep :: Either String a -> MessageFlow a-encryptStep = messageStep . firstLeft MessageEncryptError---- | Lift a sign error step into the unified MessageError channel-signStep :: Either SignError a -> MessageFlow a-signStep = messageStep . firstLeft MessageSignError--signStepT :: Monad m => Either SignError a -> MessageFlowT m a-signStepT = liftMessageFlowT . signStep--signBackendStep :: Either String a -> Either SignError a-signBackendStep = firstLeft SignBackendError--decryptSessionStep :: Either S2KError a -> Either MessageDecryptFailure a-decryptSessionStep = firstLeft SessionMaterialDerivationFailed--decryptSessionKeySizeStep :: Either CipherError a -> Either MessageDecryptFailure a-decryptSessionKeySizeStep =-  firstLeft (SessionMaterialDerivationFailed . S2KUnsupportedAlgorithm)--decryptCipherStep :: Either CipherError a -> Either MessageDecryptFailure a-decryptCipherStep = firstLeft (PayloadDecryptFailed . renderCipherError)--decryptPayloadStep :: Either String a -> Either MessageDecryptFailure a-decryptPayloadStep = firstLeft PayloadDecryptFailed--encryptMessage ::-     EncryptMessageOptions p-  -> Passphrase-  -> ClearPayload-  -> Either MessageError (EncryptedPayload, Maybe RecoveredSessionMaterial)-encryptMessage options passphrase payload = runMessageFlow $-  case options of-    RFC4880EncryptMessageOptions exposure sa s2k iv -> do-      encryptedPayload <- encryptMessageWithRFC4880Fallback sa s2k iv passphrase payload-      sessionKeyMaterial <- deriveSessionMaterial sa s2k passphrase-      pure (encryptedPayload, exposedSessionMaterial exposure sa sessionKeyMaterial)-    RFC9580EncryptMessageOptions exposure sa s2k iv -> do-      encryptStep $ validateRFC9580MessageSymmetric defaultPolicy sa-      encryptStep $ validateModernMessageS2K defaultPolicy s2k-      encrypted <--        encryptStep $-        encryptSEIPDv2WithSKESKBlock-          sa-          (messageDefaultAEADAlgorithm messagePolicy)-          (messageDefaultChunkSize messagePolicy)-          (defaultSEIPDv2SaltFromIV (messageSEIPDv2SaltOctets messagePolicy) iv)-          s2k-          (unPassphrase passphrase)-          (Block [LiteralDataPkt BinaryData BL.empty 0 (unClearPayload payload)])-      sessionKeyMaterial <- deriveSessionMaterial sa s2k passphrase-      pure-        ( EncryptedPayload (runPut (put (Block encrypted)))-        , exposedSessionMaterial exposure sa sessionKeyMaterial-        )-  where-    messagePolicy = policyMessageEncryption defaultPolicy--defaultSEIPDv2SaltFromIV :: Int -> IV -> Salt-defaultSEIPDv2SaltFromIV outputLen (IV ivBytes) =-  Salt (B.take outputLen (B.concat (replicate outputLen seed)))-  where-    seed-      | B.null ivBytes = B.singleton 0-      | otherwise = ivBytes--encryptMessageWithRFC4880Fallback ::-     SymmetricAlgorithm-  -> S2K-  -> IV-  -> Passphrase-  -> ClearPayload-  -> MessageFlow EncryptedPayload-encryptMessageWithRFC4880Fallback sa s2k iv passphrase payload = do-  keyLen          <- encryptStep . first renderCipherError $ keySize sa-  sessionMaterial <- encryptStep . first renderS2KError $-                       WrappedSessionMaterial <$> string2Key s2k keyLen (unPassphrase passphrase)-  let literal          = LiteralDataPkt BinaryData BL.empty 0 (unClearPayload payload)-      cleartext        = BL.toStrict (runPut (put (Block [literal])))-      cleartextWithMDC = cleartext <> mdcTrailerForSEIPDv1 iv cleartext-  encrypted <- encryptStep . first renderCipherError $-                 encryptOpenPGPCfbRaw OpenPGPCFBNoResyncW sa iv cleartextWithMDC (unWrappedSessionMaterial sessionMaterial)-  return . EncryptedPayload . runPut . put $-    Block-      [ SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k Nothing))-      , SymEncIntegrityProtectedDataPkt (SEIPD1 1 (BL.fromStrict encrypted))-      ]--deriveSessionMaterial ::-     SymmetricAlgorithm -> S2K -> Passphrase -> MessageFlow B.ByteString-deriveSessionMaterial sa s2k passphrase = do-  keyLen <- encryptStep . first renderCipherError $ keySize sa-  encryptStep . first renderS2KError $ string2Key s2k keyLen (unPassphrase passphrase)--exposedSessionMaterial ::-     SessionMaterialExposure-  -> SymmetricAlgorithm-  -> B.ByteString-  -> Maybe RecoveredSessionMaterial-exposedSessionMaterial DoNotExposeSessionMaterial _ _ = Nothing-exposedSessionMaterial ExposeSessionMaterial sa sessionKeyMaterial =-  Just-    (RecoveredSessionMaterial-       { recoveredSessionAlgorithm = sa-       , recoveredSessionKey = SessionKey sessionKeyMaterial-       })--decryptMessage :: Passphrase -> EncryptedPayload -> Either MessageError ClearPayload-decryptMessage passphrase encrypted = runMessageFlow $ do-  encryptedPackets <- parseStep $ rejectUnknownCriticalPacketsTyped (parsePkts (unEncryptedPayload encrypted))-  payload          <- parseStep $ extractEncryptedPayload encryptedPackets-  cleartext        <- decryptStep $ decryptPayloadTyped passphrase payload-  clearPackets     <- parseStep $ rejectUnknownCriticalPacketsTyped (parsePkts (unClearPayload cleartext))-  parseStep $ extractLiteralPayload clearPackets--signMessageWith ::-     (MonadRandom m, SigningCapability alg v)-  => Signer alg v-  -> ClearPayload-  -> m (Either MessageError BL.ByteString)-signMessageWith signer payload = runMessageFlowT $-  case signer of-    RSASigner signerPK signingKey ->-      case signerPK of-        VersionedPKPayloadV4 pk ->-          signV4Message-            pk-            (\hashed unhashed clear ->-               let builder =-                     sigBuilderInitTyped @'PKA.RSA RFC9580W BinarySig SHA512W-                   withHashed = addHashedSubs (listToHashedSubs hashed) builder-                   withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed-                in signDataWithRSABuilder withUnhashed signingKey clear)-            payload-        VersionedPKPayloadV6 pk ->-          signV6Message-            pk-            (\salt hashed unhashed clear ->-               let builder =-                     sigBuilderInitV6Typed @'PKA.RSA RFC9580W BinarySig SHA512W salt-                   withHashed = addHashedSubs (listToHashedSubs hashed) builder-                   withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed-                in signDataWithRSAV6Builder withUnhashed signingKey clear)-            payload-    Ed25519Signer signerPK signingKey ->-      case signerPK of-        VersionedPKPayloadV4 pk ->-          signV4Message-            pk-            (\hashed unhashed clear ->-               let builder =-                     sigBuilderInitTyped @'PKA.Ed25519 RFC9580W BinarySig SHA512W-                   withHashed = addHashedSubs (listToHashedSubs hashed) builder-                   withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed-                in signDataWithEd25519Builder withUnhashed signingKey clear)-            payload-        VersionedPKPayloadV6 pk ->-          signV6Message-            pk-            (\salt hashed unhashed clear ->-               let builder =-                     sigBuilderInitV6Typed @'PKA.Ed25519 RFC9580W BinarySig SHA512W salt-                   withHashed = addHashedSubs (listToHashedSubs hashed) builder-                   withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed-                in signDataWithEd25519V6Builder withUnhashed signingKey clear)-            payload-    Ed448Signer signerPK signingKey ->-      case signerPK of-        VersionedPKPayloadV4 pk ->-          signV4Message-            pk-            (\hashed unhashed clear ->-               let builder =-                     sigBuilderInitTyped @'PKA.Ed448 RFC9580W BinarySig SHA512W-                   withHashed = addHashedSubs (listToHashedSubs hashed) builder-                   withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed-                in signDataWithEd448Builder withUnhashed signingKey clear)-            payload-        VersionedPKPayloadV6 pk ->-          signV6Message-            pk-            (\salt hashed unhashed clear ->-               let builder =-                     sigBuilderInitV6Typed @'PKA.Ed448 RFC9580W BinarySig SHA512W salt-                   withHashed = addHashedSubs (listToHashedSubs hashed) builder-                   withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed-                in signDataWithEd448V6Builder withUnhashed signingKey clear)-            payload--signMessage ::-     (MonadRandom m, SigningCapability alg v)-  => Signer alg v-  -> BL.ByteString-  -> m (Either MessageError BL.ByteString)-signMessage signer = signMessageWith signer . mkClearPayload--versionedPKPayload :: VersionedPKPayload v -> PKPayload v-versionedPKPayload (VersionedPKPayloadV4 pk) = pk-versionedPKPayload (VersionedPKPayloadV6 pk) = pk--verifySignedMessage ::-     ConduitMessage.VerificationOptions-  -> PublicKeyring-  -> BL.ByteString-  -> [Either VerificationError Verification]-verifySignedMessage = ConduitMessage.verifyMessage--signV4Message ::-     Monad m-  => PKPayload 'V4-  -> ([SigSubPacket] -> [SigSubPacket] -> BL.ByteString -> Either SignError SignaturePayload)-  -> ClearPayload-  -> MessageFlowT m BL.ByteString-signV4Message signer signingFn payload =-  signStepT (signV4WithIssuers signer signingFn payload)--signV6Message ::-     MonadRandom m-  => PKPayload 'V6-  -> (SignatureSalt -> [SigSubPacket] -> [SigSubPacket] -> BL.ByteString -> Either SignError SignaturePayload)-  -> ClearPayload-  -> MessageFlowT m BL.ByteString-signV6Message signer signingFn payload = do-  salt <- lift randomSHA512SignatureSalt-  signStepT (signV6WithFingerprintOnly signer (signingFn salt) payload)--randomSHA512SignatureSalt :: MonadRandom m => m SignatureSalt-randomSHA512SignatureSalt =-  SignatureSalt . BL.fromStrict <$> getRandomBytes 32--signV4WithIssuers ::-     PKPayload 'V4-  -> ([SigSubPacket] -> [SigSubPacket] -> BL.ByteString -> Either SignError SignaturePayload)-  -> ClearPayload-  -> Either SignError BL.ByteString-signV4WithIssuers signer signingFn payload = do-  issuerKeyId <- signBackendStep (eightOctetKeyID (SomePKPayload signer))-  let hashed = [SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint (SomePKPayload signer)))]-      unhashed = [SigSubPacket False (Issuer issuerKeyId)]-  signWithSubpackets hashed unhashed signingFn payload--signV6WithFingerprintOnly ::-     PKPayload 'V6-  -> ([SigSubPacket] -> [SigSubPacket] -> BL.ByteString -> Either SignError SignaturePayload)-  -> ClearPayload-  -> Either SignError BL.ByteString-signV6WithFingerprintOnly signer signingFn payload = do-  let hashed = [SigSubPacket False (IssuerFingerprint IssuerFingerprintV6 (fingerprint (SomePKPayload signer)))]-      unhashed = []-  signWithSubpackets hashed unhashed signingFn payload--signWithSubpackets ::-     [SigSubPacket]-  -> [SigSubPacket]-  -> ([SigSubPacket] -> [SigSubPacket] -> BL.ByteString -> Either SignError SignaturePayload)-  -> ClearPayload-  -> Either SignError BL.ByteString-signWithSubpackets hashed unhashed signingFn payload = do-  let clear = unClearPayload payload-      literal = LiteralDataPkt BinaryData BL.empty 0 clear-  signature <- signingFn hashed unhashed clear-  return . runPut . put $ Block [literal, SignaturePkt signature]--encryptOpenPGPCfb ::-     SymmetricAlgorithm-  -> IV-  -> B.ByteString-  -> WrappedSessionMaterial-  -> Either CipherError B.ByteString-encryptOpenPGPCfb sa iv cleartext (WrappedSessionMaterial keydata) =-  encryptOpenPGPCfbRaw OpenPGPCFBResyncW sa iv cleartext keydata--extractEncryptedPayload ::-     [Pkt] -> Either MessageParseFailure SomeParsedEncryptedPayload-extractEncryptedPayload =-  fmap parsedEncryptedPayloadFromPrelude . extractEncryptedPreludeTyped--data EncryptedPrelude (k :: EncryptedPreludeKind) where-  LegacySEDPrelude ::-       SKESK 'SKESKV4-    -> B.ByteString-    -> EncryptedPrelude 'LegacyEncryptedPreludeKind-  LegacySEIPDv1Prelude ::-       SKESK 'SKESKV4-    -> B.ByteString-    -> EncryptedPrelude 'LegacyEncryptedPreludeKind-  SEIPDv2SKESK4Prelude ::-       SymmetricAlgorithm-    -> S2K-    -> AEADAlgorithm-    -> Word8-    -> Salt-    -> B.ByteString-    -> EncryptedPrelude 'SEIPDv2EncryptedPreludeKind-  SEIPDv2SKESK6Prelude ::-       SymmetricAlgorithm-    -> AEADAlgorithm-    -> S2K-    -> BL.ByteString-    -> BL.ByteString-    -> BL.ByteString-    -> Word8-    -> Salt-    -> B.ByteString-    -> EncryptedPrelude 'SEIPDv2EncryptedPreludeKind--data SomeEncryptedPrelude where-  SomeEncryptedPrelude :: EncryptedPrelude k -> SomeEncryptedPrelude--extractEncryptedPreludeTyped ::-     [Pkt] -> Either MessageParseFailure SomeEncryptedPrelude-extractEncryptedPreludeTyped (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k esk)):SymEncDataPkt payload:_) =-  Right-    (SomeEncryptedPrelude-       (LegacySEDPrelude-          (SKESK4Packet sa s2k esk)-          (BL.toStrict payload)))-extractEncryptedPreludeTyped (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k esk)):SymEncIntegrityProtectedDataPkt (SEIPD1 _ payload):_) =-  Right-    (SomeEncryptedPrelude-       (LegacySEIPDv1Prelude-          (SKESK4Packet sa s2k esk)-          (BL.toStrict payload)))-extractEncryptedPreludeTyped (SKESKPkt skesk:SymEncIntegrityProtectedDataPkt (SEIPD2 payloadSA aead chunkSize salt payload):_) =-  toSEIPDv2Prelude skesk payloadSA aead chunkSize salt payload-extractEncryptedPreludeTyped [] = Left MissingEncryptedMessage-extractEncryptedPreludeTyped _ = Left ExpectedSKESKThenEncryptedData--toSEIPDv2Prelude ::-     SKESKPayload-  -> SymmetricAlgorithm-  -> AEADAlgorithm-  -> Word8-  -> Salt-  -> BL.ByteString-  -> Either MessageParseFailure SomeEncryptedPrelude-toSEIPDv2Prelude (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k Nothing)) payloadSA aead chunkSize salt payload-  | sa /= payloadSA = Left SKESKSEIPDAlgorithmMismatch-  | otherwise =-      Right-        (SomeEncryptedPrelude-           (SEIPDv2SKESK4Prelude-              sa-              s2k-              aead-              chunkSize-              salt-              (BL.toStrict payload)))-toSEIPDv2Prelude (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag)) payloadSA aead chunkSize salt payload-  | sa /= payloadSA = Left SKESKSEIPDAlgorithmMismatch-  | otherwise =-      Right-        (SomeEncryptedPrelude-           (SEIPDv2SKESK6Prelude-              sa-              aa-              s2k-              iv-              esk-              tag-              chunkSize-              salt-              (BL.toStrict payload)))-toSEIPDv2Prelude (SKESKPayloadV4Packet (SKESKPayloadV4 _ _ (Just _))) _ _ _ _ _ = Left UnsupportedEncryptedSKESK-toSEIPDv2Prelude _ _ _ _ _ _ = Left ExpectedSKESKThenEncryptedData--parsedEncryptedPayloadFromPrelude :: SomeEncryptedPrelude -> SomeParsedEncryptedPayload-parsedEncryptedPayloadFromPrelude (SomeEncryptedPrelude prelude) =-  case prelude of-    LegacySEDPrelude skesk payload ->-      SomeParsedEncryptedPayload (LegacySEDPayload skesk payload)-    LegacySEIPDv1Prelude skesk payload ->-      SomeParsedEncryptedPayload (LegacySEIPDv1Payload skesk payload)-    SEIPDv2SKESK4Prelude sa s2k aead chunkSize salt payload ->-      SomeParsedEncryptedPayload-        (SEIPDv2Payload-           sa-           aead-           chunkSize-           salt-           (SEIPDv2SKESK4 sa s2k)-           payload)-    SEIPDv2SKESK6Prelude sa aa s2k iv esk tag chunkSize salt payload ->-      SomeParsedEncryptedPayload-        (SEIPDv2Payload-           sa-           aa-           chunkSize-           salt-           (SEIPDv2SKESK6 sa aa s2k iv esk tag)-           payload)--data SEIPDv2SKESKInfo (v :: KeyVersion) where-  SEIPDv2SKESK4 :: SymmetricAlgorithm -> S2K -> SEIPDv2SKESKInfo 'V4-  SEIPDv2SKESK6 ::-       SymmetricAlgorithm-    -> AEADAlgorithm-    -> S2K-    -> BL.ByteString-    -> BL.ByteString-    -> BL.ByteString-    -> SEIPDv2SKESKInfo 'V6--data ParsedEncryptedPayload (k :: ParsedEncryptedPayloadKind) where-  LegacySEDPayload ::-       SKESK 'SKESKV4-    -> B.ByteString-    -> ParsedEncryptedPayload 'LegacySEDPayloadKind-  LegacySEIPDv1Payload ::-       SKESK 'SKESKV4-    -> B.ByteString-    -> ParsedEncryptedPayload 'LegacySEIPDv1PayloadKind-  SEIPDv2Payload ::-       SymmetricAlgorithm-    -> AEADAlgorithm-    -> Word8-    -> Salt-    -> SEIPDv2SKESKInfo v-    -> B.ByteString-    -> ParsedEncryptedPayload 'SEIPDv2PayloadKind--data SomeParsedEncryptedPayload where-  SomeParsedEncryptedPayload ::-       ParsedEncryptedPayload k-    -> SomeParsedEncryptedPayload--decryptPayload :: Passphrase -> SomeParsedEncryptedPayload -> Either String ClearPayload-decryptPayload passphrase =-  first renderMessageDecryptFailure . decryptPayloadTyped passphrase--decryptPayloadTyped ::-     Passphrase -> SomeParsedEncryptedPayload -> Either MessageDecryptFailure ClearPayload-decryptPayloadTyped passphrase (SomeParsedEncryptedPayload payload) =-  case payload of-    LegacySEDPayload skesk encryptedPayload ->-      decryptLegacySEDPayloadTyped passphrase skesk encryptedPayload-    LegacySEIPDv1Payload skesk encryptedPayload ->-      decryptLegacySEIPDv1PayloadTyped passphrase skesk encryptedPayload-    SEIPDv2Payload sa aead chunkSize salt skeskInfo encryptedPayload ->-      decryptSEIPDv2PayloadTyped-        passphrase-        sa-        aead-        chunkSize-        salt-        skeskInfo-        encryptedPayload--decryptLegacySEDPayloadTyped ::-     Passphrase-  -> SKESK 'SKESKV4-  -> B.ByteString-  -> Either MessageDecryptFailure ClearPayload-decryptLegacySEDPayloadTyped passphrase skesk payload = do-  (sessionAlgorithm, sessionKeyBytes) <--    decryptSessionStep $-    skesk2SessionKey skesk (unPassphrase passphrase)-  decryptCipherStep $-    ClearPayload . BL.fromStrict <$>-    decryptOpenPGPCfb-      sessionAlgorithm-      payload-      sessionKeyBytes--decryptLegacySEIPDv1PayloadTyped ::-     Passphrase-  -> SKESK 'SKESKV4-  -> B.ByteString-  -> Either MessageDecryptFailure ClearPayload-decryptLegacySEIPDv1PayloadTyped passphrase skesk payload = do-  (sessionAlgorithm, sessionKeyBytes) <--    decryptSessionStep $-    skesk2SessionKey skesk (unPassphrase passphrase)-  (nonce, decrypted) <--    decryptCipherStep $-    decryptPreservingNonce sessionAlgorithm payload sessionKeyBytes-  cleartext <- decryptPayloadStep $ validateSEIPD1MDC nonce decrypted-  Right (ClearPayload (BL.fromStrict cleartext))--decryptSEIPDv2PayloadTyped ::-    Passphrase-  -> SymmetricAlgorithm-  -> AEADAlgorithm-  -> Word8-  -> Salt-  -> SEIPDv2SKESKInfo v-  -> B.ByteString-  -> Either MessageDecryptFailure ClearPayload-decryptSEIPDv2PayloadTyped passphrase sa aead chunkSize salt skeskInfo payload = do-  sessionKey <- SessionKey <$> deriveSEIPDv2SessionKeyBytes passphrase skeskInfo-  decryptPayloadStep $-    ClearPayload . BL.fromStrict <$>-    decryptSEIPDv2Payload sa aead chunkSize salt payload sessionKey--deriveSEIPDv2SessionKeyBytes ::-     Passphrase-  -> SEIPDv2SKESKInfo v-  -> Either MessageDecryptFailure B.ByteString-deriveSEIPDv2SessionKeyBytes passphrase (SEIPDv2SKESK4 sa s2k) =-  deriveSessionKeyBytes passphrase sa s2k-deriveSEIPDv2SessionKeyBytes passphrase (SEIPDv2SKESK6 sa aead s2k iv esk tag) = do-  ikm <- deriveSessionKeyBytes passphrase sa s2k-  kek <- decryptPayloadStep $ deriveSKESK6KEK sa aead ikm-  decryptPayloadStep $-    decryptSKESK6SessionKey sa aead kek (BL.toStrict iv) (BL.toStrict esk) (BL.toStrict tag)--deriveSessionKeyBytes ::-     Passphrase-  -> SymmetricAlgorithm-  -> S2K-  -> Either MessageDecryptFailure B.ByteString-deriveSessionKeyBytes passphrase sa s2k = do-  keyLen <- decryptSessionKeySizeStep $ keySize sa-  decryptSessionStep $ string2Key s2k keyLen (unPassphrase passphrase)--extractLiteralPayload :: [Pkt] -> Either MessageParseFailure ClearPayload-extractLiteralPayload pkts =-  case [p | LiteralDataPkt _ _ _ p <- pkts] of-    payload:_ -> Right (ClearPayload payload)-    [] -> Left MissingLiteralDataPacket--rejectUnknownCriticalPacketsTyped :: [Pkt] -> Either MessageParseFailure [Pkt]-rejectUnknownCriticalPacketsTyped =-  go []-  where-    go acc [] = Right (reverse acc)-    go acc (pkt:rest) =-      case pkt of-        OtherPacketPkt t _ | t < 40 -> Left (UnknownCriticalPacketType t)-        BrokenPacketPkt err t _ | t < 40 -> Left (BrokenCriticalPacketType t err)-        _ -> go (pkt : acc) rest--validateModernMessageS2K :: OpenPGPPolicy -> S2K -> Either String ()-validateModernMessageS2K policy s2k =-  case s2kHashAlgorithm s2k of-    Just ha-      | ha `elem` deprecatedHashAlgorithms (policyGenerationDeprecations policy) ->-          Left-            ("deprecated hash algorithm disallowed for modern message generation: " ++-             show ha)-    _ -> Right ()--validateRFC9580MessageSymmetric ::-     OpenPGPPolicy -> SymmetricAlgorithm -> Either String ()-validateRFC9580MessageSymmetric policy sa-  | supportsSEIPDv2Symmetric policy sa = Right ()-  | otherwise =-      Left-        ("symmetric algorithm disallowed for RFC9580 message generation: " ++-         show sa)+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Codec.Encryption.OpenPGP.Message+    ( Passphrase+    , mkPassphrase+    , passphraseBytes+    , EncryptedPayload+    , mkEncryptedPayload+    , encryptedPayloadBytes+    , ClearPayload+    , mkClearPayload+    , clearPayloadBytes+    , WrappedSessionMaterial+    , SigningAlgorithm (..)+    , SecretKeyFor+    , VersionedPKPayload+    , asV4PKPayload+    , asV6PKPayload+    , Signer+    , SigningCapability+    , mkRSASignerV4+    , mkRSASignerV6+    , mkEd25519SignerV4+    , mkEd25519SignerV6+    , mkEd448SignerV4+    , mkEd448SignerV6+    , MessageParseFailure (..)+    , MessageDecryptFailure (..)+    , MessageError (..)+    , SessionMaterialExposure (..)+    , EncryptMessageProfile+    , EncryptMessageOptions (..)+    , RecoveredSessionMaterial (..)+    , encryptMessage+    , decryptMessage+    , signMessage+    , signMessageWith+    , ConduitMessage.VerificationPolicy (..)+    , ConduitMessage.VerificationOptions (..)+    , ConduitMessage.defaultVerificationOptions+    , verifySignedMessage+    ) where++import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)+import qualified Crypto.Hash as CH+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.RSA.Types as RSATypes+import Crypto.Random.Types (MonadRandom, getRandomBytes)+import Data.Bifunctor (first)+import Data.Binary (put)+import Data.Binary.Put (runPut)+import qualified Data.ByteArray as BA+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Kind (Type)+import Data.Word (Word8)++import Codec.Encryption.OpenPGP.BlockCipher+    ( CipherError+    , keySize+    , renderCipherError+    , withSymmetricCipher+    )+import Codec.Encryption.OpenPGP.CFB+    ( OpenPGPCFBModeW (..)+    , decryptOpenPGPCfb+    , decryptPreservingNonce+    , encryptOpenPGPCfbRaw+    , mdcTrailerForSEIPDv1+    , seipdv1NonceFromIV+    , validateSEIPD1MDC+    )+import Codec.Encryption.OpenPGP.Encrypt+    ( encryptSEIPDv2WithSKESKBlock+    )+import Codec.Encryption.OpenPGP.Fingerprint+    ( eightOctetKeyID+    , fingerprint+    )+import Codec.Encryption.OpenPGP.Internal.CryptoSEIPDv2+    ( decryptSKESK6SessionKey+    , deriveSKESK6KEK+    )+import Codec.Encryption.OpenPGP.Internal.HOBlockCipher+    ( HOBlockCipher (..)+    )+import Codec.Encryption.OpenPGP.Policy+    ( HashAlgorithmW (..)+    , OpenPGPPolicy+    , OpenPGPRFCW (..)+    , defaultPolicy+    , deprecatedHashAlgorithms+    , messageDefaultAEADAlgorithm+    , messageDefaultChunkSize+    , messageSEIPDv2SaltOctets+    , policyGenerationDeprecations+    , policyMessageEncryption+    , supportsSEIPDv2Symmetric+    )+import Codec.Encryption.OpenPGP.S2K+    ( S2KError (..)+    , renderS2KError+    , skesk2SessionKey+    , string2Key+    )+import Codec.Encryption.OpenPGP.Serialize (parsePkts)+import Codec.Encryption.OpenPGP.Signatures+    ( SignError (..)+    , VerificationError+    , signDataWithEd25519Builder+    , signDataWithEd25519V6Builder+    , signDataWithEd448Builder+    , signDataWithEd448V6Builder+    , signDataWithRSABuilder+    , signDataWithRSAV6Builder+    )+import Codec.Encryption.OpenPGP.Subpackets+    ( addHashedSubs+    , addUnhashedSubs+    , listToHashedSubs+    , listToUnhashedSubs+    , sigBuilderInitTyped+    , sigBuilderInitV6Typed+    )+import Codec.Encryption.OpenPGP.Types+import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA+import Data.Conduit.OpenPGP.Decrypt (decryptSEIPDv2Payload)+import qualified Data.Conduit.OpenPGP.Message as ConduitMessage++newtype Passphrase = Passphrase {unPassphrase :: BL.ByteString}+    deriving (Eq, Ord, Show)++newtype EncryptedPayload = EncryptedPayload {unEncryptedPayload :: BL.ByteString}+    deriving (Eq, Ord, Show)++newtype ClearPayload = ClearPayload {unClearPayload :: BL.ByteString}+    deriving (Eq, Ord, Show)++newtype WrappedSessionMaterial = WrappedSessionMaterial+    {unWrappedSessionMaterial :: B.ByteString}+    deriving (Eq, Ord, Show)++data SigningAlgorithm = AlgoRSA | AlgoEd25519 | AlgoEd448++type family SecretKeyFor (alg :: SigningAlgorithm) where+    SecretKeyFor 'AlgoRSA = RSATypes.PrivateKey+    SecretKeyFor 'AlgoEd25519 = Ed25519.SecretKey+    SecretKeyFor 'AlgoEd448 = Ed448.SecretKey++type family KeyVersionForSig (v :: Type) :: KeyVersion where+    KeyVersionForSig V4Sig = 'V4+    KeyVersionForSig V6Sig = 'V6++data VersionedPKPayload (v :: KeyVersion) where+    VersionedPKPayloadV4 :: PKPayload 'V4 -> VersionedPKPayload 'V4+    VersionedPKPayloadV6 :: PKPayload 'V6 -> VersionedPKPayload 'V6++asV4PKPayload+    :: SomePKPayload -> Either String (VersionedPKPayload 'V4)+asV4PKPayload (SomePKPayload pk@(PKPayloadV4 _ _ _)) =+    Right (VersionedPKPayloadV4 pk)+asV4PKPayload _ = Left "Expected a v4 PKPayload"++asV6PKPayload+    :: SomePKPayload -> Either String (VersionedPKPayload 'V6)+asV6PKPayload (SomePKPayload pk@(PKPayloadV6 _ _ _)) =+    Right (VersionedPKPayloadV6 pk)+asV6PKPayload _ = Left "Expected a v6 PKPayload"++data Signer (alg :: SigningAlgorithm) (v :: Type) where+    RSASigner+        :: VersionedPKPayload (KeyVersionForSig v)+        -> SecretKeyFor 'AlgoRSA+        -> Signer 'AlgoRSA v+    Ed25519Signer+        :: VersionedPKPayload (KeyVersionForSig v)+        -> SecretKeyFor 'AlgoEd25519+        -> Signer 'AlgoEd25519 v+    Ed448Signer+        :: VersionedPKPayload (KeyVersionForSig v)+        -> SecretKeyFor 'AlgoEd448+        -> Signer 'AlgoEd448 v++class SigningCapability (alg :: SigningAlgorithm) v+instance SigningCapability 'AlgoRSA V4Sig+instance SigningCapability 'AlgoRSA V6Sig+instance SigningCapability 'AlgoEd25519 V4Sig+instance SigningCapability 'AlgoEd25519 V6Sig+instance SigningCapability 'AlgoEd448 V4Sig+instance SigningCapability 'AlgoEd448 V6Sig++mkRSASignerV4+    :: VersionedPKPayload 'V4+    -> SecretKeyFor 'AlgoRSA+    -> Signer 'AlgoRSA V4Sig+mkRSASignerV4 = RSASigner++mkRSASignerV6+    :: VersionedPKPayload 'V6+    -> SecretKeyFor 'AlgoRSA+    -> Signer 'AlgoRSA V6Sig+mkRSASignerV6 = RSASigner++mkEd25519SignerV4+    :: VersionedPKPayload 'V4+    -> SecretKeyFor 'AlgoEd25519+    -> Signer 'AlgoEd25519 V4Sig+mkEd25519SignerV4 = Ed25519Signer++mkEd25519SignerV6+    :: VersionedPKPayload 'V6+    -> SecretKeyFor 'AlgoEd25519+    -> Signer 'AlgoEd25519 V6Sig+mkEd25519SignerV6 = Ed25519Signer++mkEd448SignerV4+    :: VersionedPKPayload 'V4+    -> SecretKeyFor 'AlgoEd448+    -> Signer 'AlgoEd448 V4Sig+mkEd448SignerV4 = Ed448Signer++mkEd448SignerV6+    :: VersionedPKPayload 'V6+    -> SecretKeyFor 'AlgoEd448+    -> Signer 'AlgoEd448 V6Sig+mkEd448SignerV6 = Ed448Signer++data MessageError+    = MessageEncryptError String+    | MessageDecryptError String+    | MessageSignError SignError+    | MessageParseError String+    | MessageParseFailureError MessageParseFailure+    | MessageDecryptFailureError MessageDecryptFailure+    deriving (Eq, Show)++newtype MessageFlow a+    = MessageFlow+    { runMessageFlow :: Either MessageError a+    }++instance Functor MessageFlow where+    fmap f (MessageFlow result) = MessageFlow (fmap f result)++instance Applicative MessageFlow where+    pure = MessageFlow . Right+    MessageFlow ff <*> MessageFlow fa = MessageFlow (ff <*> fa)++instance Monad MessageFlow where+    MessageFlow result >>= f =+        case result of+            Left err -> MessageFlow (Left err)+            Right x -> f x++messageStep :: Either MessageError a -> MessageFlow a+messageStep = MessageFlow++type MessageFlowT m = ExceptT MessageError m++runMessageFlowT :: MessageFlowT m a -> m (Either MessageError a)+runMessageFlowT = runExceptT++liftMessageFlowT :: Monad m => MessageFlow a -> MessageFlowT m a+liftMessageFlowT (MessageFlow result) =+    case result of+        Left err -> throwE err+        Right x -> pure x++data MessageParseFailure+    = MissingEncryptedMessage+    | ExpectedSKESKThenEncryptedData+    | SKESKSEIPDAlgorithmMismatch+    | UnsupportedEncryptedSKESK+    | MissingLiteralDataPacket+    | UnknownCriticalPacketType Word8+    | BrokenCriticalPacketType Word8 String+    deriving (Eq, Show)++data MessageDecryptFailure+    = SessionMaterialDerivationFailed S2KError+    | PayloadDecryptFailed String+    deriving (Eq, Show)++data ParsedEncryptedPayloadKind+    = LegacySEDPayloadKind+    | LegacySEIPDv1PayloadKind+    | SEIPDv2PayloadKind++data EncryptedPreludeKind+    = LegacyEncryptedPreludeKind+    | SEIPDv2EncryptedPreludeKind++data SessionMaterialExposure+    = DoNotExposeSessionMaterial+    | ExposeSessionMaterial+    deriving (Eq, Show)++data EncryptMessageProfile+    = RFC4880Message+    | RFC9580Message++data EncryptMessageOptions (p :: EncryptMessageProfile) where+    RFC4880EncryptMessageOptions+        :: { rfc4880EncryptMessageExposure :: SessionMaterialExposure+           , rfc4880EncryptMessageSymmetricAlgorithm :: SymmetricAlgorithm+           , rfc4880EncryptMessageS2K :: S2K+           , rfc4880EncryptMessageIV :: IV+           }+        -> EncryptMessageOptions 'RFC4880Message+    RFC9580EncryptMessageOptions+        :: { rfc9580EncryptMessageExposure :: SessionMaterialExposure+           , rfc9580EncryptMessageSymmetricAlgorithm :: SymmetricAlgorithm+           , rfc9580EncryptMessageS2K :: S2K+           , rfc9580EncryptMessageIV :: IV+           }+        -> EncryptMessageOptions 'RFC9580Message++deriving instance Eq (EncryptMessageOptions p)+deriving instance Show (EncryptMessageOptions p)++data RecoveredSessionMaterial+    = RecoveredSessionMaterial+    { recoveredSessionAlgorithm :: SymmetricAlgorithm+    , recoveredSessionKey :: SessionKey+    }+    deriving (Eq, Show)++renderMessageParseFailure :: MessageParseFailure -> String+renderMessageParseFailure MissingEncryptedMessage =+    "Could not parse encrypted OpenPGP message"+renderMessageParseFailure ExpectedSKESKThenEncryptedData =+    "Expected an SKESK packet followed by symmetrically encrypted data or SEIPD v2 data"+renderMessageParseFailure SKESKSEIPDAlgorithmMismatch =+    "SKESK and SEIPD v2 algorithms do not match"+renderMessageParseFailure UnsupportedEncryptedSKESK =+    "Cannot decrypt SKESK packets with encrypted session keys"+renderMessageParseFailure MissingLiteralDataPacket =+    "Decrypted message does not contain a literal data packet"+renderMessageParseFailure (UnknownCriticalPacketType t) =+    "Unknown critical packet type: " ++ show t+renderMessageParseFailure (BrokenCriticalPacketType t err) =+    "Broken critical packet type " ++ show t ++ ": " ++ err++renderMessageDecryptFailure :: MessageDecryptFailure -> String+renderMessageDecryptFailure (SessionMaterialDerivationFailed err) = renderS2KError err+renderMessageDecryptFailure (PayloadDecryptFailed err) = err++mkPassphrase :: BL.ByteString -> Passphrase+mkPassphrase = Passphrase++passphraseBytes :: Passphrase -> BL.ByteString+passphraseBytes = unPassphrase++mkEncryptedPayload :: BL.ByteString -> EncryptedPayload+mkEncryptedPayload = EncryptedPayload++mkClearPayload :: BL.ByteString -> ClearPayload+mkClearPayload = ClearPayload++clearPayloadBytes :: ClearPayload -> BL.ByteString+clearPayloadBytes = unClearPayload++encryptedPayloadBytes :: EncryptedPayload -> BL.ByteString+encryptedPayloadBytes = unEncryptedPayload++firstLeft :: (e -> e') -> Either e a -> Either e' a+firstLeft f = either (Left . f) Right++-- | Lift a parse failure step into the unified MessageError channel+parseStep :: Either MessageParseFailure a -> MessageFlow a+parseStep = messageStep . firstLeft MessageParseFailureError++-- | Lift a decrypt failure step into the unified MessageError channel+decryptStep :: Either MessageDecryptFailure a -> MessageFlow a+decryptStep = messageStep . firstLeft MessageDecryptFailureError++-- | Lift a string encrypt error step into the unified MessageError channel+encryptStep :: Either String a -> MessageFlow a+encryptStep = messageStep . firstLeft MessageEncryptError++-- | Lift a sign error step into the unified MessageError channel+signStep :: Either SignError a -> MessageFlow a+signStep = messageStep . firstLeft MessageSignError++signStepT :: Monad m => Either SignError a -> MessageFlowT m a+signStepT = liftMessageFlowT . signStep++signBackendStep :: Either String a -> Either SignError a+signBackendStep = firstLeft SignBackendError++decryptSessionStep+    :: Either S2KError a -> Either MessageDecryptFailure a+decryptSessionStep = firstLeft SessionMaterialDerivationFailed++decryptSessionKeySizeStep+    :: Either CipherError a -> Either MessageDecryptFailure a+decryptSessionKeySizeStep =+    firstLeft+        (SessionMaterialDerivationFailed . S2KUnsupportedAlgorithm)++decryptCipherStep+    :: Either CipherError a -> Either MessageDecryptFailure a+decryptCipherStep = firstLeft (PayloadDecryptFailed . renderCipherError)++decryptPayloadStep+    :: Either String a -> Either MessageDecryptFailure a+decryptPayloadStep = firstLeft PayloadDecryptFailed++encryptMessage+    :: EncryptMessageOptions p+    -> Passphrase+    -> ClearPayload+    -> Either+        MessageError+        (EncryptedPayload, Maybe RecoveredSessionMaterial)+encryptMessage options passphrase payload = runMessageFlow $+    case options of+        RFC4880EncryptMessageOptions exposure sa s2k iv -> do+            encryptedPayload <-+                encryptMessageWithRFC4880Fallback sa s2k iv passphrase payload+            sessionKeyMaterial <- deriveSessionMaterial sa s2k passphrase+            pure+                ( encryptedPayload+                , exposedSessionMaterial exposure sa sessionKeyMaterial+                )+        RFC9580EncryptMessageOptions exposure sa s2k iv -> do+            encryptStep $ validateRFC9580MessageSymmetric defaultPolicy sa+            encryptStep $ validateModernMessageS2K defaultPolicy s2k+            encrypted <-+                encryptStep $+                    encryptSEIPDv2WithSKESKBlock+                        sa+                        (messageDefaultAEADAlgorithm messagePolicy)+                        (messageDefaultChunkSize messagePolicy)+                        ( defaultSEIPDv2SaltFromIV+                            (messageSEIPDv2SaltOctets messagePolicy)+                            iv+                        )+                        s2k+                        (unPassphrase passphrase)+                        ( Block+                            [LiteralDataPkt BinaryData BL.empty 0 (unClearPayload payload)]+                        )+            sessionKeyMaterial <- deriveSessionMaterial sa s2k passphrase+            pure+                ( EncryptedPayload (runPut (put (Block encrypted)))+                , exposedSessionMaterial exposure sa sessionKeyMaterial+                )+  where+    messagePolicy = policyMessageEncryption defaultPolicy++defaultSEIPDv2SaltFromIV :: Int -> IV -> Salt+defaultSEIPDv2SaltFromIV outputLen (IV ivBytes) =+    Salt (B.take outputLen (B.concat (replicate outputLen seed)))+  where+    seed+        | B.null ivBytes = B.singleton 0+        | otherwise = ivBytes++encryptMessageWithRFC4880Fallback+    :: SymmetricAlgorithm+    -> S2K+    -> IV+    -> Passphrase+    -> ClearPayload+    -> MessageFlow EncryptedPayload+encryptMessageWithRFC4880Fallback sa s2k iv passphrase payload = do+    keyLen <-+        encryptStep . first renderCipherError $ keySize sa+    sessionMaterial <-+        encryptStep . first renderS2KError $+            WrappedSessionMaterial+                <$> string2Key s2k keyLen (unPassphrase passphrase)+    let literal =+            LiteralDataPkt BinaryData BL.empty 0 (unClearPayload payload)+        cleartext = BL.toStrict (runPut (put (Block [literal])))+        cleartextWithMDC = cleartext <> mdcTrailerForSEIPDv1 iv cleartext+    encrypted <-+        encryptStep . first renderCipherError $+            encryptOpenPGPCfbRaw+                OpenPGPCFBNoResyncW+                sa+                iv+                cleartextWithMDC+                (unWrappedSessionMaterial sessionMaterial)+    return . EncryptedPayload . runPut . put $+        Block+            [ SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k Nothing))+            , SymEncIntegrityProtectedDataPkt+                (SEIPD1 1 (BL.fromStrict encrypted))+            ]++deriveSessionMaterial+    :: SymmetricAlgorithm+    -> S2K+    -> Passphrase+    -> MessageFlow B.ByteString+deriveSessionMaterial sa s2k passphrase = do+    keyLen <- encryptStep . first renderCipherError $ keySize sa+    encryptStep . first renderS2KError $+        string2Key s2k keyLen (unPassphrase passphrase)++exposedSessionMaterial+    :: SessionMaterialExposure+    -> SymmetricAlgorithm+    -> B.ByteString+    -> Maybe RecoveredSessionMaterial+exposedSessionMaterial DoNotExposeSessionMaterial _ _ = Nothing+exposedSessionMaterial ExposeSessionMaterial sa sessionKeyMaterial =+    Just+        ( RecoveredSessionMaterial+            { recoveredSessionAlgorithm = sa+            , recoveredSessionKey = SessionKey sessionKeyMaterial+            }+        )++decryptMessage+    :: Passphrase+    -> EncryptedPayload+    -> Either MessageError ClearPayload+decryptMessage passphrase encrypted = runMessageFlow $ do+    encryptedPackets <-+        parseStep $+            rejectUnknownCriticalPacketsTyped+                (parsePkts (unEncryptedPayload encrypted))+    payload <-+        parseStep $ extractEncryptedPayload encryptedPackets+    cleartext <-+        decryptStep $ decryptPayloadTyped passphrase payload+    clearPackets <-+        parseStep $+            rejectUnknownCriticalPacketsTyped+                (parsePkts (unClearPayload cleartext))+    parseStep $ extractLiteralPayload clearPackets++signMessageWith+    :: (MonadRandom m, SigningCapability alg v)+    => Signer alg v+    -> ClearPayload+    -> m (Either MessageError BL.ByteString)+signMessageWith signer payload = runMessageFlowT $+    case signer of+        RSASigner signerPK signingKey ->+            case signerPK of+                VersionedPKPayloadV4 pk ->+                    signV4Message+                        pk+                        ( \hashed unhashed clear ->+                            let builder =+                                    sigBuilderInitTyped @'PKA.RSA RFC9580W BinarySig SHA512W+                                withHashed = addHashedSubs (listToHashedSubs hashed) builder+                                withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed+                             in signDataWithRSABuilder withUnhashed signingKey clear+                        )+                        payload+                VersionedPKPayloadV6 pk ->+                    signV6Message+                        pk+                        ( \salt hashed unhashed clear ->+                            let builder =+                                    sigBuilderInitV6Typed @'PKA.RSA RFC9580W BinarySig SHA512W salt+                                withHashed = addHashedSubs (listToHashedSubs hashed) builder+                                withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed+                             in signDataWithRSAV6Builder withUnhashed signingKey clear+                        )+                        payload+        Ed25519Signer signerPK signingKey ->+            case signerPK of+                VersionedPKPayloadV4 pk ->+                    signV4Message+                        pk+                        ( \hashed unhashed clear ->+                            let builder =+                                    sigBuilderInitTyped @'PKA.Ed25519 RFC9580W BinarySig SHA512W+                                withHashed = addHashedSubs (listToHashedSubs hashed) builder+                                withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed+                             in signDataWithEd25519Builder withUnhashed signingKey clear+                        )+                        payload+                VersionedPKPayloadV6 pk ->+                    signV6Message+                        pk+                        ( \salt hashed unhashed clear ->+                            let builder =+                                    sigBuilderInitV6Typed @'PKA.Ed25519+                                        RFC9580W+                                        BinarySig+                                        SHA512W+                                        salt+                                withHashed = addHashedSubs (listToHashedSubs hashed) builder+                                withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed+                             in signDataWithEd25519V6Builder withUnhashed signingKey clear+                        )+                        payload+        Ed448Signer signerPK signingKey ->+            case signerPK of+                VersionedPKPayloadV4 pk ->+                    signV4Message+                        pk+                        ( \hashed unhashed clear ->+                            let builder =+                                    sigBuilderInitTyped @'PKA.Ed448 RFC9580W BinarySig SHA512W+                                withHashed = addHashedSubs (listToHashedSubs hashed) builder+                                withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed+                             in signDataWithEd448Builder withUnhashed signingKey clear+                        )+                        payload+                VersionedPKPayloadV6 pk ->+                    signV6Message+                        pk+                        ( \salt hashed unhashed clear ->+                            let builder =+                                    sigBuilderInitV6Typed @'PKA.Ed448 RFC9580W BinarySig SHA512W salt+                                withHashed = addHashedSubs (listToHashedSubs hashed) builder+                                withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed+                             in signDataWithEd448V6Builder withUnhashed signingKey clear+                        )+                        payload++signMessage+    :: (MonadRandom m, SigningCapability alg v)+    => Signer alg v+    -> BL.ByteString+    -> m (Either MessageError BL.ByteString)+signMessage signer = signMessageWith signer . mkClearPayload++versionedPKPayload :: VersionedPKPayload v -> PKPayload v+versionedPKPayload (VersionedPKPayloadV4 pk) = pk+versionedPKPayload (VersionedPKPayloadV6 pk) = pk++verifySignedMessage+    :: ConduitMessage.VerificationOptions+    -> PublicKeyring+    -> BL.ByteString+    -> [Either VerificationError Verification]+verifySignedMessage = ConduitMessage.verifyMessage++signV4Message+    :: Monad m+    => PKPayload 'V4+    -> ( [SigSubPacket]+         -> [SigSubPacket]+         -> BL.ByteString+         -> Either SignError SignaturePayload+       )+    -> ClearPayload+    -> MessageFlowT m BL.ByteString+signV4Message signer signingFn payload =+    signStepT (signV4WithIssuers signer signingFn payload)++signV6Message+    :: MonadRandom m+    => PKPayload 'V6+    -> ( SignatureSalt+         -> [SigSubPacket]+         -> [SigSubPacket]+         -> BL.ByteString+         -> Either SignError SignaturePayload+       )+    -> ClearPayload+    -> MessageFlowT m BL.ByteString+signV6Message signer signingFn payload = do+    salt <- lift randomSHA512SignatureSalt+    signStepT+        (signV6WithFingerprintOnly signer (signingFn salt) payload)++randomSHA512SignatureSalt :: MonadRandom m => m SignatureSalt+randomSHA512SignatureSalt =+    SignatureSalt . BL.fromStrict <$> getRandomBytes 32++signV4WithIssuers+    :: PKPayload 'V4+    -> ( [SigSubPacket]+         -> [SigSubPacket]+         -> BL.ByteString+         -> Either SignError SignaturePayload+       )+    -> ClearPayload+    -> Either SignError BL.ByteString+signV4WithIssuers signer signingFn payload = do+    issuerKeyId <-+        signBackendStep (eightOctetKeyID (SomePKPayload signer))+    let hashed =+            [ SigSubPacket+                False+                ( IssuerFingerprint+                    IssuerFingerprintV4+                    (fingerprint (SomePKPayload signer))+                )+            ]+        unhashed = [SigSubPacket False (Issuer issuerKeyId)]+    signWithSubpackets hashed unhashed signingFn payload++signV6WithFingerprintOnly+    :: PKPayload 'V6+    -> ( [SigSubPacket]+         -> [SigSubPacket]+         -> BL.ByteString+         -> Either SignError SignaturePayload+       )+    -> ClearPayload+    -> Either SignError BL.ByteString+signV6WithFingerprintOnly signer signingFn payload = do+    let hashed =+            [ SigSubPacket+                False+                ( IssuerFingerprint+                    IssuerFingerprintV6+                    (fingerprint (SomePKPayload signer))+                )+            ]+        unhashed = []+    signWithSubpackets hashed unhashed signingFn payload++signWithSubpackets+    :: [SigSubPacket]+    -> [SigSubPacket]+    -> ( [SigSubPacket]+         -> [SigSubPacket]+         -> BL.ByteString+         -> Either SignError SignaturePayload+       )+    -> ClearPayload+    -> Either SignError BL.ByteString+signWithSubpackets hashed unhashed signingFn payload = do+    let clear = unClearPayload payload+        literal = LiteralDataPkt BinaryData BL.empty 0 clear+    signature <- signingFn hashed unhashed clear+    return . runPut . put $ Block [literal, SignaturePkt signature]++encryptOpenPGPCfb+    :: SymmetricAlgorithm+    -> IV+    -> B.ByteString+    -> WrappedSessionMaterial+    -> Either CipherError B.ByteString+encryptOpenPGPCfb sa iv cleartext (WrappedSessionMaterial keydata) =+    encryptOpenPGPCfbRaw OpenPGPCFBResyncW sa iv cleartext keydata++extractEncryptedPayload+    :: [Pkt] -> Either MessageParseFailure SomeParsedEncryptedPayload+extractEncryptedPayload =+    fmap parsedEncryptedPayloadFromPrelude+        . extractEncryptedPreludeTyped++data EncryptedPrelude (k :: EncryptedPreludeKind) where+    LegacySEDPrelude+        :: SKESK 'SKESKV4+        -> B.ByteString+        -> EncryptedPrelude 'LegacyEncryptedPreludeKind+    LegacySEIPDv1Prelude+        :: SKESK 'SKESKV4+        -> B.ByteString+        -> EncryptedPrelude 'LegacyEncryptedPreludeKind+    SEIPDv2SKESK4Prelude+        :: SymmetricAlgorithm+        -> S2K+        -> AEADAlgorithm+        -> Word8+        -> Salt+        -> B.ByteString+        -> EncryptedPrelude 'SEIPDv2EncryptedPreludeKind+    SEIPDv2SKESK6Prelude+        :: SymmetricAlgorithm+        -> AEADAlgorithm+        -> S2K+        -> BL.ByteString+        -> BL.ByteString+        -> BL.ByteString+        -> Word8+        -> Salt+        -> B.ByteString+        -> EncryptedPrelude 'SEIPDv2EncryptedPreludeKind++data SomeEncryptedPrelude where+    SomeEncryptedPrelude+        :: EncryptedPrelude k -> SomeEncryptedPrelude++extractEncryptedPreludeTyped+    :: [Pkt] -> Either MessageParseFailure SomeEncryptedPrelude+extractEncryptedPreludeTyped+    ( SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k esk))+            : SymEncDataPkt payload+            : _+        ) =+        Right+            ( SomeEncryptedPrelude+                ( LegacySEDPrelude+                    (SKESK4Packet sa s2k esk)+                    (BL.toStrict payload)+                )+            )+extractEncryptedPreludeTyped+    ( SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k esk))+            : SymEncIntegrityProtectedDataPkt (SEIPD1 _ payload)+            : _+        ) =+        Right+            ( SomeEncryptedPrelude+                ( LegacySEIPDv1Prelude+                    (SKESK4Packet sa s2k esk)+                    (BL.toStrict payload)+                )+            )+extractEncryptedPreludeTyped+    ( SKESKPkt skesk+            : SymEncIntegrityProtectedDataPkt+                (SEIPD2 payloadSA aead chunkSize salt payload)+            : _+        ) =+        toSEIPDv2Prelude skesk payloadSA aead chunkSize salt payload+extractEncryptedPreludeTyped [] = Left MissingEncryptedMessage+extractEncryptedPreludeTyped _ = Left ExpectedSKESKThenEncryptedData++toSEIPDv2Prelude+    :: SKESKPayload+    -> SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> Salt+    -> BL.ByteString+    -> Either MessageParseFailure SomeEncryptedPrelude+toSEIPDv2Prelude (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k Nothing)) payloadSA aead chunkSize salt payload+    | sa /= payloadSA = Left SKESKSEIPDAlgorithmMismatch+    | otherwise =+        Right+            ( SomeEncryptedPrelude+                ( SEIPDv2SKESK4Prelude+                    sa+                    s2k+                    aead+                    chunkSize+                    salt+                    (BL.toStrict payload)+                )+            )+toSEIPDv2Prelude (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag)) payloadSA aead chunkSize salt payload+    | sa /= payloadSA = Left SKESKSEIPDAlgorithmMismatch+    | otherwise =+        Right+            ( SomeEncryptedPrelude+                ( SEIPDv2SKESK6Prelude+                    sa+                    aa+                    s2k+                    iv+                    esk+                    tag+                    chunkSize+                    salt+                    (BL.toStrict payload)+                )+            )+toSEIPDv2Prelude (SKESKPayloadV4Packet (SKESKPayloadV4 _ _ (Just _))) _ _ _ _ _ = Left UnsupportedEncryptedSKESK++parsedEncryptedPayloadFromPrelude+    :: SomeEncryptedPrelude -> SomeParsedEncryptedPayload+parsedEncryptedPayloadFromPrelude (SomeEncryptedPrelude prelude) =+    case prelude of+        LegacySEDPrelude skesk payload ->+            SomeParsedEncryptedPayload (LegacySEDPayload skesk payload)+        LegacySEIPDv1Prelude skesk payload ->+            SomeParsedEncryptedPayload (LegacySEIPDv1Payload skesk payload)+        SEIPDv2SKESK4Prelude sa s2k aead chunkSize salt payload ->+            SomeParsedEncryptedPayload+                ( SEIPDv2Payload+                    sa+                    aead+                    chunkSize+                    salt+                    (SEIPDv2SKESK4 sa s2k)+                    payload+                )+        SEIPDv2SKESK6Prelude sa aa s2k iv esk tag chunkSize salt payload ->+            SomeParsedEncryptedPayload+                ( SEIPDv2Payload+                    sa+                    aa+                    chunkSize+                    salt+                    (SEIPDv2SKESK6 sa aa s2k iv esk tag)+                    payload+                )++data SEIPDv2SKESKInfo (v :: KeyVersion) where+    SEIPDv2SKESK4+        :: SymmetricAlgorithm -> S2K -> SEIPDv2SKESKInfo 'V4+    SEIPDv2SKESK6+        :: SymmetricAlgorithm+        -> AEADAlgorithm+        -> S2K+        -> BL.ByteString+        -> BL.ByteString+        -> BL.ByteString+        -> SEIPDv2SKESKInfo 'V6++data ParsedEncryptedPayload (k :: ParsedEncryptedPayloadKind) where+    LegacySEDPayload+        :: SKESK 'SKESKV4+        -> B.ByteString+        -> ParsedEncryptedPayload 'LegacySEDPayloadKind+    LegacySEIPDv1Payload+        :: SKESK 'SKESKV4+        -> B.ByteString+        -> ParsedEncryptedPayload 'LegacySEIPDv1PayloadKind+    SEIPDv2Payload+        :: SymmetricAlgorithm+        -> AEADAlgorithm+        -> Word8+        -> Salt+        -> SEIPDv2SKESKInfo v+        -> B.ByteString+        -> ParsedEncryptedPayload 'SEIPDv2PayloadKind++data SomeParsedEncryptedPayload where+    SomeParsedEncryptedPayload+        :: ParsedEncryptedPayload k+        -> SomeParsedEncryptedPayload++decryptPayload+    :: Passphrase+    -> SomeParsedEncryptedPayload+    -> Either String ClearPayload+decryptPayload passphrase =+    first renderMessageDecryptFailure+        . decryptPayloadTyped passphrase++decryptPayloadTyped+    :: Passphrase+    -> SomeParsedEncryptedPayload+    -> Either MessageDecryptFailure ClearPayload+decryptPayloadTyped passphrase (SomeParsedEncryptedPayload payload) =+    case payload of+        LegacySEDPayload skesk encryptedPayload ->+            decryptLegacySEDPayloadTyped passphrase skesk encryptedPayload+        LegacySEIPDv1Payload skesk encryptedPayload ->+            decryptLegacySEIPDv1PayloadTyped+                passphrase+                skesk+                encryptedPayload+        SEIPDv2Payload sa aead chunkSize salt skeskInfo encryptedPayload ->+            decryptSEIPDv2PayloadTyped+                passphrase+                sa+                aead+                chunkSize+                salt+                skeskInfo+                encryptedPayload++decryptLegacySEDPayloadTyped+    :: Passphrase+    -> SKESK 'SKESKV4+    -> B.ByteString+    -> Either MessageDecryptFailure ClearPayload+decryptLegacySEDPayloadTyped passphrase skesk payload = do+    (sessionAlgorithm, sessionKeyBytes) <-+        decryptSessionStep $+            skesk2SessionKey skesk (unPassphrase passphrase)+    decryptCipherStep $+        ClearPayload . BL.fromStrict+            <$> decryptOpenPGPCfb+                sessionAlgorithm+                payload+                sessionKeyBytes++decryptLegacySEIPDv1PayloadTyped+    :: Passphrase+    -> SKESK 'SKESKV4+    -> B.ByteString+    -> Either MessageDecryptFailure ClearPayload+decryptLegacySEIPDv1PayloadTyped passphrase skesk payload = do+    (sessionAlgorithm, sessionKeyBytes) <-+        decryptSessionStep $+            skesk2SessionKey skesk (unPassphrase passphrase)+    (nonce, decrypted) <-+        decryptCipherStep $+            decryptPreservingNonce sessionAlgorithm payload sessionKeyBytes+    cleartext <-+        decryptPayloadStep $ validateSEIPD1MDC nonce decrypted+    Right (ClearPayload (BL.fromStrict cleartext))++decryptSEIPDv2PayloadTyped+    :: Passphrase+    -> SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> Salt+    -> SEIPDv2SKESKInfo v+    -> B.ByteString+    -> Either MessageDecryptFailure ClearPayload+decryptSEIPDv2PayloadTyped passphrase sa aead chunkSize salt skeskInfo payload = do+    sessionKey <-+        SessionKey <$> deriveSEIPDv2SessionKeyBytes passphrase skeskInfo+    decryptPayloadStep $+        ClearPayload . BL.fromStrict+            <$> decryptSEIPDv2Payload sa aead chunkSize salt payload sessionKey++deriveSEIPDv2SessionKeyBytes+    :: Passphrase+    -> SEIPDv2SKESKInfo v+    -> Either MessageDecryptFailure B.ByteString+deriveSEIPDv2SessionKeyBytes passphrase (SEIPDv2SKESK4 sa s2k) =+    deriveSessionKeyBytes passphrase sa s2k+deriveSEIPDv2SessionKeyBytes passphrase (SEIPDv2SKESK6 sa aead s2k iv esk tag) = do+    ikm <- deriveSessionKeyBytes passphrase sa s2k+    kek <- decryptPayloadStep $ deriveSKESK6KEK sa aead ikm+    decryptPayloadStep $+        decryptSKESK6SessionKey+            sa+            aead+            kek+            (BL.toStrict iv)+            (BL.toStrict esk)+            (BL.toStrict tag)++deriveSessionKeyBytes+    :: Passphrase+    -> SymmetricAlgorithm+    -> S2K+    -> Either MessageDecryptFailure B.ByteString+deriveSessionKeyBytes passphrase sa s2k = do+    keyLen <- decryptSessionKeySizeStep $ keySize sa+    decryptSessionStep $+        string2Key s2k keyLen (unPassphrase passphrase)++extractLiteralPayload+    :: [Pkt] -> Either MessageParseFailure ClearPayload+extractLiteralPayload pkts =+    case [p | LiteralDataPkt _ _ _ p <- pkts] of+        payload : _ -> Right (ClearPayload payload)+        [] -> Left MissingLiteralDataPacket++rejectUnknownCriticalPacketsTyped+    :: [Pkt] -> Either MessageParseFailure [Pkt]+rejectUnknownCriticalPacketsTyped =+    go []+  where+    go acc [] = Right (reverse acc)+    go acc (pkt : rest) =+        case pkt of+            OtherPacketPkt t _ | t < 40 -> Left (UnknownCriticalPacketType t)+            BrokenPacketPkt err t _ | t < 40 -> Left (BrokenCriticalPacketType t err)+            _ -> go (pkt : acc) rest++validateModernMessageS2K+    :: OpenPGPPolicy -> S2K -> Either String ()+validateModernMessageS2K policy s2k =+    case s2kHashAlgorithm s2k of+        Just ha+            | ha+                `elem` deprecatedHashAlgorithms (policyGenerationDeprecations policy) ->+                Left+                    ( "deprecated hash algorithm disallowed for modern message generation: "+                        ++ show ha+                    )+        _ -> Right ()++validateRFC9580MessageSymmetric+    :: OpenPGPPolicy -> SymmetricAlgorithm -> Either String ()+validateRFC9580MessageSymmetric policy sa+    | supportsSEIPDv2Symmetric policy sa = Right ()+    | otherwise =+        Left+            ( "symmetric algorithm disallowed for RFC9580 message generation: "+                ++ show sa+            )  s2kHashAlgorithm :: S2K -> Maybe HashAlgorithm s2kHashAlgorithm (Simple ha) = Just ha
Codec/Encryption/OpenPGP/Policy.hs view
@@ -2,7 +2,6 @@ -- Copyright © 2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).- {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-}@@ -10,74 +9,87 @@ {-# LANGUAGE TypeFamilies #-}  module Codec.Encryption.OpenPGP.Policy-  ( OpenPGPRFC(..)-  , OpenPGPRFCW(..)-  , SomeOpenPGPRFCW(..)-  , promoteOpenPGPRFC-  , demoteOpenPGPRFCW-  , HashAlgorithmW(..)-  , SomeHashAlgorithmW(..)-  , promoteHashAlgorithm-  , demoteHashAlgorithmW-  , HashAlgoStatus(..)-  , HashAlgoStatusFor-  , HashAlgoAllowedFor-  , HashAlgoVerifiableFor-  , PKESKVersionPolicy(..)-  , MessageEncryptionPolicy(..)-  , SecretKeyProtectionPolicy(..)-  , GenerationDeprecationPolicy(..)-  , VerificationDefaults(..)-  , DecryptPolicy(..)-  , OpenPGPPolicy(..)-  , policyForRFC-  , defaultPolicy-  , defaultPKESKVersionPolicy-  , defaultVerificationDefaults-  , defaultDecryptPolicy-  , lenientDecryptPolicy-  , supportsSEIPDv2Symmetric-  , secretKeyProtectionPolicyForKeyVersion-  , signatureV6SaltSizeForHashAlgorithm-  , ecdhKdfHashDigest-  , validateTable30PolicyForRecipient-  , legacySecretKeyProtectionErrorMessage-  -- * Signature context validation (RFC9580/RFC4880)-  , isAllowedPrimaryKeySig-  , isAllowedSubkeySig-  , isAllowedUIDSig-  -- * Signature type validation helpers (for parser use)-  , isAllowedPrimaryKeySigType-  , isAllowedSubkeySigType-  , isAllowedUIDSigType-  ) where+    ( OpenPGPRFC (..)+    , OpenPGPRFCW (..)+    , SomeOpenPGPRFCW (..)+    , promoteOpenPGPRFC+    , demoteOpenPGPRFCW+    , HashAlgorithmW (..)+    , SomeHashAlgorithmW (..)+    , promoteHashAlgorithm+    , demoteHashAlgorithmW+    , HashAlgoStatus (..)+    , HashAlgoStatusFor+    , HashAlgoAllowedFor+    , HashAlgoVerifiableFor+    , PKESKVersionPolicy (..)+    , MessageEncryptionPolicy (..)+    , SecretKeyProtectionPolicy (..)+    , GenerationDeprecationPolicy (..)+    , VerificationDefaults (..)+    , DecryptPolicy (..)+    , OpenPGPPolicy (..)+    , policyForRFC+    , defaultPolicy+    , defaultPKESKVersionPolicy+    , defaultVerificationDefaults+    , defaultDecryptPolicy+    , lenientDecryptPolicy+    , supportsSEIPDv2Symmetric+    , secretKeyProtectionPolicyForKeyVersion+    , signatureV6SaltSizeForHashAlgorithm+    , ecdhKdfHashDigest+    , validateTable30PolicyForRecipient+    , legacySecretKeyProtectionErrorMessage -import Codec.Encryption.OpenPGP.Types-import Codec.Encryption.OpenPGP.SignatureQualities (sigType)+      -- * Signature verification policy+    , VerificationPolicy (..)+    , VerificationPolicyAction (..)+    , defaultVerificationPolicy+    , strictVerificationPolicy+    , lenientVerificationPolicy+    , isVerificationError+    , isVerificationWarning+    , applyVerificationPolicy++      -- * Signature context validation (RFC9580/RFC4880)+    , isAllowedPrimaryKeySig+    , isAllowedSubkeySig+    , isAllowedUIDSig++      -- * Signature type validation helpers (for parser use)+    , isAllowedPrimaryKeySigType+    , isAllowedSubkeySigType+    , isAllowedUIDSigType+    ) where+ import qualified Crypto.Hash as CH import qualified Crypto.Hash.Algorithms as CHAlg import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.ECC.Types as ECCT import qualified Data.ByteArray as BA import qualified Data.ByteString as B-import Data.List (elem) import Data.Kind (Constraint)+import Data.List (elem) import Data.Word (Word8)-import GHC.TypeLits (ErrorMessage(..), TypeError)+import GHC.TypeLits (ErrorMessage (..), TypeError) +import Codec.Encryption.OpenPGP.SignatureQualities (sigType)+import Codec.Encryption.OpenPGP.Types+ data OpenPGPRFC-  = RFC2440-  | RFC4880-  | RFC9580-  deriving (Eq, Show)+    = RFC2440+    | RFC4880+    | RFC9580+    deriving (Eq, Show)  data OpenPGPRFCW (rfc :: OpenPGPRFC) where-  RFC2440W :: OpenPGPRFCW 'RFC2440-  RFC4880W :: OpenPGPRFCW 'RFC4880-  RFC9580W :: OpenPGPRFCW 'RFC9580+    RFC2440W :: OpenPGPRFCW 'RFC2440+    RFC4880W :: OpenPGPRFCW 'RFC4880+    RFC9580W :: OpenPGPRFCW 'RFC9580  data SomeOpenPGPRFCW where-  SomeOpenPGPRFCW :: OpenPGPRFCW rfc -> SomeOpenPGPRFCW+    SomeOpenPGPRFCW :: OpenPGPRFCW rfc -> SomeOpenPGPRFCW  demoteOpenPGPRFCW :: OpenPGPRFCW rfc -> OpenPGPRFC demoteOpenPGPRFCW RFC2440W = RFC2440@@ -90,18 +102,18 @@ promoteOpenPGPRFC RFC9580 = SomeOpenPGPRFCW RFC9580W  data HashAlgorithmW (h :: HashAlgorithm) where-  DeprecatedMD5W :: HashAlgorithmW 'DeprecatedMD5-  SHA1W :: HashAlgorithmW 'SHA1-  RIPEMD160W :: HashAlgorithmW 'RIPEMD160-  SHA256W :: HashAlgorithmW 'SHA256-  SHA384W :: HashAlgorithmW 'SHA384-  SHA512W :: HashAlgorithmW 'SHA512-  SHA224W :: HashAlgorithmW 'SHA224-  SHA3_256W :: HashAlgorithmW 'SHA3_256-  SHA3_512W :: HashAlgorithmW 'SHA3_512+    DeprecatedMD5W :: HashAlgorithmW 'DeprecatedMD5+    SHA1W :: HashAlgorithmW 'SHA1+    RIPEMD160W :: HashAlgorithmW 'RIPEMD160+    SHA256W :: HashAlgorithmW 'SHA256+    SHA384W :: HashAlgorithmW 'SHA384+    SHA512W :: HashAlgorithmW 'SHA512+    SHA224W :: HashAlgorithmW 'SHA224+    SHA3_256W :: HashAlgorithmW 'SHA3_256+    SHA3_512W :: HashAlgorithmW 'SHA3_512  data SomeHashAlgorithmW where-  SomeHashAlgorithmW :: HashAlgorithmW h -> SomeHashAlgorithmW+    SomeHashAlgorithmW :: HashAlgorithmW h -> SomeHashAlgorithmW  demoteHashAlgorithmW :: HashAlgorithmW h -> HashAlgorithm demoteHashAlgorithmW DeprecatedMD5W = DeprecatedMD5@@ -126,7 +138,8 @@ promoteHashAlgorithm SHA3_512 = Just (SomeHashAlgorithmW SHA3_512W) promoteHashAlgorithm (OtherHA _) = Nothing -signatureV6SaltSizeForHashAlgorithm :: HashAlgorithm -> Maybe Word8+signatureV6SaltSizeForHashAlgorithm+    :: HashAlgorithm -> Maybe Word8 signatureV6SaltSizeForHashAlgorithm SHA224 = Just 16 signatureV6SaltSizeForHashAlgorithm SHA256 = Just 16 signatureV6SaltSizeForHashAlgorithm SHA384 = Just 24@@ -136,200 +149,330 @@ signatureV6SaltSizeForHashAlgorithm _ = Nothing  data HashAlgoStatus-  = HashAllowed-  | HashShouldNot-  | HashMustNot+    = HashAllowed+    | HashShouldNot+    | HashMustNot -type family HashAlgoStatusFor (rfc :: OpenPGPRFC) (h :: HashAlgorithm) :: HashAlgoStatus where-  HashAlgoStatusFor 'RFC4880 'DeprecatedMD5 = 'HashShouldNot-  HashAlgoStatusFor 'RFC9580 'DeprecatedMD5 = 'HashMustNot-  HashAlgoStatusFor 'RFC9580 'SHA1 = 'HashMustNot-  HashAlgoStatusFor 'RFC9580 'RIPEMD160 = 'HashShouldNot-  HashAlgoStatusFor rfc h = 'HashAllowed+type family+    HashAlgoStatusFor (rfc :: OpenPGPRFC) (h :: HashAlgorithm)+        :: HashAlgoStatus+    where+    HashAlgoStatusFor 'RFC4880 'DeprecatedMD5 = 'HashShouldNot+    HashAlgoStatusFor 'RFC9580 'DeprecatedMD5 = 'HashMustNot+    HashAlgoStatusFor 'RFC9580 'SHA1 = 'HashMustNot+    HashAlgoStatusFor 'RFC9580 'RIPEMD160 = 'HashShouldNot+    HashAlgoStatusFor rfc h = 'HashAllowed  type family AssertHashAllowed (status :: HashAlgoStatus) :: Constraint where-  AssertHashAllowed 'HashAllowed = ()-  AssertHashAllowed 'HashShouldNot =-    TypeError ('Text "Hash algorithm is deprecated (SHOULD NOT) for new signatures under this RFC")-  AssertHashAllowed 'HashMustNot =-    TypeError ('Text "Hash algorithm is disallowed (MUST NOT) for new signatures under this RFC")+    AssertHashAllowed 'HashAllowed = ()+    AssertHashAllowed 'HashShouldNot =+        TypeError+            ( 'Text+                "Hash algorithm is deprecated (SHOULD NOT) for new signatures under this RFC"+            )+    AssertHashAllowed 'HashMustNot =+        TypeError+            ( 'Text+                "Hash algorithm is disallowed (MUST NOT) for new signatures under this RFC"+            ) -type HashAlgoAllowedFor rfc h = AssertHashAllowed (HashAlgoStatusFor rfc h)+type HashAlgoAllowedFor rfc h =+    AssertHashAllowed (HashAlgoStatusFor rfc h)  type family AssertHashVerifiable (status :: HashAlgoStatus) :: Constraint where-  AssertHashVerifiable 'HashAllowed = ()-  AssertHashVerifiable 'HashShouldNot = ()-  AssertHashVerifiable 'HashMustNot =-    TypeError ('Text "Hash algorithm is disallowed for verification in this RFC context")+    AssertHashVerifiable 'HashAllowed = ()+    AssertHashVerifiable 'HashShouldNot = ()+    AssertHashVerifiable 'HashMustNot =+        TypeError+            ( 'Text+                "Hash algorithm is disallowed for verification in this RFC context"+            ) -type HashAlgoVerifiableFor rfc h = AssertHashVerifiable (HashAlgoStatusFor rfc h)+type HashAlgoVerifiableFor rfc h =+    AssertHashVerifiable (HashAlgoStatusFor rfc h)  data PKESKVersionPolicy-  = PreferV6-  | ForceV3Interop-  deriving (Eq, Show)+    = PreferV6+    | ForceV3Interop+    deriving (Eq, Show)  data MessageEncryptionPolicy = MessageEncryptionPolicy-  { messageDefaultSymmetricAlgorithm :: SymmetricAlgorithm-  , messageDefaultAEADAlgorithm :: AEADAlgorithm-  , messageDefaultChunkSize :: Word8-  , messageS2KSaltOctets :: Int-  , messageSEIPDv2SaltOctets :: Int-  , messageDefaultS2KForSalt :: Salt -> S2K-  , messageSEIPDv2SymmetricAlgorithms :: [SymmetricAlgorithm]-  }+    { messageDefaultSymmetricAlgorithm :: SymmetricAlgorithm+    , messageDefaultAEADAlgorithm :: AEADAlgorithm+    , messageDefaultChunkSize :: Word8+    , messageS2KSaltOctets :: Int+    , messageSEIPDv2SaltOctets :: Int+    , messageDefaultS2KForSalt :: Salt -> S2K+    , messageSEIPDv2SymmetricAlgorithms :: [SymmetricAlgorithm]+    }  data SecretKeyProtectionPolicy = SecretKeyProtectionPolicy-  { secretKeyDefaultSymmetricAlgorithm :: SymmetricAlgorithm-  , secretKeyDefaultAEADAlgorithm :: AEADAlgorithm-  , secretKeyDefaultS2KForSalt :: Salt -> S2K-  , secretKeyS2KSaltOctets :: Int-  , secretKeyAEADNonceOctets :: Int-  }+    { secretKeyDefaultSymmetricAlgorithm :: SymmetricAlgorithm+    , secretKeyDefaultAEADAlgorithm :: AEADAlgorithm+    , secretKeyDefaultS2KForSalt :: Salt -> S2K+    , secretKeyS2KSaltOctets :: Int+    , secretKeyAEADNonceOctets :: Int+    }  data GenerationDeprecationPolicy = GenerationDeprecationPolicy-  { deprecatedHashAlgorithms :: [HashAlgorithm]-  , deprecatedSymmetricAlgorithms :: [SymmetricAlgorithm]-  }+    { deprecatedHashAlgorithms :: [HashAlgorithm]+    , deprecatedSymmetricAlgorithms :: [SymmetricAlgorithm]+    }  data VerificationDefaults = VerificationDefaults-  { verificationDefaultStrict :: Bool-  , verificationDefaultStreaming :: Bool-  }+    { verificationDefaultStrict :: Bool+    , verificationDefaultStreaming :: Bool+    } --- | Per-message decrypt-side enforcement policy.------ 'defaultDecryptPolicy' applies RFC9580-strict rules: no unauthenticated--- (SED) ciphertext, modern symmetric algorithms only, and rejection of--- deprecated S2K specifiers in SKESK.  Use 'lenientDecryptPolicy' when--- interoperating with older RFC4880 or RFC2440 messages.+-- | Action to take when a signature feature violates policy.+data VerificationPolicyAction+    = -- | Treat as a hard verification error (reject signature)+      VerificationError+    | -- | Accept signature but record a warning+      VerificationWarning+    deriving (Eq, Show)++{- | Policy controlling how signature verification handles deprecated or+discouraged features.  This allows callers to choose between strict+rejection (errors) and lenient acceptance with warnings.+-}+data VerificationPolicy = VerificationPolicy+    { vpDeprecatedHashAlgorithm :: VerificationPolicyAction+    -- ^ Action for deprecated hash algorithms (MD5, SHA1, RIPEMD160)+    , vpUnsupportedHashAlgorithm :: VerificationPolicyAction+    -- ^ Action for unsupported/unknown hash algorithms+    , vpPkaMismatch :: VerificationPolicyAction+    -- ^ Action for PKA mismatch between signature and key+    , vpUnsupportedCriticalSubpacket :: VerificationPolicyAction+    -- ^ Action for unsupported critical subpackets+    , vpLegacyIssuerKeyIdInV6 :: VerificationPolicyAction+    -- ^ Action for legacy Issuer Key ID subpacket in v6 signatures+    , vpMissingSubkeyBackSignature :: VerificationPolicyAction+    -- ^ Action for missing subkey back-signature (v6 subkeys)+    , vpInvalidSignatureContext :: VerificationPolicyAction+    -- ^ Action for signature context violations (wrong sig type for context)+    , vpExpiredSignature :: VerificationPolicyAction+    -- ^ Action for expired signatures+    }+    deriving (Eq, Show)++{- | Default verification policy: strict on security-critical issues,+lenient on deprecated but still verifiable features.+-}+defaultVerificationPolicy :: VerificationPolicy+defaultVerificationPolicy =+    VerificationPolicy+        { vpDeprecatedHashAlgorithm = VerificationWarning+        , vpUnsupportedHashAlgorithm = VerificationError+        , vpPkaMismatch = VerificationError+        , vpUnsupportedCriticalSubpacket = VerificationError+        , vpLegacyIssuerKeyIdInV6 = VerificationError+        , vpMissingSubkeyBackSignature = VerificationWarning+        , vpInvalidSignatureContext = VerificationError+        , vpExpiredSignature = VerificationError+        }++-- | Strict verification policy: all policy violations are hard errors.+strictVerificationPolicy :: VerificationPolicy+strictVerificationPolicy =+    VerificationPolicy+        { vpDeprecatedHashAlgorithm = VerificationError+        , vpUnsupportedHashAlgorithm = VerificationError+        , vpPkaMismatch = VerificationError+        , vpUnsupportedCriticalSubpacket = VerificationError+        , vpLegacyIssuerKeyIdInV6 = VerificationError+        , vpMissingSubkeyBackSignature = VerificationError+        , vpInvalidSignatureContext = VerificationError+        , vpExpiredSignature = VerificationError+        }++{- | Lenient verification policy: all policy violations are warnings.+Use only for interoperability with legacy data.+-}+lenientVerificationPolicy :: VerificationPolicy+lenientVerificationPolicy =+    VerificationPolicy+        { vpDeprecatedHashAlgorithm = VerificationWarning+        , vpUnsupportedHashAlgorithm = VerificationWarning+        , vpPkaMismatch = VerificationWarning+        , vpUnsupportedCriticalSubpacket = VerificationWarning+        , vpLegacyIssuerKeyIdInV6 = VerificationWarning+        , vpMissingSubkeyBackSignature = VerificationWarning+        , vpInvalidSignatureContext = VerificationWarning+        , vpExpiredSignature = VerificationWarning+        }++-- | Check if a policy action is an error.+isVerificationError :: VerificationPolicyAction -> Bool+isVerificationError VerificationError = True+isVerificationError VerificationWarning = False++-- | Check if a policy action is a warning.+isVerificationWarning :: VerificationPolicyAction -> Bool+isVerificationWarning VerificationWarning = True+isVerificationWarning VerificationError = False++-- | Apply a policy action: return Left error or Right warning message.+applyVerificationPolicy+    :: VerificationPolicyAction+    -> String+    -> Either String String+applyVerificationPolicy action msg =+    if isVerificationError action+        then Left msg+        else Right msg++{- | Per-message decrypt-side enforcement policy.++'defaultDecryptPolicy' applies RFC9580-strict rules: no unauthenticated+(SED) ciphertext, modern symmetric algorithms only, and rejection of+deprecated S2K specifiers in SKESK.  Use 'lenientDecryptPolicy' when+interoperating with older RFC4880 or RFC2440 messages.+-} data DecryptPolicy = DecryptPolicy-  { -- | When 'False' (RFC9580 default), receiving a Symmetrically Encrypted-    -- Data packet (SED, tag 9) is a hard error.  RFC9580 §5.9 says-    -- implementations SHOULD reject unauthenticated ciphertext.-    decryptAllowSEDNoIntegrity :: Bool-    -- | When 'False', receiving a SEIPDv1 (MDC-protected) packet is rejected.-    -- Defaults to 'True' for interoperability with RFC4880 senders.-  , decryptAllowSEIPDv1 :: Bool-    -- | Allowed symmetric algorithms for session keys.  'Nothing' means-    -- unrestricted.  The RFC9580 default restricts to AES-128/192/256.-  , decryptAllowedSymmetricAlgos :: Maybe [SymmetricAlgorithm]-    -- | Allowed AEAD algorithms for SEIPDv2 payloads.  'Nothing' means-    -- unrestricted.  The RFC9580 default allows EAX, OCB, and GCM.-  , decryptAllowedAEADAlgos :: Maybe [AEADAlgorithm]-    -- | When 'True' (RFC9580 default), reject SKESK packets that use Simple-    -- or Salted S2K specifiers (both deprecated since RFC9580).-  , decryptRejectDeprecatedSKESK :: Bool-    -- | When 'True' (RFC9580 default), any packet received after the-    -- message-integrity boundary (MDC for SEIPDv1, final AEAD tag for-    -- SEIPDv2, or the outer encrypted-data packet for SED) is a hard error.-    -- RFC9580 §5.13.2 requires that implementations detect and reject-    -- data appended after the authenticated payload.  Set to 'False' only-    -- when interoperating with legacy implementations that emit trailing-    -- garbage (implies 'lenientDecryptPolicy').-  , decryptRejectTrailingData :: Bool-    -- | When 'True' (RFC9580 default), a payload with no version-aligned-    -- ESK is a hard error even when misaligned ESKs are present.  This is a-    -- distinct concern from trailing-data rejection: a message could have-    -- correct framing yet still carry only v6 PKESKs before a SEIPDv1-    -- payload (or only v4 SKESKs before a SEIPDv2 payload), which indicates-    -- a mis-assembled message rather than an integrity violation.-    -- Set to 'False' only when salvaging malformed legacy messages.-  , decryptRejectESKVersionMismatch :: Bool-  } deriving (Eq, Show)+    { decryptAllowSEDNoIntegrity :: Bool+    {- ^ When 'False' (RFC9580 default), receiving a Symmetrically Encrypted+    Data packet (SED, tag 9) is a hard error.  RFC9580 §5.9 says+    implementations SHOULD reject unauthenticated ciphertext.+    -}+    , decryptAllowSEIPDv1 :: Bool+    {- ^ When 'False', receiving a SEIPDv1 (MDC-protected) packet is rejected.+    Defaults to 'True' for interoperability with RFC4880 senders.+    -}+    , decryptAllowedSymmetricAlgos :: Maybe [SymmetricAlgorithm]+    {- ^ Allowed symmetric algorithms for session keys.  'Nothing' means+    unrestricted.  The RFC9580 default restricts to AES-128/192/256.+    -}+    , decryptAllowedAEADAlgos :: Maybe [AEADAlgorithm]+    {- ^ Allowed AEAD algorithms for SEIPDv2 payloads.  'Nothing' means+    unrestricted.  The RFC9580 default allows EAX, OCB, and GCM.+    -}+    , decryptRejectDeprecatedSKESK :: Bool+    {- ^ When 'True' (RFC9580 default), reject SKESK packets that use Simple+    or Salted S2K specifiers (both deprecated since RFC9580).+    -}+    , decryptRejectTrailingData :: Bool+    {- ^ When 'True' (RFC9580 default), any packet received after the+    message-integrity boundary (MDC for SEIPDv1, final AEAD tag for+    SEIPDv2, or the outer encrypted-data packet for SED) is a hard error.+    RFC9580 §5.13.2 requires that implementations detect and reject+    data appended after the authenticated payload.  Set to 'False' only+    when interoperating with legacy implementations that emit trailing+    garbage (implies 'lenientDecryptPolicy').+    -}+    , decryptRejectESKVersionMismatch :: Bool+    {- ^ When 'True' (RFC9580 default), a payload with no version-aligned+    ESK is a hard error even when misaligned ESKs are present.  This is a+    distinct concern from trailing-data rejection: a message could have+    correct framing yet still carry only v6 PKESKs before a SEIPDv1+    payload (or only v4 SKESKs before a SEIPDv2 payload), which indicates+    a mis-assembled message rather than an integrity violation.+    Set to 'False' only when salvaging malformed legacy messages.+    -}+    }+    deriving (Eq, Show)  data OpenPGPPolicy = OpenPGPPolicy-  { policyRFC :: OpenPGPRFC-  , policyMessageEncryption :: MessageEncryptionPolicy-  , policySecretKeyProtection :: Maybe SecretKeyProtectionPolicy-  , policyGenerationDeprecations :: GenerationDeprecationPolicy-  , policyDecrypt :: DecryptPolicy-  }+    { policyRFC :: OpenPGPRFC+    , policyMessageEncryption :: MessageEncryptionPolicy+    , policySecretKeyProtection :: Maybe SecretKeyProtectionPolicy+    , policyGenerationDeprecations :: GenerationDeprecationPolicy+    , policyDecrypt :: DecryptPolicy+    }  policyForRFC :: OpenPGPRFC -> OpenPGPPolicy policyForRFC RFC2440 =-  OpenPGPPolicy-    { policyRFC = RFC2440-    , policyMessageEncryption =-        MessageEncryptionPolicy-          { messageDefaultSymmetricAlgorithm = TripleDES-          , messageDefaultAEADAlgorithm = OCB-          , messageDefaultChunkSize = 6-          , messageS2KSaltOctets = 8-          , messageSEIPDv2SaltOctets = 32-          , messageDefaultS2KForSalt = \salt -> IteratedSalted SHA1 (requireSalt8 "RFC2440 message S2K" salt) 65536-          , messageSEIPDv2SymmetricAlgorithms = []-          }-    , policySecretKeyProtection = Nothing-    , policyGenerationDeprecations =-        GenerationDeprecationPolicy-          { deprecatedHashAlgorithms = []-          , deprecatedSymmetricAlgorithms = []-          }-    , policyDecrypt = lenientDecryptPolicy-    }+    OpenPGPPolicy+        { policyRFC = RFC2440+        , policyMessageEncryption =+            MessageEncryptionPolicy+                { messageDefaultSymmetricAlgorithm = TripleDES+                , messageDefaultAEADAlgorithm = OCB+                , messageDefaultChunkSize = 6+                , messageS2KSaltOctets = 8+                , messageSEIPDv2SaltOctets = 32+                , messageDefaultS2KForSalt = \salt ->+                    IteratedSalted+                        SHA1+                        (requireSalt8 "RFC2440 message S2K" salt)+                        65536+                , messageSEIPDv2SymmetricAlgorithms = []+                }+        , policySecretKeyProtection = Nothing+        , policyGenerationDeprecations =+            GenerationDeprecationPolicy+                { deprecatedHashAlgorithms = []+                , deprecatedSymmetricAlgorithms = []+                }+        , policyDecrypt = lenientDecryptPolicy+        } policyForRFC RFC4880 =-  OpenPGPPolicy-    { policyRFC = RFC4880-    , policyMessageEncryption =-        MessageEncryptionPolicy-          { messageDefaultSymmetricAlgorithm = AES128-          , messageDefaultAEADAlgorithm = OCB-          , messageDefaultChunkSize = 6-          , messageS2KSaltOctets = 8-          , messageSEIPDv2SaltOctets = 32-          , messageDefaultS2KForSalt = \salt -> IteratedSalted SHA256 (requireSalt8 "RFC4880 message S2K" salt) 65536-          , messageSEIPDv2SymmetricAlgorithms = []-          }-    , policySecretKeyProtection = Nothing-    , policyGenerationDeprecations =-        GenerationDeprecationPolicy-          { deprecatedHashAlgorithms = [DeprecatedMD5]-          , deprecatedSymmetricAlgorithms = []-          }-    , policyDecrypt = lenientDecryptPolicy-    }+    OpenPGPPolicy+        { policyRFC = RFC4880+        , policyMessageEncryption =+            MessageEncryptionPolicy+                { messageDefaultSymmetricAlgorithm = AES128+                , messageDefaultAEADAlgorithm = OCB+                , messageDefaultChunkSize = 6+                , messageS2KSaltOctets = 8+                , messageSEIPDv2SaltOctets = 32+                , messageDefaultS2KForSalt = \salt ->+                    IteratedSalted+                        SHA256+                        (requireSalt8 "RFC4880 message S2K" salt)+                        65536+                , messageSEIPDv2SymmetricAlgorithms = []+                }+        , policySecretKeyProtection = Nothing+        , policyGenerationDeprecations =+            GenerationDeprecationPolicy+                { deprecatedHashAlgorithms = [DeprecatedMD5]+                , deprecatedSymmetricAlgorithms = []+                }+        , policyDecrypt = lenientDecryptPolicy+        } policyForRFC RFC9580 =-  OpenPGPPolicy-    { policyRFC = RFC9580-    , policyMessageEncryption =-        MessageEncryptionPolicy-          { messageDefaultSymmetricAlgorithm = AES256-          , messageDefaultAEADAlgorithm = OCB-          , messageDefaultChunkSize = 6-          , messageS2KSaltOctets = 16-          , messageSEIPDv2SaltOctets = 32-          , messageDefaultS2KForSalt = \salt -> Argon2 (requireSalt16 "RFC9580 message S2K" salt) 1 4 15-          , messageSEIPDv2SymmetricAlgorithms = [AES128, AES192, AES256]-          }-    , policySecretKeyProtection =-        Just-          SecretKeyProtectionPolicy-            { secretKeyDefaultSymmetricAlgorithm = AES256-            , secretKeyDefaultAEADAlgorithm = OCB-            , secretKeyDefaultS2KForSalt = \salt -> Argon2 (requireSalt16 "RFC9580 secret key S2K" salt) 1 4 15-            , secretKeyS2KSaltOctets = 16-            , secretKeyAEADNonceOctets = 15-            }-    , policyGenerationDeprecations =-        GenerationDeprecationPolicy-          { deprecatedHashAlgorithms = [DeprecatedMD5, SHA1, RIPEMD160]-          , deprecatedSymmetricAlgorithms = [IDEA, TripleDES, CAST5, Blowfish]-          }-    , policyDecrypt = defaultDecryptPolicy-    }+    OpenPGPPolicy+        { policyRFC = RFC9580+        , policyMessageEncryption =+            MessageEncryptionPolicy+                { messageDefaultSymmetricAlgorithm = AES256+                , messageDefaultAEADAlgorithm = OCB+                , messageDefaultChunkSize = 6+                , messageS2KSaltOctets = 16+                , messageSEIPDv2SaltOctets = 32+                , messageDefaultS2KForSalt = \salt -> Argon2 (requireSalt16 "RFC9580 message S2K" salt) 1 4 15+                , messageSEIPDv2SymmetricAlgorithms = [AES128, AES192, AES256]+                }+        , policySecretKeyProtection =+            Just+                SecretKeyProtectionPolicy+                    { secretKeyDefaultSymmetricAlgorithm = AES256+                    , secretKeyDefaultAEADAlgorithm = OCB+                    , secretKeyDefaultS2KForSalt = \salt -> Argon2 (requireSalt16 "RFC9580 secret key S2K" salt) 1 4 15+                    , secretKeyS2KSaltOctets = 16+                    , secretKeyAEADNonceOctets = 15+                    }+        , policyGenerationDeprecations =+            GenerationDeprecationPolicy+                { deprecatedHashAlgorithms = [DeprecatedMD5, SHA1, RIPEMD160]+                , deprecatedSymmetricAlgorithms =+                    [IDEA, TripleDES, CAST5, Blowfish]+                }+        , policyDecrypt = defaultDecryptPolicy+        }  requireSalt8 :: String -> Salt -> Salt8 requireSalt8 context salt =-  case salt8FromSalt salt of-    Just salt8 -> salt8-    Nothing -> error (context ++ " requires an 8-octet salt")+    case salt8FromSalt salt of+        Just salt8 -> salt8+        Nothing -> error (context ++ " requires an 8-octet salt")  requireSalt16 :: String -> Salt -> Salt16 requireSalt16 context salt =-  case salt16FromSalt salt of-    Just salt16 -> salt16-    Nothing -> error (context ++ " requires a 16-octet salt")+    case salt16FromSalt salt of+        Just salt16 -> salt16+        Nothing -> error (context ++ " requires a 16-octet salt")  defaultPolicy :: OpenPGPPolicy defaultPolicy = policyForRFC RFC9580@@ -339,51 +482,58 @@  defaultVerificationDefaults :: VerificationDefaults defaultVerificationDefaults =-  VerificationDefaults-    { verificationDefaultStrict = True-    , verificationDefaultStreaming = True-    }+    VerificationDefaults+        { verificationDefaultStrict = True+        , verificationDefaultStreaming = True+        } --- | RFC9580-strict decrypt policy.  Rejects unauthenticated SED ciphertext,--- restricts session-key symmetric algorithms to AES-128/192/256 and AEAD to--- EAX/OCB/GCM, and rejects SKESK packets carrying deprecated Simple or--- Salted S2K specifiers.  SEIPDv1 (MDC-protected) is still accepted for--- interoperability with RFC4880 senders.+{- | RFC9580-strict decrypt policy.  Rejects unauthenticated SED ciphertext,+restricts session-key symmetric algorithms to AES-128/192/256 and AEAD to+EAX/OCB/GCM, and rejects SKESK packets carrying deprecated Simple or+Salted S2K specifiers.  SEIPDv1 (MDC-protected) is still accepted for+interoperability with RFC4880 senders.+-} defaultDecryptPolicy :: DecryptPolicy defaultDecryptPolicy =-  DecryptPolicy-    { decryptAllowSEDNoIntegrity = False-    , decryptAllowSEIPDv1 = True-    , decryptAllowedSymmetricAlgos = Just [AES128, AES192, AES256]-    , decryptAllowedAEADAlgos = Just [EAX, OCB, GCM]-    , decryptRejectDeprecatedSKESK = True-    , decryptRejectTrailingData = True-    , decryptRejectESKVersionMismatch = True-    }+    DecryptPolicy+        { decryptAllowSEDNoIntegrity = False+        , decryptAllowSEIPDv1 = True+        , decryptAllowedSymmetricAlgos = Just [AES128, AES192, AES256]+        , decryptAllowedAEADAlgos = Just [EAX, OCB, GCM]+        , decryptRejectDeprecatedSKESK = True+        , decryptRejectTrailingData = True+        , decryptRejectESKVersionMismatch = True+        } --- | Permissive decrypt policy for interoperability with RFC4880 and RFC2440--- messages.  No algorithm or integrity restrictions are applied.+{- | Permissive decrypt policy for interoperability with RFC4880 and RFC2440+messages.  No algorithm or integrity restrictions are applied.+-} lenientDecryptPolicy :: DecryptPolicy lenientDecryptPolicy =-  DecryptPolicy-    { decryptAllowSEDNoIntegrity = True-    , decryptAllowSEIPDv1 = True-    , decryptAllowedSymmetricAlgos = Nothing-    , decryptAllowedAEADAlgos = Nothing-    , decryptRejectDeprecatedSKESK = False-    , decryptRejectTrailingData = False-    , decryptRejectESKVersionMismatch = False-    }+    DecryptPolicy+        { decryptAllowSEDNoIntegrity = True+        , decryptAllowSEIPDv1 = True+        , decryptAllowedSymmetricAlgos = Nothing+        , decryptAllowedAEADAlgos = Nothing+        , decryptRejectDeprecatedSKESK = False+        , decryptRejectTrailingData = False+        , decryptRejectESKVersionMismatch = False+        } -supportsSEIPDv2Symmetric :: OpenPGPPolicy -> SymmetricAlgorithm -> Bool+supportsSEIPDv2Symmetric+    :: OpenPGPPolicy -> SymmetricAlgorithm -> Bool supportsSEIPDv2Symmetric policy sa =-  sa `elem` messageSEIPDv2SymmetricAlgorithms (policyMessageEncryption policy)+    sa+        `elem` messageSEIPDv2SymmetricAlgorithms+            (policyMessageEncryption policy) -secretKeyProtectionPolicyForKeyVersion :: OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy+secretKeyProtectionPolicyForKeyVersion+    :: OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy secretKeyProtectionPolicyForKeyVersion policy V6 = policySecretKeyProtection policy secretKeyProtectionPolicyForKeyVersion _ _ = Nothing -ecdhKdfHashDigest :: HashAlgorithm -> B.ByteString -> Either String B.ByteString+ecdhKdfHashDigest+    :: HashAlgorithm -> B.ByteString -> Either String B.ByteString ecdhKdfHashDigest SHA1 _ = Left "ECDH KDF hash algorithm SHA1 is disallowed by policy" ecdhKdfHashDigest SHA224 bs = Right (BA.convert (CH.hash bs :: CH.Digest CHAlg.SHA224)) ecdhKdfHashDigest SHA256 bs = Right (BA.convert (CH.hash bs :: CH.Digest CHAlg.SHA256))@@ -393,68 +543,74 @@ ecdhKdfHashDigest SHA3_512 bs = Right (BA.convert (CH.hash bs :: CH.Digest CHAlg.SHA3_512)) ecdhKdfHashDigest _ _ = Left "ECDH KDF hash algorithm is unsupported" -validateTable30PolicyForRecipient ::-     SomePKPayload -> HashAlgorithm -> SymmetricAlgorithm -> Either String ()+validateTable30PolicyForRecipient+    :: SomePKPayload+    -> HashAlgorithm+    -> SymmetricAlgorithm+    -> Either String () validateTable30PolicyForRecipient recipientPKP kdfHA kdfSA =-  case allowedTable30EcdhParameterSets recipientPKP (_pubkey recipientPKP) of-    Nothing -> Right ()-    Just (curveName, allowedParams) ->-      if (kdfHA, kdfSA) `elem` allowedParams-        then Right ()-        else-          Left-            ("RFC9580 Table 30 policy violation for " ++-             show (_keyVersion recipientPKP) ++-             " ECDH key on " ++-             curveName ++-             ": expected one of " ++-             show allowedParams ++-             ", got (" ++-             show kdfHA ++-             ", " ++-             show kdfSA ++-             ")")+    case allowedTable30EcdhParameterSets+        recipientPKP+        (_pubkey recipientPKP) of+        Nothing -> Right ()+        Just (curveName, allowedParams) ->+            if (kdfHA, kdfSA) `elem` allowedParams+                then Right ()+                else+                    Left+                        ( "RFC9580 Table 30 policy violation for "+                            ++ show (_keyVersion recipientPKP)+                            ++ " ECDH key on "+                            ++ curveName+                            ++ ": expected one of "+                            ++ show allowedParams+                            ++ ", got ("+                            ++ show kdfHA+                            ++ ", "+                            ++ show kdfSA+                            ++ ")"+                        ) -allowedTable30EcdhParameterSets ::-     SomePKPayload-  -> PKey-  -> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])+allowedTable30EcdhParameterSets+    :: SomePKPayload+    -> PKey+    -> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)]) allowedTable30EcdhParameterSets recipientPKP (ECDHPubKey ecdhPub _ _)-  | _keyVersion recipientPKP == V4 =-      case ecdhPub of-        EdDSAPubKey Ed25519 _ ->-          Just-            ( "Curve25519Legacy"-            , [ (ha, sa)-              | ha <- [SHA256, SHA384, SHA512]-              , sa <- [AES128, AES192, AES256]-              ]-            )-        ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))-          | curve == ECCT.getCurveByName ECCT.SEC_p256r1 ->-              Just ("NIST P-256", [(SHA256, AES128)])-          | curve == ECCT.getCurveByName ECCT.SEC_p384r1 ->-              Just ("NIST P-384", [(SHA384, AES192)])-          | curve == ECCT.getCurveByName ECCT.SEC_p521r1 ->-              Just ("NIST P-521", [(SHA512, AES256)])-        _ -> Nothing-  | _keyVersion recipientPKP == V6 =-      case ecdhPub of-        EdDSAPubKey Ed25519 _ -> Just ("Curve25519Legacy", [(SHA256, AES128)])-        ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))-          | curve == ECCT.getCurveByName ECCT.SEC_p256r1 ->-              Just ("NIST P-256", [(SHA256, AES128)])-          | curve == ECCT.getCurveByName ECCT.SEC_p384r1 ->-              Just ("NIST P-384", [(SHA384, AES192)])-          | curve == ECCT.getCurveByName ECCT.SEC_p521r1 ->-              Just ("NIST P-521", [(SHA512, AES256)])-        _ -> Nothing-  | otherwise = Nothing+    | _keyVersion recipientPKP == V4 =+        case ecdhPub of+            EdDSAPubKey EdSigningCurve25519 _ ->+                Just+                    ( "Curve25519Legacy"+                    , [ (ha, sa)+                      | ha <- [SHA256, SHA384, SHA512]+                      , sa <- [AES128, AES192, AES256]+                      ]+                    )+            ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))+                | curve == ECCT.getCurveByName ECCT.SEC_p256r1 ->+                    Just ("NIST P-256", [(SHA256, AES128)])+                | curve == ECCT.getCurveByName ECCT.SEC_p384r1 ->+                    Just ("NIST P-384", [(SHA384, AES192)])+                | curve == ECCT.getCurveByName ECCT.SEC_p521r1 ->+                    Just ("NIST P-521", [(SHA512, AES256)])+            _ -> Nothing+    | _keyVersion recipientPKP == V6 =+        case ecdhPub of+            EdDSAPubKey EdSigningCurve25519 _ -> Just ("Curve25519Legacy", [(SHA256, AES128)])+            ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))+                | curve == ECCT.getCurveByName ECCT.SEC_p256r1 ->+                    Just ("NIST P-256", [(SHA256, AES128)])+                | curve == ECCT.getCurveByName ECCT.SEC_p384r1 ->+                    Just ("NIST P-384", [(SHA384, AES192)])+                | curve == ECCT.getCurveByName ECCT.SEC_p521r1 ->+                    Just ("NIST P-521", [(SHA512, AES256)])+            _ -> Nothing+    | otherwise = Nothing allowedTable30EcdhParameterSets _ _ = Nothing  legacySecretKeyProtectionErrorMessage :: String legacySecretKeyProtectionErrorMessage =-  "re-encrypting legacy secret keys without SHA-1 protection is unsupported; explicit legacy override required"+    "re-encrypting legacy secret keys without SHA-1 protection is unsupported; explicit legacy override required"  -- RFC9580/RFC4880 signature context validation predicates -- These enforce which signature types are allowed in which structural contexts
Codec/Encryption/OpenPGP/Serialize.hs view
@@ -2,3130 +2,3620 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE FlexibleInstances #-}--module Codec.Encryption.OpenPGP.Serialize-  (-  -- * Serialization functions-    putPkt-  , putPktEither-  , putSKAddendum-  , getSecretKey-  , putSKeyForPKPayload-  -- * Utilities-  , dearmorIfAsciiArmored-  , dearmorIfAsciiArmoredLenient-  , looksLikeAsciiArmor-  , armorPayloadsOfType-  , singleArmorPayloadOfType-  , singleClearSignedBlock-  , recommendedArmorType-  , WireRepInput(..)-  , wireRepRefFromInput-  , PktParseError(..)-  , parsePkts-  , parsePktsEither-  , parsePktsWithWireRep-  , conduitParsePktsWithWireRep-  ) where--import Control.Applicative (many, some)-import Control.Arrow ((***))-import Control.Lens ((^.), _1)-import Control.Monad (guard, replicateM, replicateM_, when)-import Crypto.Number.Basic (numBits)-import Crypto.Number.ModArithmetic (inverse)-import Crypto.Number.Serialize (i2osp, os2ip)-import qualified Crypto.PubKey.DSA as D-import qualified Crypto.PubKey.ECC.ECDSA as ECDSA-import qualified Crypto.PubKey.ECC.Types as ECCT-import qualified Crypto.PubKey.RSA as R-import Data.Bifunctor (bimap)-import Data.Binary (Binary, get, put)-import Data.Binary.Get-  ( ByteOffset-  , Get-  , bytesRead-  , getByteString-  , getLazyByteString-  , getRemainingLazyByteString-  , getWord16be-  , getWord16le-  , getWord32be-  , getWord8-  , lookAhead-  , runGetOrFail-  )-import Data.Binary.Put-  ( Put-  , putByteString-  , putLazyByteString-  , putWord16be-  , putWord16le-  , putWord32be-  , putWord8-  , runPut-  )-import Data.Bits ((.&.), (.|.), shiftL, shiftR, testBit)-import qualified Data.ByteString as B-import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Char8 as BLC8-import qualified Data.Foldable as F-import Data.Int (Int64)-import Data.List (mapAccumL)-import qualified Data.List.NonEmpty as NE-import Data.Maybe (fromMaybe)-import Data.Set (Set)-import qualified Data.Set as Set-import qualified Data.Text as T-import Data.Text.Encoding (decodeUtf8With, encodeUtf8)-import Data.Text.Encoding.Error (lenientDecode)-import Data.Word (Word16, Word32, Word8)-import Network.URI (nullURI, parseURI, uriToString)--import Codec.Encryption.OpenPGP.Internal-  ( curve2Curve-  , curveFromCurve-  , curveToCurveoidBS-  , curveoidBSToCurve-  , curveoidBSToEdSigningCurve-  , edSigningCurveToCurveoidBS-  , leftPadTo-  , pubkeyToMPIs-  )-import Codec.Encryption.OpenPGP.Policy (signatureV6SaltSizeForHashAlgorithm)-import Codec.Encryption.OpenPGP.Types-import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA-import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor(..), ArmorType(..))-import Data.Conduit (ConduitT, await, yield)-import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as BTypes-import qualified Codec.Encryption.OpenPGP.Types.Internal.PKITypes as P--instance Binary SigSubPacket where-  get = getSigSubPacket-  put = putSigSubPacket---- instance Binary (Set NotationFlag) where---     put = putNotationFlagSet-instance Binary CompressionAlgorithm where-  get = toFVal <$> getWord8-  put = putWord8 . fromFVal--instance Binary PubKeyAlgorithm where-  get = toFVal <$> getWord8-  put = putWord8 . fromFVal--instance Binary HashAlgorithm where-  get = toFVal <$> getWord8-  put = putWord8 . fromFVal--instance Binary SymmetricAlgorithm where-  get = toFVal <$> getWord8-  put = putWord8 . fromFVal--instance Binary MPI where-  get = getMPI-  put = putMPI--instance Binary SigType where-  get = toFVal <$> getWord8-  put = putWord8 . fromFVal--instance Binary UserAttrSubPacket where-  get = getUserAttrSubPacket-  put = putUserAttrSubPacket--instance Binary S2K where-  get = getS2K-  put = putS2K--instance Binary (PKESK 'PKESKV3) where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary (PKESK 'PKESKV6) where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary Signature where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary (SKESK 'SKESKV4) where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary (SKESK 'SKESKV6) where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary (OnePassSignature 'OPSV3) where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary (OnePassSignature 'OPSV6) where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary SecretKey where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary PublicKey where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary SecretSubkey where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary CompressedData where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary SymEncData where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary Marker where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary LiteralData where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary Trust where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary UserId where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary PublicSubkey where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary UserAttribute where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary SymEncIntegrityProtectedData where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary ModificationDetectionCode where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary OtherPacket where-  get = getPkt >>= either fail pure . fromPktEither-  put = putPkt . toPkt--instance Binary Pkt where-  get = getPkt-  put = putPkt--instance Binary a => Binary (Block a) where-  get = Block `fmap` many get-  put = mapM_ put . unBlock--instance Binary SomePKPayload where-  get = getPKPayload-  put = putPKPayload--instance Binary SignaturePayload where-  get = getSignaturePayload-  put = putSignaturePayload--instance Binary TKUnknown where-  get = fail "Binary TKUnknown decode is not implemented"-  put = putTK--getSigSubPacket :: Get SigSubPacket-getSigSubPacket = do-  l <- fmap fromIntegral getSubPacketLength-  (crit, pt) <- getSigSubPacketType-  getSigSubPacket' pt crit l-  where-    getSigSubPacket' :: Word8 -> Bool -> ByteOffset -> Get SigSubPacket-    getSigSubPacket' pt crit l-      | pt == 2 = do-        et <- fmap ThirtyTwoBitTimeStamp getWord32be-        return $ SigSubPacket crit (SigCreationTime et)-      | pt == 3 = do-        et <- fmap ThirtyTwoBitDuration getWord32be-        return $ SigSubPacket crit (SigExpirationTime et)-      | pt == 4 = do-        e <- get-        return $ SigSubPacket crit (ExportableCertification e)-      | pt == 5 = do-        tl <- getWord8-        ta <- getWord8-        return $ SigSubPacket crit (TrustSignature tl ta)-      | pt == 6 = do-        apdre <- getLazyByteString (l - 2)-        nul <- getWord8-        guard (nul == 0)-        return $ SigSubPacket crit (RegularExpression (BL.copy apdre))-      | pt == 7 = do-        r <- get-        return $ SigSubPacket crit (Revocable r)-      | pt == 9 = do-        et <- fmap ThirtyTwoBitDuration getWord32be-        return $ SigSubPacket crit (KeyExpirationTime et)-      | pt == 11 = do-        sa <- replicateM (fromIntegral (l - 1)) get-        return $ SigSubPacket crit (PreferredSymmetricAlgorithms sa)-      | pt == 12 = do-        rclass <- getWord8-        guard (testBit rclass 7)-        algid <- get-        fp <- getLazyByteString (fromIntegral l - 3)-        return $-          SigSubPacket-            crit-            (RevocationKey-               (bsToFFSet . BL.singleton $ rclass .&. 0x7f)-               algid-               (Fingerprint fp))-      | pt == 16 = do-        keyid <- getLazyByteString (l - 1)-        return $ SigSubPacket crit (Issuer (EightOctetKeyId keyid))-      | pt == 20 = do-        flags <- getLazyByteString 4-        nl <- getWord16be-        vl <- getWord16be-        nn <- getLazyByteString (fromIntegral nl)-        nv <- getLazyByteString (fromIntegral vl)-        return $-          SigSubPacket-            crit-            (NotationData (bsToFFSet flags) (NotationName nn) (NotationValue nv))-      | pt == 21 = do-        ha <- replicateM (fromIntegral (l - 1)) get-        return $ SigSubPacket crit (PreferredHashAlgorithms ha)-      | pt == 22 = do-        ca <- replicateM (fromIntegral (l - 1)) get-        return $ SigSubPacket crit (PreferredCompressionAlgorithms ca)-      | pt == 23 = do-        ksps <- getLazyByteString (l - 1)-        return $ SigSubPacket crit (KeyServerPreferences (bsToFFSet ksps))-      | pt == 24 = do-        pks <- getLazyByteString (l - 1)-        return $ SigSubPacket crit (PreferredKeyServer pks)-      | pt == 25 = do-        primacy <- get-        return $ SigSubPacket crit (PrimaryUserId primacy)-      | pt == 26 = do-        url <--          fmap-            (URL . fromMaybe nullURI . parseURI . T.unpack .-             decodeUtf8With lenientDecode)-            (getByteString (fromIntegral (l - 1)))-        return $ SigSubPacket crit (PolicyURL url)-      | pt == 27 = do-        kfs <- getLazyByteString (l - 1)-        return $ SigSubPacket crit (KeyFlags (bsToFFSet kfs))-      | pt == 28 = do-        uid <- getByteString (fromIntegral (l - 1))-        return $-          SigSubPacket crit (SignersUserId (decodeUtf8With lenientDecode uid))-      | pt == 29 = do-        rcode <- getWord8-        rreason <--          fmap-            (decodeUtf8With lenientDecode)-            (getByteString (fromIntegral (l - 2)))-        return $ SigSubPacket crit (ReasonForRevocation (toFVal rcode) rreason)-      | pt == 30 = do-        fbs <- getLazyByteString (l - 1)-        return $ SigSubPacket crit (Features (bsToFFSet fbs))-      | pt == 31 = do-        pka <- get-        ha <- get-        hash <- getLazyByteString (l - 3)-        return $ SigSubPacket crit (SignatureTarget pka ha hash)-      | pt == 32 = do-        spbs <- getLazyByteString (l - 1)-        case runGetOrFail get spbs of-            Left (_, _, e) -> fail ("embedded signature subpacket " ++ e)-            Right (_, _, sp) -> return $ SigSubPacket crit (EmbeddedSignature sp)-      | pt == 33 = do-        when (l /= 22 && l /= 34) $-          fail ("invalid issuer fingerprint subpacket length: " ++ show l)-        kv <- getWord8-        let fpLen = l - 2-        when (fpLen /= 20 && fpLen /= 32) $-          fail ("invalid issuer fingerprint length: " ++ show fpLen)-        case BTypes.packetVersionToIssuerFingerprintVersion kv of-          Nothing ->-            fail ("invalid issuer fingerprint version marker: " ++ show kv)-          Just ifVersion -> do-            fp <--              case kv of-                4 -> getLazyByteString (fromIntegral fpLen)-                6 -> getLazyByteString (fromIntegral fpLen)-                _ -> fail ("invalid issuer fingerprint version marker: " ++ show kv)-            return $-              SigSubPacket crit (IssuerFingerprint ifVersion (Fingerprint fp))-      | pt > 99 && pt < 111 = do-        payload <- getLazyByteString (l - 1)-        return $ SigSubPacket crit (UserDefinedSigSub pt payload)-      | otherwise = do-        payload <- getLazyByteString (l - 1)-        return $ SigSubPacket crit (OtherSigSub pt payload)--putSigSubPacket :: SigSubPacket -> Put-putSigSubPacket (SigSubPacket crit (SigCreationTime et)) = do-  putSubPacketLength 5-  putSigSubPacketType crit 2-  putWord32be . unThirtyTwoBitTimeStamp $ et-putSigSubPacket (SigSubPacket crit (SigExpirationTime et)) = do-  putSubPacketLength 5-  putSigSubPacketType crit 3-  putWord32be . unThirtyTwoBitDuration $ et-putSigSubPacket (SigSubPacket crit (ExportableCertification e)) = do-  putSubPacketLength 2-  putSigSubPacketType crit 4-  put e-putSigSubPacket (SigSubPacket crit (TrustSignature tl ta)) = do-  putSubPacketLength 3-  putSigSubPacketType crit 5-  put tl-  put ta-putSigSubPacket (SigSubPacket crit (RegularExpression apdre)) = do-  putSubPacketLength . fromIntegral $ (2 + BL.length apdre)-  putSigSubPacketType crit 6-  putLazyByteString apdre-  putWord8 0-putSigSubPacket (SigSubPacket crit (Revocable r)) = do-  putSubPacketLength 2-  putSigSubPacketType crit 7-  put r-putSigSubPacket (SigSubPacket crit (KeyExpirationTime et)) = do-  putSubPacketLength 5-  putSigSubPacketType crit 9-  putWord32be . unThirtyTwoBitDuration $ et-putSigSubPacket (SigSubPacket crit (PreferredSymmetricAlgorithms ess)) = do-  putSubPacketLength . fromIntegral $ (1 + length ess)-  putSigSubPacketType crit 11-  mapM_ put ess-putSigSubPacket (SigSubPacket crit (RevocationKey rclass algid fp)) = do-  let fpLen = BL.length (unFingerprint fp)-  putSubPacketLength (fromIntegral (3 + fpLen))  -- type(1) + rclass(1) + algid(1) + fingerprint-  putSigSubPacketType crit 12-  putLazyByteString . ffSetToFixedLengthBS (1 :: Int) $-    Set.insert (RClOther 0) rclass-  put algid-  putLazyByteString (unFingerprint fp)-putSigSubPacket (SigSubPacket crit (Issuer keyid)) = do-  putSubPacketLength 9-  putSigSubPacketType crit 16-  putLazyByteString (unEOKI keyid) -- 8 octets-putSigSubPacket (SigSubPacket crit (NotationData nfs (NotationName nn) (NotationValue nv))) = do-  putSubPacketLength . fromIntegral $ (9 + BL.length nn + BL.length nv)-  putSigSubPacketType crit 20-  putLazyByteString . ffSetToFixedLengthBS (4 :: Int) $ nfs-  putWord16be . fromIntegral . BL.length $ nn-  putWord16be . fromIntegral . BL.length $ nv-  putLazyByteString nn-  putLazyByteString nv-putSigSubPacket (SigSubPacket crit (PreferredHashAlgorithms ehs)) = do-  putSubPacketLength . fromIntegral $ (1 + length ehs)-  putSigSubPacketType crit 21-  mapM_ put ehs-putSigSubPacket (SigSubPacket crit (PreferredCompressionAlgorithms ecs)) = do-  putSubPacketLength . fromIntegral $ (1 + length ecs)-  putSigSubPacketType crit 22-  mapM_ put ecs-putSigSubPacket (SigSubPacket crit (KeyServerPreferences ksps)) = do-  let kbs = ffSetToBS ksps-  putSubPacketLength . fromIntegral $ (1 + BL.length kbs)-  putSigSubPacketType crit 23-  putLazyByteString kbs-putSigSubPacket (SigSubPacket crit (PreferredKeyServer ks)) = do-  putSubPacketLength . fromIntegral $ (1 + BL.length ks)-  putSigSubPacketType crit 24-  putLazyByteString ks-putSigSubPacket (SigSubPacket crit (PrimaryUserId primacy)) = do-  putSubPacketLength 2-  putSigSubPacketType crit 25-  put primacy-putSigSubPacket (SigSubPacket crit (PolicyURL (URL uri))) = do-  let bs = encodeUtf8 (T.pack (uriToString id uri ""))-  putSubPacketLength . fromIntegral $ (1 + B.length bs)-  putSigSubPacketType crit 26-  putByteString bs-putSigSubPacket (SigSubPacket crit (KeyFlags kfs)) = do-  let kbs = ffSetToBS kfs-  putSubPacketLength . fromIntegral $ (1 + BL.length kbs)-  putSigSubPacketType crit 27-  putLazyByteString kbs-putSigSubPacket (SigSubPacket crit (SignersUserId userid)) = do-  let bs = encodeUtf8 userid-  putSubPacketLength . fromIntegral $ (1 + B.length bs)-  putSigSubPacketType crit 28-  putByteString bs-putSigSubPacket (SigSubPacket crit (ReasonForRevocation rcode rreason)) = do-  let reasonbs = encodeUtf8 rreason-  putSubPacketLength . fromIntegral $ (2 + B.length reasonbs)-  putSigSubPacketType crit 29-  putWord8 . fromFVal $ rcode-  putByteString reasonbs-putSigSubPacket (SigSubPacket crit (Features fs)) = do-  let fbs = ffSetToBS fs-  putSubPacketLength . fromIntegral $ (1 + BL.length fbs)-  putSigSubPacketType crit 30-  putLazyByteString fbs-putSigSubPacket (SigSubPacket crit (SignatureTarget pka ha hash)) = do-  putSubPacketLength . fromIntegral $ (3 + BL.length hash)-  putSigSubPacketType crit 31-  put pka-  put ha-  putLazyByteString hash-putSigSubPacket (SigSubPacket crit (EmbeddedSignature sp)) = do-  let spb = runPut (put sp)-  putSubPacketLength . fromIntegral $ (1 + BL.length spb)-  putSigSubPacketType crit 32-  putLazyByteString spb-putSigSubPacket (SigSubPacket crit (IssuerFingerprint kv fp)) = do-  let kv' = BTypes.issuerFingerprintVersionToPacketVersion kv-  let fpb = unFingerprint fp-  when (BL.length fpb /= 20 && BL.length fpb /= 32) $-    error ("invalid issuer fingerprint length: " ++ show (BL.length fpb))-  putSubPacketLength . fromIntegral $ (2 + BL.length fpb)-  putSigSubPacketType crit 33-  putWord8 kv'-  putLazyByteString fpb-putSigSubPacket (SigSubPacket crit (UserDefinedSigSub ptype payload)) =-  putSigSubPacket (SigSubPacket crit (OtherSigSub ptype payload))-putSigSubPacket (SigSubPacket crit (OtherSigSub ptype payload)) = do-  putSubPacketLength . fromIntegral $ (1 + BL.length payload)-  putSigSubPacketType crit ptype-  putLazyByteString payload--getSubPacketLength :: Get Word32-getSubPacketLength = getSubPacketLength' =<< getWord8-  where-    getSubPacketLength' :: Integral a => Word8 -> Get a-    getSubPacketLength' f-      | f < 192 = return . fromIntegral $ f-      | f < 224 = do-        secondOctet <- getWord8-        return . fromIntegral $ shiftL (fromIntegral (f - 192) :: Int) 8 +-          (fromIntegral secondOctet :: Int) +-          192-      | f == 255 = do-        len <- getWord32be-        return . fromIntegral $ len-      | otherwise = fail "Partial body length invalid."--putSubPacketLength :: Word32 -> Put-putSubPacketLength l-  | l < 192 = putWord8 (fromIntegral l)-  | l < 8384 =-    putWord8 (fromIntegral ((fromIntegral (l - 192) `shiftR` 8) + 192 :: Int)) >>-    putWord8 (fromIntegral (l - 192) .&. 0xff)-  | l <= 0xffffffff = putWord8 255 >> putWord32be (fromIntegral l)-  | otherwise = error ("too big (" ++ show l ++ ")")--getSigSubPacketType :: Get (Bool, Word8)-getSigSubPacketType = do-  x <- getWord8-  return-    (if x .&. 128 == 128-       then (True, x .&. 127)-       else (False, x))--putSigSubPacketType :: Bool -> Word8 -> Put-putSigSubPacketType False sst = putWord8 sst-putSigSubPacketType True sst = putWord8 (sst .|. 0x80)--bsToFFSet :: FutureFlag a => ByteString -> Set a-bsToFFSet bs =-  Set.fromAscList . concat . snd $-  mapAccumL-    (\acc y -> (acc + 8, concatMap (shifty acc y) [0 .. 7]))-    0-    (BL.unpack bs)-  where-    shifty acc y x = [toFFlag (acc + x) | y .&. shiftR 128 x == shiftR 128 x]--ffSetToFixedLengthBS :: (Integral a, FutureFlag b) => a -> Set b -> ByteString-ffSetToFixedLengthBS len ffs =-  BL.take-    (fromIntegral len)-    (BL.append (ffSetToBS ffs) (BL.pack (replicate 5 0)))--ffSetToBS :: FutureFlag a => Set a -> ByteString-ffSetToBS = BL.pack . ffSetToBS'-  where-    ffSetToBS' :: FutureFlag a => Set a -> [Word8]-    ffSetToBS' ks-      -- Emit a single zero octet for an empty flag set so encoded flag-      -- subpackets always carry an explicit flags byte.-      | Set.null ks = [0]-      | otherwise =-        map-          ((foldl (.|.) 0 . map (shiftR 128 . flip mod 8 . fromFFlag) .-            Set.toAscList) .-           (\x -> Set.filter (\y -> fromFFlag y `div` 8 == x) ks))-          [0 .. fromFFlag (Set.findMax ks) `div` 8]--fromS2K :: S2K -> ByteString-fromS2K (Simple hashalgo) = BL.pack [0, fromIntegral . fromFVal $ hashalgo]-fromS2K (Salted hashalgo salt) =-  BL.pack [1, fromIntegral . fromFVal $ hashalgo] `BL.append`-  (BL.fromStrict . unSalt8) salt-fromS2K (IteratedSalted hashalgo salt count) =-  BL.pack [3, fromIntegral . fromFVal $ hashalgo] `BL.append`-  (BL.fromStrict . unSalt8) salt `BL.snoc`-  encodeIterationCount count-fromS2K (Argon2 salt t p encodedM) =-  BL.pack [4] `BL.append` (BL.fromStrict . unSalt16) salt `BL.append`-  BL.pack [t, p, encodedM]-fromS2K (OtherS2K _ bs) = bs--getPacketLength :: Get Integer-getPacketLength = do-  firstOctet <- getWord8-  lenOrPartial <- lengthOctetToLength firstOctet-  case lenOrPartial of-    Left _ ->-      fail "Partial body length is invalid in this context"-    Right len -> return len-  where-    lengthOctetToLength :: Word8 -> Get (Either Integer Integer)-    lengthOctetToLength f-      | f < 192 = return . Right . fromIntegral $ f-      | f < 224 = do-        secondOctet <- getWord8-        return . Right . fromIntegral $-          shiftL (fromIntegral (f - 192) :: Int) 8 +-          (fromIntegral secondOctet :: Int) +-          192-      | f < 255 =-        return . Left . fromIntegral $ (1 :: Integer) `shiftL` fromIntegral (f .&. 0x1f)-      | otherwise = do-        len <- getWord32be-        return . Right . fromIntegral $ len--putPacketLength :: Integer -> Put-putPacketLength l-  | l < 192 = putWord8 (fromIntegral l)-  | l < 8384 =-    putWord8 (fromIntegral ((fromIntegral (l - 192) `shiftR` 8) + 192 :: Int)) >>-    putWord8 (fromIntegral (l - 192) .&. 0xff)-  | l < 0x100000000 = putWord8 255 >> putWord32be (fromIntegral l)-  | otherwise = error "packet length exceeds 32-bit definite length encoding"--putPartialLength :: Word8 -> Put-putPartialLength n = putWord8 (224 + n)--getPacketLengthFromOctet :: Word8 -> Get (Either Int64 Int64)-getPacketLengthFromOctet f-  | f < 192 = return . Right . fromIntegral $ f-  | f < 224 = do-    secondOctet <- getWord8-    return . Right . fromIntegral $-      shiftL (fromIntegral (f - 192) :: Int) 8 +-      (fromIntegral secondOctet :: Int) +-      192-  | f < 255 =-    return . Left . fromIntegral $ (1 :: Integer) `shiftL` fromIntegral (f .&. 0x1f)-  | otherwise = do-    len <- getWord32be-    return . Right . fromIntegral $ len--getS2K :: Get S2K-getS2K = getS2K' =<< getWord8-  where-    getS2K' :: Word8 -> Get S2K-    getS2K' t-      | t == 0 = do-        ha <- getWord8-        return $ Simple (toFVal ha)-      | t == 1 = do-        ha <- getWord8-        salt <- getByteString 8-        return $ Salted (toFVal ha) (Salt8 salt)-      | t == 3 = do-        ha <- getWord8-        salt <- getByteString 8-        count <- getWord8-        return $-          IteratedSalted (toFVal ha) (Salt8 salt) (decodeIterationCount count)-      | t == 4 = do-        salt <- getByteString 16-        passes <- getWord8-        parallelism <- getWord8-        encodedM <- getWord8-        return $ Argon2 (Salt16 salt) passes parallelism encodedM-      | otherwise = do-        bs <- getRemainingLazyByteString-        return $ OtherS2K t bs--putS2K :: S2K -> Put-putS2K (Simple hashalgo) = error ("confused by simple" ++ show hashalgo)-putS2K (Salted hashalgo salt) =-  error ("confused by salted" ++ show hashalgo ++ " by " ++ show salt)-putS2K (IteratedSalted ha salt count) = do-  putWord8 3-  put ha-  putByteString (unSalt8 salt)-  putWord8 $ encodeIterationCount count-putS2K (Argon2 salt t p encodedM) = do-  putWord8 4-  putByteString (unSalt16 salt)-  putWord8 t-  putWord8 p-  putWord8 encodedM-putS2K (OtherS2K t bs) = putWord8 t >> putLazyByteString bs--v6SaltSizeForHashAlgorithm :: HashAlgorithm -> Maybe Word8-v6SaltSizeForHashAlgorithm = signatureV6SaltSizeForHashAlgorithm--getPacketTypeAndPayload :: Get (Word8, ByteString)-getPacketTypeAndPayload = do-  tag <- getWord8-  guard (testBit tag 7)-  case tag .&. 0x40 of-    0x00 -> do-      let t = shiftR (tag .&. 0x3c) 2-      case tag .&. 0x03 of-        0 -> do-          len <- getWord8-          bs <- getLazyByteString (fromIntegral len)-          return (t, bs)-        1 -> do-          len <- getWord16be-          bs <- getLazyByteString (fromIntegral len)-          return (t, bs)-        2 -> do-          len <- getWord32be-          bs <- getLazyByteString (fromIntegral len)-          return (t, bs)-        3 -> do-          bs <- getRemainingLazyByteString-          return (t, bs)-        _ -> error "This should never happen (getPacketTypeAndPayload/0x00)."-    0x40 -> do-      firstLenOctet <- getWord8-      bs <- getPacketPayloadFromLengthOctet firstLenOctet-      return (tag .&. 0x3f, bs)-    _ -> error "This should never happen (getPacketTypeAndPayload/???)."-  where-    getPacketPayloadFromLengthOctet :: Word8 -> Get ByteString-    getPacketPayloadFromLengthOctet lenOctet = do-      lenOrPartial <- getPacketLengthFromOctet lenOctet-      case lenOrPartial of-        Right len -> getLazyByteString len-        Left partialLen -> do-          chunk <- getLazyByteString partialLen-          rest <- getRemainingPartialPayload-          return (chunk <> rest)-    getRemainingPartialPayload :: Get ByteString-    getRemainingPartialPayload = do-      lenOctet <- getWord8-      lenOrPartial <- getPacketLengthFromOctet lenOctet-      case lenOrPartial of-        Right len -> getLazyByteString len-        Left partialLen -> do-          chunk <- getLazyByteString partialLen-          (chunk <>) <$> getRemainingPartialPayload--getPkt :: Get Pkt-getPkt = do-  (t, pl) <- getPacketTypeAndPayload-  case runGetOrFail (getPkt' t (BL.length pl)) pl of-    Left (_, _, e) -> return $! BrokenPacketPkt e t pl-    Right (_, _, p) -> return p-  where-    parseLegacyPKESK :: PacketVersion -> BL.ByteString -> Either String Pkt-    parseLegacyPKESK pv body = do-      (_, _, (eokeyid, pkaRaw, mpib)) <--        bimap (\(_, _, e) -> e) id $-        runGetOrFail-          (do eokeyid <- getLazyByteString 8-              pka <- getWord8-              mpib <- getRemainingLazyByteString-              pure (eokeyid, pka, mpib))-          body-      let pka = toFVal pkaRaw-      sk <- parseLegacyPKESKMPIs pka mpib-      pure $-        PKESKPkt-          (PKESKPayloadV3Packet (PKESKPayloadV3 pv (EightOctetKeyId eokeyid) pka sk))--    parseLegacyPKESKMPIs :: PubKeyAlgorithm -> BL.ByteString -> Either String (NE.NonEmpty MPI)-    parseLegacyPKESKMPIs pka mpib = do-      case parseLegacyPKESKMPIsStrict pka mpib of-        Right sk -> pure sk-        Left strictErr-          | pka == X25519 ->-              case parseLegacyPKESKX25519V3Octets mpib of-                Right sk -> Right sk-                Left octetErr ->-                  Left-                    (strictErr ++-                     "; also failed to parse RFC9580 X25519 v3 octet layout: " ++-                     octetErr)-          | pka == ECDH ->-              case parseLegacyPKESKECDHOctets mpib of-                Right sk -> Right sk-                Left octetErr ->-                  Left-                    (strictErr ++-                     "; also failed to parse RFC6637 ECDH v3 octet layout: " ++-                     octetErr)-          | otherwise -> Left strictErr--    parseLegacyPKESKMPIsStrict ::-         PubKeyAlgorithm -> BL.ByteString -> Either String (NE.NonEmpty MPI)-    parseLegacyPKESKMPIsStrict pka mpib = do-      (rest, _, sk) <--        bimap (\(_, _, e) -> e) id $-        runGetOrFail (parserForLegacyPKESKMPIs pka) mpib-      if BL.null rest-        then pure (NE.fromList sk)-        else-          Left-            ("unexpected trailing PKESK MPI data for algorithm " ++ show pka)--    parseLegacyPKESKX25519V3Octets :: BL.ByteString -> Either String (NE.NonEmpty MPI)-    parseLegacyPKESKX25519V3Octets mpib = do-      if BL.length mpib < 33-        then Left "X25519 v3 PKESK octet layout is too short"-        else Right ()-      let ephemeral = BL.toStrict (BL.take 32 mpib)-          eskLen = fromIntegral (BL.index mpib 32) :: Int-          eskWithAlgo = BL.toStrict (BL.drop 33 mpib)-      if eskLen /= B.length eskWithAlgo-        then Left "X25519 v3 PKESK octet layout has inconsistent ESK length"-        else Right ()-      if B.null eskWithAlgo-        then Left "X25519 v3 PKESK octet layout must include a symmetric algorithm octet"-        else Right ()-      let symAlgo = B.head eskWithAlgo-      if symAlgo `elem` [fromIntegral (fromFVal AES128), fromIntegral (fromFVal AES192), fromIntegral (fromFVal AES256)]-        then pure (NE.fromList [MPI (os2ip ephemeral), MPI (os2ip eskWithAlgo)])-        else-          Left-            ("X25519 v3 PKESK octet layout has unsupported symmetric algorithm octet " ++-             show symAlgo)--    -- | Parse an RFC 6637 §8 ECDH PKESKv3 body as MPI(ephemeral) || 1-octet-count || C.-    -- This is the interoperable wire format produced by GnuPG and other RFC-compliant-    -- implementations. hOpenPGP previously wrote both fields as MPIs; this fallback-    -- allows reading RFC-compliant packets when the strict two-MPI path fails.-    parseLegacyPKESKECDHOctets :: BL.ByteString -> Either String (NE.NonEmpty MPI)-    parseLegacyPKESKECDHOctets mpib = do-      (rest, _, ephMPI) <--        bimap (\(_, _, e) -> e) id $ runGetOrFail getMPI mpib-      let restBS = BL.toStrict rest-      when (B.null restBS) $-        Left "ECDH v3 PKESK RFC6637 octet layout: missing wrapped-key length octet after ephemeral MPI"-      let wrappedLen = fromIntegral (B.head restBS) :: Int-          wrapped = B.tail restBS-      when (wrappedLen /= B.length wrapped) $-        Left-          ("ECDH v3 PKESK RFC6637 octet layout: wrapped key length field " ++-           show wrappedLen ++ " does not match body length " ++ show (B.length wrapped))-      when (wrappedLen < 24 || wrappedLen `mod` 8 /= 0) $-        Left-          ("ECDH v3 PKESK RFC6637 octet layout: wrapped key length " ++-           show wrappedLen ++ " is not a valid RFC 3394 wrapped key size")-      pure (ephMPI NE.:| [MPI (os2ip wrapped)])--    parserForLegacyPKESKMPIs :: PubKeyAlgorithm -> Get [MPI]-    parserForLegacyPKESKMPIs pka =-      case expectedLegacyPKESKMPIArity pka of-        Just mpiCount -> replicateM mpiCount getMPI-        Nothing -> some getMPI--    expectedLegacyPKESKMPIArity :: PubKeyAlgorithm -> Maybe Int-    expectedLegacyPKESKMPIArity pka-      | pka `elem` [RSA, DeprecatedRSAEncryptOnly] = Just 1-      | pka `elem` [ElgamalEncryptOnly, ForbiddenElgamal, ECDH, X25519] = Just 2-      | otherwise = Nothing--    validateV4SKESKEncryptedSessionKeyS2K :: S2K -> Maybe BL.ByteString -> Get ()-    validateV4SKESKEncryptedSessionKeyS2K _ Nothing = pure ()-    validateV4SKESKEncryptedSessionKeyS2K Simple {} (Just _) =-      fail-        "v4 SKESK packets with encrypted session keys must not use Simple S2K"-    validateV4SKESKEncryptedSessionKeyS2K _ (Just _) = pure ()--    parseV6PKESK :: BL.ByteString -> Either String Pkt-    parseV6PKESK body = do-      (_, _, (recipientKeyIdentifier, pka, esk)) <--        bimap (\(_, _, e) -> e) id $-        runGetOrFail-          (do keyIdentifierLen <- getWord8-              recipientKeyIdentifier <- getLazyByteString (fromIntegral keyIdentifierLen)-              pka <- getWord8-              esk <- getRemainingLazyByteString-              pure (recipientKeyIdentifier, pka, esk))-          body-      validateV6PKESKRecipientIdentifier recipientKeyIdentifier-      pure $-        PKESKPkt-          (PKESKPayloadV6Packet (PKESKPayloadV6 recipientKeyIdentifier (toFVal pka) esk))-      where-        validateV6PKESKRecipientIdentifier :: BL.ByteString -> Either String ()-        validateV6PKESKRecipientIdentifier rid =-          case BL.length rid of-            0 -> Right ()-            20 -> Right ()-            32 -> Right ()-            21 -> validateVersionedFingerprint rid-            33 -> validateVersionedFingerprint rid-            ridLen ->-              Left-                ("invalid PKESK v6 recipient identifier length: " ++-                 show ridLen ++-                 " (expected 0, 20, 21, 32, or 33)")--        validateVersionedFingerprint :: BL.ByteString -> Either String ()-        validateVersionedFingerprint rid =-          let keyVersion = BL.head rid-              fingerprintLen = BL.length (BL.tail rid)-           in case keyVersion of-                4 ->-                  if fingerprintLen == 20-                    then Right ()-                    else-                      Left-                        ("PKESK v6 recipient identifier length/version mismatch: key version 4 requires fingerprint length 20, got " ++-                         show fingerprintLen)-                6 ->-                  if fingerprintLen == 32-                    then Right ()-                    else-                      Left-                        ("PKESK v6 recipient identifier length/version mismatch: key version 6 requires fingerprint length 32, got " ++-                         show fingerprintLen)-                _ ->-                  Left-                    ("invalid PKESK v6 recipient key version: " ++-                     show keyVersion ++ " (expected 4 or 6)")--    getPkt' :: Word8 -> ByteOffset -> Get Pkt-    getPkt' t len-      | t == 1 = do-        pv <- getWord8-        body <- getRemainingLazyByteString-        if pv == 6-          then case parseV6PKESK body of-                 Right pkt -> return pkt-                 Left v6Err -> fail ("PKESK v6 parse failed: " ++ v6Err)-          else case parseLegacyPKESK pv body of-                 Right pkt -> return pkt-                 Left legacyErr -> fail ("PKESK MPIs " ++ legacyErr)-      | t == 2 = do-        bs <- getRemainingLazyByteString-        case runGetOrFail get bs of-          Left (_, _, e) -> fail ("signature packet " ++ e)-          Right (_, _, sp) -> return $ SignaturePkt sp-      | t == 3 = do-        pv <- getWord8-        let getV6SKESKParams = do-              symalgoWord <- getWord8-              aeadWord <- getWord8-              s2kLen <- getWord8-              s2kBytes <- getLazyByteString (fromIntegral s2kLen)-              s2k <--                case runGetOrFail getS2K s2kBytes of-                  Left (_, _, err) -> fail err-                  Right (rest, _, parsed)-                    | not (BL.null rest) -> fail "unexpected trailing bytes in v6 SKESK S2K specifier"-                    | otherwise -> pure parsed-              let symalgo = toFVal symalgoWord-                  aead = toFVal aeadWord-                  ivLen = fromIntegral (aeadNonceSize aead)-              iv <- getLazyByteString ivLen-              pure (symalgo, aead, s2k, iv)-        case pv of-          6 -> do-            paramsLen <- getWord8-            params <- getLazyByteString (fromIntegral paramsLen)-            (symalgo, aead, s2k, iv) <--              case runGetOrFail getV6SKESKParams params of-                Left (_, _, err) -> fail err-                Right (rest, _, parsed)-                  | not (BL.null rest) -> fail "unexpected trailing v6 SKESK parameters"-                  | otherwise -> pure parsed-            payload <- getRemainingLazyByteString-            when (BL.length payload < 16) $-              fail "v6 SKESK payload must include encrypted session key and authentication tag"-            let (esk, tag) = BL.splitAt (BL.length payload - 16) payload-            return $-              SKESKPkt-                (SKESKPayloadV6Packet-                  (SKESKPayloadV6-                  symalgo-                  aead-                  s2k-                  iv-                  esk-                  tag))-          4 -> do-            symalgo <- getWord8-            s2k <- getS2K-            esk <- getRemainingLazyByteString-            let mesk = if BL.null esk then Nothing else Just esk-            validateV4SKESKEncryptedSessionKeyS2K s2k mesk-            return $-              SKESKPkt-                (SKESKPayloadV4Packet-                  (SKESKPayloadV4-                  (toFVal symalgo)-                  s2k-                  mesk))-          _ -> fail ("unsupported SKESK packet version " ++ show pv)-      | t == 4 = do-        pv <- getWord8-        sigtype <- toFVal <$> getWord8-        ha <- toFVal <$> getWord8-        pka <- toFVal <$> getWord8-        case pv of-          3 -> do-            skeyid <- getLazyByteString 8-            nested <- getWord8 >>= parseOPSNestedFlag-            return $-              OnePassSignaturePkt-                (OPSPayloadV3Packet-                  (OPSPayloadV3-                  pv-                  sigtype-                  ha-                  pka-                  (EightOctetKeyId skeyid)-                  nested))-          6 -> do-            saltSize <- getWord8-            expectedSaltSize <--              maybe-                (fail ("signature hash algorithm does not define a V6 salt size: " ++ show ha))-                pure-                (v6SaltSizeForHashAlgorithm ha)-            when (saltSize /= expectedSaltSize) $-              fail-                ("OPS v6 salt size mismatch for " ++-                 show ha ++ ": expected " ++ show expectedSaltSize ++ ", got " ++ show saltSize)-            salt <- SignatureSalt <$> getLazyByteString (fromIntegral saltSize)-            signerFingerprint <- getLazyByteString 32-            nested <- getWord8 >>= parseOPSNestedFlag-            return $-              OnePassSignaturePkt-                (OPSPayloadV6Packet-                  (OPSPayloadV6-                  sigtype-                  ha-                  pka-                  salt-                  signerFingerprint-                  nested))-          _ -> fail ("Unsupported OPS version: " ++ show pv)-      | t == 5 = do-        bs <- getLazyByteString len-        let ps =-              flip runGetOrFail bs $ do-                pkp <- getPKPayload-                ska <- getSKAddendum pkp-                return $ SecretKeyPkt pkp ska-        case ps of-          Left (_, _, err) -> fail ("secret key " ++ err)-          Right (_, _, pkt) -> return pkt-      | t == 6 = do-        pkp <- getPKPayload-        return $ PublicKeyPkt pkp-      | t == 7 = do-        bs <- getLazyByteString len-        let ps =-              flip runGetOrFail bs $ do-                pkp <- getPKPayload-                ska <- getSKAddendum pkp-                return $ SecretSubkeyPkt pkp ska-        case ps of-          Left (_, _, err) -> fail ("secret subkey " ++ err)-          Right (_, _, pkt) -> return pkt-      | t == 8 = do-        ca <- getWord8-        cdata <- getLazyByteString (len - 1)-        return $ CompressedDataPkt (toFVal ca) cdata-      | t == 9 = do-        sdata <- getLazyByteString len-        return $ SymEncDataPkt sdata-      | t == 10 = do-        marker <- getLazyByteString len-        return $ MarkerPkt marker-      | t == 11 = do-        dt <- getWord8-        flen <- getWord8-        fn <- getLazyByteString (fromIntegral flen)-        ts <- fmap ThirtyTwoBitTimeStamp getWord32be-        ldata <- getLazyByteString (len - (6 + fromIntegral flen))-        return $ LiteralDataPkt (toFVal dt) fn ts ldata-      | t == 12 = do-        tdata <- getLazyByteString len-        return $ TrustPkt tdata-      | t == 13 = do-        udata <- getByteString (fromIntegral len)-        return . UserIdPkt . decodeUtf8With lenientDecode $ udata-      | t == 14 = do-        bs <- getLazyByteString len-        let ps =-              flip runGetOrFail bs $ do-                pkp <- getPKPayload-                return $ PublicSubkeyPkt pkp-        case ps of-          Left (_, _, err) -> fail ("public subkey " ++ err)-          Right (_, _, pkt) -> return pkt-      | t == 17 = do-        bs <- getLazyByteString len-        case runGetOrFail (many getUserAttrSubPacket) bs of-          Left (_, _, err) -> fail ("user attribute " ++ err)-          Right (_, _, uas) -> return $ UserAttributePkt uas-      | t == 18 = do-        pv <- getWord8-        case pv of-          1 -> do-            b <- getLazyByteString (len - 1)-            return $ SymEncIntegrityProtectedDataPkt (SEIPD1 pv b)-          2 -> do-            when (len < 36) $-              fail "SEIPD v2 packet too short"-            symalgo <- toFVal <$> getWord8-            aeadalgo <- toFVal <$> getWord8-            chunkSize <- getWord8-            salt <- Salt <$> getByteString 32-            encrypted <- getLazyByteString (len - 36)-            validateSEIPDv2Header symalgo aeadalgo chunkSize encrypted-            return $-              SymEncIntegrityProtectedDataPkt-                (SEIPD2-                  symalgo-                  aeadalgo-                  chunkSize-                  salt-                  encrypted)-          _ -> fail ("Unsupported SEIPD version: " ++ show pv)-      | t == 19 = do-        hash <- getLazyByteString 20-        return $ ModificationDetectionCodePkt hash-      | otherwise = do-        payload <- getLazyByteString len-        return $ OtherPacketPkt t payload--getUserAttrSubPacket :: Get UserAttrSubPacket-getUserAttrSubPacket = do-  l <- fmap fromIntegral getSubPacketLength-  t <- getWord8-  getUserAttrSubPacket' t l-  where-    getUserAttrSubPacket' :: Word8 -> ByteOffset -> Get UserAttrSubPacket-    getUserAttrSubPacket' t l-      | t == 1 = do-        _ <- getWord16le -- ihlen-        hver <- getWord8 -- should be 1-        iformat <- getWord8-        nuls <- getLazyByteString 12 -- should be NULs-        bs <- getLazyByteString (l - 17)-        if hver /= 1 || nuls /= BL.pack (replicate 12 0)-          then fail "Corrupt UAt subpacket"-          else return $ ImageAttribute (ImageHV1 (toFVal iformat)) bs-      | otherwise = do-        bs <- getLazyByteString (l - 1)-        return $ OtherUASub t bs--putUserAttrSubPacket :: UserAttrSubPacket -> Put-putUserAttrSubPacket ua = do-  let sp = runPut $ putUserAttrSubPacket' ua-  putSubPacketLength . fromIntegral . BL.length $ sp-  putLazyByteString sp-  where-    putUserAttrSubPacket' (ImageAttribute (ImageHV1 iformat) idata) = do-      putWord8 1-      putWord16le 16-      putWord8 1-      putWord8 (fromFVal iformat)-      replicateM_ 12 $ putWord8 0-      putLazyByteString idata-    putUserAttrSubPacket' (OtherUASub t bs) = do-      putWord8 t-      putLazyByteString bs---- | Serialize PKESKv3 session-key material.--- For ECDH and X25519 the RFC 6637 §8 / RFC 9580 §5.1.6 wire format is used:--- MPI(ephemeral_key) || 1-octet-count || wrapped_session_key_bytes.--- All other algorithms use the standard MPI sequence.-putPKESKv3SessionKeyMaterial :: PubKeyAlgorithm -> NE.NonEmpty MPI -> Put-putPKESKv3SessionKeyMaterial pka mpis-  | pka `elem` [ECDH, X25519]-  , (ephMPI NE.:| [wrappedMPI]) <- mpis = do-      put ephMPI-      let rawWrapped = i2osp (unMPI wrappedMPI)-          -- Left-pad to the nearest valid RFC 3394 wrapped-key length so that-          -- leading-zero bytes stripped by i2osp are restored.-          targetLen = headDef (B.length rawWrapped) (filter (>= B.length rawWrapped) [32, 40, 48])-          paddedWrapped = leftPadTo targetLen rawWrapped-      putWord8 (fromIntegral (B.length paddedWrapped))-      putByteString paddedWrapped-  | otherwise = F.mapM_ put mpis-  where-    headDef d [] = d-    headDef _ (x:_) = x--putPkt :: Pkt -> Put-putPkt (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 pv eokeyid pka mpis))) = do-  putWord8 (0xc0 .|. 1)-  let bsk = runPut $ putPKESKv3SessionKeyMaterial pka mpis-  putPacketLength . fromIntegral $ 10 + BL.length bsk-  putWord8 pv -- must be 3-  putLazyByteString (unEOKI eokeyid) -- must be 8 octets-  putWord8 $ fromIntegral . fromFVal $ pka-  putLazyByteString bsk-putPkt (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 recipientKeyIdentifier pka esk))) = do-  putWord8 (0xc0 .|. 1)-  let keyIdentifierLen = BL.length recipientKeyIdentifier-  when (keyIdentifierLen > 255) $-    error "PKESK v6 recipient key identifier must fit in one octet"-  putPacketLength . fromIntegral $ 3 + keyIdentifierLen + BL.length esk-  putWord8 6-  putWord8 (fromIntegral keyIdentifierLen)-  putLazyByteString recipientKeyIdentifier-  putWord8 $ fromIntegral . fromFVal $ pka-  putLazyByteString esk-putPkt (SignaturePkt sp) = do-  putWord8 (0xc0 .|. 2)-  let bs = runPut $ put sp-  putLengthThenPayload bs-putPkt (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 symalgo s2k mesk))) = do-  putWord8 (0xc0 .|. 3)-  let bs2k = fromS2K s2k-  let bsk = fromMaybe BL.empty mesk-  putPacketLength . fromIntegral $ 2 + BL.length bs2k + BL.length bsk-  putWord8 4-  putWord8 $ fromIntegral . fromFVal $ symalgo-  putLazyByteString bs2k-  putLazyByteString bsk-putPkt (SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 symalgo aead s2k iv esk tag))) = do-  putWord8 (0xc0 .|. 3)-  let bs2k = fromS2K s2k-  let params =-        BL.pack-          [ fromIntegral (fromFVal symalgo)-          , fromIntegral (fromFVal aead)-          , fromIntegral (BL.length bs2k)-          ] <>-        bs2k <> iv-  putPacketLength . fromIntegral $ 2 + BL.length params + BL.length esk + BL.length tag-  putWord8 6-  putWord8 (fromIntegral (BL.length params))-  putLazyByteString params-  putLazyByteString esk-  putLazyByteString tag-putPkt (OnePassSignaturePkt (OPSPayloadV3Packet (OPSPayloadV3 pv sigtype ha pka skeyid nested))) = do-  putWord8 (0xc0 .|. 4)-  let bs =-        runPut $ do-          putWord8 pv -- should be 3-          putWord8 $ fromIntegral . fromFVal $ sigtype-          putWord8 $ fromIntegral . fromFVal $ ha-          putWord8 $ fromIntegral . fromFVal $ pka-          putLazyByteString (unEOKI skeyid)-          putWord8 . fromIntegral . fromEnum $ not nested-  putLengthThenPayload bs-putPkt (OnePassSignaturePkt (OPSPayloadV6Packet (OPSPayloadV6 sigtype ha pka salt signerFingerprint nested))) = do-  putWord8 (0xc0 .|. 4)-  let saltBytes = unSignatureSalt salt-      saltSize = BL.length saltBytes-      expectedSaltSize =-        maybe-          (error ("signature hash algorithm does not define a V6 salt size: " ++ show ha))-          id-          (v6SaltSizeForHashAlgorithm ha)-  when (fromIntegral saltSize /= expectedSaltSize) $-    error-      ("OPS v6 salt size mismatch for " ++-       show ha ++ ": expected " ++ show expectedSaltSize ++ ", got " ++ show saltSize)-  when (BL.length signerFingerprint /= 32) $-    error "OPS v6 signer fingerprint must be exactly 32 octets"-  let bs =-        runPut $ do-          putWord8 6-          putWord8 $ fromIntegral . fromFVal $ sigtype-          putWord8 $ fromIntegral . fromFVal $ ha-          putWord8 $ fromIntegral . fromFVal $ pka-          putWord8 (fromIntegral saltSize)-          putLazyByteString saltBytes-          putLazyByteString signerFingerprint-          putWord8 . fromIntegral . fromEnum $ not nested-  putLengthThenPayload bs-putPkt (SecretKeyPkt pkp ska) = do-  putWord8 (0xc0 .|. 5)-  let bs = runPut (putPKPayload pkp >> putSKAddendumForPKPayload pkp ska)-  putLengthThenPayload bs-putPkt (PublicKeyPkt pkp) = do-  putWord8 (0xc0 .|. 6)-  let bs = runPut $ putPKPayload pkp-  putLengthThenPayload bs-putPkt (SecretSubkeyPkt pkp ska) = do-  putWord8 (0xc0 .|. 7)-  let bs = runPut (putPKPayload pkp >> putSKAddendumForPKPayload pkp ska)-  putLengthThenPayload bs-putPkt (CompressedDataPkt ca cdata) = do-  putWord8 (0xc0 .|. 8)-  let bs =-        runPut $ do-          putWord8 $ fromIntegral . fromFVal $ ca-          putLazyByteString cdata-  putLengthThenPayload bs-putPkt (SymEncDataPkt b) = do-  putWord8 (0xc0 .|. 9)-  putLengthThenPayload b-putPkt (MarkerPkt b) = do-  putWord8 (0xc0 .|. 10)-  putLengthThenPayload b-putPkt (LiteralDataPkt dt fn ts b) = do-  putWord8 (0xc0 .|. 11)-  let bs =-        runPut $ do-          putWord8 $ fromIntegral . fromFVal $ dt-          putWord8 $ fromIntegral . BL.length $ fn-          putLazyByteString fn-          putWord32be . unThirtyTwoBitTimeStamp $ ts-          putLazyByteString b-  putLengthThenPayload bs-putPkt (TrustPkt b) = do-  putWord8 (0xc0 .|. 12)-  putLengthThenPayload b-putPkt (UserIdPkt u) = do-  putWord8 (0xc0 .|. 13)-  let bs = encodeUtf8 u-  putPacketLength . fromIntegral $ B.length bs-  putByteString bs-putPkt (PublicSubkeyPkt pkp) = do-  putWord8 (0xc0 .|. 14)-  let bs = runPut $ putPKPayload pkp-  putLengthThenPayload bs-putPkt (UserAttributePkt us) = do-  putWord8 (0xc0 .|. 17)-  let bs = runPut $ mapM_ put us-  putLengthThenPayload bs-putPkt (SymEncIntegrityProtectedDataPkt (SEIPD1 pv b)) = do-  putWord8 (0xc0 .|. 18)-  putPacketLength . fromIntegral $ BL.length b + 1-  putWord8 pv -- should be 1-  putLazyByteString b-putPkt (SymEncIntegrityProtectedDataPkt (SEIPD2 symalgo aeadalgo chunkSize salt b)) = do-  when (B.length (unSalt salt) /= 32) $-    error "SEIPD v2 salt must be exactly 32 octets"-  when (chunkSize > 16) $-    error "SEIPD v2 chunk size octet must be between 0 and 16"-  case symalgo of-    OtherSA _ -> error "SEIPD v2 requires a known symmetric algorithm"-    Plaintext -> error "SEIPD v2 cannot use plaintext cipher"-    _ -> return ()-  case aeadalgo of-    OtherAEADAlgo _ -> error "SEIPD v2 requires a known AEAD algorithm"-    _ -> return ()-  putWord8 (0xc0 .|. 18)-  putPacketLength . fromIntegral $ BL.length b + 36-  putWord8 2-  putWord8 (fromFVal symalgo)-  putWord8 (fromFVal aeadalgo)-  putWord8 chunkSize-  putByteString (unSalt salt)-  putLazyByteString b-putPkt (ModificationDetectionCodePkt hash) = do-  putWord8 (0xc0 .|. 19)-  putLengthThenPayload hash-putPkt (OtherPacketPkt t payload) = do-  when (t > 63) $-    error ("cannot serialize OtherPacket packet tag > 63: " ++ show t)-  putWord8 (0xc0 .|. t)-  putLengthThenPayload payload-putPkt (BrokenPacketPkt _ t payload) = putPkt (OtherPacketPkt t payload)---- | Validate a packet before serialization to catch constraint violations early.--- Returns Left with descriptive error if validation fails.-validatePkt :: Pkt -> Either String ()-validatePkt (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 recipientKeyIdentifier _ _))) = do-  let keyIdentifierLen = BL.length recipientKeyIdentifier-  when (keyIdentifierLen > 255) $-    Left "PKESK v6 recipient key identifier must fit in one octet (max 255 bytes)"-  Right ()-validatePkt (OnePassSignaturePkt (OPSPayloadV6Packet (OPSPayloadV6 _ ha _ salt signerFingerprint _))) = do-  let saltBytes = unSignatureSalt salt-      saltSize = BL.length saltBytes-  expectedSaltSize <--    case v6SaltSizeForHashAlgorithm ha of-      Nothing -> Left $ "signature hash algorithm does not define a V6 salt size: " ++ show ha-      Just sz -> Right sz-  when (fromIntegral saltSize /= expectedSaltSize) $-    Left-      ("OPS v6 salt size mismatch for " ++-       show ha ++ ": expected " ++ show expectedSaltSize ++ ", got " ++ show saltSize)-  when (BL.length signerFingerprint /= 32) $-    Left "OPS v6 signer fingerprint must be exactly 32 octets"-  Right ()-validatePkt (SymEncIntegrityProtectedDataPkt (SEIPD2 symalgo aeadalgo chunkSize salt _)) = do-  when (B.length (unSalt salt) /= 32) $-    Left "SEIPD v2 salt must be exactly 32 octets"-  when (chunkSize > 16) $-    Left "SEIPD v2 chunk size octet must be between 0 and 16"-  case symalgo of-    OtherSA _ -> Left "SEIPD v2 requires a known symmetric algorithm"-    Plaintext -> Left "SEIPD v2 cannot use plaintext cipher"-    _ -> Right ()-  case aeadalgo of-    OtherAEADAlgo _ -> Left "SEIPD v2 requires a known AEAD algorithm"-    _ -> Right ()-validatePkt (OtherPacketPkt t _) = do-  when (t > 63) $-    Left ("cannot serialize OtherPacket packet tag > 63: " ++ show t)-  Right ()-validatePkt _ = Right ()---- | Serialize a packet with explicit validation and error handling.--- Validates constraints before calling putPkt to ensure errors are caught early.-putPktEither :: Pkt -> Either String Put-putPktEither pkt = case validatePkt pkt of-  Left err -> Left err-  Right () -> Right (putPkt pkt)--putLengthThenPayload :: ByteString -> Put-putLengthThenPayload bs = do-  let len = BL.length bs-  if len < fromIntegral (0x100000000 :: Integer)-    then do-      putPacketLength (fromIntegral len)-      putLazyByteString bs-    else putPartialLengthPayload bs-  where-    maxPartialChunkSize :: Int64-    maxPartialChunkSize = 1 `shiftL` (30 :: Int)-    putPartialLengthPayload :: ByteString -> Put-    putPartialLengthPayload payload-      | BL.length payload > maxPartialChunkSize = do-        let (chunk, rest) = BL.splitAt maxPartialChunkSize payload-        putPartialLength 30-        putLazyByteString chunk-        putPartialLengthPayload rest-      | otherwise = do-        putPacketLength (fromIntegral (BL.length payload))-        putLazyByteString payload--validateSEIPDv2Header ::-     SymmetricAlgorithm -> AEADAlgorithm -> Word8 -> ByteString -> Get ()-validateSEIPDv2Header symalgo aeadalgo chunkSize encrypted = do-  when (chunkSize > 16) $-    fail "SEIPD v2 chunk size octet must be between 0 and 16"-  when (BL.null encrypted) $-    fail "SEIPD v2 payload is missing encrypted data and final authentication tag"-  case symalgo of-    OtherSA _ -> fail "SEIPD v2 requires a known symmetric algorithm"-    Plaintext -> fail "SEIPD v2 cannot use plaintext cipher"-    _ -> return ()-  case aeadalgo of-    OtherAEADAlgo _ -> fail "SEIPD v2 requires a known AEAD algorithm"-    _ -> return ()--getMPI :: Get MPI-getMPI = do-  mpilen <- getWord16be-  bs <- getByteString (fromIntegral (mpilen + 7) `div` 8)-  return $ MPI (os2ip bs)--getPubkey :: PubKeyAlgorithm -> Get PKey-getPubkey RSA = do-  MPI n <- get-  MPI e <- get-  return $-    RSAPubKey-      (RSA_PublicKey (R.PublicKey (fromIntegral . B.length . i2osp $ n) n e))-getPubkey DeprecatedRSAEncryptOnly = getPubkey RSA-getPubkey DeprecatedRSASignOnly = getPubkey RSA-getPubkey DSA = do-  MPI p <- get-  MPI q <- get-  MPI g <- get-  MPI y <- get-  return $ DSAPubKey (DSA_PublicKey (D.PublicKey (D.Params p g q) y))-getPubkey ElgamalEncryptOnly = getPubkey ForbiddenElgamal-getPubkey ForbiddenElgamal = do-  MPI p <- get-  MPI g <- get-  MPI y <- get-  return $ ElGamalPubKey p g y-getPubkey ECDSA = do-  curvelength <- getWord8-  when (curvelength == 0 || curvelength == 0xff) $-    fail "invalid ECC curve OID length octet (reserved value)"-  curveoid <- getByteString (fromIntegral curvelength)-  MPI mpi <- getMPI-  case curveoidBSToCurve curveoid of-    Left e -> fail e-    Right Curve25519 ->-      EdDSAPubKey P.Ed25519 <$> (PrefixedNativeEPoint <$> validatePrefixedNativePoint 32 "Curve25519Legacy" mpi)-    Right curve ->-      case bs2Point (i2osp mpi) of-        Left e -> fail e-        Right point ->-          return . ECDSAPubKey . ECDSA_PublicKey .-          ECDSA.PublicKey (curve2Curve curve) $-          point-getPubkey ECDH = do-  ed <- getPubkey ECDSA -- could be an ECDSA or an EdDSA-  kdflen <- getWord8-  when (kdflen == 0 || kdflen == 0xff) $-    fail "invalid ECDH KDF field length octet (reserved value)"-  when (kdflen /= 3) $-    fail ("invalid ECDH KDF field length: " ++ show kdflen)-  one <- getWord8-  when (one /= 1) $-    fail ("invalid ECDH KDF reserved octet: " ++ show one)-  kdfHA <- get-  kdfSA <- get-  return $ ECDHPubKey ed kdfHA kdfSA-getPubkey EdDSA = do-  curvelength <- getWord8-  when (curvelength == 0 || curvelength == 0xff) $-    fail "invalid EdDSA curve OID length octet (reserved value)"-  curveoid <- getByteString (fromIntegral curvelength)-  MPI mpi <- getMPI-  case curveoidBSToEdSigningCurve curveoid of-    Left e -> fail e-    Right P.Ed25519 ->-      EdDSAPubKey P.Ed25519 <$> (PrefixedNativeEPoint <$> validatePrefixedNativePoint 32 "Ed25519Legacy" mpi)-    Right P.Ed448 ->-      EdDSAPubKey P.Ed448 <$> (PrefixedNativeEPoint <$> validatePrefixedNativePoint 57 "Ed448Legacy" mpi)-getPubkey pka | pka == BTypes.Ed25519 =-  parseFixedLengthOrLegacyPubkey-    32-    (EdDSAPubKey P.Ed25519 . NativeEPoint . EPoint . os2ip . BL.toStrict)-    (getPubkey EdDSA)-getPubkey pka | pka == BTypes.Ed448 =-  parseFixedLengthOrLegacyPubkey-    57-    (EdDSAPubKey P.Ed448 . NativeEPoint . EPoint . os2ip . BL.toStrict)-    (getPubkey EdDSA)-getPubkey X25519 =-  parseFixedLengthOrLegacyPubkey-    32-    (EdDSAPubKey P.Ed25519 . NativeEPoint . EPoint . os2ip . BL.toStrict)-    (getPubkey ECDH)-getPubkey X448 =-  parseFixedLengthOrLegacyPubkey-    56-    (EdDSAPubKey P.Ed448 . NativeEPoint . EPoint . os2ip . BL.toStrict)-    (getPubkey ECDH)-getPubkey _ = UnknownPKey <$> getRemainingLazyByteString--parseFixedLengthOrLegacyPubkey :: Int64 -> (BL.ByteString -> PKey) -> Get PKey -> Get PKey-parseFixedLengthOrLegacyPubkey expectedLen decodeFixed legacyParser = do-  remaining <- lookAhead getRemainingLazyByteString-  if BL.length remaining == expectedLen-    then decodeFixed <$> getLazyByteString expectedLen-    else legacyParser--getPubkeyV6 :: PubKeyAlgorithm -> Get PKey-getPubkeyV6 pka-  | pka == BTypes.Ed25519 = do-      len <- getWord32be-      bs <- getByteString (fromIntegral len)-      when (B.length bs /= 32) $-        fail "invalid v6 Ed25519 public key length"-      return $ EdDSAPubKey P.Ed25519 (NativeEPoint (EPoint (os2ip bs)))-  | pka == BTypes.Ed448 = do-      len <- getWord32be-      bs <- getByteString (fromIntegral len)-      when (B.length bs /= 57) $-        fail "invalid v6 Ed448 public key length"-      return $ EdDSAPubKey P.Ed448 (NativeEPoint (EPoint (os2ip bs)))-  | pka == BTypes.X25519 = do-      len <- getWord32be-      bs <- getByteString (fromIntegral len)-      when (B.length bs /= 32) $-        fail "invalid v6 X25519 public key length"-      return $ EdDSAPubKey P.Ed25519 (NativeEPoint (EPoint (os2ip bs)))-  | pka == BTypes.X448 = do-      len <- getWord32be-      bs <- getByteString (fromIntegral len)-      when (B.length bs /= 56) $-        fail "invalid v6 X448 public key length"-      return $ EdDSAPubKey P.Ed448 (NativeEPoint (EPoint (os2ip bs)))-  | otherwise = getPubkey pka--bs2Point :: B.ByteString -> Either String ECDSA.PublicPoint-bs2Point bs =-  if B.null bs-    then Left "empty EC point encoding"-    else-      let xy = B.drop 1 bs-          l = B.length xy-       in if B.head bs /= 0x04-            then Left $ "unknown type of point: " ++ show (B.unpack bs)-            else if odd l-                   then Left "malformed EC point encoding: odd coordinate payload length"-                   else-                     return-                       (uncurry-                          ECCT.Point-                          ((os2ip *** os2ip) (B.splitAt (div l 2) xy)))--putPubkey :: PKey -> Put-putPubkey (UnknownPKey bs) = putLazyByteString bs-putPubkey p@(ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) =-  let Right curveoidbs = curveToCurveoidBS (curveFromCurve curve)-   in putCurveOID curveoidbs >>-      mapM_ put (pubkeyToMPIs p)-putPubkey p@(ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) kha ksa) =-  let Right curveoidbs = curveToCurveoidBS (curveFromCurve curve)-   in putCurveOID curveoidbs >>-      mapM_ put (pubkeyToMPIs p) >>-      putECDHKDFParams kha ksa-putPubkey p@(ECDHPubKey (EdDSAPubKey curve (PrefixedNativeEPoint _)) kha ksa) =-  let Right curveoidbs = curveToCurveoidBS (ed2ec curve)-   in putCurveOID curveoidbs >>-      mapM_ put (pubkeyToMPIs p) >>-      putECDHKDFParams kha ksa-  where-    ed2ec P.Ed25519 = Curve25519-    ed2ec P.Ed448 = Curve448-putPubkey p@(EdDSAPubKey curve (PrefixedNativeEPoint _)) =-  let Right curveoidbs = edSigningCurveToCurveoidBS curve-   in putCurveOID curveoidbs >>-      mapM_ put (pubkeyToMPIs p)-putPubkey (ECDHPubKey (EdDSAPubKey curve (NativeEPoint _)) _ _) =-  error ("legacy ECDH serialization requires a prefixed-native " ++ show curve ++ " point")-putPubkey (EdDSAPubKey curve (NativeEPoint _)) =-  error ("legacy EdDSA serialization requires a prefixed-native " ++ show curve ++ " point")-putPubkey p = mapM_ put (pubkeyToMPIs p)--putPubkeyV6 :: PKey -> Put-putPubkeyV6 (EdDSAPubKey P.Ed25519 (NativeEPoint (EPoint x))) = do-  let bs = fixedLengthOctets 32 x-  putWord32be . fromIntegral . B.length $ bs-  putByteString bs-putPubkeyV6 (EdDSAPubKey P.Ed448 (NativeEPoint (EPoint x))) = do-  let bs = fixedLengthOctets 57 x-  putWord32be . fromIntegral . B.length $ bs-  putByteString bs-putPubkeyV6 (ECDHPubKey (EdDSAPubKey P.Ed25519 (NativeEPoint (EPoint x))) kha ksa) = do-  let bs = fixedLengthOctets 32 x-  putWord32be . fromIntegral . B.length $ bs-  putByteString bs-  put kha-  put ksa-putPubkeyV6 (ECDHPubKey (EdDSAPubKey P.Ed448 (NativeEPoint (EPoint x))) kha ksa) = do-  let bs = fixedLengthOctets 56 x-  putWord32be . fromIntegral . B.length $ bs-  putByteString bs-  put kha-  put ksa-putPubkeyV6 p = putPubkey p--fixedLengthOctets :: Int -> Integer -> B.ByteString-fixedLengthOctets targetLen x =-  let bs = i2osp x-   in if B.length bs > targetLen-        then error ("public key element does not fit in " ++ show targetLen ++ " octets")-        else B.replicate (targetLen - B.length bs) 0 <> bs--validatePrefixedNativePoint :: Int -> String -> Integer -> Get EPoint-validatePrefixedNativePoint targetLen label i =-  let bs = i2osp i-   in if B.length bs /= targetLen + 1-        then-          fail-            ("invalid " ++ label ++ " public key length: expected " ++-             show (targetLen + 1) ++ " octets with 0x40 prefix, got " ++ show (B.length bs))-        else-          if B.head bs /= 0x40-            then fail ("invalid " ++ label ++ " public key: missing 0x40 prefix")-            else pure (EPoint i)--putCurveOID :: B.ByteString -> Put-putCurveOID oid = do-  let oidLength = B.length oid-  when (oidLength == 0 || oidLength == 0xff) $-    error "curve OID length cannot use reserved values 0 or 255"-  putWord8 (fromIntegral oidLength)-  putByteString oid--putECDHKDFParams :: HashAlgorithm -> SymmetricAlgorithm -> Put-putECDHKDFParams kdfHA kdfSA = do-  let kdfLengthOctet = 0x03-  when (kdfLengthOctet == 0 || kdfLengthOctet == 0xff) $-    error "ECDH KDF field length cannot use reserved values 0 or 255"-  putWord8 kdfLengthOctet-  putWord8 0x01-  put kdfHA-  put kdfSA--parseOPSNestedFlag :: Word8 -> Get NestedFlag-parseOPSNestedFlag 0 = pure True-parseOPSNestedFlag 1 = pure False-parseOPSNestedFlag other =-  fail ("invalid OPS nested flag octet: " ++ show other)--getSecretKey :: SomePKPayload -> Get SKey-getSecretKey pkp-  | _pkalgo pkp `elem` [RSA, DeprecatedRSAEncryptOnly, DeprecatedRSASignOnly] = do-    MPI d <- get-    MPI p <- get-    MPI q <- get-    MPI _ <- get -- u-    case inverse q p of-      Nothing -> fail "invalid RSA secret key: q has no inverse modulo p"-      Just qinv -> do-        let dP = d `mod` (p - 1)-            dQ = d `mod` (q - 1)-            pub = (\(RSAPubKey (RSA_PublicKey x)) -> x) (_pubkey pkp)-        return $ RSAPrivateKey (RSA_PrivateKey (R.PrivateKey pub d p q dP dQ qinv))-  | _pkalgo pkp == DSA = do-    MPI x <- get-    return $ DSAPrivateKey (DSA_PrivateKey (D.PrivateKey (D.Params 0 0 0) x))-  | _pkalgo pkp `elem` [ElgamalEncryptOnly, ForbiddenElgamal] = do-   MPI x <- get-   return $ ElGamalPrivateKey x-  | _pkalgo pkp == ECDSA = do-   let pubcurve =-         (\(ECDSAPubKey (ECDSA_PublicKey p)) -> ECDSA.public_curve p)-           (_pubkey pkp)-   getECDSAScalarPrivateKey pubcurve-  | _pkalgo pkp == ECDH-   = do-   pubcurve <- ecdhPrivateCurveFromPKPayload pkp-   getECDHScalarPrivateKey pubcurve-  | _pkalgo pkp == X25519 = do-   if _keyVersion pkp == V6-    then do-       sk <- getByteString 32-       return $ X25519PrivateKey sk-     else do-       pubcurve <- ecdhPrivateCurveFromPKPayload pkp-       getECDHScalarPrivateKey pubcurve-  | _pkalgo pkp == X448 = do-    if _keyVersion pkp == V6-      then do-        sk <- getByteString 56-        return $ X448PrivateKey sk-      else UnknownSKey <$> getRemainingLazyByteString-  | _pkalgo pkp == EdDSA = do-    if _keyVersion pkp == V6-      then do-        case _pubkey pkp of-          EdDSAPubKey P.Ed25519 _ -> EdDSAPrivateKey P.Ed25519 <$> getByteString 32-          EdDSAPubKey P.Ed448 _ -> EdDSAPrivateKey P.Ed448 <$> getByteString 57-          _ -> UnknownSKey <$> getRemainingLazyByteString-      else do-        MPI x <- get-        case _pubkey pkp of-          EdDSAPubKey P.Ed25519 _ ->-            return $ EdDSAPrivateKey P.Ed25519 (leftPadTo 32 (i2osp x))-          EdDSAPubKey P.Ed448 _ ->-            return $ EdDSAPrivateKey P.Ed448 (leftPadTo 57 (i2osp x))-          _ -> return $ UnknownSKey (BL.fromStrict (i2osp x))-  | otherwise = UnknownSKey <$> getRemainingLazyByteString--getECDSAScalarPrivateKey :: ECCT.Curve -> Get SKey-getECDSAScalarPrivateKey curve = do-  MPI pn <- get-  pure $ ECDSAPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey curve pn))--getECDHScalarPrivateKey :: ECCT.Curve -> Get SKey-getECDHScalarPrivateKey curve = do-  MPI pn <- get-  pure $ ECDHPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey curve pn))--ecdhPrivateCurveFromPKPayload :: SomePKPayload -> Get ECCT.Curve-ecdhPrivateCurveFromPKPayload pkp =-  case _pubkey pkp of-    ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey p)) _ _ ->-      pure (ECDSA.public_curve p)-    ECDHPubKey (EdDSAPubKey P.Ed25519 _) _ _ ->-      pure (curve2Curve Curve25519)-    ECDHPubKey (EdDSAPubKey P.Ed448 _) _ _ ->-      pure (curve2Curve Curve448)-    other ->-      fail-        ("ECDH/X25519 secret key requires an ECDH public key packet, got " ++-         show other)--putSKey :: SKey -> Either String Put-putSKey (RSAPrivateKey (RSA_PrivateKey (R.PrivateKey _ d p q _ _ _))) =-  case inverse q p of-    Just u ->-      Right (put (MPI d) >> put (MPI p) >> put (MPI q) >> put (MPI u))-    Nothing ->-      Left-        "putSKey: invalid RSA key — q has no multiplicative inverse mod p (key is mathematically broken)"-putSKey (DSAPrivateKey (DSA_PrivateKey (D.PrivateKey _ x))) =-  Right (put (MPI x))-putSKey (ElGamalPrivateKey x) =-  Right (put (MPI x))-putSKey (ECDHPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey _ d))) =-  Right (put (MPI d))-putSKey (ECDSAPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey _ d))) =-  Right (put (MPI d))-putSKey (EdDSAPrivateKey P.Ed25519 sk) = Right (putByteString sk)-putSKey (EdDSAPrivateKey P.Ed448 sk) = Right (putByteString sk)-putSKey (X25519PrivateKey sk) = Right (putByteString sk)-putSKey (X448PrivateKey sk) = Right (putByteString sk)-putSKey (UnknownSKey bs) = Right (putLazyByteString bs)--putSKeyForPKPayload :: SomePKPayload -> SKey -> Either String Put-putSKeyForPKPayload pkp sk@(EdDSAPrivateKey _ bs)-  | _keyVersion pkp == V6 = putSKey sk-  | otherwise = Right (put (MPI (os2ip bs)))-putSKeyForPKPayload _ sk = putSKey sk--putMPI :: MPI -> Put-putMPI (MPI i) = do-  let bs = i2osp i-  putWord16be . fromIntegral . numBits $ i-  putByteString bs--data PKPayloadReadCase where-  PKPayloadReadCaseV3 :: V3Expiration -> PubKeyAlgorithm -> PKPayloadReadCase-  PKPayloadReadCaseV4 :: PubKeyAlgorithm -> PKPayloadReadCase-  PKPayloadReadCaseV6 :: PubKeyAlgorithm -> PKPayloadReadCase--pkPayloadReadCase :: Word8 -> Get PKPayloadReadCase-pkPayloadReadCase version =-  case version of-    2 -> do-      v3e <- getWord16be-      pka <- get-      pure (PKPayloadReadCaseV3 v3e pka)-    3 -> do-      v3e <- getWord16be-      pka <- get-      pure (PKPayloadReadCaseV3 v3e pka)-    4 -> PKPayloadReadCaseV4 <$> get-    6 -> PKPayloadReadCaseV6 <$> get-    _ -> fail ("unsupported key packet version " ++ show version)--getPKPayload :: Get SomePKPayload-getPKPayload = do-  version <- getWord8-  ctime <- fmap ThirtyTwoBitTimeStamp getWord32be-  readCase <- pkPayloadReadCase version-  case readCase of-    PKPayloadReadCaseV3 v3e pka -> do-      pk <- getPubkey pka-      pure $! PKPayload DeprecatedV3 ctime v3e pka pk-    PKPayloadReadCaseV4 pka -> do-      pk <- getPubkey pka-      pure $! PKPayload V4 ctime 0 pka pk-    PKPayloadReadCaseV6 pka -> do-      pk <- getPubkeyV6 pka-      pure $! PKPayload V6 ctime 0 pka pk--data PKPayloadWriteCase where-  PKPayloadWriteCaseV3 :: PKPayload 'DeprecatedV3 -> PKPayloadWriteCase-  PKPayloadWriteCaseV4 :: PKPayload 'V4 -> PKPayloadWriteCase-  PKPayloadWriteCaseV6 :: PKPayload 'V6 -> PKPayloadWriteCase--pkPayloadWriteCase :: SomePKPayload -> PKPayloadWriteCase-pkPayloadWriteCase (SomePKPayload pkp) =-  case pkp of-    PKPayloadV3 {} -> PKPayloadWriteCaseV3 pkp-    PKPayloadV4 {} -> PKPayloadWriteCaseV4 pkp-    PKPayloadV6 {} -> PKPayloadWriteCaseV6 pkp--putPKPayload :: SomePKPayload -> Put-putPKPayload pkpSome =-  case pkPayloadWriteCase pkpSome of-    PKPayloadWriteCaseV3 (PKPayloadV3 ctime v3e pka pk) -> do-      putWord8 3-      putWord32be . unThirtyTwoBitTimeStamp $ ctime-      putWord16be v3e-      put pka-      putPubkey pk-    PKPayloadWriteCaseV4 (PKPayloadV4 ctime pka pk) -> do-      putWord8 4-      putWord32be . unThirtyTwoBitTimeStamp $ ctime-      put pka-      putPubkeyV4ForAlgorithm pka pk-    PKPayloadWriteCaseV6 (PKPayloadV6 ctime pka pk) -> do-      putWord8 6-      putWord32be . unThirtyTwoBitTimeStamp $ ctime-      put pka-      putPubkeyV6 pk--putPubkeyV4ForAlgorithm :: PubKeyAlgorithm -> PKey -> Put-putPubkeyV4ForAlgorithm pka pk-  | pka == BTypes.Ed25519 = putPubkeyV4Fixed 32 P.Ed25519 pk-  | pka == BTypes.Ed448 = putPubkeyV4Fixed 57 P.Ed448 pk-  | pka == BTypes.X25519 = putPubkeyV4Fixed 32 P.Ed25519 pk-  | pka == BTypes.X448 = putPubkeyV4Fixed 56 P.Ed448 pk-  | otherwise = putPubkey pk--putPubkeyV4Fixed :: Int -> P.EdSigningCurve -> PKey -> Put-putPubkeyV4Fixed targetLen expectedCurve (EdDSAPubKey curve (NativeEPoint (EPoint x)))-  | curve == expectedCurve = putByteString (fixedLengthOctets targetLen x)-putPubkeyV4Fixed _ _ pk = putPubkey pk--getSKAddendum :: SomePKPayload -> Get SKAddendum-getSKAddendum (SomePKPayload pkp) =-  toSKAddendum <$> getSKAddendumTyped pkp--getSKAddendumTyped :: PKPayload v -> Get (SKAddendumV v)-getSKAddendumTyped pkp = do-  s2kusage <- getWord8-  let pkpSome = SomePKPayload pkp-      getLegacyS2KProtected constructor = do-        symencWord <- getWord8-        s2k <- getS2K-        let symenc = toFVal symencWord-        case s2k of-          OtherS2K _ _ -> return $ constructor symenc s2k mempty BL.empty-          _ -> do-            blockSize <- either fail pure (symEncBlockSize symenc)-            iv <- IV <$> getByteString blockSize-            encryptedblock <- getRemainingLazyByteString-            return $ constructor symenc s2k iv encryptedblock-  case s2kusage of-    0 ->-      case pkp of-        PKPayloadV6 {} -> do-          sk <- getSecretKey pkpSome-          return (SKAUnencryptedV6 sk)-        PKPayloadV3 {} -> do-          rest <- lookAhead getRemainingLazyByteString-          secretLen <--            case runGetOrFail-                   (do-                      start <- bytesRead-                      _ <- getSecretKey pkpSome-                      end <- bytesRead-                      pure (end - start))-                   rest of-              Left (_, _, err) -> fail err-              Right (_, _, len) -> pure len-          sk <- getSecretKey pkpSome-          checksum <- getWord16be-          let expectedChecksum =-                checksum16Bytes (BL.toStrict (BL.take secretLen rest))-          when (checksum /= expectedChecksum) $-            fail-              ("legacy unencrypted secret-key checksum mismatch: expected " ++-               show expectedChecksum ++ ", got " ++ show checksum)-          return (SKAUnencryptedLegacy sk checksum)-        PKPayloadV4 {} -> do-          rest <- lookAhead getRemainingLazyByteString-          secretLen <--            case runGetOrFail-                   (do-                      start <- bytesRead-                      _ <- getSecretKey pkpSome-                      end <- bytesRead-                      pure (end - start))-                   rest of-              Left (_, _, err) -> fail err-              Right (_, _, len) -> pure len-          sk <- getSecretKey pkpSome-          checksum <- getWord16be-          let expectedChecksum =-                checksum16Bytes (BL.toStrict (BL.take secretLen rest))-          when (checksum /= expectedChecksum) $-            fail-              ("legacy unencrypted secret-key checksum mismatch: expected " ++-               show expectedChecksum ++ ", got " ++ show checksum)-          return (SKAUnencryptedLegacy sk checksum)-    255 ->-      case pkp of-        PKPayloadV6 {} ->-          fail "v6 secret key packets MUST NOT use s2k usage 255"-        PKPayloadV3 {} ->-          getLegacyS2KProtected SKA16bit-        PKPayloadV4 {} ->-          getLegacyS2KProtected SKA16bit-    254 ->-      case pkp of-        PKPayloadV6 {} -> do-          paramsLen <- getWord8-          params <- getLazyByteString (fromIntegral paramsLen)-          (symenc, s2k, iv) <--            case runGetOrFail getV6CFBParams params of-              Left (_, _, err) -> fail err-              Right (rest, _, parsed)-                | not (BL.null rest) -> fail "unexpected trailing v6 CFB parameters"-                | otherwise -> pure parsed-          encryptedblock <- getRemainingLazyByteString-          return (SKASHA1V6 symenc s2k (IV iv) encryptedblock)-        PKPayloadV3 {} ->-          getLegacyS2KProtected SKASHA1Legacy-        PKPayloadV4 {} ->-          getLegacyS2KProtected SKASHA1Legacy-      where-        getV6CFBParams = do-          symencWord <- getWord8-          s2kLen <- getWord8-          s2kBytes <- getLazyByteString (fromIntegral s2kLen)-          s2k <--            case runGetOrFail getS2K s2kBytes of-              Left (_, _, err) -> fail err-              Right (rest, _, parsed)-                | not (BL.null rest) -> fail "unexpected trailing bytes in v6 S2K specifier"-                | otherwise -> pure parsed-          iv <- getRemainingLazyByteString-          let symenc = toFVal symencWord-          blockSize <- either fail pure (symEncBlockSize symenc)-          when (BL.length iv /= fromIntegral blockSize) $-            fail "invalid v6 CFB IV length"-          pure (symenc, s2k, BL.toStrict iv)-    253 ->-      case pkp of-        PKPayloadV6 {} -> do-          paramsLen <- getWord8-          params <- getLazyByteString (fromIntegral paramsLen)-          (symenc, aead, s2k, iv) <--            case runGetOrFail getV6AEADParams params of-              Left (_, _, err) -> fail err-              Right (rest, _, parsed)-                | not (BL.null rest) -> fail "unexpected trailing v6 AEAD parameters"-                | otherwise -> pure parsed-          encryptedblock <- getRemainingLazyByteString-          return (SKAAEADV6 symenc aead s2k (IV iv) encryptedblock)-        PKPayloadV3 {} -> do-          (symenc, aead, s2k, iv) <- getLegacyAEADParams-          encryptedblock <- getRemainingLazyByteString-          return (SKAAEADLegacy symenc aead s2k (IV iv) encryptedblock)-        PKPayloadV4 {} -> do-          (symenc, aead, s2k, iv) <- getLegacyAEADParams-          encryptedblock <- getRemainingLazyByteString-          return (SKAAEADLegacy symenc aead s2k (IV iv) encryptedblock)-      where-        getV6AEADParams :: Get (SymmetricAlgorithm, AEADAlgorithm, S2K, B.ByteString)-        getV6AEADParams = do-          symencWord <- getWord8-          aeadWord <- getWord8-          s2kLen <- getWord8-          s2kBytes <- getLazyByteString (fromIntegral s2kLen)-          s2k <--            case runGetOrFail getS2K s2kBytes of-              Left (_, _, err) -> fail err-              Right (rest, _, parsed)-                | not (BL.null rest) -> fail "unexpected trailing bytes in v6 S2K specifier"-                | otherwise -> pure parsed-          iv <- getRemainingLazyByteString-          let symenc = toFVal symencWord-              aead = toFVal aeadWord-          when (BL.length iv /= fromIntegral (aeadNonceSize aead)) $-            fail "invalid v6 AEAD IV length"-          pure (symenc, aead, s2k, BL.toStrict iv)-        -- v3/v4: no cumulative-params-length octet, no S2K-size octet-        getLegacyAEADParams :: Get (SymmetricAlgorithm, AEADAlgorithm, S2K, B.ByteString)-        getLegacyAEADParams = do-          symencWord <- getWord8-          aeadWord <- getWord8-          s2k <- getS2K-          let aead = toFVal aeadWord-          iv <- BL.toStrict <$> getLazyByteString (fromIntegral (aeadNonceSize aead))-          pure (toFVal symencWord, aead, s2k, iv)-    symenc ->-      case pkp of-        PKPayloadV6 {} -> do-          paramsLen <- getWord8-          iv <- getByteString (fromIntegral paramsLen)-          let symencAlg = toFVal symenc-          blockSize <- either fail pure (symEncBlockSize symencAlg)-          when (B.length iv /= blockSize) $-            fail "invalid v6 CFB IV length"-          encryptedblock <- getRemainingLazyByteString-          return (SKASymV6 symencAlg (IV iv) encryptedblock)-        PKPayloadV3 {} -> do-          blockSize <- either fail pure (symEncBlockSize (toFVal symenc))-          iv <- getByteString blockSize-          encryptedblock <- getRemainingLazyByteString-          return (SKASymLegacy (toFVal symenc) (IV iv) encryptedblock)-        PKPayloadV4 {} -> do-          blockSize <- either fail pure (symEncBlockSize (toFVal symenc))-          iv <- getByteString blockSize-          encryptedblock <- getRemainingLazyByteString-          return (SKASymLegacy (toFVal symenc) (IV iv) encryptedblock)--putSKAddendum :: SKAddendum -> Either String Put-putSKAddendum (SUS16bit symenc s2k iv encryptedblock) = -  Right $ do-    putWord8 255-    put symenc-    put s2k-    putByteString (unIV iv)-    putLazyByteString encryptedblock-putSKAddendum (SUSSHA1 symenc s2k iv encryptedblock) = -  Right $ do-    putWord8 254-    put symenc-    put s2k-    putByteString (unIV iv)-    putLazyByteString encryptedblock-putSKAddendum (SUSAEAD symenc aead s2k iv encryptedblock) = -  Right $ do-    putWord8 253-    put symenc-    putWord8 (fromFVal aead)-    put s2k-    putByteString (unIV iv)-    putLazyByteString encryptedblock-putSKAddendum (SUSym symenc iv encryptedblock) = -  Right $ do-    put symenc-    putByteString (unIV iv)-    putLazyByteString encryptedblock-putSKAddendum (SUUnencrypted sk checksum) = -  do-    putSecret <- putSKey sk-    Right $ do-      putWord8 0-      let skb = runPut putSecret-      putLazyByteString skb-      putWord16be-        (if checksum == 0-           then checksum16Bytes (BL.toStrict skb)-           else checksum)--checksum16Bytes :: B.ByteString -> Word16-checksum16Bytes =-  B.foldl'-    (\a b -> fromIntegral ((fromIntegral a + fromIntegral b) `mod` (65536 :: Integer)))-    0--putSKAddendumForPKPayload :: SomePKPayload -> SKAddendum -> Put-putSKAddendumForPKPayload pkp ska =-  case fromSKAddendumForPKPayload pkp ska of-    Left e -> error e-    Right (SomeSKAddendumV skaV) ->-      putSKAddendumForPKPayloadTyped pkp skaV--putSKAddendumForPKPayloadTyped ::-     SomePKPayload-  -> SKAddendumV v-  -> Put-putSKAddendumForPKPayloadTyped pkp (SKAUnencryptedLegacy sk checksum) = do-  putWord8 0-  let putSecret =-        case putSKeyForPKPayload pkp sk of-          Left err -> error err-          Right p -> p-      skb = runPut putSecret-  putLazyByteString skb-  putWord16be-    (if checksum == 0-       then BL.foldl (\a b -> mod (a + fromIntegral b) 0xffff) (0 :: Word16) skb-       else checksum)-putSKAddendumForPKPayloadTyped pkp (SKAUnencryptedV6 sk) = do-  putWord8 0-  let putSecret =-        case putSKeyForPKPayload pkp sk of-          Left err -> error err-          Right p -> p-      skb = runPut putSecret-  putLazyByteString skb-putSKAddendumForPKPayloadTyped _ (SKASHA1V6 symenc s2k iv encryptedblock) = do-  let s2kbs = runPut (put s2k)-      paramsLen = 1 + 1 + BL.length s2kbs + fromIntegral (B.length (unIV iv))-  putWord8 254-  putWord8 (fromIntegral paramsLen)-  put symenc-  putWord8 (fromIntegral (BL.length s2kbs))-  putLazyByteString s2kbs-  putByteString (unIV iv)-  putLazyByteString encryptedblock-putSKAddendumForPKPayloadTyped _ (SKAAEADV6 symenc aead s2k iv encryptedblock) = do-  let s2kbs = runPut (put s2k)-      paramsLen = 1 + 1 + 1 + BL.length s2kbs + fromIntegral (B.length (unIV iv))-  putWord8 253-  putWord8 (fromIntegral paramsLen)-  put symenc-  putWord8 (fromFVal aead)-  putWord8 (fromIntegral (BL.length s2kbs))-  putLazyByteString s2kbs-  putByteString (unIV iv)-  putLazyByteString encryptedblock-putSKAddendumForPKPayloadTyped _ (SKAAEADLegacy symenc aead s2k iv encryptedblock) = do-  putWord8 253-  put symenc-  putWord8 (fromFVal aead)-  put s2k-  putByteString (unIV iv)-  putLazyByteString encryptedblock-putSKAddendumForPKPayloadTyped _ (SKASymV6 symenc iv encryptedblock) = do-  putWord8 (fromFVal symenc)-  putWord8 (fromIntegral (B.length (unIV iv)))-  putByteString (unIV iv)-  putLazyByteString encryptedblock-putSKAddendumForPKPayloadTyped _ skaV =-  case putSKAddendum (toSKAddendum skaV) of-    Left e -> error e-    Right p -> p--aeadNonceSize :: AEADAlgorithm -> Int-aeadNonceSize EAX = 16-aeadNonceSize OCB = 15-aeadNonceSize GCM = 12-aeadNonceSize (OtherAEADAlgo _) = 0--symEncBlockSize :: SymmetricAlgorithm -> Either String Int-symEncBlockSize Plaintext = Right 0-symEncBlockSize IDEA = Right 8-symEncBlockSize TripleDES = Right 8-symEncBlockSize CAST5 = Right 8-symEncBlockSize Blowfish = Right 8-symEncBlockSize AES128 = Right 16-symEncBlockSize AES192 = Right 16-symEncBlockSize AES256 = Right 16-symEncBlockSize Twofish = Right 16-symEncBlockSize Camellia128 = Right 16-symEncBlockSize Camellia192 = Right 16-symEncBlockSize Camellia256 = Right 16-symEncBlockSize sa =-  Left ("unsupported symmetric algorithm for secret-key IV sizing: " ++ show sa)--decodeIterationCount :: Word8 -> IterationCount-decodeIterationCount c =-  IterationCount-    ((16 + (fromIntegral c .&. 15)) `shiftL` ((fromIntegral c `shiftR` 4) + 6))--encodeIterationCount :: IterationCount -> Word8 -- should this really be a lookup table?-encodeIterationCount 1024 = 0-encodeIterationCount 1088 = 1-encodeIterationCount 1152 = 2-encodeIterationCount 1216 = 3-encodeIterationCount 1280 = 4-encodeIterationCount 1344 = 5-encodeIterationCount 1408 = 6-encodeIterationCount 1472 = 7-encodeIterationCount 1536 = 8-encodeIterationCount 1600 = 9-encodeIterationCount 1664 = 10-encodeIterationCount 1728 = 11-encodeIterationCount 1792 = 12-encodeIterationCount 1856 = 13-encodeIterationCount 1920 = 14-encodeIterationCount 1984 = 15-encodeIterationCount 2048 = 16-encodeIterationCount 2176 = 17-encodeIterationCount 2304 = 18-encodeIterationCount 2432 = 19-encodeIterationCount 2560 = 20-encodeIterationCount 2688 = 21-encodeIterationCount 2816 = 22-encodeIterationCount 2944 = 23-encodeIterationCount 3072 = 24-encodeIterationCount 3200 = 25-encodeIterationCount 3328 = 26-encodeIterationCount 3456 = 27-encodeIterationCount 3584 = 28-encodeIterationCount 3712 = 29-encodeIterationCount 3840 = 30-encodeIterationCount 3968 = 31-encodeIterationCount 4096 = 32-encodeIterationCount 4352 = 33-encodeIterationCount 4608 = 34-encodeIterationCount 4864 = 35-encodeIterationCount 5120 = 36-encodeIterationCount 5376 = 37-encodeIterationCount 5632 = 38-encodeIterationCount 5888 = 39-encodeIterationCount 6144 = 40-encodeIterationCount 6400 = 41-encodeIterationCount 6656 = 42-encodeIterationCount 6912 = 43-encodeIterationCount 7168 = 44-encodeIterationCount 7424 = 45-encodeIterationCount 7680 = 46-encodeIterationCount 7936 = 47-encodeIterationCount 8192 = 48-encodeIterationCount 8704 = 49-encodeIterationCount 9216 = 50-encodeIterationCount 9728 = 51-encodeIterationCount 10240 = 52-encodeIterationCount 10752 = 53-encodeIterationCount 11264 = 54-encodeIterationCount 11776 = 55-encodeIterationCount 12288 = 56-encodeIterationCount 12800 = 57-encodeIterationCount 13312 = 58-encodeIterationCount 13824 = 59-encodeIterationCount 14336 = 60-encodeIterationCount 14848 = 61-encodeIterationCount 15360 = 62-encodeIterationCount 15872 = 63-encodeIterationCount 16384 = 64-encodeIterationCount 17408 = 65-encodeIterationCount 18432 = 66-encodeIterationCount 19456 = 67-encodeIterationCount 20480 = 68-encodeIterationCount 21504 = 69-encodeIterationCount 22528 = 70-encodeIterationCount 23552 = 71-encodeIterationCount 24576 = 72-encodeIterationCount 25600 = 73-encodeIterationCount 26624 = 74-encodeIterationCount 27648 = 75-encodeIterationCount 28672 = 76-encodeIterationCount 29696 = 77-encodeIterationCount 30720 = 78-encodeIterationCount 31744 = 79-encodeIterationCount 32768 = 80-encodeIterationCount 34816 = 81-encodeIterationCount 36864 = 82-encodeIterationCount 38912 = 83-encodeIterationCount 40960 = 84-encodeIterationCount 43008 = 85-encodeIterationCount 45056 = 86-encodeIterationCount 47104 = 87-encodeIterationCount 49152 = 88-encodeIterationCount 51200 = 89-encodeIterationCount 53248 = 90-encodeIterationCount 55296 = 91-encodeIterationCount 57344 = 92-encodeIterationCount 59392 = 93-encodeIterationCount 61440 = 94-encodeIterationCount 63488 = 95-encodeIterationCount 65536 = 96-encodeIterationCount 69632 = 97-encodeIterationCount 73728 = 98-encodeIterationCount 77824 = 99-encodeIterationCount 81920 = 100-encodeIterationCount 86016 = 101-encodeIterationCount 90112 = 102-encodeIterationCount 94208 = 103-encodeIterationCount 98304 = 104-encodeIterationCount 102400 = 105-encodeIterationCount 106496 = 106-encodeIterationCount 110592 = 107-encodeIterationCount 114688 = 108-encodeIterationCount 118784 = 109-encodeIterationCount 122880 = 110-encodeIterationCount 126976 = 111-encodeIterationCount 131072 = 112-encodeIterationCount 139264 = 113-encodeIterationCount 147456 = 114-encodeIterationCount 155648 = 115-encodeIterationCount 163840 = 116-encodeIterationCount 172032 = 117-encodeIterationCount 180224 = 118-encodeIterationCount 188416 = 119-encodeIterationCount 196608 = 120-encodeIterationCount 204800 = 121-encodeIterationCount 212992 = 122-encodeIterationCount 221184 = 123-encodeIterationCount 229376 = 124-encodeIterationCount 237568 = 125-encodeIterationCount 245760 = 126-encodeIterationCount 253952 = 127-encodeIterationCount 262144 = 128-encodeIterationCount 278528 = 129-encodeIterationCount 294912 = 130-encodeIterationCount 311296 = 131-encodeIterationCount 327680 = 132-encodeIterationCount 344064 = 133-encodeIterationCount 360448 = 134-encodeIterationCount 376832 = 135-encodeIterationCount 393216 = 136-encodeIterationCount 409600 = 137-encodeIterationCount 425984 = 138-encodeIterationCount 442368 = 139-encodeIterationCount 458752 = 140-encodeIterationCount 475136 = 141-encodeIterationCount 491520 = 142-encodeIterationCount 507904 = 143-encodeIterationCount 524288 = 144-encodeIterationCount 557056 = 145-encodeIterationCount 589824 = 146-encodeIterationCount 622592 = 147-encodeIterationCount 655360 = 148-encodeIterationCount 688128 = 149-encodeIterationCount 720896 = 150-encodeIterationCount 753664 = 151-encodeIterationCount 786432 = 152-encodeIterationCount 819200 = 153-encodeIterationCount 851968 = 154-encodeIterationCount 884736 = 155-encodeIterationCount 917504 = 156-encodeIterationCount 950272 = 157-encodeIterationCount 983040 = 158-encodeIterationCount 1015808 = 159-encodeIterationCount 1048576 = 160-encodeIterationCount 1114112 = 161-encodeIterationCount 1179648 = 162-encodeIterationCount 1245184 = 163-encodeIterationCount 1310720 = 164-encodeIterationCount 1376256 = 165-encodeIterationCount 1441792 = 166-encodeIterationCount 1507328 = 167-encodeIterationCount 1572864 = 168-encodeIterationCount 1638400 = 169-encodeIterationCount 1703936 = 170-encodeIterationCount 1769472 = 171-encodeIterationCount 1835008 = 172-encodeIterationCount 1900544 = 173-encodeIterationCount 1966080 = 174-encodeIterationCount 2031616 = 175-encodeIterationCount 2097152 = 176-encodeIterationCount 2228224 = 177-encodeIterationCount 2359296 = 178-encodeIterationCount 2490368 = 179-encodeIterationCount 2621440 = 180-encodeIterationCount 2752512 = 181-encodeIterationCount 2883584 = 182-encodeIterationCount 3014656 = 183-encodeIterationCount 3145728 = 184-encodeIterationCount 3276800 = 185-encodeIterationCount 3407872 = 186-encodeIterationCount 3538944 = 187-encodeIterationCount 3670016 = 188-encodeIterationCount 3801088 = 189-encodeIterationCount 3932160 = 190-encodeIterationCount 4063232 = 191-encodeIterationCount 4194304 = 192-encodeIterationCount 4456448 = 193-encodeIterationCount 4718592 = 194-encodeIterationCount 4980736 = 195-encodeIterationCount 5242880 = 196-encodeIterationCount 5505024 = 197-encodeIterationCount 5767168 = 198-encodeIterationCount 6029312 = 199-encodeIterationCount 6291456 = 200-encodeIterationCount 6553600 = 201-encodeIterationCount 6815744 = 202-encodeIterationCount 7077888 = 203-encodeIterationCount 7340032 = 204-encodeIterationCount 7602176 = 205-encodeIterationCount 7864320 = 206-encodeIterationCount 8126464 = 207-encodeIterationCount 8388608 = 208-encodeIterationCount 8912896 = 209-encodeIterationCount 9437184 = 210-encodeIterationCount 9961472 = 211-encodeIterationCount 10485760 = 212-encodeIterationCount 11010048 = 213-encodeIterationCount 11534336 = 214-encodeIterationCount 12058624 = 215-encodeIterationCount 12582912 = 216-encodeIterationCount 13107200 = 217-encodeIterationCount 13631488 = 218-encodeIterationCount 14155776 = 219-encodeIterationCount 14680064 = 220-encodeIterationCount 15204352 = 221-encodeIterationCount 15728640 = 222-encodeIterationCount 16252928 = 223-encodeIterationCount 16777216 = 224-encodeIterationCount 17825792 = 225-encodeIterationCount 18874368 = 226-encodeIterationCount 19922944 = 227-encodeIterationCount 20971520 = 228-encodeIterationCount 22020096 = 229-encodeIterationCount 23068672 = 230-encodeIterationCount 24117248 = 231-encodeIterationCount 25165824 = 232-encodeIterationCount 26214400 = 233-encodeIterationCount 27262976 = 234-encodeIterationCount 28311552 = 235-encodeIterationCount 29360128 = 236-encodeIterationCount 30408704 = 237-encodeIterationCount 31457280 = 238-encodeIterationCount 32505856 = 239-encodeIterationCount 33554432 = 240-encodeIterationCount 35651584 = 241-encodeIterationCount 37748736 = 242-encodeIterationCount 39845888 = 243-encodeIterationCount 41943040 = 244-encodeIterationCount 44040192 = 245-encodeIterationCount 46137344 = 246-encodeIterationCount 48234496 = 247-encodeIterationCount 50331648 = 248-encodeIterationCount 52428800 = 249-encodeIterationCount 54525952 = 250-encodeIterationCount 56623104 = 251-encodeIterationCount 58720256 = 252-encodeIterationCount 60817408 = 253-encodeIterationCount 62914560 = 254-encodeIterationCount 65011712 = 255-encodeIterationCount n = error ("invalid iteration count" ++ show n)--getSignaturePayload :: Get SignaturePayload-getSignaturePayload = do-  pv <- getWord8-  case pv of-    3 -> do-      hashlen <- getWord8-      guard (hashlen == 5)-      st <- getWord8-      ctime <- fmap ThirtyTwoBitTimeStamp getWord32be-      eok <- getLazyByteString 8-      pka <- get-      ha <- get-      left16 <- getWord16be-      mpib <- getRemainingLazyByteString-      case runGetOrFail (some getMPI) mpib of-        Left (_, _, e) -> fail ("v3 sig MPIs " ++ e)-        Right (_, _, mpis) ->-          return $-          SigV3-            (toFVal st)-            ctime-            (EightOctetKeyId eok)-            (toFVal pka)-            (toFVal ha)-            left16-            (NE.fromList mpis)-    4 -> do-      st <- getWord8-      pkaOctet <- get-      ha <- get-      let pka = toFVal pkaOctet :: PubKeyAlgorithm-      hlen <- getWord16be-      hb <- getLazyByteString (fromIntegral hlen)-      let hashed =-            case runGetOrFail (many getSigSubPacket) hb of-              Left (_, _, err) -> fail ("v4 sig hasheds " ++ err)-              Right (_, _, h) -> h-      ulen <- getWord16be-      ub <- getLazyByteString (fromIntegral ulen)-      let unhashed =-            case runGetOrFail (many getSigSubPacket) ub of-              Left (_, _, err) -> fail ("v4 sig unhasheds " ++ err)-              Right (_, _, u) -> u-      left16 <- getWord16be-      mpib <- getRemainingLazyByteString-      let parseV4MPIs parseErrPrefix =-            case runGetOrFail (some getMPI) mpib of-              Left (_, _, e) -> fail (parseErrPrefix ++ e)-              Right (_, _, mpis) ->-                return $-                SigV4-                  (toFVal st)-                  pka-                  (toFVal ha)-                  hashed-                  unhashed-                  left16-                  (NE.fromList mpis)-      if pka == BTypes.Ed25519-        then-          if BL.length mpib == 64-            then do-              let sig = BL.toStrict mpib-                  (rbs, sbs) = B.splitAt 32 sig-              return $-                SigV4-                  (toFVal st)-                  pka-                  (toFVal ha)-                  hashed-                  unhashed-                  left16-                  (NE.fromList [MPI (os2ip rbs), MPI (os2ip sbs)])-            else parseV4MPIs "v4 Ed25519 legacy MPIs "-        else-          if pka == BTypes.Ed448-            then-              if BL.length mpib == 114-                then do-                  let sig = BL.toStrict mpib-                      (rbs, sbs) = B.splitAt 57 sig-                  return $-                    SigV4-                      (toFVal st)-                      pka-                      (toFVal ha)-                      hashed-                      unhashed-                      left16-                      (NE.fromList [MPI (os2ip rbs), MPI (os2ip sbs)])-                else parseV4MPIs "v4 Ed448 legacy MPIs "-            else parseV4MPIs "v4 sig MPIs "-    6 -> do-      st <- getWord8-      pka <- get-      ha <- get-      hlen <- getWord32be-      hb <- getLazyByteString (fromIntegral hlen)-      let hashed =-            case runGetOrFail (many getSigSubPacket) hb of-              Left (_, _, err) -> fail ("v6 sig hasheds " ++ err)-              Right (_, _, h) -> h-      ulen <- getWord32be-      ub <- getLazyByteString (fromIntegral ulen)-      let unhashed =-            case runGetOrFail (many getSigSubPacket) ub of-              Left (_, _, err) -> fail ("v6 sig unhasheds " ++ err)-              Right (_, _, u) -> u-      left16 <- getWord16be-      saltSize <- getWord8-      let haVal = (toFVal ha :: HashAlgorithm)-      expectedSaltSize <--        maybe-          (fail ("signature hash algorithm does not define a V6 salt size: " ++ show haVal))-          pure-          (v6SaltSizeForHashAlgorithm haVal)-      when (saltSize /= expectedSaltSize) $-        fail-          ("v6 signature salt size mismatch for " ++-           show haVal ++ ": expected " ++ show expectedSaltSize ++ ", got " ++ show saltSize)-      saltbs <- getByteString (fromIntegral saltSize)-      let salt = SignatureSalt (BL.fromStrict saltbs)-      if pka == BTypes.Ed25519-        then do-          sig <- getByteString 64-          let (rbs, sbs) = B.splitAt 32 sig-              mpis = [MPI (os2ip rbs), MPI (os2ip sbs)]-          return $-            SigV6-              (toFVal st)-              pka-              (toFVal ha)-              salt-              hashed-              unhashed-              left16-              (NE.fromList mpis)-        else-          if pka == BTypes.Ed448-            then do-              sig <- getByteString 114-              let (rbs, sbs) = B.splitAt 57 sig-                  mpis = [MPI (os2ip rbs), MPI (os2ip sbs)]-              return $-                SigV6-                  (toFVal st)-                  pka-                  (toFVal ha)-                  salt-                  hashed-                  unhashed-                  left16-                  (NE.fromList mpis)-            else do-              mpib <- getRemainingLazyByteString-              case runGetOrFail (some getMPI) mpib of-                Left (_, _, e) -> fail ("v6 sig MPIs " ++ e)-                Right (_, _, mpis) ->-                  return $-                  SigV6-                    (toFVal st)-                    pka-                    (toFVal ha)-                    salt-                    hashed-                    unhashed-                    left16-                    (NE.fromList mpis)-    _ -> do-      bs <- getRemainingLazyByteString-      return $ SigVOther pv bs--putSignaturePayload :: SignaturePayload -> Put-putSignaturePayload (SigV3 st ctime eok pka ha left16 mpis) = do-  putWord8 3-  putWord8 5 -- hashlen-  put st-  putWord32be . unThirtyTwoBitTimeStamp $ ctime-  putLazyByteString (unEOKI eok)-  put pka-  put ha-  putWord16be left16-  F.mapM_ put mpis-putSignaturePayload (SigV4 st pka ha hashed unhashed left16 mpis) = do-  putWord8 4-  put st-  put pka-  put ha-  let hb = runPut $ mapM_ put hashed-  putWord16be . fromIntegral . BL.length $ hb-  putLazyByteString hb-  let ub = runPut $ mapM_ put unhashed-  putWord16be . fromIntegral . BL.length $ ub-  putLazyByteString ub-  putWord16be left16-  if pka == BTypes.Ed25519-    then-      case NE.toList mpis of-        [MPI r, MPI s] -> do-          putByteString (padN 32 r)-          putByteString (padN 32 s)-        _ -> error "Ed25519 v4 signatures must have two MPIs"-    else-      if pka == BTypes.Ed448-        then-          case NE.toList mpis of-            [MPI r, MPI s] -> do-              putByteString (padN 57 r)-              putByteString (padN 57 s)-            _ -> error "Ed448 v4 signatures must have two MPIs"-        else F.mapM_ put mpis-  where-    padN n i =-      let bs = i2osp i-       in B.replicate (max 0 (n - B.length bs)) 0 <> bs-putSignaturePayload (SigV6 st pka ha salt hashed unhashed left16 mpis) = do-  let expectedSaltSize =-        maybe-          (error ("signature hash algorithm does not define a V6 salt size: " ++ show ha))-          id-          (v6SaltSizeForHashAlgorithm ha)-      actualSaltSize = fromIntegral (BL.length (unSignatureSalt salt))-  when (actualSaltSize /= expectedSaltSize) $-    error-      ("v6 signature salt size mismatch for " ++-       show ha ++ ": expected " ++ show expectedSaltSize ++ ", got " ++ show actualSaltSize)-  putWord8 6-  put st-  put pka-  put ha-  let hb = runPut $ mapM_ put hashed-  putWord32be . fromIntegral . BL.length $ hb-  putLazyByteString hb-  let ub = runPut $ mapM_ put unhashed-  putWord32be . fromIntegral . BL.length $ ub-  putLazyByteString ub-  putWord16be left16-  putWord8 . fromIntegral . BL.length . unSignatureSalt $ salt-  putByteString (BL.toStrict (unSignatureSalt salt))-  if pka == BTypes.Ed25519-    then-      case NE.toList mpis of-        [MPI r, MPI s] -> do-          putByteString (padN 32 r)-          putByteString (padN 32 s)-        _ -> error "Ed25519 v6 signatures must have two MPIs"-    else-      if pka == BTypes.Ed448-        then-          case NE.toList mpis of-            [MPI r, MPI s] -> do-              putByteString (padN 57 r)-              putByteString (padN 57 s)-            _ -> error "Ed448 v6 signatures must have two MPIs"-        else F.mapM_ put mpis-  where-    padN n i =-      let bs = i2osp i-       in B.replicate (max 0 (n - B.length bs)) 0 <> bs-putSignaturePayload (SigVOther pv bs) = do-  putWord8 pv-  putLazyByteString bs--putTK :: TKUnknown -> Put-putTK tk = do-  let pkp = tk ^. tkuKey . _1-  maybe-    (put (PublicKey pkp))-    (\ska -> put (SecretKey pkp ska))-    (snd (tk ^. tkuKey))-  mapM_ (put . Signature) (_tkuRevs tk)-  mapM_ putUid' (_tkuUIDs tk)-  mapM_ putUat' (_tkuUAts tk)-  mapM_ putSub' (_tkuSubs tk)-  where-    putUid' (u, sps) = put (UserId u) >> mapM_ (put . Signature) sps-    putUat' (us, sps) = put (UserAttribute us) >> mapM_ (put . Signature) sps-    putSub' (p, sps) = put p >> mapM_ (put . Signature) sps---- | Parse the packets from a ByteString, with no error reporting-parsePkts :: ByteString -> [Pkt]-parsePkts = reverse . fst . parsePktsAccum 0 []---- | Parse packets from a ByteString and report the first parse failure.-parsePktsEither :: ByteString -> Either PktParseError [Pkt]-parsePktsEither lbs =-  case parsePktsAccum 0 [] lbs of-    (pkts, Nothing) -> Right (reverse pkts)-    (_, Just err) -> Left err--data PktParseError =-  PktParseError-    { pktParseErrorOffset :: Int64-    , pktParseErrorMessage :: String-    }-  deriving (Eq, Show)--parsePktsAccum ::-     Int64 -> [Pkt] -> ByteString -> ([Pkt], Maybe PktParseError)-parsePktsAccum offset acc lbs-  | BL.null lbs = (acc, Nothing)-  | otherwise =-      case runGetOrFail getPkt lbs of-        Left (_, parseOffset, msg) -> (acc, err parseOffset msg)-        Right (rest, consumed, pkt) ->-          parsePktsAccum (offset + consumed) (pkt : acc) rest-  where-    err parseOffset msg =-      Just-        PktParseError-          { pktParseErrorOffset = offset + parseOffset-          , pktParseErrorMessage = msg-          }--armorPayloads :: [Armor] -> [ByteString]-armorPayloads =-  foldr collect []-  where-    collect (Armor _ _ payload) = (BL.fromStrict (BLC8.toStrict payload) :)-    collect (ClearSigned _ _ inner) = (armorPayloads [inner] ++)--looksLikeAsciiArmor :: ByteString -> Bool-looksLikeAsciiArmor =-  (armorHeaderLazy `BL.isPrefixOf`) . BL.dropWhile isLeadingArmorWhitespace--looksLikeAsciiArmorLenient :: ByteString -> Bool-looksLikeAsciiArmorLenient = looksLikeAsciiArmor . stripUtf8Bom--armorPayloadsOfType :: ArmorType -> [Armor] -> [ByteString]-armorPayloadsOfType atype =-  foldr collect []-  where-    collect (Armor innerType _ payload)-      | innerType == atype = (BL.fromStrict (BLC8.toStrict payload) :)-      | otherwise = id-    collect (ClearSigned _ _ inner) = (armorPayloadsOfType atype [inner] ++)--singleArmorPayloadOfType :: ArmorType -> [Armor] -> Either String ByteString-singleArmorPayloadOfType atype armors =-  case armorPayloadsOfType atype armors of-    [payload] -> Right payload-    [] -> Left ("ASCII armor decode returned no " ++ show atype ++ " blocks")-    payloads ->-      Left-        ("ASCII armor decode returned " ++-         show (length payloads) ++ " " ++ show atype ++ " blocks (expected exactly one)")--singleClearSignedBlock ::-     [Armor] -> Either String ([(String, String)], ByteString, ByteString)-singleClearSignedBlock armors =-  case [clearSignedBlockFromArmor armor | armor@ClearSigned {} <- armors] of-    [Right clearSigned] -> Right clearSigned-    [Left err] -> Left err-    [] -> Left "ASCII armor decode returned no clear-signed blocks"-    clearSigneds ->-      Left-        ("ASCII armor decode returned " ++-         show (length clearSigneds) ++ " clear-signed blocks (expected exactly one)")-  where-    clearSignedBlockFromArmor (ClearSigned hs cleartext inner) =-      case inner of-        Armor ArmorSignature _ sig ->-          Right-            ( hs-            , BL.fromStrict (BLC8.toStrict cleartext)-            , BL.fromStrict (BLC8.toStrict sig)-            )-        Armor atype _ _ ->-          Left-            ("clear-signed block contained inner armor type " ++-             show atype ++ " (expected ArmorSignature)")-        ClearSigned {} ->-          Left "clear-signed block contained nested clear-signed payload"-    clearSignedBlockFromArmor _ =-      Left "internal error: expected ClearSigned armor block"--recommendedArmorType :: [Pkt] -> Maybe ArmorType-recommendedArmorType [] = Nothing-recommendedArmorType (pkt:_)-  | isPrivateKeyPacket pkt = Just ArmorPrivateKeyBlock-  | isPublicKeyPacket pkt = Just ArmorPublicKeyBlock-  | isSignaturePacket pkt = Just ArmorSignature-  | otherwise = Just ArmorMessage-  where-    isPrivateKeyPacket SecretKeyPkt {} = True-    isPrivateKeyPacket SecretSubkeyPkt {} = True-    isPrivateKeyPacket _ = False--    isPublicKeyPacket PublicKeyPkt {} = True-    isPublicKeyPacket PublicSubkeyPkt {} = True-    isPublicKeyPacket _ = False--    isSignaturePacket SignaturePkt {} = True-    isSignaturePacket _ = False--dearmorIfAsciiArmored :: ByteString -> Either String (Bool, ByteString)-dearmorIfAsciiArmored bs-  | looksLikeAsciiArmor bs =-      (\payload -> (True, payload)) <$> decodeSingleArmorPayload bs-  | otherwise = Right (False, bs)--dearmorIfAsciiArmoredLenient :: ByteString -> Either String (Bool, ByteString)-dearmorIfAsciiArmoredLenient bs-  | looksLikeAsciiArmorLenient bs =-      (\payload -> (True, payload)) <$> decodeSingleArmorPayloadLenient (stripUtf8Bom bs)-  | otherwise = Right (False, bs)--decodeSingleArmorPayload :: ByteString -> Either String ByteString-decodeSingleArmorPayload bs =-  case AA.decodeLazy bs of-    Left err -> Left err-    Right armors -> singleArmorPayload armors--decodeSingleArmorPayloadLenient :: ByteString -> Either String ByteString-decodeSingleArmorPayloadLenient bs =-  case decodeSingleArmorPayload bs of-    Right payload -> Right payload-    Left strictErr ->-      let normalized = normalizeAsciiArmorForLenientDecode bs-       in if normalized == bs-            then Left strictErr-            else case decodeSingleArmorPayload normalized of-                   Left lenientErr ->-                     Left-                       (strictErr ++-                        " (lenient normalization retry failed: " ++ lenientErr ++ ")")-                   Right payload -> Right payload--singleArmorPayload :: [Armor] -> Either String ByteString-singleArmorPayload armors =-  case armorPayloads armors of-    [payload] -> Right payload-    [] -> Left "ASCII armor decode succeeded but returned no blocks"-    payloads ->-      Left-        ("ASCII armor decode returned " ++-         show (length payloads) ++ " blocks (expected exactly one)")--data WireRepInput =-  WireRepInput-    { wireRepInputRef :: WireRepRef-    , wireRepInputPayload :: ByteString-    }--wireRepRefFromInput :: Maybe T.Text -> ByteString -> Either String WireRepInput-wireRepRefFromInput mname bs =-  (\(wasArmored, payload) ->-      WireRepInput-        { wireRepInputRef = BTypes.mkWireRepRef mname wasArmored payload-        , wireRepInputPayload = payload-        }) <$>-  dearmorIfAsciiArmored bs--data ParseState =-  ParseState-    { psOffset :: Int64-    , psIndex :: Int-    , psSource :: WireRepRef-    , psRemaining :: BL.ByteString-    }---- | Parse packets from a source bytestream, preserving packet provenance.-parsePktsWithWireRep :: WireRepRef -> ByteString -> [PktWithWireRep]-parsePktsWithWireRep src input = go initialState-  where-    initialState =-      ParseState-        { psOffset = 0-        , psIndex = 0-        , psSource = src-        , psRemaining = input-        }-    go state-      | BL.null (psRemaining state) = []-      | otherwise =-          case runGetOrFail getPkt (psRemaining state) of-            Left (_, _, _) -> []-            Right (rest, consumed, pkt) ->-              let raw = BL.take consumed (psRemaining state)-                  newState =-                    state-                      { psOffset = psOffset state + consumed-                      , psIndex = psIndex state + 1-                      , psRemaining = rest-                      }-                  pktWithSource =-                    PktWithWireRep-                      (psSource state)-                      (ByteRange (psOffset state) consumed)-                      raw-                      (psIndex state)-                      pkt-               in pktWithSource : go newState--conduitParsePktsWithWireRep ::-     Monad m => Maybe T.Text -> ConduitT B.ByteString PktWithWireRep m ()-conduitParsePktsWithWireRep mname = go (UndecidedInput [])-  where-    go !state = do-      mchunk <- await-      case mchunk of-        Nothing -> mapM_ yield (finishConduitState mname state)-        Just chunk ->-          let !nextState = consumeConduitChunk chunk state-           in go nextState--data ConduitParseState-  = UndecidedInput ![B.ByteString]-  | ArmoredInput ![B.ByteString]-  | BinaryInput !BinaryParseState--data BinaryParseState =-  BinaryParseState-    { bpsLength :: !Int64-    , bpsOffset :: !Int64-    , bpsIndex :: !Int-    , bpsBuffer :: !B.ByteString-    , bpsParsedRev :: [ParsedPacketChunk]-    }--data ArmorPrefixDecision-  = PrefixNeedsMore-  | PrefixIsArmored-  | PrefixIsBinary--consumeConduitChunk :: B.ByteString -> ConduitParseState -> ConduitParseState-consumeConduitChunk chunk (UndecidedInput chunksRev) =-  let prefixChunksRev = chunk : chunksRev-      prefix = B.concat (reverse prefixChunksRev)-   in case classifyArmorPrefix prefix of-        PrefixNeedsMore -> UndecidedInput prefixChunksRev-        PrefixIsArmored -> ArmoredInput prefixChunksRev-        PrefixIsBinary -> feedBinaryChunk prefix initialBinaryParseState-consumeConduitChunk chunk (ArmoredInput chunksRev) = ArmoredInput (chunk : chunksRev)-consumeConduitChunk chunk (BinaryInput state) = BinaryInput (advanceBinaryParseState chunk state)--finishConduitState :: Maybe T.Text -> ConduitParseState -> [PktWithWireRep]-finishConduitState mname (UndecidedInput chunksRev) =-  finalizeBinaryParseState-    mname-    (advanceBinaryParseState (B.concat (reverse chunksRev)) initialBinaryParseState)-finishConduitState mname (ArmoredInput chunksRev) =-  let input = BL.fromChunks (reverse chunksRev)-   in case wireRepRefFromInput mname input of-        Left _ -> []-        Right WireRepInput-          { wireRepInputRef = src-          , wireRepInputPayload = payload-          } ->-          parsePktsWithWireRep src payload-finishConduitState mname (BinaryInput state) = finalizeBinaryParseState mname state--initialBinaryParseState :: BinaryParseState-initialBinaryParseState =-  BinaryParseState-    { bpsLength = 0-    , bpsOffset = 0-    , bpsIndex = 0-    , bpsBuffer = B.empty-    , bpsParsedRev = []-    }--feedBinaryChunk :: B.ByteString -> BinaryParseState -> ConduitParseState-feedBinaryChunk chunk = BinaryInput . advanceBinaryParseState chunk--advanceBinaryParseState :: B.ByteString -> BinaryParseState -> BinaryParseState-advanceBinaryParseState chunk state =-  let !nextLength = bpsLength state + fromIntegral (B.length chunk)-      !(nextOffset, nextIndex, nextBuffer, nextParsedRev) =-        drainParsedPackets-          (bpsOffset state)-          (bpsIndex state)-          (bpsBuffer state <> chunk)-          (bpsParsedRev state)-   in BinaryParseState-        { bpsLength = nextLength-        , bpsOffset = nextOffset-        , bpsIndex = nextIndex-        , bpsBuffer = nextBuffer-        , bpsParsedRev = nextParsedRev-        }--finalizeBinaryParseState :: Maybe T.Text -> BinaryParseState -> [PktWithWireRep]-finalizeBinaryParseState mname state =-  let src = BTypes.mkWireRepRefWithLength mname False (bpsLength state)-   in map (toPktWithWireRep src) (reverse (bpsParsedRev state))--classifyArmorPrefix :: B.ByteString -> ArmorPrefixDecision-classifyArmorPrefix prefix =-  case B.dropWhile isLeadingArmorWhitespace prefix of-    rest-      | B.null rest -> PrefixNeedsMore-      | armorHeader `B.isPrefixOf` rest -> PrefixIsArmored-      | rest `B.isPrefixOf` armorHeader -> PrefixNeedsMore-      | otherwise -> PrefixIsBinary--armorHeader :: B.ByteString-armorHeader = B.pack (map (fromIntegral . fromEnum) "-----BEGIN PGP ")--armorHeaderLazy :: ByteString-armorHeaderLazy = BL.fromStrict armorHeader--utf8Bom :: ByteString-utf8Bom = BL.pack [0xef, 0xbb, 0xbf]--isLeadingArmorWhitespace :: Word8 -> Bool-isLeadingArmorWhitespace w = w == 0x20 || w == 0x09 || w == 0x0d || w == 0x0a--stripUtf8Bom :: ByteString -> ByteString-stripUtf8Bom bs-  | utf8Bom `BL.isPrefixOf` bs = BL.drop (fromIntegral (BL.length utf8Bom)) bs-  | otherwise = bs--normalizeAsciiArmorForLenientDecode :: ByteString -> ByteString-normalizeAsciiArmorForLenientDecode =-  ensureTrailingLf . normalizeLineEndings-  where-    ensureTrailingLf lbs-      | BL.null lbs = lbs-      | BL.last lbs == 0x0a = lbs-      | otherwise = lbs <> BL.singleton 0x0a-    normalizeLineEndings lbs =-      case BL.uncons lbs of-        Nothing -> BL.empty-        Just (0x0d, rest) ->-          case BL.uncons rest of-            Just (0x0a, rest') -> BL.cons 0x0a (normalizeLineEndings rest')-            _ -> BL.cons 0x0a (normalizeLineEndings rest)-        Just (w, rest) -> BL.cons w (normalizeLineEndings rest)--data ParsedPacketChunk =-  ParsedPacketChunk-    { ppcRange :: ByteRange-    , ppcRaw :: ByteString-    , ppcIndex :: Int-    , ppcValue :: Pkt-    }--toPktWithWireRep :: WireRepRef -> ParsedPacketChunk -> PktWithWireRep-toPktWithWireRep src ppc =-  PktWithWireRep src (ppcRange ppc) (ppcRaw ppc) (ppcIndex ppc) (ppcValue ppc)--drainParsedPackets ::-     Int64-  -> Int-  -> B.ByteString-  -> [ParsedPacketChunk]-  -> (Int64, Int, B.ByteString, [ParsedPacketChunk])-drainParsedPackets !offset !idx !buffer acc-  | B.null buffer = (offset, idx, B.empty, acc)-  | otherwise =-     case runGetOrFail getPkt (BL.fromStrict buffer) of-        Left _ -> (offset, idx, buffer, acc)-        Right (rest, consumed, pkt) ->-         let !consumedLen = fromIntegral consumed-             !nextOffset = offset + consumed-             !nextIdx = idx + 1-             !nextBuffer = BL.toStrict rest-             parsedPacket =-               ParsedPacketChunk-                 { ppcRange = ByteRange offset consumed-                 , ppcRaw = BL.fromStrict (B.take consumedLen buffer)-                 , ppcIndex = idx-                 , ppcValue = pkt-                 }-          in drainParsedPackets-               nextOffset-               nextIdx-               nextBuffer-               (parsedPacket : acc)+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}++module Codec.Encryption.OpenPGP.Serialize+    ( -- * Serialization functions+      putPkt+    , putPktEither+    , putSKAddendum+    , getSecretKey+    , putSKeyForPKPayload++      -- * Utilities+    , dearmorIfAsciiArmored+    , dearmorIfAsciiArmoredLenient+    , looksLikeAsciiArmor+    , armorPayloadsOfType+    , singleArmorPayloadOfType+    , singleClearSignedBlock+    , recommendedArmorType+    , WireRepInput (..)+    , wireRepRefFromInput+    , PktParseError (..)+    , parsePkts+    , parsePktsEither+    , parsePktsWithWireRep+    , conduitParsePktsWithWireRep+    ) where++import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA+import Codec.Encryption.OpenPGP.ASCIIArmor.Types+    ( Armor (..)+    , ArmorType (..)+    )+import Control.Applicative (many, some)+import Control.Arrow ((***))+import Control.Lens ((^.), _1)+import Control.Monad (guard, replicateM, replicateM_, when)+import Crypto.Number.Basic (numBits)+import Crypto.Number.ModArithmetic (inverse)+import Crypto.Number.Serialize (i2osp, os2ip)+import qualified Crypto.PubKey.DSA as D+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.ECC.Types as ECCT+import qualified Crypto.PubKey.RSA as R+import Data.Bifunctor (bimap)+import Data.Binary (Binary, get, put)+import Data.Binary.Get+    ( ByteOffset+    , Get+    , bytesRead+    , getByteString+    , getLazyByteString+    , getRemainingLazyByteString+    , getWord16be+    , getWord16le+    , getWord32be+    , getWord8+    , lookAhead+    , runGetOrFail+    )+import Data.Binary.Put+    ( Put+    , putByteString+    , putLazyByteString+    , putWord16be+    , putWord16le+    , putWord32be+    , putWord8+    , runPut+    )+import Data.Bits (shiftL, shiftR, testBit, (.&.), (.|.))+import qualified Data.ByteString as B+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC8+import Data.Conduit (ConduitT, await, yield)+import qualified Data.Foldable as F+import Data.Int (Int64)+import Data.List (mapAccumL)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (fromMaybe)+import Data.Set (Set)+import qualified Data.Set as Set+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8With, encodeUtf8)+import Data.Text.Encoding.Error (lenientDecode)+import Data.Word (Word16, Word32, Word8)+import Network.URI (nullURI, parseURI, uriToString)++import Codec.Encryption.OpenPGP.Internal+    ( curve2Curve+    , curveFromCurve+    , curveToCurveoidBS+    , curveoidBSToCurve+    , curveoidBSToEdSigningCurve+    , edSigningCurveToCurveoidBS+    , leftPadTo+    , pubkeyToMPIs+    )+import Codec.Encryption.OpenPGP.Policy+    ( signatureV6SaltSizeForHashAlgorithm+    )+import Codec.Encryption.OpenPGP.Types+import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as BTypes+import qualified Codec.Encryption.OpenPGP.Types.Internal.PKITypes as P++instance Binary SigSubPacket where+    get = getSigSubPacket+    put = putSigSubPacket++-- instance Binary (Set NotationFlag) where+--     put = putNotationFlagSet+instance Binary CompressionAlgorithm where+    get = toFVal <$> getWord8+    put = putWord8 . fromFVal++instance Binary PubKeyAlgorithm where+    get = toFVal <$> getWord8+    put = putWord8 . fromFVal++instance Binary HashAlgorithm where+    get = toFVal <$> getWord8+    put = putWord8 . fromFVal++instance Binary SymmetricAlgorithm where+    get = toFVal <$> getWord8+    put = putWord8 . fromFVal++instance Binary AEADAlgorithm where+    get = toFVal <$> getWord8+    put = putWord8 . fromFVal++instance Binary MPI where+    get = getMPI+    put = putMPI++instance Binary SigType where+    get = toFVal <$> getWord8+    put = putWord8 . fromFVal++instance Binary UserAttrSubPacket where+    get = getUserAttrSubPacket+    put = putUserAttrSubPacket++instance Binary S2K where+    get = getS2K+    put = putS2K++instance Binary (PKESK 'PKESKV3) where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary (PKESK 'PKESKV6) where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary Signature where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary (SKESK 'SKESKV4) where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary (SKESK 'SKESKV6) where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary (OnePassSignature 'OPSV3) where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary (OnePassSignature 'OPSV6) where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary SecretKey where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary PublicKey where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary SecretSubkey where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary CompressedData where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary SymEncData where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary Marker where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary LiteralData where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary Trust where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary UserId where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary PublicSubkey where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary UserAttribute where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary SymEncIntegrityProtectedData where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary ModificationDetectionCode where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary OtherPacket where+    get = getPkt >>= either fail pure . fromPktEither+    put = putPkt . toPkt++instance Binary Pkt where+    get = getPkt+    put = putPkt++instance (Binary a) => Binary (Block a) where+    get = Block `fmap` many get+    put = mapM_ put . unBlock++instance Binary SomePKPayload where+    get = getPKPayload+    put = putPKPayload++instance Binary SignaturePayload where+    get = getSignaturePayload+    put = putSignaturePayload++instance Binary TKUnknown where+    get = fail "Binary TKUnknown decode is not implemented"+    put = putTK++getSigSubPacket :: Get SigSubPacket+getSigSubPacket = do+    l <- fmap fromIntegral getSubPacketLength+    (crit, pt) <- getSigSubPacketType+    getSigSubPacket' pt crit l+  where+    getSigSubPacket'+        :: Word8 -> Bool -> ByteOffset -> Get SigSubPacket+    getSigSubPacket' pt crit l+        | pt == 2 = do+            et <- fmap ThirtyTwoBitTimeStamp getWord32be+            return $ SigSubPacket crit (SigCreationTime et)+        | pt == 3 = do+            et <- fmap ThirtyTwoBitDuration getWord32be+            return $ SigSubPacket crit (SigExpirationTime et)+        | pt == 4 = do+            e <- get+            return $ SigSubPacket crit (ExportableCertification e)+        | pt == 5 = do+            tl <- getWord8+            ta <- getWord8+            return $ SigSubPacket crit (TrustSignature tl ta)+        | pt == 6 = do+            apdre <- getLazyByteString (l - 2)+            nul <- getWord8+            guard (nul == 0)+            return $ SigSubPacket crit (RegularExpression (BL.copy apdre))+        | pt == 7 = do+            r <- get+            return $ SigSubPacket crit (Revocable r)+        | pt == 9 = do+            et <- fmap ThirtyTwoBitDuration getWord32be+            return $ SigSubPacket crit (KeyExpirationTime et)+        | pt == 11 = do+            sa <- replicateM (fromIntegral (l - 1)) get+            return $ SigSubPacket crit (PreferredSymmetricAlgorithms sa)+        | pt == 12 = do+            rclass <- getWord8+            guard (testBit rclass 7)+            algid <- get+            fp <- getLazyByteString (fromIntegral l - 3)+            return $+                SigSubPacket+                    crit+                    ( RevocationKey+                        (bsToFFSet . BL.singleton $ rclass .&. 0x7f)+                        algid+                        (Fingerprint fp)+                    )+        | pt == 16 = do+            keyid <- getLazyByteString (l - 1)+            return $ SigSubPacket crit (Issuer (EightOctetKeyId keyid))+        | pt == 20 = do+            flags <- getLazyByteString 4+            nl <- getWord16be+            vl <- getWord16be+            nn <- getLazyByteString (fromIntegral nl)+            nv <- getLazyByteString (fromIntegral vl)+            return $+                SigSubPacket+                    crit+                    ( NotationData+                        (bsToFFSet flags)+                        (NotationName nn)+                        (NotationValue nv)+                    )+        | pt == 21 = do+            ha <- replicateM (fromIntegral (l - 1)) get+            return $ SigSubPacket crit (PreferredHashAlgorithms ha)+        | pt == 22 = do+            ca <- replicateM (fromIntegral (l - 1)) get+            return $ SigSubPacket crit (PreferredCompressionAlgorithms ca)+        | pt == 23 = do+            ksps <- getLazyByteString (l - 1)+            return $+                SigSubPacket crit (KeyServerPreferences (bsToFFSet ksps))+        | pt == 24 = do+            pks <- getLazyByteString (l - 1)+            return $ SigSubPacket crit (PreferredKeyServer pks)+        | pt == 25 = do+            primacy <- get+            return $ SigSubPacket crit (PrimaryUserId primacy)+        | pt == 26 = do+            url <-+                fmap+                    ( URL+                        . fromMaybe nullURI+                        . parseURI+                        . T.unpack+                        . decodeUtf8With lenientDecode+                    )+                    (getByteString (fromIntegral (l - 1)))+            return $ SigSubPacket crit (PolicyURL url)+        | pt == 27 = do+            kfs <- getLazyByteString (l - 1)+            return $ SigSubPacket crit (KeyFlags (bsToFFSet kfs))+        | pt == 28 = do+            uid <- getByteString (fromIntegral (l - 1))+            return $+                SigSubPacket+                    crit+                    (SignersUserId (decodeUtf8With lenientDecode uid))+        | pt == 29 = do+            rcode <- getWord8+            rreason <-+                fmap+                    (decodeUtf8With lenientDecode)+                    (getByteString (fromIntegral (l - 2)))+            return $+                SigSubPacket crit (ReasonForRevocation (toFVal rcode) rreason)+        | pt == 30 = do+            fbs <- getLazyByteString (l - 1)+            return $ SigSubPacket crit (Features (bsToFFSet fbs))+        | pt == 31 = do+            pka <- get+            ha <- get+            hash <- getLazyByteString (l - 3)+            return $ SigSubPacket crit (SignatureTarget pka ha hash)+        | pt == 32 = do+            spbs <- getLazyByteString (l - 1)+            case runGetOrFail get spbs of+                Left (_, _, e) -> fail ("embedded signature subpacket " ++ e)+                Right (_, _, sp) -> return $ SigSubPacket crit (EmbeddedSignature sp)+        | pt == 33 = do+            when (l /= 22 && l /= 34) $+                fail ("invalid issuer fingerprint subpacket length: " ++ show l)+            kv <- getWord8+            let fpLen = l - 2+            when (fpLen /= 20 && fpLen /= 32) $+                fail ("invalid issuer fingerprint length: " ++ show fpLen)+            case BTypes.packetVersionToIssuerFingerprintVersion kv of+                Nothing ->+                    fail ("invalid issuer fingerprint version marker: " ++ show kv)+                Just ifVersion -> do+                    fp <-+                        case kv of+                            4 -> getLazyByteString (fromIntegral fpLen)+                            6 -> getLazyByteString (fromIntegral fpLen)+                            _ ->+                                fail ("invalid issuer fingerprint version marker: " ++ show kv)+                    return $+                        SigSubPacket crit (IssuerFingerprint ifVersion (Fingerprint fp))+        | pt == 35 = do+            kv <- getWord8+            fp <- getLazyByteString (l - 2)+            when (BL.length fp /= 20 && BL.length fp /= 32) $+                fail+                    ( "invalid intended recipient fingerprint length: "+                        ++ show (BL.length fp)+                    )+            case BTypes.packetVersionToIssuerFingerprintVersion kv of+                Nothing ->+                    fail+                        ( "invalid intended recipient fingerprint version marker: "+                            ++ show kv+                        )+                Just ifVersion ->+                    return $+                        SigSubPacket crit (IntendedRecipient ifVersion (Fingerprint fp))+        | pt == 39 = do+            let payloadLen = fromIntegral (l - 1)+            when (payloadLen `mod` 2 /= 0) $+                fail "preferred AEAD ciphersuites subpacket length must be even"+            pairs <- replicateM (payloadLen `div` 2) $ do+                sa <- get+                aead <- get+                return (sa, aead)+            return $ SigSubPacket crit (PreferredAEADCiphersuites pairs)+        | pt > 99 && pt < 111 = do+            payload <- getLazyByteString (l - 1)+            return $ SigSubPacket crit (UserDefinedSigSub pt payload)+        | otherwise = do+            payload <- getLazyByteString (l - 1)+            return $ SigSubPacket crit (OtherSigSub pt payload)++putSigSubPacket :: SigSubPacket -> Put+putSigSubPacket (SigSubPacket crit (SigCreationTime et)) = do+    putSubPacketLength 5+    putSigSubPacketType crit 2+    putWord32be . unThirtyTwoBitTimeStamp $ et+putSigSubPacket (SigSubPacket crit (SigExpirationTime et)) = do+    putSubPacketLength 5+    putSigSubPacketType crit 3+    putWord32be . unThirtyTwoBitDuration $ et+putSigSubPacket (SigSubPacket crit (ExportableCertification e)) = do+    putSubPacketLength 2+    putSigSubPacketType crit 4+    put e+putSigSubPacket (SigSubPacket crit (TrustSignature tl ta)) = do+    putSubPacketLength 3+    putSigSubPacketType crit 5+    put tl+    put ta+putSigSubPacket (SigSubPacket crit (RegularExpression apdre)) = do+    putSubPacketLength . fromIntegral $ (2 + BL.length apdre)+    putSigSubPacketType crit 6+    putLazyByteString apdre+    putWord8 0+putSigSubPacket (SigSubPacket crit (Revocable r)) = do+    putSubPacketLength 2+    putSigSubPacketType crit 7+    put r+putSigSubPacket (SigSubPacket crit (KeyExpirationTime et)) = do+    putSubPacketLength 5+    putSigSubPacketType crit 9+    putWord32be . unThirtyTwoBitDuration $ et+putSigSubPacket (SigSubPacket crit (PreferredSymmetricAlgorithms ess)) = do+    putSubPacketLength . fromIntegral $ (1 + length ess)+    putSigSubPacketType crit 11+    mapM_ put ess+putSigSubPacket (SigSubPacket crit (RevocationKey rclass algid fp)) = do+    let fpLen = BL.length (unFingerprint fp)+    putSubPacketLength (fromIntegral (3 + fpLen)) -- type(1) + rclass(1) + algid(1) + fingerprint+    putSigSubPacketType crit 12+    putLazyByteString . ffSetToFixedLengthBS (1 :: Int) $+        Set.insert (RClOther 0) rclass+    put algid+    putLazyByteString (unFingerprint fp)+putSigSubPacket (SigSubPacket crit (Issuer keyid)) = do+    putSubPacketLength 9+    putSigSubPacketType crit 16+    putLazyByteString (unEOKI keyid) -- 8 octets+putSigSubPacket+    ( SigSubPacket+            crit+            (NotationData nfs (NotationName nn) (NotationValue nv))+        ) = do+        putSubPacketLength . fromIntegral $+            (9 + BL.length nn + BL.length nv)+        putSigSubPacketType crit 20+        putLazyByteString . ffSetToFixedLengthBS (4 :: Int) $ nfs+        putWord16be . fromIntegral . BL.length $ nn+        putWord16be . fromIntegral . BL.length $ nv+        putLazyByteString nn+        putLazyByteString nv+putSigSubPacket (SigSubPacket crit (PreferredHashAlgorithms ehs)) = do+    putSubPacketLength . fromIntegral $ (1 + length ehs)+    putSigSubPacketType crit 21+    mapM_ put ehs+putSigSubPacket (SigSubPacket crit (PreferredCompressionAlgorithms ecs)) = do+    putSubPacketLength . fromIntegral $ (1 + length ecs)+    putSigSubPacketType crit 22+    mapM_ put ecs+putSigSubPacket (SigSubPacket crit (KeyServerPreferences ksps)) = do+    let kbs = ffSetToBS ksps+    putSubPacketLength . fromIntegral $ (1 + BL.length kbs)+    putSigSubPacketType crit 23+    putLazyByteString kbs+putSigSubPacket (SigSubPacket crit (PreferredKeyServer ks)) = do+    putSubPacketLength . fromIntegral $ (1 + BL.length ks)+    putSigSubPacketType crit 24+    putLazyByteString ks+putSigSubPacket (SigSubPacket crit (PrimaryUserId primacy)) = do+    putSubPacketLength 2+    putSigSubPacketType crit 25+    put primacy+putSigSubPacket (SigSubPacket crit (PolicyURL (URL uri))) = do+    let bs = encodeUtf8 (T.pack (uriToString id uri ""))+    putSubPacketLength . fromIntegral $ (1 + B.length bs)+    putSigSubPacketType crit 26+    putByteString bs+putSigSubPacket (SigSubPacket crit (KeyFlags kfs)) = do+    let kbs = ffSetToBS kfs+    putSubPacketLength . fromIntegral $ (1 + BL.length kbs)+    putSigSubPacketType crit 27+    putLazyByteString kbs+putSigSubPacket (SigSubPacket crit (SignersUserId userid)) = do+    let bs = encodeUtf8 userid+    putSubPacketLength . fromIntegral $ (1 + B.length bs)+    putSigSubPacketType crit 28+    putByteString bs+putSigSubPacket (SigSubPacket crit (ReasonForRevocation rcode rreason)) = do+    let reasonbs = encodeUtf8 rreason+    putSubPacketLength . fromIntegral $ (2 + B.length reasonbs)+    putSigSubPacketType crit 29+    putWord8 . fromFVal $ rcode+    putByteString reasonbs+putSigSubPacket (SigSubPacket crit (Features fs)) = do+    let fbs = ffSetToBS fs+    putSubPacketLength . fromIntegral $ (1 + BL.length fbs)+    putSigSubPacketType crit 30+    putLazyByteString fbs+putSigSubPacket (SigSubPacket crit (SignatureTarget pka ha hash)) = do+    putSubPacketLength . fromIntegral $ (3 + BL.length hash)+    putSigSubPacketType crit 31+    put pka+    put ha+    putLazyByteString hash+putSigSubPacket (SigSubPacket crit (EmbeddedSignature sp)) = do+    let spb = runPut (put sp)+    putSubPacketLength . fromIntegral $ (1 + BL.length spb)+    putSigSubPacketType crit 32+    putLazyByteString spb+putSigSubPacket (SigSubPacket crit (IssuerFingerprint kv fp)) = do+    let kv' = BTypes.issuerFingerprintVersionToPacketVersion kv+    let fpb = unFingerprint fp+    when (BL.length fpb /= 20 && BL.length fpb /= 32) $+        error+            ("invalid issuer fingerprint length: " ++ show (BL.length fpb))+    putSubPacketLength . fromIntegral $ (2 + BL.length fpb)+    putSigSubPacketType crit 33+    putWord8 kv'+    putLazyByteString fpb+putSigSubPacket (SigSubPacket crit (IntendedRecipient kv irf)) = do+    let kv' = BTypes.issuerFingerprintVersionToPacketVersion kv+    let fpb = unFingerprint irf+    when (BL.length fpb /= 20 && BL.length fpb /= 32) $+        error+            ( "invalid intended-recipient fingerprint length: "+                ++ show (BL.length fpb)+            )+    putSubPacketLength . fromIntegral $ (2 + BL.length fpb)+    putSigSubPacketType crit 35+    putWord8 kv'+    putLazyByteString fpb+putSigSubPacket (SigSubPacket crit (PreferredAEADCiphersuites ps)) = do+    putSubPacketLength . fromIntegral $ (1 + 2 * length ps)+    putSigSubPacketType crit 39+    mapM_ (\(sa, aead) -> put sa >> put aead) ps+putSigSubPacket (SigSubPacket crit (UserDefinedSigSub ptype payload)) =+    putSigSubPacket (SigSubPacket crit (OtherSigSub ptype payload))+putSigSubPacket (SigSubPacket crit (OtherSigSub ptype payload)) = do+    putSubPacketLength . fromIntegral $ (1 + BL.length payload)+    putSigSubPacketType crit ptype+    putLazyByteString payload++getSubPacketLength :: Get Word32+getSubPacketLength = getSubPacketLength' =<< getWord8+  where+    getSubPacketLength' :: (Integral a) => Word8 -> Get a+    getSubPacketLength' f+        | f < 192 = return . fromIntegral $ f+        | f < 224 = do+            secondOctet <- getWord8+            return . fromIntegral $+                shiftL (fromIntegral (f - 192) :: Int) 8+                    + (fromIntegral secondOctet :: Int)+                    + 192+        | f == 255 = do+            len <- getWord32be+            return . fromIntegral $ len+        | otherwise = fail "Partial body length invalid."++putSubPacketLength :: Word32 -> Put+putSubPacketLength l+    | l < 192 = putWord8 (fromIntegral l)+    | l < 8384 =+        putWord8+            (fromIntegral ((fromIntegral (l - 192) `shiftR` 8) + 192 :: Int))+            >> putWord8 (fromIntegral (l - 192) .&. 0xff)+    | l <= 0xffffffff = putWord8 255 >> putWord32be (fromIntegral l)+    | otherwise = error ("too big (" ++ show l ++ ")")++getSigSubPacketType :: Get (Bool, Word8)+getSigSubPacketType = do+    x <- getWord8+    return+        ( if x .&. 128 == 128+            then (True, x .&. 127)+            else (False, x)+        )++putSigSubPacketType :: Bool -> Word8 -> Put+putSigSubPacketType False sst = putWord8 sst+putSigSubPacketType True sst = putWord8 (sst .|. 0x80)++bsToFFSet :: (FutureFlag a) => ByteString -> Set a+bsToFFSet bs =+    Set.fromAscList . concat . snd $+        mapAccumL+            (\acc y -> (acc + 8, concatMap (shifty acc y) [0 .. 7]))+            0+            (BL.unpack bs)+  where+    shifty acc y x = [toFFlag (acc + x) | y .&. shiftR 128 x == shiftR 128 x]++ffSetToFixedLengthBS+    :: (FutureFlag b, Integral a) => a -> Set b -> ByteString+ffSetToFixedLengthBS len ffs =+    BL.take+        (fromIntegral len)+        (BL.append (ffSetToBS ffs) (BL.pack (replicate 5 0)))++ffSetToBS :: (FutureFlag a) => Set a -> ByteString+ffSetToBS = BL.pack . ffSetToBS'+  where+    ffSetToBS' :: (FutureFlag a) => Set a -> [Word8]+    ffSetToBS' ks+        -- Emit a single zero octet for an empty flag set so encoded flag+        -- subpackets always carry an explicit flags byte.+        | Set.null ks = [0]+        | otherwise =+            map+                ( ( foldl (.|.) 0+                        . map (shiftR 128 . flip mod 8 . fromFFlag)+                        . Set.toAscList+                  )+                    . (\x -> Set.filter (\y -> fromFFlag y `div` 8 == x) ks)+                )+                [0 .. fromFFlag (Set.findMax ks) `div` 8]++fromS2K :: S2K -> ByteString+fromS2K (Simple hashalgo) = BL.pack [0, fromIntegral . fromFVal $ hashalgo]+fromS2K (Salted hashalgo salt) =+    BL.pack [1, fromIntegral . fromFVal $ hashalgo]+        `BL.append` (BL.fromStrict . unSalt8) salt+fromS2K (IteratedSalted hashalgo salt count) =+    BL.pack [3, fromIntegral . fromFVal $ hashalgo]+        `BL.append` (BL.fromStrict . unSalt8) salt+        `BL.snoc` encodeIterationCount count+fromS2K (Argon2 salt t p encodedM) =+    BL.pack [4]+        `BL.append` (BL.fromStrict . unSalt16) salt+        `BL.append` BL.pack [t, p, encodedM]+fromS2K (OtherS2K _ bs) = bs++getPacketLength :: Get Integer+getPacketLength = do+    firstOctet <- getWord8+    lenOrPartial <- lengthOctetToLength firstOctet+    case lenOrPartial of+        Left _ ->+            fail "Partial body length is invalid in this context"+        Right len -> return len+  where+    lengthOctetToLength :: Word8 -> Get (Either Integer Integer)+    lengthOctetToLength f+        | f < 192 = return . Right . fromIntegral $ f+        | f < 224 = do+            secondOctet <- getWord8+            return . Right . fromIntegral $+                shiftL (fromIntegral (f - 192) :: Int) 8+                    + (fromIntegral secondOctet :: Int)+                    + 192+        | f < 255 =+            return . Left . fromIntegral $+                (1 :: Integer) `shiftL` fromIntegral (f .&. 0x1f)+        | otherwise = do+            len <- getWord32be+            return . Right . fromIntegral $ len++putPacketLength :: Integer -> Put+putPacketLength l+    | l < 192 = putWord8 (fromIntegral l)+    | l < 8384 =+        putWord8+            (fromIntegral ((fromIntegral (l - 192) `shiftR` 8) + 192 :: Int))+            >> putWord8 (fromIntegral (l - 192) .&. 0xff)+    | l < 0x100000000 = putWord8 255 >> putWord32be (fromIntegral l)+    | otherwise =+        error "packet length exceeds 32-bit definite length encoding"++putPartialLength :: Word8 -> Put+putPartialLength n = putWord8 (224 + n)++getPacketLengthFromOctet :: Word8 -> Get (Either Int64 Int64)+getPacketLengthFromOctet f+    | f < 192 = return . Right . fromIntegral $ f+    | f < 224 = do+        secondOctet <- getWord8+        return . Right . fromIntegral $+            shiftL (fromIntegral (f - 192) :: Int) 8+                + (fromIntegral secondOctet :: Int)+                + 192+    | f < 255 =+        return . Left . fromIntegral $+            (1 :: Integer) `shiftL` fromIntegral (f .&. 0x1f)+    | otherwise = do+        len <- getWord32be+        return . Right . fromIntegral $ len++getS2K :: Get S2K+getS2K = getS2K' =<< getWord8+  where+    getS2K' :: Word8 -> Get S2K+    getS2K' t+        | t == 0 = do+            ha <- getWord8+            return $ Simple (toFVal ha)+        | t == 1 = do+            ha <- getWord8+            salt <- getByteString 8+            return $ Salted (toFVal ha) (Salt8 salt)+        | t == 3 = do+            ha <- getWord8+            salt <- getByteString 8+            count <- getWord8+            return $+                IteratedSalted+                    (toFVal ha)+                    (Salt8 salt)+                    (decodeIterationCount count)+        | t == 4 = do+            salt <- getByteString 16+            passes <- getWord8+            parallelism <- getWord8+            encodedM <- getWord8+            return $ Argon2 (Salt16 salt) passes parallelism encodedM+        | otherwise = do+            bs <- getRemainingLazyByteString+            return $ OtherS2K t bs++putS2K :: S2K -> Put+putS2K (Simple hashalgo) = error ("confused by simple" ++ show hashalgo)+putS2K (Salted hashalgo salt) =+    error+        ("confused by salted" ++ show hashalgo ++ " by " ++ show salt)+putS2K (IteratedSalted ha salt count) = do+    putWord8 3+    put ha+    putByteString (unSalt8 salt)+    putWord8 $ encodeIterationCount count+putS2K (Argon2 salt t p encodedM) = do+    putWord8 4+    putByteString (unSalt16 salt)+    putWord8 t+    putWord8 p+    putWord8 encodedM+putS2K (OtherS2K t bs) = putWord8 t >> putLazyByteString bs++v6SaltSizeForHashAlgorithm :: HashAlgorithm -> Maybe Word8+v6SaltSizeForHashAlgorithm = signatureV6SaltSizeForHashAlgorithm++getPacketTypeAndPayload :: Get (Word8, ByteString)+getPacketTypeAndPayload = do+    tag <- getWord8+    guard (testBit tag 7)+    case tag .&. 0x40 of+        0x00 -> do+            let t = shiftR (tag .&. 0x3c) 2+            case tag .&. 0x03 of+                0 -> do+                    len <- getWord8+                    bs <- getLazyByteString (fromIntegral len)+                    return (t, bs)+                1 -> do+                    len <- getWord16be+                    bs <- getLazyByteString (fromIntegral len)+                    return (t, bs)+                2 -> do+                    len <- getWord32be+                    bs <- getLazyByteString (fromIntegral len)+                    return (t, bs)+                3 -> do+                    bs <- getRemainingLazyByteString+                    return (t, bs)+                _ ->+                    error "This should never happen (getPacketTypeAndPayload/0x00)."+        0x40 -> do+            firstLenOctet <- getWord8+            bs <- getPacketPayloadFromLengthOctet firstLenOctet+            return (tag .&. 0x3f, bs)+        _ ->+            error "This should never happen (getPacketTypeAndPayload/???)."+  where+    getPacketPayloadFromLengthOctet :: Word8 -> Get ByteString+    getPacketPayloadFromLengthOctet lenOctet = do+        lenOrPartial <- getPacketLengthFromOctet lenOctet+        case lenOrPartial of+            Right len -> getLazyByteString len+            Left partialLen -> do+                chunk <- getLazyByteString partialLen+                rest <- getRemainingPartialPayload+                return (chunk <> rest)+    getRemainingPartialPayload :: Get ByteString+    getRemainingPartialPayload = do+        lenOctet <- getWord8+        lenOrPartial <- getPacketLengthFromOctet lenOctet+        case lenOrPartial of+            Right len -> getLazyByteString len+            Left partialLen -> do+                chunk <- getLazyByteString partialLen+                (chunk <>) <$> getRemainingPartialPayload++getPkt :: Get Pkt+getPkt = do+    (t, pl) <- getPacketTypeAndPayload+    case runGetOrFail (getPkt' t (BL.length pl)) pl of+        Left (_, _, e) -> return $! BrokenPacketPkt e t pl+        Right (_, _, p) -> return p+  where+    parseLegacyPKESK+        :: PacketVersion -> BL.ByteString -> Either String Pkt+    parseLegacyPKESK pv body = do+        (_, _, (eokeyid, pkaRaw, mpib)) <-+            bimap (\(_, _, e) -> e) id $+                runGetOrFail+                    ( do+                        eokeyid <- getLazyByteString 8+                        pka <- getWord8+                        mpib <- getRemainingLazyByteString+                        pure (eokeyid, pka, mpib)+                    )+                    body+        let pka = toFVal pkaRaw+        sk <- parseLegacyPKESKMPIs pka mpib+        pure $+            PKESKPkt+                ( PKESKPayloadV3Packet+                    (PKESKPayloadV3 pv (EightOctetKeyId eokeyid) pka sk)+                )++    parseLegacyPKESKMPIs+        :: PubKeyAlgorithm+        -> BL.ByteString+        -> Either String (NE.NonEmpty MPI)+    parseLegacyPKESKMPIs pka mpib = do+        case parseLegacyPKESKMPIsStrict pka mpib of+            Right sk -> pure sk+            Left strictErr+                | pka == X25519 ->+                    case parseLegacyPKESKX25519V3Octets mpib of+                        Right sk -> Right sk+                        Left octetErr ->+                            Left+                                ( strictErr+                                    ++ "; also failed to parse RFC9580 X25519 v3 octet layout: "+                                    ++ octetErr+                                )+                | pka == ECDH ->+                    case parseLegacyPKESKECDHOctets mpib of+                        Right sk -> Right sk+                        Left octetErr ->+                            Left+                                ( strictErr+                                    ++ "; also failed to parse RFC6637 ECDH v3 octet layout: "+                                    ++ octetErr+                                )+                | otherwise -> Left strictErr++    parseLegacyPKESKMPIsStrict+        :: PubKeyAlgorithm+        -> BL.ByteString+        -> Either String (NE.NonEmpty MPI)+    parseLegacyPKESKMPIsStrict pka mpib = do+        (rest, _, sk) <-+            bimap (\(_, _, e) -> e) id $+                runGetOrFail (parserForLegacyPKESKMPIs pka) mpib+        if BL.null rest+            then pure (NE.fromList sk)+            else+                Left+                    ("unexpected trailing PKESK MPI data for algorithm " ++ show pka)++    parseLegacyPKESKX25519V3Octets+        :: BL.ByteString -> Either String (NE.NonEmpty MPI)+    parseLegacyPKESKX25519V3Octets mpib = do+        if BL.length mpib < 33+            then Left "X25519 v3 PKESK octet layout is too short"+            else Right ()+        let ephemeral = BL.toStrict (BL.take 32 mpib)+            eskLen = fromIntegral (BL.index mpib 32) :: Int+            eskWithAlgo = BL.toStrict (BL.drop 33 mpib)+        if eskLen /= B.length eskWithAlgo+            then+                Left "X25519 v3 PKESK octet layout has inconsistent ESK length"+            else Right ()+        if B.null eskWithAlgo+            then+                Left+                    "X25519 v3 PKESK octet layout must include a symmetric algorithm octet"+            else Right ()+        let symAlgo = B.head eskWithAlgo+        if symAlgo+            `elem` [ fromIntegral (fromFVal AES128)+                   , fromIntegral (fromFVal AES192)+                   , fromIntegral (fromFVal AES256)+                   ]+            then+                pure+                    (NE.fromList [MPI (os2ip ephemeral), MPI (os2ip eskWithAlgo)])+            else+                Left+                    ( "X25519 v3 PKESK octet layout has unsupported symmetric algorithm octet "+                        ++ show symAlgo+                    )++    -- \| Parse an RFC 6637 §8 ECDH PKESKv3 body as MPI(ephemeral) || 1-octet-count || C.+    -- This is the interoperable wire format produced by GnuPG and other RFC-compliant+    -- implementations. hOpenPGP previously wrote both fields as MPIs; this fallback+    -- allows reading RFC-compliant packets when the strict two-MPI path fails.+    parseLegacyPKESKECDHOctets+        :: BL.ByteString -> Either String (NE.NonEmpty MPI)+    parseLegacyPKESKECDHOctets mpib = do+        (rest, _, ephMPI) <-+            bimap (\(_, _, e) -> e) id $ runGetOrFail getMPI mpib+        let restBS = BL.toStrict rest+        when (B.null restBS) $+            Left+                "ECDH v3 PKESK RFC6637 octet layout: missing wrapped-key length octet after ephemeral MPI"+        let wrappedLen = fromIntegral (B.head restBS) :: Int+            wrapped = B.tail restBS+        when (wrappedLen /= B.length wrapped) $+            Left+                ( "ECDH v3 PKESK RFC6637 octet layout: wrapped key length field "+                    ++ show wrappedLen+                    ++ " does not match body length "+                    ++ show (B.length wrapped)+                )+        when (wrappedLen < 24 || wrappedLen `mod` 8 /= 0) $+            Left+                ( "ECDH v3 PKESK RFC6637 octet layout: wrapped key length "+                    ++ show wrappedLen+                    ++ " is not a valid RFC 3394 wrapped key size"+                )+        pure (ephMPI NE.:| [MPI (os2ip wrapped)])++    parserForLegacyPKESKMPIs :: PubKeyAlgorithm -> Get [MPI]+    parserForLegacyPKESKMPIs pka =+        case expectedLegacyPKESKMPIArity pka of+            Just mpiCount -> replicateM mpiCount getMPI+            Nothing -> some getMPI++    expectedLegacyPKESKMPIArity :: PubKeyAlgorithm -> Maybe Int+    expectedLegacyPKESKMPIArity pka+        | pka `elem` [RSA, DeprecatedRSAEncryptOnly] = Just 1+        | pka `elem` [ElgamalEncryptOnly, ForbiddenElgamal, ECDH, X25519] =+            Just 2+        | otherwise = Nothing++    validateV4SKESKEncryptedSessionKeyS2K+        :: S2K -> Maybe BL.ByteString -> Get ()+    validateV4SKESKEncryptedSessionKeyS2K _ Nothing = pure ()+    validateV4SKESKEncryptedSessionKeyS2K Simple {} (Just _) =+        fail+            "v4 SKESK packets with encrypted session keys must not use Simple S2K"+    validateV4SKESKEncryptedSessionKeyS2K _ (Just _) = pure ()++    parseV6PKESK :: BL.ByteString -> Either String Pkt+    parseV6PKESK body = do+        (_, _, (recipientKeyIdentifier, pka, esk)) <-+            bimap (\(_, _, e) -> e) id $+                runGetOrFail+                    ( do+                        keyIdentifierLen <- getWord8+                        recipientKeyIdentifier <-+                            getLazyByteString (fromIntegral keyIdentifierLen)+                        pka <- getWord8+                        esk <- getRemainingLazyByteString+                        pure (recipientKeyIdentifier, pka, esk)+                    )+                    body+        validateV6PKESKRecipientIdentifier recipientKeyIdentifier+        pure $+            PKESKPkt+                ( PKESKPayloadV6Packet+                    (PKESKPayloadV6 recipientKeyIdentifier (toFVal pka) esk)+                )+      where+        validateV6PKESKRecipientIdentifier+            :: BL.ByteString -> Either String ()+        validateV6PKESKRecipientIdentifier rid =+            case BL.length rid of+                0 -> Right ()+                20 -> Right ()+                32 -> Right ()+                21 -> validateVersionedFingerprint rid+                33 -> validateVersionedFingerprint rid+                ridLen ->+                    Left+                        ( "invalid PKESK v6 recipient identifier length: "+                            ++ show ridLen+                            ++ " (expected 0, 20, 21, 32, or 33)"+                        )++        validateVersionedFingerprint :: BL.ByteString -> Either String ()+        validateVersionedFingerprint rid =+            let keyVersion = BL.head rid+                fingerprintLen = BL.length (BL.tail rid)+             in case keyVersion of+                    4 ->+                        if fingerprintLen == 20+                            then Right ()+                            else+                                Left+                                    ( "PKESK v6 recipient identifier length/version mismatch: key version 4 requires fingerprint length 20, got "+                                        ++ show fingerprintLen+                                    )+                    6 ->+                        if fingerprintLen == 32+                            then Right ()+                            else+                                Left+                                    ( "PKESK v6 recipient identifier length/version mismatch: key version 6 requires fingerprint length 32, got "+                                        ++ show fingerprintLen+                                    )+                    _ ->+                        Left+                            ( "invalid PKESK v6 recipient key version: "+                                ++ show keyVersion+                                ++ " (expected 4 or 6)"+                            )++    getPkt' :: Word8 -> ByteOffset -> Get Pkt+    getPkt' t len+        | t == 1 = do+            pv <- getWord8+            body <- getRemainingLazyByteString+            if pv == 6+                then case parseV6PKESK body of+                    Right pkt -> return pkt+                    Left v6Err -> fail ("PKESK v6 parse failed: " ++ v6Err)+                else case parseLegacyPKESK pv body of+                    Right pkt -> return pkt+                    Left legacyErr -> fail ("PKESK MPIs " ++ legacyErr)+        | t == 2 = do+            bs <- getRemainingLazyByteString+            case runGetOrFail get bs of+                Left (_, _, e) -> fail ("signature packet " ++ e)+                Right (_, _, sp) -> return $ SignaturePkt sp+        | t == 3 = do+            pv <- getWord8+            let getV6SKESKParams = do+                    symalgoWord <- getWord8+                    aeadWord <- getWord8+                    s2kLen <- getWord8+                    s2kBytes <- getLazyByteString (fromIntegral s2kLen)+                    s2k <-+                        case runGetOrFail getS2K s2kBytes of+                            Left (_, _, err) -> fail err+                            Right (rest, _, parsed)+                                | not (BL.null rest) ->+                                    fail "unexpected trailing bytes in v6 SKESK S2K specifier"+                                | otherwise -> pure parsed+                    let symalgo = toFVal symalgoWord+                        aead = toFVal aeadWord+                        ivLen = fromIntegral (aeadNonceSize aead)+                    iv <- getLazyByteString ivLen+                    pure (symalgo, aead, s2k, iv)+            case pv of+                6 -> do+                    paramsLen <- getWord8+                    params <- getLazyByteString (fromIntegral paramsLen)+                    (symalgo, aead, s2k, iv) <-+                        case runGetOrFail getV6SKESKParams params of+                            Left (_, _, err) -> fail err+                            Right (rest, _, parsed)+                                | not (BL.null rest) ->+                                    fail "unexpected trailing v6 SKESK parameters"+                                | otherwise -> pure parsed+                    payload <- getRemainingLazyByteString+                    when (BL.length payload < 16) $+                        fail+                            "v6 SKESK payload must include encrypted session key and authentication tag"+                    let (esk, tag) = BL.splitAt (BL.length payload - 16) payload+                    return $+                        SKESKPkt+                            ( SKESKPayloadV6Packet+                                ( SKESKPayloadV6+                                    symalgo+                                    aead+                                    s2k+                                    iv+                                    esk+                                    tag+                                )+                            )+                4 -> do+                    symalgo <- getWord8+                    s2k <- getS2K+                    esk <- getRemainingLazyByteString+                    let mesk = if BL.null esk then Nothing else Just esk+                    validateV4SKESKEncryptedSessionKeyS2K s2k mesk+                    return $+                        SKESKPkt+                            ( SKESKPayloadV4Packet+                                ( SKESKPayloadV4+                                    (toFVal symalgo)+                                    s2k+                                    mesk+                                )+                            )+                _ -> fail ("unsupported SKESK packet version " ++ show pv)+        | t == 4 = do+            pv <- getWord8+            sigtype <- toFVal <$> getWord8+            ha <- toFVal <$> getWord8+            pka <- toFVal <$> getWord8+            case pv of+                3 -> do+                    skeyid <- getLazyByteString 8+                    nested <- getWord8 >>= parseOPSNestedFlag+                    return $+                        OnePassSignaturePkt+                            ( OPSPayloadV3Packet+                                ( OPSPayloadV3+                                    pv+                                    sigtype+                                    ha+                                    pka+                                    (EightOctetKeyId skeyid)+                                    nested+                                )+                            )+                6 -> do+                    saltSize <- getWord8+                    expectedSaltSize <-+                        maybe+                            ( fail+                                ( "signature hash algorithm does not define a V6 salt size: "+                                    ++ show ha+                                )+                            )+                            pure+                            (v6SaltSizeForHashAlgorithm ha)+                    when (saltSize /= expectedSaltSize) $+                        fail+                            ( "OPS v6 salt size mismatch for "+                                ++ show ha+                                ++ ": expected "+                                ++ show expectedSaltSize+                                ++ ", got "+                                ++ show saltSize+                            )+                    salt <-+                        SignatureSalt <$> getLazyByteString (fromIntegral saltSize)+                    signerFingerprint <- getLazyByteString 32+                    nested <- getWord8 >>= parseOPSNestedFlag+                    return $+                        OnePassSignaturePkt+                            ( OPSPayloadV6Packet+                                ( OPSPayloadV6+                                    sigtype+                                    ha+                                    pka+                                    salt+                                    signerFingerprint+                                    nested+                                )+                            )+                _ -> fail ("Unsupported OPS version: " ++ show pv)+        | t == 5 = do+            bs <- getLazyByteString len+            let ps =+                    flip runGetOrFail bs $ do+                        pkp <- getPKPayload+                        ska <- getSKAddendum pkp+                        return $ SecretKeyPkt pkp ska+            case ps of+                Left (_, _, err) -> fail ("secret key " ++ err)+                Right (_, _, pkt) -> return pkt+        | t == 6 = do+            pkp <- getPKPayload+            return $ PublicKeyPkt pkp+        | t == 7 = do+            bs <- getLazyByteString len+            let ps =+                    flip runGetOrFail bs $ do+                        pkp <- getPKPayload+                        ska <- getSKAddendum pkp+                        return $ SecretSubkeyPkt pkp ska+            case ps of+                Left (_, _, err) -> fail ("secret subkey " ++ err)+                Right (_, _, pkt) -> return pkt+        | t == 8 = do+            ca <- getWord8+            cdata <- getLazyByteString (len - 1)+            return $ CompressedDataPkt (toFVal ca) cdata+        | t == 9 = do+            sdata <- getLazyByteString len+            return $ SymEncDataPkt sdata+        | t == 10 = do+            marker <- getLazyByteString len+            return $ MarkerPkt marker+        | t == 11 = do+            dt <- getWord8+            flen <- getWord8+            fn <- getLazyByteString (fromIntegral flen)+            ts <- fmap ThirtyTwoBitTimeStamp getWord32be+            ldata <- getLazyByteString (len - (6 + fromIntegral flen))+            return $ LiteralDataPkt (toFVal dt) fn ts ldata+        | t == 12 = do+            tdata <- getLazyByteString len+            return $ TrustPkt tdata+        | t == 13 = do+            udata <- getByteString (fromIntegral len)+            return . UserIdPkt . decodeUtf8With lenientDecode $ udata+        | t == 14 = do+            bs <- getLazyByteString len+            let ps =+                    flip runGetOrFail bs $ do+                        pkp <- getPKPayload+                        return $ PublicSubkeyPkt pkp+            case ps of+                Left (_, _, err) -> fail ("public subkey " ++ err)+                Right (_, _, pkt) -> return pkt+        | t == 17 = do+            bs <- getLazyByteString len+            case runGetOrFail (many getUserAttrSubPacket) bs of+                Left (_, _, err) -> fail ("user attribute " ++ err)+                Right (_, _, uas) -> return $ UserAttributePkt uas+        | t == 18 = do+            pv <- getWord8+            case pv of+                1 -> do+                    b <- getLazyByteString (len - 1)+                    return $ SymEncIntegrityProtectedDataPkt (SEIPD1 pv b)+                2 -> do+                    when (len < 36) $+                        fail "SEIPD v2 packet too short"+                    symalgo <- toFVal <$> getWord8+                    aeadalgo <- toFVal <$> getWord8+                    chunkSize <- getWord8+                    salt <- Salt <$> getByteString 32+                    encrypted <- getLazyByteString (len - 36)+                    validateSEIPDv2Header symalgo aeadalgo chunkSize encrypted+                    return $+                        SymEncIntegrityProtectedDataPkt+                            ( SEIPD2+                                symalgo+                                aeadalgo+                                chunkSize+                                salt+                                encrypted+                            )+                _ -> fail ("Unsupported SEIPD version: " ++ show pv)+        | t == 19 = do+            hash <- getLazyByteString 20+            return $ ModificationDetectionCodePkt hash+        | t == 21 = do+            payload <- getLazyByteString len+            return $ PaddingPkt payload+        | otherwise = do+            payload <- getLazyByteString len+            return $ OtherPacketPkt t payload++getUserAttrSubPacket :: Get UserAttrSubPacket+getUserAttrSubPacket = do+    l <- fmap fromIntegral getSubPacketLength+    t <- getWord8+    getUserAttrSubPacket' t l+  where+    getUserAttrSubPacket'+        :: Word8 -> ByteOffset -> Get UserAttrSubPacket+    getUserAttrSubPacket' t l+        | t == 1 = do+            _ <- getWord16le -- ihlen+            hver <- getWord8 -- should be 1+            iformat <- getWord8+            nuls <- getLazyByteString 12 -- should be NULs+            bs <- getLazyByteString (l - 17)+            if hver /= 1 || nuls /= BL.pack (replicate 12 0)+                then fail "Corrupt UAt subpacket"+                else return $ ImageAttribute (ImageHV1 (toFVal iformat)) bs+        | otherwise = do+            bs <- getLazyByteString (l - 1)+            return $ OtherUASub t bs++putUserAttrSubPacket :: UserAttrSubPacket -> Put+putUserAttrSubPacket ua = do+    let sp = runPut $ putUserAttrSubPacket' ua+    putSubPacketLength . fromIntegral . BL.length $ sp+    putLazyByteString sp+  where+    putUserAttrSubPacket' (ImageAttribute (ImageHV1 iformat) idata) = do+        putWord8 1+        putWord16le 16+        putWord8 1+        putWord8 (fromFVal iformat)+        replicateM_ 12 $ putWord8 0+        putLazyByteString idata+    putUserAttrSubPacket' (OtherUASub t bs) = do+        putWord8 t+        putLazyByteString bs++{- | Serialize PKESKv3 session-key material.+For ECDH and X25519 the RFC 6637 §8 / RFC 9580 §5.1.6 wire format is used:+MPI(ephemeral_key) || 1-octet-count || wrapped_session_key_bytes.+All other algorithms use the standard MPI sequence.+-}+putPKESKv3SessionKeyMaterial+    :: PubKeyAlgorithm -> NE.NonEmpty MPI -> Put+putPKESKv3SessionKeyMaterial pka mpis+    | pka `elem` [ECDH, X25519]+    , (ephMPI NE.:| [wrappedMPI]) <- mpis = do+        put ephMPI+        let rawWrapped = i2osp (unMPI wrappedMPI)+            -- Left-pad to the nearest valid RFC 3394 wrapped-key length so that+            -- leading-zero bytes stripped by i2osp are restored.+            targetLen =+                headDef+                    (B.length rawWrapped)+                    (filter (>= B.length rawWrapped) [32, 40, 48])+            paddedWrapped = leftPadTo targetLen rawWrapped+        putWord8 (fromIntegral (B.length paddedWrapped))+        putByteString paddedWrapped+    | otherwise = F.mapM_ put mpis+  where+    headDef d [] = d+    headDef _ (x : _) = x++putPkt :: Pkt -> Put+putPkt+    ( PKESKPkt+            (PKESKPayloadV3Packet (PKESKPayloadV3 pv eokeyid pka mpis))+        ) = do+        putWord8 (0xc0 .|. 1)+        let bsk = runPut $ putPKESKv3SessionKeyMaterial pka mpis+        putPacketLength . fromIntegral $ 10 + BL.length bsk+        putWord8 pv -- must be 3+        putLazyByteString (unEOKI eokeyid) -- must be 8 octets+        putWord8 $ fromIntegral . fromFVal $ pka+        putLazyByteString bsk+putPkt+    ( PKESKPkt+            ( PKESKPayloadV6Packet+                    (PKESKPayloadV6 recipientKeyIdentifier pka esk)+                )+        ) = do+        putWord8 (0xc0 .|. 1)+        let keyIdentifierLen = BL.length recipientKeyIdentifier+        when (keyIdentifierLen > 255) $+            error "PKESK v6 recipient key identifier must fit in one octet"+        putPacketLength . fromIntegral $+            3 + keyIdentifierLen + BL.length esk+        putWord8 6+        putWord8 (fromIntegral keyIdentifierLen)+        putLazyByteString recipientKeyIdentifier+        putWord8 $ fromIntegral . fromFVal $ pka+        putLazyByteString esk+putPkt (SignaturePkt sp) = do+    putWord8 (0xc0 .|. 2)+    let bs = runPut $ put sp+    putLengthThenPayload bs+putPkt (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 symalgo s2k mesk))) = do+    putWord8 (0xc0 .|. 3)+    let bs2k = fromS2K s2k+    let bsk = fromMaybe BL.empty mesk+    putPacketLength . fromIntegral $+        2 + BL.length bs2k + BL.length bsk+    putWord8 4+    putWord8 $ fromIntegral . fromFVal $ symalgo+    putLazyByteString bs2k+    putLazyByteString bsk+putPkt+    ( SKESKPkt+            (SKESKPayloadV6Packet (SKESKPayloadV6 symalgo aead s2k iv esk tag))+        ) = do+        putWord8 (0xc0 .|. 3)+        let bs2k = fromS2K s2k+        let params =+                BL.pack+                    [ fromIntegral (fromFVal symalgo)+                    , fromIntegral (fromFVal aead)+                    , fromIntegral (BL.length bs2k)+                    ]+                    <> bs2k+                    <> iv+        putPacketLength . fromIntegral $+            2 + BL.length params + BL.length esk + BL.length tag+        putWord8 6+        putWord8 (fromIntegral (BL.length params))+        putLazyByteString params+        putLazyByteString esk+        putLazyByteString tag+putPkt+    ( OnePassSignaturePkt+            (OPSPayloadV3Packet (OPSPayloadV3 pv sigtype ha pka skeyid nested))+        ) = do+        putWord8 (0xc0 .|. 4)+        let bs =+                runPut $ do+                    putWord8 pv -- should be 3+                    putWord8 $ fromIntegral . fromFVal $ sigtype+                    putWord8 $ fromIntegral . fromFVal $ ha+                    putWord8 $ fromIntegral . fromFVal $ pka+                    putLazyByteString (unEOKI skeyid)+                    putWord8 . fromIntegral . fromEnum $ not nested+        putLengthThenPayload bs+putPkt+    ( OnePassSignaturePkt+            ( OPSPayloadV6Packet+                    (OPSPayloadV6 sigtype ha pka salt signerFingerprint nested)+                )+        ) = do+        putWord8 (0xc0 .|. 4)+        let saltBytes = unSignatureSalt salt+            saltSize = BL.length saltBytes+            expectedSaltSize =+                maybe+                    ( error+                        ( "signature hash algorithm does not define a V6 salt size: "+                            ++ show ha+                        )+                    )+                    id+                    (v6SaltSizeForHashAlgorithm ha)+        when (fromIntegral saltSize /= expectedSaltSize) $+            error+                ( "OPS v6 salt size mismatch for "+                    ++ show ha+                    ++ ": expected "+                    ++ show expectedSaltSize+                    ++ ", got "+                    ++ show saltSize+                )+        when (BL.length signerFingerprint /= 32) $+            error "OPS v6 signer fingerprint must be exactly 32 octets"+        let bs =+                runPut $ do+                    putWord8 6+                    putWord8 $ fromIntegral . fromFVal $ sigtype+                    putWord8 $ fromIntegral . fromFVal $ ha+                    putWord8 $ fromIntegral . fromFVal $ pka+                    putWord8 (fromIntegral saltSize)+                    putLazyByteString saltBytes+                    putLazyByteString signerFingerprint+                    putWord8 . fromIntegral . fromEnum $ not nested+        putLengthThenPayload bs+putPkt (SecretKeyPkt pkp ska) = do+    putWord8 (0xc0 .|. 5)+    let bs = runPut (putPKPayload pkp >> putSKAddendumForPKPayload pkp ska)+    putLengthThenPayload bs+putPkt (PublicKeyPkt pkp) = do+    putWord8 (0xc0 .|. 6)+    let bs = runPut $ putPKPayload pkp+    putLengthThenPayload bs+putPkt (SecretSubkeyPkt pkp ska) = do+    putWord8 (0xc0 .|. 7)+    let bs = runPut (putPKPayload pkp >> putSKAddendumForPKPayload pkp ska)+    putLengthThenPayload bs+putPkt (CompressedDataPkt ca cdata) = do+    putWord8 (0xc0 .|. 8)+    let bs =+            runPut $ do+                putWord8 $ fromIntegral . fromFVal $ ca+                putLazyByteString cdata+    putLengthThenPayload bs+putPkt (SymEncDataPkt b) = do+    putWord8 (0xc0 .|. 9)+    putLengthThenPayload b+putPkt (MarkerPkt b) = do+    putWord8 (0xc0 .|. 10)+    putLengthThenPayload b+putPkt (LiteralDataPkt dt fn ts b) = do+    putWord8 (0xc0 .|. 11)+    let bs =+            runPut $ do+                putWord8 $ fromIntegral . fromFVal $ dt+                putWord8 $ fromIntegral . BL.length $ fn+                putLazyByteString fn+                putWord32be . unThirtyTwoBitTimeStamp $ ts+                putLazyByteString b+    putLengthThenPayload bs+putPkt (TrustPkt b) = do+    putWord8 (0xc0 .|. 12)+    putLengthThenPayload b+putPkt (UserIdPkt u) = do+    putWord8 (0xc0 .|. 13)+    let bs = encodeUtf8 u+    putPacketLength . fromIntegral $ B.length bs+    putByteString bs+putPkt (PublicSubkeyPkt pkp) = do+    putWord8 (0xc0 .|. 14)+    let bs = runPut $ putPKPayload pkp+    putLengthThenPayload bs+putPkt (UserAttributePkt us) = do+    putWord8 (0xc0 .|. 17)+    let bs = runPut $ mapM_ put us+    putLengthThenPayload bs+putPkt (SymEncIntegrityProtectedDataPkt (SEIPD1 pv b)) = do+    putWord8 (0xc0 .|. 18)+    putPacketLength . fromIntegral $ BL.length b + 1+    putWord8 pv -- should be 1+    putLazyByteString b+putPkt+    ( SymEncIntegrityProtectedDataPkt+            (SEIPD2 symalgo aeadalgo chunkSize salt b)+        ) = do+        when (B.length (unSalt salt) /= 32) $+            error "SEIPD v2 salt must be exactly 32 octets"+        when (chunkSize > 16) $+            error "SEIPD v2 chunk size octet must be between 0 and 16"+        case symalgo of+            OtherSA _ -> error "SEIPD v2 requires a known symmetric algorithm"+            Plaintext -> error "SEIPD v2 cannot use plaintext cipher"+            _ -> return ()+        case aeadalgo of+            OtherAEADAlgo _ -> error "SEIPD v2 requires a known AEAD algorithm"+            _ -> return ()+        putWord8 (0xc0 .|. 18)+        putPacketLength . fromIntegral $ BL.length b + 36+        putWord8 2+        putWord8 (fromFVal symalgo)+        putWord8 (fromFVal aeadalgo)+        putWord8 chunkSize+        putByteString (unSalt salt)+        putLazyByteString b+putPkt (ModificationDetectionCodePkt hash) = do+    putWord8 (0xc0 .|. 19)+    putLengthThenPayload hash+putPkt (PaddingPkt padding) = do+    putWord8 (0xc0 .|. 21)+    putLengthThenPayload padding+putPkt (OtherPacketPkt t payload) = do+    when (t > 63) $+        error+            ("cannot serialize OtherPacket packet tag > 63: " ++ show t)+    putWord8 (0xc0 .|. t)+    putLengthThenPayload payload+putPkt (BrokenPacketPkt _ t payload) = putPkt (OtherPacketPkt t payload)++{- | Validate a packet before serialization to catch constraint violations early.+Returns Left with descriptive error if validation fails.+-}+validatePkt :: Pkt -> Either String ()+validatePkt+    ( PKESKPkt+            (PKESKPayloadV6Packet (PKESKPayloadV6 recipientKeyIdentifier _ _))+        ) = do+        let keyIdentifierLen = BL.length recipientKeyIdentifier+        when (keyIdentifierLen > 255) $+            Left+                "PKESK v6 recipient key identifier must fit in one octet (max 255 bytes)"+        Right ()+validatePkt+    ( OnePassSignaturePkt+            (OPSPayloadV6Packet (OPSPayloadV6 _ ha _ salt signerFingerprint _))+        ) = do+        let saltBytes = unSignatureSalt salt+            saltSize = BL.length saltBytes+        expectedSaltSize <-+            case v6SaltSizeForHashAlgorithm ha of+                Nothing ->+                    Left $+                        "signature hash algorithm does not define a V6 salt size: "+                            ++ show ha+                Just sz -> Right sz+        when (fromIntegral saltSize /= expectedSaltSize) $+            Left+                ( "OPS v6 salt size mismatch for "+                    ++ show ha+                    ++ ": expected "+                    ++ show expectedSaltSize+                    ++ ", got "+                    ++ show saltSize+                )+        when (BL.length signerFingerprint /= 32) $+            Left "OPS v6 signer fingerprint must be exactly 32 octets"+        Right ()+validatePkt+    ( SymEncIntegrityProtectedDataPkt+            (SEIPD2 symalgo aeadalgo chunkSize salt _)+        ) = do+        when (B.length (unSalt salt) /= 32) $+            Left "SEIPD v2 salt must be exactly 32 octets"+        when (chunkSize > 16) $+            Left "SEIPD v2 chunk size octet must be between 0 and 16"+        case symalgo of+            OtherSA _ -> Left "SEIPD v2 requires a known symmetric algorithm"+            Plaintext -> Left "SEIPD v2 cannot use plaintext cipher"+            _ -> Right ()+        case aeadalgo of+            OtherAEADAlgo _ -> Left "SEIPD v2 requires a known AEAD algorithm"+            _ -> Right ()+validatePkt (OtherPacketPkt t _) = do+    when (t > 63) $+        Left ("cannot serialize OtherPacket packet tag > 63: " ++ show t)+    Right ()+validatePkt _ = Right ()++{- | Serialize a packet with explicit validation and error handling.+Validates constraints before calling putPkt to ensure errors are caught early.+-}+putPktEither :: Pkt -> Either String Put+putPktEither pkt = case validatePkt pkt of+    Left err -> Left err+    Right () -> Right (putPkt pkt)++putLengthThenPayload :: ByteString -> Put+putLengthThenPayload bs = do+    let len = BL.length bs+    if len < fromIntegral (0x100000000 :: Integer)+        then do+            putPacketLength (fromIntegral len)+            putLazyByteString bs+        else putPartialLengthPayload bs+  where+    maxPartialChunkSize :: Int64+    maxPartialChunkSize = 1 `shiftL` (30 :: Int)+    putPartialLengthPayload :: ByteString -> Put+    putPartialLengthPayload payload+        | BL.length payload > maxPartialChunkSize = do+            let (chunk, rest) = BL.splitAt maxPartialChunkSize payload+            putPartialLength 30+            putLazyByteString chunk+            putPartialLengthPayload rest+        | otherwise = do+            putPacketLength (fromIntegral (BL.length payload))+            putLazyByteString payload++validateSEIPDv2Header+    :: SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> ByteString+    -> Get ()+validateSEIPDv2Header symalgo aeadalgo chunkSize encrypted = do+    when (chunkSize > 16) $+        fail "SEIPD v2 chunk size octet must be between 0 and 16"+    when (BL.null encrypted) $+        fail+            "SEIPD v2 payload is missing encrypted data and final authentication tag"+    case symalgo of+        OtherSA _ -> fail "SEIPD v2 requires a known symmetric algorithm"+        Plaintext -> fail "SEIPD v2 cannot use plaintext cipher"+        _ -> return ()+    case aeadalgo of+        OtherAEADAlgo _ -> fail "SEIPD v2 requires a known AEAD algorithm"+        _ -> return ()++getMPI :: Get MPI+getMPI = do+    mpilen <- getWord16be+    bs <- getByteString (fromIntegral (mpilen + 7) `div` 8)+    return $ MPI (os2ip bs)++getPubkey :: PubKeyAlgorithm -> Get PKey+getPubkey RSA = do+    MPI n <- get+    MPI e <- get+    return $+        RSAPubKey+            ( RSA_PublicKey+                (R.PublicKey (fromIntegral . B.length . i2osp $ n) n e)+            )+getPubkey DeprecatedRSAEncryptOnly = getPubkey RSA+getPubkey DeprecatedRSASignOnly = getPubkey RSA+getPubkey DSA = do+    MPI p <- get+    MPI q <- get+    MPI g <- get+    MPI y <- get+    return $+        DSAPubKey (DSA_PublicKey (D.PublicKey (D.Params p g q) y))+getPubkey ElgamalEncryptOnly = getPubkey ForbiddenElgamal+getPubkey ForbiddenElgamal = do+    MPI p <- get+    MPI g <- get+    MPI y <- get+    return $ ElGamalPubKey p g y+getPubkey ECDSA = do+    curvelength <- getWord8+    when (curvelength == 0 || curvelength == 0xff) $+        fail "invalid ECC curve OID length octet (reserved value)"+    curveoid <- getByteString (fromIntegral curvelength)+    MPI mpi <- getMPI+    case curveoidBSToCurve curveoid of+        Left e -> fail e+        Right Curve25519 ->+            EdDSAPubKey P.EdSigningCurve25519+                <$> ( PrefixedNativeEPoint+                        <$> validatePrefixedNativePoint 32 "Curve25519Legacy" mpi+                    )+        Right curve ->+            case bs2Point (i2osp mpi) of+                Left e -> fail e+                Right point ->+                    return+                        . ECDSAPubKey+                        . ECDSA_PublicKey+                        . ECDSA.PublicKey (curve2Curve curve)+                        $ point+getPubkey ECDH = do+    ed <- getPubkey ECDSA -- could be an ECDSA or an EdDSA+    kdflen <- getWord8+    when (kdflen == 0 || kdflen == 0xff) $+        fail "invalid ECDH KDF field length octet (reserved value)"+    when (kdflen /= 3) $+        fail ("invalid ECDH KDF field length: " ++ show kdflen)+    one <- getWord8+    when (one /= 1) $+        fail ("invalid ECDH KDF reserved octet: " ++ show one)+    kdfHA <- get+    kdfSA <- get+    return $ ECDHPubKey ed kdfHA kdfSA+getPubkey EdDSA = do+    curvelength <- getWord8+    when (curvelength == 0 || curvelength == 0xff) $+        fail "invalid EdDSA curve OID length octet (reserved value)"+    curveoid <- getByteString (fromIntegral curvelength)+    MPI mpi <- getMPI+    case curveoidBSToEdSigningCurve curveoid of+        Left e -> fail e+        Right P.EdSigningCurve25519 ->+            EdDSAPubKey P.EdSigningCurve25519+                <$> ( PrefixedNativeEPoint+                        <$> validatePrefixedNativePoint 32 "Ed25519Legacy" mpi+                    )+        Right P.EdSigningCurve448 ->+            EdDSAPubKey P.EdSigningCurve448+                <$> ( PrefixedNativeEPoint+                        <$> validatePrefixedNativePoint 57 "Ed448Legacy" mpi+                    )+getPubkey pka+    | pka == BTypes.Ed25519 =+        parseFixedLengthOrLegacyPubkey+            32+            ( EdDSAPubKey P.EdSigningCurve25519+                . NativeEPoint+                . EPoint+                . os2ip+                . BL.toStrict+            )+            (getPubkey EdDSA)+getPubkey pka+    | pka == BTypes.Ed448 =+        parseFixedLengthOrLegacyPubkey+            57+            ( EdDSAPubKey P.EdSigningCurve448+                . NativeEPoint+                . EPoint+                . os2ip+                . BL.toStrict+            )+            (getPubkey EdDSA)+getPubkey X25519 =+    parseFixedLengthOrLegacyPubkey+        32+        ( EdDSAPubKey P.EdSigningCurve25519+            . NativeEPoint+            . EPoint+            . os2ip+            . BL.toStrict+        )+        (getPubkey ECDH)+getPubkey X448 =+    parseFixedLengthOrLegacyPubkey+        56+        ( EdDSAPubKey P.EdSigningCurve448+            . NativeEPoint+            . EPoint+            . os2ip+            . BL.toStrict+        )+        (getPubkey ECDH)+getPubkey MLKEM768X25519 = MLKEMPubKey . BL.toStrict <$> getRemainingLazyByteString+getPubkey MLKEM1024X448 = MLKEMPubKey . BL.toStrict <$> getRemainingLazyByteString+getPubkey MLDSA65Ed25519 = MLDSAPubKey . BL.toStrict <$> getRemainingLazyByteString+getPubkey MLDSA87Ed448 = MLDSAPubKey . BL.toStrict <$> getRemainingLazyByteString+getPubkey SLHDSASHAKE128s = SLHDSAPubKey . BL.toStrict <$> getRemainingLazyByteString+getPubkey SLHDSASHAKE128f = SLHDSAPubKey . BL.toStrict <$> getRemainingLazyByteString+getPubkey SLHDSASHAKE256s = SLHDSAPubKey . BL.toStrict <$> getRemainingLazyByteString+getPubkey _ = UnknownPKey <$> getRemainingLazyByteString++parseFixedLengthOrLegacyPubkey+    :: Int64 -> (BL.ByteString -> PKey) -> Get PKey -> Get PKey+parseFixedLengthOrLegacyPubkey expectedLen decodeFixed legacyParser = do+    remaining <- lookAhead getRemainingLazyByteString+    if BL.length remaining == expectedLen+        then decodeFixed <$> getLazyByteString expectedLen+        else legacyParser++getPubkeyV6 :: PubKeyAlgorithm -> Get PKey+getPubkeyV6 pka+    | pka == BTypes.Ed25519 = do+        len <- getWord32be+        bs <- getByteString (fromIntegral len)+        when (B.length bs /= 32) $+            fail "invalid v6 Ed25519 public key length"+        return $+            EdDSAPubKey+                P.EdSigningCurve25519+                (NativeEPoint (EPoint (os2ip bs)))+    | pka == BTypes.Ed448 = do+        len <- getWord32be+        bs <- getByteString (fromIntegral len)+        when (B.length bs /= 57) $+            fail "invalid v6 Ed448 public key length"+        return $+            EdDSAPubKey+                P.EdSigningCurve448+                (NativeEPoint (EPoint (os2ip bs)))+    | pka == BTypes.X25519 = do+        len <- getWord32be+        bs <- getByteString (fromIntegral len)+        when (B.length bs /= 32) $+            fail "invalid v6 X25519 public key length"+        return $+            EdDSAPubKey+                P.EdSigningCurve25519+                (NativeEPoint (EPoint (os2ip bs)))+    | pka == BTypes.X448 = do+        len <- getWord32be+        bs <- getByteString (fromIntegral len)+        when (B.length bs /= 56) $+            fail "invalid v6 X448 public key length"+        return $+            EdDSAPubKey+                P.EdSigningCurve448+                (NativeEPoint (EPoint (os2ip bs)))+    | pka == MLKEM768X25519 = do+        len <- getWord32be+        bs <- getByteString (fromIntegral len)+        return $ MLKEMPubKey bs+    | pka == MLKEM1024X448 = do+        len <- getWord32be+        bs <- getByteString (fromIntegral len)+        return $ MLKEMPubKey bs+    | pka == MLDSA65Ed25519 = do+        len <- getWord32be+        bs <- getByteString (fromIntegral len)+        return $ MLDSAPubKey bs+    | pka == MLDSA87Ed448 = do+        len <- getWord32be+        bs <- getByteString (fromIntegral len)+        return $ MLDSAPubKey bs+    | pka == SLHDSASHAKE128s = do+        len <- getWord32be+        bs <- getByteString (fromIntegral len)+        return $ SLHDSAPubKey bs+    | pka == SLHDSASHAKE128f = do+        len <- getWord32be+        bs <- getByteString (fromIntegral len)+        return $ SLHDSAPubKey bs+    | pka == SLHDSASHAKE256s = do+        len <- getWord32be+        bs <- getByteString (fromIntegral len)+        return $ SLHDSAPubKey bs+    | otherwise = getPubkey pka++bs2Point :: B.ByteString -> Either String ECDSA.PublicPoint+bs2Point bs =+    if B.null bs+        then Left "empty EC point encoding"+        else+            let xy = B.drop 1 bs+                l = B.length xy+             in if B.head bs /= 0x04+                    then Left $ "unknown type of point: " ++ show (B.unpack bs)+                    else+                        if odd l+                            then+                                Left "malformed EC point encoding: odd coordinate payload length"+                            else+                                return+                                    ( uncurry+                                        ECCT.Point+                                        ((os2ip *** os2ip) (B.splitAt (div l 2) xy))+                                    )++putPubkey :: PKey -> Put+putPubkey (UnknownPKey bs) = putLazyByteString bs+putPubkey (MLKEMPubKey bs) = putLazyByteString (BL.fromStrict bs)+putPubkey (MLDSAPubKey bs) = putLazyByteString (BL.fromStrict bs)+putPubkey (SLHDSAPubKey bs) = putLazyByteString (BL.fromStrict bs)+putPubkey p@(ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) =+    let Right curveoidbs = curveToCurveoidBS (curveFromCurve curve)+     in putCurveOID curveoidbs+            >> mapM_ put (pubkeyToMPIs p)+putPubkey+    p@( ECDHPubKey+            (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _)))+            kha+            ksa+        ) =+        let Right curveoidbs = curveToCurveoidBS (curveFromCurve curve)+         in putCurveOID curveoidbs+                >> mapM_ put (pubkeyToMPIs p)+                >> putECDHKDFParams kha ksa+putPubkey p@(ECDHPubKey (EdDSAPubKey curve (PrefixedNativeEPoint _)) kha ksa) =+    let Right curveoidbs = curveToCurveoidBS (ed2ec curve)+     in putCurveOID curveoidbs+            >> mapM_ put (pubkeyToMPIs p)+            >> putECDHKDFParams kha ksa+  where+    ed2ec P.EdSigningCurve25519 = Curve25519+    ed2ec P.EdSigningCurve448 = Curve448+putPubkey p@(EdDSAPubKey curve (PrefixedNativeEPoint _)) =+    let Right curveoidbs = edSigningCurveToCurveoidBS curve+     in putCurveOID curveoidbs+            >> mapM_ put (pubkeyToMPIs p)+putPubkey (ECDHPubKey (EdDSAPubKey curve (NativeEPoint _)) _ _) =+    error+        ( "legacy ECDH serialization requires a prefixed-native "+            ++ show curve+            ++ " point"+        )+putPubkey (EdDSAPubKey curve (NativeEPoint _)) =+    error+        ( "legacy EdDSA serialization requires a prefixed-native "+            ++ show curve+            ++ " point"+        )+putPubkey p = mapM_ put (pubkeyToMPIs p)++putPubkeyV6 :: PKey -> Put+putPubkeyV6 (EdDSAPubKey P.EdSigningCurve25519 (NativeEPoint (EPoint x))) = do+    let bs = fixedLengthOctets 32 x+    putWord32be . fromIntegral . B.length $ bs+    putByteString bs+putPubkeyV6 (EdDSAPubKey P.EdSigningCurve448 (NativeEPoint (EPoint x))) = do+    let bs = fixedLengthOctets 57 x+    putWord32be . fromIntegral . B.length $ bs+    putByteString bs+putPubkeyV6+    ( ECDHPubKey+            (EdDSAPubKey P.EdSigningCurve25519 (NativeEPoint (EPoint x)))+            kha+            ksa+        ) = do+        let bs = fixedLengthOctets 32 x+        putWord32be . fromIntegral . B.length $ bs+        putByteString bs+        put kha+        put ksa+putPubkeyV6+    ( ECDHPubKey+            (EdDSAPubKey P.EdSigningCurve448 (NativeEPoint (EPoint x)))+            kha+            ksa+        ) = do+        let bs = fixedLengthOctets 56 x+        putWord32be . fromIntegral . B.length $ bs+        putByteString bs+        put kha+        put ksa+putPubkeyV6 (MLKEMPubKey bs) = do+    putWord32be . fromIntegral . B.length $ bs+    putByteString bs+putPubkeyV6 (MLDSAPubKey bs) = do+    putWord32be . fromIntegral . B.length $ bs+    putByteString bs+putPubkeyV6 (SLHDSAPubKey bs) = do+    putWord32be . fromIntegral . B.length $ bs+    putByteString bs+putPubkeyV6 p = putPubkey p++fixedLengthOctets :: Int -> Integer -> B.ByteString+fixedLengthOctets targetLen x =+    let bs = i2osp x+     in if B.length bs > targetLen+            then+                error+                    ( "public key element does not fit in "+                        ++ show targetLen+                        ++ " octets"+                    )+            else B.replicate (targetLen - B.length bs) 0 <> bs++validatePrefixedNativePoint+    :: Int -> String -> Integer -> Get EPoint+validatePrefixedNativePoint targetLen label i =+    let bs = i2osp i+     in if B.length bs /= targetLen + 1+            then+                fail+                    ( "invalid "+                        ++ label+                        ++ " public key length: expected "+                        ++ show (targetLen + 1)+                        ++ " octets with 0x40 prefix, got "+                        ++ show (B.length bs)+                    )+            else+                if B.head bs /= 0x40+                    then+                        fail ("invalid " ++ label ++ " public key: missing 0x40 prefix")+                    else pure (EPoint i)++putCurveOID :: B.ByteString -> Put+putCurveOID oid = do+    let oidLength = B.length oid+    when (oidLength == 0 || oidLength == 0xff) $+        error "curve OID length cannot use reserved values 0 or 255"+    putWord8 (fromIntegral oidLength)+    putByteString oid++putECDHKDFParams :: HashAlgorithm -> SymmetricAlgorithm -> Put+putECDHKDFParams kdfHA kdfSA = do+    let kdfLengthOctet = 0x03+    when (kdfLengthOctet == 0 || kdfLengthOctet == 0xff) $+        error "ECDH KDF field length cannot use reserved values 0 or 255"+    putWord8 kdfLengthOctet+    putWord8 0x01+    put kdfHA+    put kdfSA++parseOPSNestedFlag :: Word8 -> Get NestedFlag+parseOPSNestedFlag 0 = pure True+parseOPSNestedFlag 1 = pure False+parseOPSNestedFlag other =+    fail ("invalid OPS nested flag octet: " ++ show other)++getSecretKey :: SomePKPayload -> Get SKey+getSecretKey pkp+    | _pkalgo pkp+        `elem` [RSA, DeprecatedRSAEncryptOnly, DeprecatedRSASignOnly] = do+        MPI d <- get+        MPI p <- get+        MPI q <- get+        MPI _ <- get -- u+        case inverse q p of+            Nothing -> fail "invalid RSA secret key: q has no inverse modulo p"+            Just qinv -> do+                let dP = d `mod` (p - 1)+                    dQ = d `mod` (q - 1)+                    pub = (\(RSAPubKey (RSA_PublicKey x)) -> x) (_pubkey pkp)+                return $+                    RSAPrivateKey+                        (RSA_PrivateKey (R.PrivateKey pub d p q dP dQ qinv))+    | _pkalgo pkp == DSA = do+        MPI x <- get+        return $+            DSAPrivateKey (DSA_PrivateKey (D.PrivateKey (D.Params 0 0 0) x))+    | _pkalgo pkp `elem` [ElgamalEncryptOnly, ForbiddenElgamal] = do+        MPI x <- get+        return $ ElGamalPrivateKey x+    | _pkalgo pkp == ECDSA = do+        let pubcurve =+                (\(ECDSAPubKey (ECDSA_PublicKey p)) -> ECDSA.public_curve p)+                    (_pubkey pkp)+        getECDSAScalarPrivateKey pubcurve+    | _pkalgo pkp == ECDH =+        do+            pubcurve <- ecdhPrivateCurveFromPKPayload pkp+            getECDHScalarPrivateKey pubcurve+    | _pkalgo pkp == X25519 = do+        if _keyVersion pkp == V6+            then do+                sk <- getByteString 32+                return $ X25519PrivateKey sk+            else do+                pubcurve <- ecdhPrivateCurveFromPKPayload pkp+                getECDHScalarPrivateKey pubcurve+    | _pkalgo pkp == X448 = do+        if _keyVersion pkp == V6+            then do+                sk <- getByteString 56+                return $ X448PrivateKey sk+            else UnknownSKey <$> getRemainingLazyByteString+    | _pkalgo pkp == EdDSA = do+        if _keyVersion pkp == V6+            then do+                case _pubkey pkp of+                    EdDSAPubKey P.EdSigningCurve25519 _ -> EdDSAPrivateKey P.EdSigningCurve25519 <$> getByteString 32+                    EdDSAPubKey P.EdSigningCurve448 _ -> EdDSAPrivateKey P.EdSigningCurve448 <$> getByteString 57+                    _ -> UnknownSKey <$> getRemainingLazyByteString+            else do+                MPI x <- get+                case _pubkey pkp of+                    EdDSAPubKey P.EdSigningCurve25519 _ ->+                        return $+                            EdDSAPrivateKey P.EdSigningCurve25519 (leftPadTo 32 (i2osp x))+                    EdDSAPubKey P.EdSigningCurve448 _ ->+                        return $+                            EdDSAPrivateKey P.EdSigningCurve448 (leftPadTo 57 (i2osp x))+                    _ -> return $ UnknownSKey (BL.fromStrict (i2osp x))+    | _pkalgo pkp `elem` [MLKEM768X25519, MLKEM1024X448] = do+        if _keyVersion pkp == V6+            then do+                len <- getWord32be+                bs <- getByteString (fromIntegral len)+                return $ MLKEMPrivateKey bs+            else UnknownSKey <$> getRemainingLazyByteString+    | _pkalgo pkp `elem` [MLDSA65Ed25519, MLDSA87Ed448] = do+        if _keyVersion pkp == V6+            then do+                len <- getWord32be+                bs <- getByteString (fromIntegral len)+                return $ MLDSAPrivateKey bs+            else UnknownSKey <$> getRemainingLazyByteString+    | _pkalgo pkp+        `elem` [SLHDSASHAKE128s, SLHDSASHAKE128f, SLHDSASHAKE256s] = do+        if _keyVersion pkp == V6+            then do+                len <- getWord32be+                bs <- getByteString (fromIntegral len)+                return $ SLHDSAPrivateKey bs+            else UnknownSKey <$> getRemainingLazyByteString+    | otherwise = UnknownSKey <$> getRemainingLazyByteString++getECDSAScalarPrivateKey :: ECCT.Curve -> Get SKey+getECDSAScalarPrivateKey curve = do+    MPI pn <- get+    pure $+        ECDSAPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey curve pn))++getECDHScalarPrivateKey :: ECCT.Curve -> Get SKey+getECDHScalarPrivateKey curve = do+    MPI pn <- get+    pure $+        ECDHPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey curve pn))++ecdhPrivateCurveFromPKPayload :: SomePKPayload -> Get ECCT.Curve+ecdhPrivateCurveFromPKPayload pkp =+    case _pubkey pkp of+        ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey p)) _ _ ->+            pure (ECDSA.public_curve p)+        ECDHPubKey (EdDSAPubKey P.EdSigningCurve25519 _) _ _ ->+            pure (curve2Curve Curve25519)+        ECDHPubKey (EdDSAPubKey P.EdSigningCurve448 _) _ _ ->+            pure (curve2Curve Curve448)+        other ->+            fail+                ( "ECDH/X25519 secret key requires an ECDH public key packet, got "+                    ++ show other+                )++putSKey :: SKey -> Either String Put+putSKey (RSAPrivateKey (RSA_PrivateKey (R.PrivateKey _ d p q _ _ _))) =+    case inverse q p of+        Just u ->+            Right (put (MPI d) >> put (MPI p) >> put (MPI q) >> put (MPI u))+        Nothing ->+            Left+                "putSKey: invalid RSA key — q has no multiplicative inverse mod p (key is mathematically broken)"+putSKey (DSAPrivateKey (DSA_PrivateKey (D.PrivateKey _ x))) =+    Right (put (MPI x))+putSKey (ElGamalPrivateKey x) =+    Right (put (MPI x))+putSKey (ECDHPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey _ d))) =+    Right (put (MPI d))+putSKey (ECDSAPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey _ d))) =+    Right (put (MPI d))+putSKey (EdDSAPrivateKey P.EdSigningCurve25519 sk) = Right (putByteString sk)+putSKey (EdDSAPrivateKey P.EdSigningCurve448 sk) = Right (putByteString sk)+putSKey (X25519PrivateKey sk) = Right (putByteString sk)+putSKey (X448PrivateKey sk) = Right (putByteString sk)+putSKey (MLKEMPrivateKey sk) = Right (putLazyByteString (BL.fromStrict sk))+putSKey (MLDSAPrivateKey sk) = Right (putLazyByteString (BL.fromStrict sk))+putSKey (SLHDSAPrivateKey sk) = Right (putLazyByteString (BL.fromStrict sk))+putSKey (UnknownSKey bs) = Right (putLazyByteString bs)++putSKeyForPKPayload :: SomePKPayload -> SKey -> Either String Put+putSKeyForPKPayload pkp sk@(EdDSAPrivateKey _ bs)+    | _keyVersion pkp == V6 = putSKey sk+    | otherwise = Right (put (MPI (os2ip bs)))+putSKeyForPKPayload _ sk = putSKey sk++putMPI :: MPI -> Put+putMPI (MPI i) = do+    let bs = i2osp i+    putWord16be . fromIntegral . numBits $ i+    putByteString bs++data PKPayloadReadCase where+    PKPayloadReadCaseV3+        :: V3Expiration -> PubKeyAlgorithm -> PKPayloadReadCase+    PKPayloadReadCaseV4 :: PubKeyAlgorithm -> PKPayloadReadCase+    PKPayloadReadCaseV6 :: PubKeyAlgorithm -> PKPayloadReadCase++pkPayloadReadCase :: Word8 -> Get PKPayloadReadCase+pkPayloadReadCase version =+    case version of+        2 -> do+            v3e <- getWord16be+            pka <- get+            pure (PKPayloadReadCaseV3 v3e pka)+        3 -> do+            v3e <- getWord16be+            pka <- get+            pure (PKPayloadReadCaseV3 v3e pka)+        4 -> PKPayloadReadCaseV4 <$> get+        6 -> PKPayloadReadCaseV6 <$> get+        _ -> fail ("unsupported key packet version " ++ show version)++getPKPayload :: Get SomePKPayload+getPKPayload = do+    version <- getWord8+    ctime <- fmap ThirtyTwoBitTimeStamp getWord32be+    readCase <- pkPayloadReadCase version+    case readCase of+        PKPayloadReadCaseV3 v3e pka -> do+            pk <- getPubkey pka+            pure $! PKPayload DeprecatedV3 ctime v3e pka pk+        PKPayloadReadCaseV4 pka -> do+            pk <- getPubkey pka+            pure $! PKPayload V4 ctime 0 pka pk+        PKPayloadReadCaseV6 pka -> do+            pk <- getPubkeyV6 pka+            pure $! PKPayload V6 ctime 0 pka pk++data PKPayloadWriteCase where+    PKPayloadWriteCaseV3+        :: PKPayload 'DeprecatedV3 -> PKPayloadWriteCase+    PKPayloadWriteCaseV4 :: PKPayload 'V4 -> PKPayloadWriteCase+    PKPayloadWriteCaseV6 :: PKPayload 'V6 -> PKPayloadWriteCase++pkPayloadWriteCase :: SomePKPayload -> PKPayloadWriteCase+pkPayloadWriteCase (SomePKPayload pkp) =+    case pkp of+        PKPayloadV3 {} -> PKPayloadWriteCaseV3 pkp+        PKPayloadV4 {} -> PKPayloadWriteCaseV4 pkp+        PKPayloadV6 {} -> PKPayloadWriteCaseV6 pkp++putPKPayload :: SomePKPayload -> Put+putPKPayload pkpSome =+    case pkPayloadWriteCase pkpSome of+        PKPayloadWriteCaseV3 (PKPayloadV3 ctime v3e pka pk) -> do+            putWord8 3+            putWord32be . unThirtyTwoBitTimeStamp $ ctime+            putWord16be v3e+            put pka+            putPubkey pk+        PKPayloadWriteCaseV4 (PKPayloadV4 ctime pka pk) -> do+            putWord8 4+            putWord32be . unThirtyTwoBitTimeStamp $ ctime+            put pka+            putPubkeyV4ForAlgorithm pka pk+        PKPayloadWriteCaseV6 (PKPayloadV6 ctime pka pk) -> do+            putWord8 6+            putWord32be . unThirtyTwoBitTimeStamp $ ctime+            put pka+            putPubkeyV6 pk++putPubkeyV4ForAlgorithm :: PubKeyAlgorithm -> PKey -> Put+putPubkeyV4ForAlgorithm pka pk+    | pka == BTypes.Ed25519 =+        putPubkeyV4Fixed 32 P.EdSigningCurve25519 pk+    | pka == BTypes.Ed448 =+        putPubkeyV4Fixed 57 P.EdSigningCurve448 pk+    | pka == BTypes.X25519 =+        putPubkeyV4Fixed 32 P.EdSigningCurve25519 pk+    | pka == BTypes.X448 = putPubkeyV4Fixed 56 P.EdSigningCurve448 pk+    | otherwise = putPubkey pk++putPubkeyV4Fixed :: Int -> P.EdSigningCurve -> PKey -> Put+putPubkeyV4Fixed targetLen expectedCurve (EdDSAPubKey curve (NativeEPoint (EPoint x)))+    | curve == expectedCurve =+        putByteString (fixedLengthOctets targetLen x)+putPubkeyV4Fixed _ _ pk = putPubkey pk++getSKAddendum :: SomePKPayload -> Get SKAddendum+getSKAddendum (SomePKPayload pkp) =+    toSKAddendum <$> getSKAddendumTyped pkp++getSKAddendumTyped :: PKPayload v -> Get (SKAddendumV v)+getSKAddendumTyped pkp = do+    s2kusage <- getWord8+    let pkpSome = SomePKPayload pkp+        getLegacyS2KProtected constructor = do+            symencWord <- getWord8+            s2k <- getS2K+            let symenc = toFVal symencWord+            case s2k of+                OtherS2K _ _ -> return $ constructor symenc s2k mempty BL.empty+                _ -> do+                    blockSize <- either fail pure (symEncBlockSize symenc)+                    iv <- IV <$> getByteString blockSize+                    encryptedblock <- getRemainingLazyByteString+                    return $ constructor symenc s2k iv encryptedblock+    case s2kusage of+        0 ->+            case pkp of+                PKPayloadV6 {} -> do+                    sk <- getSecretKey pkpSome+                    return (SKAUnencryptedV6 sk)+                PKPayloadV3 {} -> do+                    rest <- lookAhead getRemainingLazyByteString+                    secretLen <-+                        case runGetOrFail+                            ( do+                                start <- bytesRead+                                _ <- getSecretKey pkpSome+                                end <- bytesRead+                                pure (end - start)+                            )+                            rest of+                            Left (_, _, err) -> fail err+                            Right (_, _, len) -> pure len+                    sk <- getSecretKey pkpSome+                    checksum <- getWord16be+                    let expectedChecksum =+                            checksum16Bytes (BL.toStrict (BL.take secretLen rest))+                    when (checksum /= expectedChecksum) $+                        fail+                            ( "legacy unencrypted secret-key checksum mismatch: expected "+                                ++ show expectedChecksum+                                ++ ", got "+                                ++ show checksum+                            )+                    return (SKAUnencryptedLegacy sk checksum)+                PKPayloadV4 {} -> do+                    rest <- lookAhead getRemainingLazyByteString+                    secretLen <-+                        case runGetOrFail+                            ( do+                                start <- bytesRead+                                _ <- getSecretKey pkpSome+                                end <- bytesRead+                                pure (end - start)+                            )+                            rest of+                            Left (_, _, err) -> fail err+                            Right (_, _, len) -> pure len+                    sk <- getSecretKey pkpSome+                    checksum <- getWord16be+                    let expectedChecksum =+                            checksum16Bytes (BL.toStrict (BL.take secretLen rest))+                    when (checksum /= expectedChecksum) $+                        fail+                            ( "legacy unencrypted secret-key checksum mismatch: expected "+                                ++ show expectedChecksum+                                ++ ", got "+                                ++ show checksum+                            )+                    return (SKAUnencryptedLegacy sk checksum)+        255 ->+            case pkp of+                PKPayloadV6 {} ->+                    fail "v6 secret key packets MUST NOT use s2k usage 255"+                PKPayloadV3 {} ->+                    getLegacyS2KProtected SKA16bit+                PKPayloadV4 {} ->+                    getLegacyS2KProtected SKA16bit+        254 ->+            case pkp of+                PKPayloadV6 {} -> do+                    paramsLen <- getWord8+                    params <- getLazyByteString (fromIntegral paramsLen)+                    (symenc, s2k, iv) <-+                        case runGetOrFail getV6CFBParams params of+                            Left (_, _, err) -> fail err+                            Right (rest, _, parsed)+                                | not (BL.null rest) ->+                                    fail "unexpected trailing v6 CFB parameters"+                                | otherwise -> pure parsed+                    encryptedblock <- getRemainingLazyByteString+                    return (SKASHA1V6 symenc s2k (IV iv) encryptedblock)+                PKPayloadV3 {} ->+                    getLegacyS2KProtected SKASHA1Legacy+                PKPayloadV4 {} ->+                    getLegacyS2KProtected SKASHA1Legacy+          where+            getV6CFBParams = do+                symencWord <- getWord8+                s2kLen <- getWord8+                s2kBytes <- getLazyByteString (fromIntegral s2kLen)+                s2k <-+                    case runGetOrFail getS2K s2kBytes of+                        Left (_, _, err) -> fail err+                        Right (rest, _, parsed)+                            | not (BL.null rest) ->+                                fail "unexpected trailing bytes in v6 S2K specifier"+                            | otherwise -> pure parsed+                iv <- getRemainingLazyByteString+                let symenc = toFVal symencWord+                blockSize <- either fail pure (symEncBlockSize symenc)+                when (BL.length iv /= fromIntegral blockSize) $+                    fail "invalid v6 CFB IV length"+                pure (symenc, s2k, BL.toStrict iv)+        253 ->+            case pkp of+                PKPayloadV6 {} -> do+                    paramsLen <- getWord8+                    params <- getLazyByteString (fromIntegral paramsLen)+                    (symenc, aead, s2k, iv) <-+                        case runGetOrFail getV6AEADParams params of+                            Left (_, _, err) -> fail err+                            Right (rest, _, parsed)+                                | not (BL.null rest) ->+                                    fail "unexpected trailing v6 AEAD parameters"+                                | otherwise -> pure parsed+                    encryptedblock <- getRemainingLazyByteString+                    return (SKAAEADV6 symenc aead s2k (IV iv) encryptedblock)+                PKPayloadV3 {} -> do+                    (symenc, aead, s2k, iv) <- getLegacyAEADParams+                    encryptedblock <- getRemainingLazyByteString+                    return (SKAAEADLegacy symenc aead s2k (IV iv) encryptedblock)+                PKPayloadV4 {} -> do+                    (symenc, aead, s2k, iv) <- getLegacyAEADParams+                    encryptedblock <- getRemainingLazyByteString+                    return (SKAAEADLegacy symenc aead s2k (IV iv) encryptedblock)+          where+            getV6AEADParams+                :: Get (SymmetricAlgorithm, AEADAlgorithm, S2K, B.ByteString)+            getV6AEADParams = do+                symencWord <- getWord8+                aeadWord <- getWord8+                s2kLen <- getWord8+                s2kBytes <- getLazyByteString (fromIntegral s2kLen)+                s2k <-+                    case runGetOrFail getS2K s2kBytes of+                        Left (_, _, err) -> fail err+                        Right (rest, _, parsed)+                            | not (BL.null rest) ->+                                fail "unexpected trailing bytes in v6 S2K specifier"+                            | otherwise -> pure parsed+                iv <- getRemainingLazyByteString+                let symenc = toFVal symencWord+                    aead = toFVal aeadWord+                when (BL.length iv /= fromIntegral (aeadNonceSize aead)) $+                    fail "invalid v6 AEAD IV length"+                pure (symenc, aead, s2k, BL.toStrict iv)+            -- v3/v4: no cumulative-params-length octet, no S2K-size octet+            getLegacyAEADParams+                :: Get (SymmetricAlgorithm, AEADAlgorithm, S2K, B.ByteString)+            getLegacyAEADParams = do+                symencWord <- getWord8+                aeadWord <- getWord8+                s2k <- getS2K+                let aead = toFVal aeadWord+                iv <-+                    BL.toStrict+                        <$> getLazyByteString (fromIntegral (aeadNonceSize aead))+                pure (toFVal symencWord, aead, s2k, iv)+        symenc ->+            case pkp of+                PKPayloadV6 {} -> do+                    paramsLen <- getWord8+                    iv <- getByteString (fromIntegral paramsLen)+                    let symencAlg = toFVal symenc+                    blockSize <- either fail pure (symEncBlockSize symencAlg)+                    when (B.length iv /= blockSize) $+                        fail "invalid v6 CFB IV length"+                    encryptedblock <- getRemainingLazyByteString+                    return (SKASymV6 symencAlg (IV iv) encryptedblock)+                PKPayloadV3 {} -> do+                    blockSize <- either fail pure (symEncBlockSize (toFVal symenc))+                    iv <- getByteString blockSize+                    encryptedblock <- getRemainingLazyByteString+                    return (SKASymLegacy (toFVal symenc) (IV iv) encryptedblock)+                PKPayloadV4 {} -> do+                    blockSize <- either fail pure (symEncBlockSize (toFVal symenc))+                    iv <- getByteString blockSize+                    encryptedblock <- getRemainingLazyByteString+                    return (SKASymLegacy (toFVal symenc) (IV iv) encryptedblock)++putSKAddendum :: SKAddendum -> Either String Put+putSKAddendum (SUS16bit symenc s2k iv encryptedblock) =+    Right $ do+        putWord8 255+        put symenc+        put s2k+        putByteString (unIV iv)+        putLazyByteString encryptedblock+putSKAddendum (SUSSHA1 symenc s2k iv encryptedblock) =+    Right $ do+        putWord8 254+        put symenc+        put s2k+        putByteString (unIV iv)+        putLazyByteString encryptedblock+putSKAddendum (SUSAEAD symenc aead s2k iv encryptedblock) =+    Right $ do+        putWord8 253+        put symenc+        putWord8 (fromFVal aead)+        put s2k+        putByteString (unIV iv)+        putLazyByteString encryptedblock+putSKAddendum (SUSym symenc iv encryptedblock) =+    Right $ do+        put symenc+        putByteString (unIV iv)+        putLazyByteString encryptedblock+putSKAddendum (SUUnencrypted sk checksum) =+    do+        putSecret <- putSKey sk+        Right $ do+            putWord8 0+            let skb = runPut putSecret+            putLazyByteString skb+            putWord16be+                ( if checksum == 0+                    then checksum16Bytes (BL.toStrict skb)+                    else checksum+                )++checksum16Bytes :: B.ByteString -> Word16+checksum16Bytes =+    B.foldl'+        ( \a b ->+            fromIntegral+                ((fromIntegral a + fromIntegral b) `mod` (65536 :: Integer))+        )+        0++putSKAddendumForPKPayload :: SomePKPayload -> SKAddendum -> Put+putSKAddendumForPKPayload pkp ska =+    case fromSKAddendumForPKPayload pkp ska of+        Left e -> error e+        Right (SomeSKAddendumV skaV) ->+            putSKAddendumForPKPayloadTyped pkp skaV++putSKAddendumForPKPayloadTyped+    :: SomePKPayload+    -> SKAddendumV v+    -> Put+putSKAddendumForPKPayloadTyped pkp (SKAUnencryptedLegacy sk checksum) = do+    putWord8 0+    let putSecret =+            case putSKeyForPKPayload pkp sk of+                Left err -> error err+                Right p -> p+        skb = runPut putSecret+    putLazyByteString skb+    putWord16be+        ( if checksum == 0+            then+                BL.foldl+                    (\a b -> mod (a + fromIntegral b) 0xffff)+                    (0 :: Word16)+                    skb+            else checksum+        )+putSKAddendumForPKPayloadTyped pkp (SKAUnencryptedV6 sk) = do+    putWord8 0+    let putSecret =+            case putSKeyForPKPayload pkp sk of+                Left err -> error err+                Right p -> p+        skb = runPut putSecret+    putLazyByteString skb+putSKAddendumForPKPayloadTyped _ (SKASHA1V6 symenc s2k iv encryptedblock) = do+    let s2kbs = runPut (put s2k)+        paramsLen = 1 + 1 + BL.length s2kbs + fromIntegral (B.length (unIV iv))+    putWord8 254+    putWord8 (fromIntegral paramsLen)+    put symenc+    putWord8 (fromIntegral (BL.length s2kbs))+    putLazyByteString s2kbs+    putByteString (unIV iv)+    putLazyByteString encryptedblock+putSKAddendumForPKPayloadTyped _ (SKAAEADV6 symenc aead s2k iv encryptedblock) = do+    let s2kbs = runPut (put s2k)+        paramsLen =+            1 + 1 + 1 + BL.length s2kbs + fromIntegral (B.length (unIV iv))+    putWord8 253+    putWord8 (fromIntegral paramsLen)+    put symenc+    putWord8 (fromFVal aead)+    putWord8 (fromIntegral (BL.length s2kbs))+    putLazyByteString s2kbs+    putByteString (unIV iv)+    putLazyByteString encryptedblock+putSKAddendumForPKPayloadTyped _ (SKAAEADLegacy symenc aead s2k iv encryptedblock) = do+    putWord8 253+    put symenc+    putWord8 (fromFVal aead)+    put s2k+    putByteString (unIV iv)+    putLazyByteString encryptedblock+putSKAddendumForPKPayloadTyped _ (SKASymV6 symenc iv encryptedblock) = do+    putWord8 (fromFVal symenc)+    putWord8 (fromIntegral (B.length (unIV iv)))+    putByteString (unIV iv)+    putLazyByteString encryptedblock+putSKAddendumForPKPayloadTyped _ skaV =+    case putSKAddendum (toSKAddendum skaV) of+        Left e -> error e+        Right p -> p++aeadNonceSize :: AEADAlgorithm -> Int+aeadNonceSize EAX = 16+aeadNonceSize OCB = 15+aeadNonceSize GCM = 12+aeadNonceSize (OtherAEADAlgo _) = 0++symEncBlockSize :: SymmetricAlgorithm -> Either String Int+symEncBlockSize Plaintext = Right 0+symEncBlockSize IDEA = Right 8+symEncBlockSize TripleDES = Right 8+symEncBlockSize CAST5 = Right 8+symEncBlockSize Blowfish = Right 8+symEncBlockSize AES128 = Right 16+symEncBlockSize AES192 = Right 16+symEncBlockSize AES256 = Right 16+symEncBlockSize Twofish = Right 16+symEncBlockSize Camellia128 = Right 16+symEncBlockSize Camellia192 = Right 16+symEncBlockSize Camellia256 = Right 16+symEncBlockSize sa =+    Left+        ( "unsupported symmetric algorithm for secret-key IV sizing: "+            ++ show sa+        )++decodeIterationCount :: Word8 -> IterationCount+decodeIterationCount c =+    IterationCount+        ( (16 + (fromIntegral c .&. 15))+            `shiftL` ((fromIntegral c `shiftR` 4) + 6)+        )++encodeIterationCount :: IterationCount -> Word8 -- should this really be a lookup table?+encodeIterationCount 1024 = 0+encodeIterationCount 1088 = 1+encodeIterationCount 1152 = 2+encodeIterationCount 1216 = 3+encodeIterationCount 1280 = 4+encodeIterationCount 1344 = 5+encodeIterationCount 1408 = 6+encodeIterationCount 1472 = 7+encodeIterationCount 1536 = 8+encodeIterationCount 1600 = 9+encodeIterationCount 1664 = 10+encodeIterationCount 1728 = 11+encodeIterationCount 1792 = 12+encodeIterationCount 1856 = 13+encodeIterationCount 1920 = 14+encodeIterationCount 1984 = 15+encodeIterationCount 2048 = 16+encodeIterationCount 2176 = 17+encodeIterationCount 2304 = 18+encodeIterationCount 2432 = 19+encodeIterationCount 2560 = 20+encodeIterationCount 2688 = 21+encodeIterationCount 2816 = 22+encodeIterationCount 2944 = 23+encodeIterationCount 3072 = 24+encodeIterationCount 3200 = 25+encodeIterationCount 3328 = 26+encodeIterationCount 3456 = 27+encodeIterationCount 3584 = 28+encodeIterationCount 3712 = 29+encodeIterationCount 3840 = 30+encodeIterationCount 3968 = 31+encodeIterationCount 4096 = 32+encodeIterationCount 4352 = 33+encodeIterationCount 4608 = 34+encodeIterationCount 4864 = 35+encodeIterationCount 5120 = 36+encodeIterationCount 5376 = 37+encodeIterationCount 5632 = 38+encodeIterationCount 5888 = 39+encodeIterationCount 6144 = 40+encodeIterationCount 6400 = 41+encodeIterationCount 6656 = 42+encodeIterationCount 6912 = 43+encodeIterationCount 7168 = 44+encodeIterationCount 7424 = 45+encodeIterationCount 7680 = 46+encodeIterationCount 7936 = 47+encodeIterationCount 8192 = 48+encodeIterationCount 8704 = 49+encodeIterationCount 9216 = 50+encodeIterationCount 9728 = 51+encodeIterationCount 10240 = 52+encodeIterationCount 10752 = 53+encodeIterationCount 11264 = 54+encodeIterationCount 11776 = 55+encodeIterationCount 12288 = 56+encodeIterationCount 12800 = 57+encodeIterationCount 13312 = 58+encodeIterationCount 13824 = 59+encodeIterationCount 14336 = 60+encodeIterationCount 14848 = 61+encodeIterationCount 15360 = 62+encodeIterationCount 15872 = 63+encodeIterationCount 16384 = 64+encodeIterationCount 17408 = 65+encodeIterationCount 18432 = 66+encodeIterationCount 19456 = 67+encodeIterationCount 20480 = 68+encodeIterationCount 21504 = 69+encodeIterationCount 22528 = 70+encodeIterationCount 23552 = 71+encodeIterationCount 24576 = 72+encodeIterationCount 25600 = 73+encodeIterationCount 26624 = 74+encodeIterationCount 27648 = 75+encodeIterationCount 28672 = 76+encodeIterationCount 29696 = 77+encodeIterationCount 30720 = 78+encodeIterationCount 31744 = 79+encodeIterationCount 32768 = 80+encodeIterationCount 34816 = 81+encodeIterationCount 36864 = 82+encodeIterationCount 38912 = 83+encodeIterationCount 40960 = 84+encodeIterationCount 43008 = 85+encodeIterationCount 45056 = 86+encodeIterationCount 47104 = 87+encodeIterationCount 49152 = 88+encodeIterationCount 51200 = 89+encodeIterationCount 53248 = 90+encodeIterationCount 55296 = 91+encodeIterationCount 57344 = 92+encodeIterationCount 59392 = 93+encodeIterationCount 61440 = 94+encodeIterationCount 63488 = 95+encodeIterationCount 65536 = 96+encodeIterationCount 69632 = 97+encodeIterationCount 73728 = 98+encodeIterationCount 77824 = 99+encodeIterationCount 81920 = 100+encodeIterationCount 86016 = 101+encodeIterationCount 90112 = 102+encodeIterationCount 94208 = 103+encodeIterationCount 98304 = 104+encodeIterationCount 102400 = 105+encodeIterationCount 106496 = 106+encodeIterationCount 110592 = 107+encodeIterationCount 114688 = 108+encodeIterationCount 118784 = 109+encodeIterationCount 122880 = 110+encodeIterationCount 126976 = 111+encodeIterationCount 131072 = 112+encodeIterationCount 139264 = 113+encodeIterationCount 147456 = 114+encodeIterationCount 155648 = 115+encodeIterationCount 163840 = 116+encodeIterationCount 172032 = 117+encodeIterationCount 180224 = 118+encodeIterationCount 188416 = 119+encodeIterationCount 196608 = 120+encodeIterationCount 204800 = 121+encodeIterationCount 212992 = 122+encodeIterationCount 221184 = 123+encodeIterationCount 229376 = 124+encodeIterationCount 237568 = 125+encodeIterationCount 245760 = 126+encodeIterationCount 253952 = 127+encodeIterationCount 262144 = 128+encodeIterationCount 278528 = 129+encodeIterationCount 294912 = 130+encodeIterationCount 311296 = 131+encodeIterationCount 327680 = 132+encodeIterationCount 344064 = 133+encodeIterationCount 360448 = 134+encodeIterationCount 376832 = 135+encodeIterationCount 393216 = 136+encodeIterationCount 409600 = 137+encodeIterationCount 425984 = 138+encodeIterationCount 442368 = 139+encodeIterationCount 458752 = 140+encodeIterationCount 475136 = 141+encodeIterationCount 491520 = 142+encodeIterationCount 507904 = 143+encodeIterationCount 524288 = 144+encodeIterationCount 557056 = 145+encodeIterationCount 589824 = 146+encodeIterationCount 622592 = 147+encodeIterationCount 655360 = 148+encodeIterationCount 688128 = 149+encodeIterationCount 720896 = 150+encodeIterationCount 753664 = 151+encodeIterationCount 786432 = 152+encodeIterationCount 819200 = 153+encodeIterationCount 851968 = 154+encodeIterationCount 884736 = 155+encodeIterationCount 917504 = 156+encodeIterationCount 950272 = 157+encodeIterationCount 983040 = 158+encodeIterationCount 1015808 = 159+encodeIterationCount 1048576 = 160+encodeIterationCount 1114112 = 161+encodeIterationCount 1179648 = 162+encodeIterationCount 1245184 = 163+encodeIterationCount 1310720 = 164+encodeIterationCount 1376256 = 165+encodeIterationCount 1441792 = 166+encodeIterationCount 1507328 = 167+encodeIterationCount 1572864 = 168+encodeIterationCount 1638400 = 169+encodeIterationCount 1703936 = 170+encodeIterationCount 1769472 = 171+encodeIterationCount 1835008 = 172+encodeIterationCount 1900544 = 173+encodeIterationCount 1966080 = 174+encodeIterationCount 2031616 = 175+encodeIterationCount 2097152 = 176+encodeIterationCount 2228224 = 177+encodeIterationCount 2359296 = 178+encodeIterationCount 2490368 = 179+encodeIterationCount 2621440 = 180+encodeIterationCount 2752512 = 181+encodeIterationCount 2883584 = 182+encodeIterationCount 3014656 = 183+encodeIterationCount 3145728 = 184+encodeIterationCount 3276800 = 185+encodeIterationCount 3407872 = 186+encodeIterationCount 3538944 = 187+encodeIterationCount 3670016 = 188+encodeIterationCount 3801088 = 189+encodeIterationCount 3932160 = 190+encodeIterationCount 4063232 = 191+encodeIterationCount 4194304 = 192+encodeIterationCount 4456448 = 193+encodeIterationCount 4718592 = 194+encodeIterationCount 4980736 = 195+encodeIterationCount 5242880 = 196+encodeIterationCount 5505024 = 197+encodeIterationCount 5767168 = 198+encodeIterationCount 6029312 = 199+encodeIterationCount 6291456 = 200+encodeIterationCount 6553600 = 201+encodeIterationCount 6815744 = 202+encodeIterationCount 7077888 = 203+encodeIterationCount 7340032 = 204+encodeIterationCount 7602176 = 205+encodeIterationCount 7864320 = 206+encodeIterationCount 8126464 = 207+encodeIterationCount 8388608 = 208+encodeIterationCount 8912896 = 209+encodeIterationCount 9437184 = 210+encodeIterationCount 9961472 = 211+encodeIterationCount 10485760 = 212+encodeIterationCount 11010048 = 213+encodeIterationCount 11534336 = 214+encodeIterationCount 12058624 = 215+encodeIterationCount 12582912 = 216+encodeIterationCount 13107200 = 217+encodeIterationCount 13631488 = 218+encodeIterationCount 14155776 = 219+encodeIterationCount 14680064 = 220+encodeIterationCount 15204352 = 221+encodeIterationCount 15728640 = 222+encodeIterationCount 16252928 = 223+encodeIterationCount 16777216 = 224+encodeIterationCount 17825792 = 225+encodeIterationCount 18874368 = 226+encodeIterationCount 19922944 = 227+encodeIterationCount 20971520 = 228+encodeIterationCount 22020096 = 229+encodeIterationCount 23068672 = 230+encodeIterationCount 24117248 = 231+encodeIterationCount 25165824 = 232+encodeIterationCount 26214400 = 233+encodeIterationCount 27262976 = 234+encodeIterationCount 28311552 = 235+encodeIterationCount 29360128 = 236+encodeIterationCount 30408704 = 237+encodeIterationCount 31457280 = 238+encodeIterationCount 32505856 = 239+encodeIterationCount 33554432 = 240+encodeIterationCount 35651584 = 241+encodeIterationCount 37748736 = 242+encodeIterationCount 39845888 = 243+encodeIterationCount 41943040 = 244+encodeIterationCount 44040192 = 245+encodeIterationCount 46137344 = 246+encodeIterationCount 48234496 = 247+encodeIterationCount 50331648 = 248+encodeIterationCount 52428800 = 249+encodeIterationCount 54525952 = 250+encodeIterationCount 56623104 = 251+encodeIterationCount 58720256 = 252+encodeIterationCount 60817408 = 253+encodeIterationCount 62914560 = 254+encodeIterationCount 65011712 = 255+encodeIterationCount n = error ("invalid iteration count" ++ show n)++getSignaturePayload :: Get SignaturePayload+getSignaturePayload = do+    pv <- getWord8+    case pv of+        3 -> do+            hashlen <- getWord8+            guard (hashlen == 5)+            st <- getWord8+            ctime <- fmap ThirtyTwoBitTimeStamp getWord32be+            eok <- getLazyByteString 8+            pka <- get+            ha <- get+            left16 <- getWord16be+            mpib <- getRemainingLazyByteString+            case runGetOrFail (some getMPI) mpib of+                Left (_, _, e) -> fail ("v3 sig MPIs " ++ e)+                Right (_, _, mpis) ->+                    return $+                        SigV3+                            (toFVal st)+                            ctime+                            (EightOctetKeyId eok)+                            (toFVal pka)+                            (toFVal ha)+                            left16+                            (NE.fromList mpis)+        4 -> do+            st <- getWord8+            pkaOctet <- get+            ha <- get+            let pka = toFVal pkaOctet :: PubKeyAlgorithm+            hlen <- getWord16be+            hb <- getLazyByteString (fromIntegral hlen)+            let hashed =+                    case runGetOrFail (many getSigSubPacket) hb of+                        Left (_, _, err) -> fail ("v4 sig hasheds " ++ err)+                        Right (_, _, h) -> h+            ulen <- getWord16be+            ub <- getLazyByteString (fromIntegral ulen)+            let unhashed =+                    case runGetOrFail (many getSigSubPacket) ub of+                        Left (_, _, err) -> fail ("v4 sig unhasheds " ++ err)+                        Right (_, _, u) -> u+            left16 <- getWord16be+            mpib <- getRemainingLazyByteString+            let parseV4MPIs parseErrPrefix =+                    case runGetOrFail (some getMPI) mpib of+                        Left (_, _, e) -> fail (parseErrPrefix ++ e)+                        Right (_, _, mpis) ->+                            return $+                                SigV4+                                    (toFVal st)+                                    pka+                                    (toFVal ha)+                                    hashed+                                    unhashed+                                    left16+                                    (NE.fromList mpis)+            if pka == BTypes.Ed25519+                then+                    if BL.length mpib == 64+                        then do+                            let sig = BL.toStrict mpib+                                (rbs, sbs) = B.splitAt 32 sig+                            return $+                                SigV4+                                    (toFVal st)+                                    pka+                                    (toFVal ha)+                                    hashed+                                    unhashed+                                    left16+                                    (NE.fromList [MPI (os2ip rbs), MPI (os2ip sbs)])+                        else parseV4MPIs "v4 Ed25519 legacy MPIs "+                else+                    if pka == BTypes.Ed448+                        then+                            if BL.length mpib == 114+                                then do+                                    let sig = BL.toStrict mpib+                                        (rbs, sbs) = B.splitAt 57 sig+                                    return $+                                        SigV4+                                            (toFVal st)+                                            pka+                                            (toFVal ha)+                                            hashed+                                            unhashed+                                            left16+                                            (NE.fromList [MPI (os2ip rbs), MPI (os2ip sbs)])+                                else parseV4MPIs "v4 Ed448 legacy MPIs "+                        else parseV4MPIs "v4 sig MPIs "+        6 -> do+            st <- getWord8+            pka <- get+            ha <- get+            hlen <- getWord32be+            hb <- getLazyByteString (fromIntegral hlen)+            let hashed =+                    case runGetOrFail (many getSigSubPacket) hb of+                        Left (_, _, err) -> fail ("v6 sig hasheds " ++ err)+                        Right (_, _, h) -> h+            ulen <- getWord32be+            ub <- getLazyByteString (fromIntegral ulen)+            let unhashed =+                    case runGetOrFail (many getSigSubPacket) ub of+                        Left (_, _, err) -> fail ("v6 sig unhasheds " ++ err)+                        Right (_, _, u) -> u+            left16 <- getWord16be+            saltSize <- getWord8+            let haVal = (toFVal ha :: HashAlgorithm)+            expectedSaltSize <-+                maybe+                    ( fail+                        ( "signature hash algorithm does not define a V6 salt size: "+                            ++ show haVal+                        )+                    )+                    pure+                    (v6SaltSizeForHashAlgorithm haVal)+            when (saltSize /= expectedSaltSize) $+                fail+                    ( "v6 signature salt size mismatch for "+                        ++ show haVal+                        ++ ": expected "+                        ++ show expectedSaltSize+                        ++ ", got "+                        ++ show saltSize+                    )+            saltbs <- getByteString (fromIntegral saltSize)+            let salt = SignatureSalt (BL.fromStrict saltbs)+            if pka == BTypes.Ed25519+                then do+                    sig <- getByteString 64+                    let (rbs, sbs) = B.splitAt 32 sig+                        mpis = [MPI (os2ip rbs), MPI (os2ip sbs)]+                    return $+                        SigV6+                            (toFVal st)+                            pka+                            (toFVal ha)+                            salt+                            hashed+                            unhashed+                            left16+                            (NE.fromList mpis)+                else+                    if pka == BTypes.Ed448+                        then do+                            sig <- getByteString 114+                            let (rbs, sbs) = B.splitAt 57 sig+                                mpis = [MPI (os2ip rbs), MPI (os2ip sbs)]+                            return $+                                SigV6+                                    (toFVal st)+                                    pka+                                    (toFVal ha)+                                    salt+                                    hashed+                                    unhashed+                                    left16+                                    (NE.fromList mpis)+                        else do+                            mpib <- getRemainingLazyByteString+                            case runGetOrFail (some getMPI) mpib of+                                Left (_, _, e) -> fail ("v6 sig MPIs " ++ e)+                                Right (_, _, mpis) ->+                                    return $+                                        SigV6+                                            (toFVal st)+                                            pka+                                            (toFVal ha)+                                            salt+                                            hashed+                                            unhashed+                                            left16+                                            (NE.fromList mpis)+        _ -> do+            bs <- getRemainingLazyByteString+            return $ SigVOther pv bs++putSignaturePayload :: SignaturePayload -> Put+putSignaturePayload (SigV3 st ctime eok pka ha left16 mpis) = do+    putWord8 3+    putWord8 5 -- hashlen+    put st+    putWord32be . unThirtyTwoBitTimeStamp $ ctime+    putLazyByteString (unEOKI eok)+    put pka+    put ha+    putWord16be left16+    F.mapM_ put mpis+putSignaturePayload (SigV4 st pka ha hashed unhashed left16 mpis) = do+    putWord8 4+    put st+    put pka+    put ha+    let hb = runPut $ mapM_ put hashed+    putWord16be . fromIntegral . BL.length $ hb+    putLazyByteString hb+    let ub = runPut $ mapM_ put unhashed+    putWord16be . fromIntegral . BL.length $ ub+    putLazyByteString ub+    putWord16be left16+    if pka == BTypes.Ed25519+        then case NE.toList mpis of+            [MPI r, MPI s] -> do+                putByteString (padN 32 r)+                putByteString (padN 32 s)+            _ -> error "Ed25519 v4 signatures must have two MPIs"+        else+            if pka == BTypes.Ed448+                then case NE.toList mpis of+                    [MPI r, MPI s] -> do+                        putByteString (padN 57 r)+                        putByteString (padN 57 s)+                    _ -> error "Ed448 v4 signatures must have two MPIs"+                else F.mapM_ put mpis+  where+    padN n i =+        let bs = i2osp i+         in B.replicate (max 0 (n - B.length bs)) 0 <> bs+putSignaturePayload (SigV6 st pka ha salt hashed unhashed left16 mpis) = do+    let expectedSaltSize =+            maybe+                ( error+                    ( "signature hash algorithm does not define a V6 salt size: "+                        ++ show ha+                    )+                )+                id+                (v6SaltSizeForHashAlgorithm ha)+        actualSaltSize = fromIntegral (BL.length (unSignatureSalt salt))+    when (actualSaltSize /= expectedSaltSize) $+        error+            ( "v6 signature salt size mismatch for "+                ++ show ha+                ++ ": expected "+                ++ show expectedSaltSize+                ++ ", got "+                ++ show actualSaltSize+            )+    putWord8 6+    put st+    put pka+    put ha+    let hb = runPut $ mapM_ put hashed+    putWord32be . fromIntegral . BL.length $ hb+    putLazyByteString hb+    let ub = runPut $ mapM_ put unhashed+    putWord32be . fromIntegral . BL.length $ ub+    putLazyByteString ub+    putWord16be left16+    putWord8 . fromIntegral . BL.length . unSignatureSalt $ salt+    putByteString (BL.toStrict (unSignatureSalt salt))+    if pka == BTypes.Ed25519+        then case NE.toList mpis of+            [MPI r, MPI s] -> do+                putByteString (padN 32 r)+                putByteString (padN 32 s)+            _ -> error "Ed25519 v6 signatures must have two MPIs"+        else+            if pka == BTypes.Ed448+                then case NE.toList mpis of+                    [MPI r, MPI s] -> do+                        putByteString (padN 57 r)+                        putByteString (padN 57 s)+                    _ -> error "Ed448 v6 signatures must have two MPIs"+                else F.mapM_ put mpis+  where+    padN n i =+        let bs = i2osp i+         in B.replicate (max 0 (n - B.length bs)) 0 <> bs+putSignaturePayload (SigVOther pv bs) = do+    putWord8 pv+    putLazyByteString bs++putTK :: TKUnknown -> Put+putTK tk = do+    let pkp = tk ^. tkuKey . _1+    maybe+        (put (PublicKey pkp))+        (\ska -> put (SecretKey pkp ska))+        (snd (tk ^. tkuKey))+    mapM_ (put . Signature) (_tkuRevs tk)+    mapM_ putUid' (_tkuUIDs tk)+    mapM_ putUat' (_tkuUAts tk)+    mapM_ putSub' (_tkuSubs tk)+  where+    putUid' (u, sps) = put (UserId u) >> mapM_ (put . Signature) sps+    putUat' (us, sps) = put (UserAttribute us) >> mapM_ (put . Signature) sps+    putSub' (p, sps) = put p >> mapM_ (put . Signature) sps++-- | Parse the packets from a ByteString, with no error reporting+parsePkts :: ByteString -> [Pkt]+parsePkts = reverse . fst . parsePktsAccum 0 []++-- | Parse packets from a ByteString and report the first parse failure.+parsePktsEither :: ByteString -> Either PktParseError [Pkt]+parsePktsEither lbs =+    case parsePktsAccum 0 [] lbs of+        (pkts, Nothing) -> Right (reverse pkts)+        (_, Just err) -> Left err++data PktParseError+    = PktParseError+    { pktParseErrorOffset :: Int64+    , pktParseErrorMessage :: String+    }+    deriving (Eq, Show)++parsePktsAccum+    :: Int64 -> [Pkt] -> ByteString -> ([Pkt], Maybe PktParseError)+parsePktsAccum offset acc lbs+    | BL.null lbs = (acc, Nothing)+    | otherwise =+        case runGetOrFail getPkt lbs of+            Left (_, parseOffset, msg) -> (acc, err parseOffset msg)+            Right (rest, consumed, pkt) ->+                parsePktsAccum (offset + consumed) (pkt : acc) rest+  where+    err parseOffset msg =+        Just+            PktParseError+                { pktParseErrorOffset = offset + parseOffset+                , pktParseErrorMessage = msg+                }++armorPayloads :: [Armor] -> [ByteString]+armorPayloads =+    foldr collect []+  where+    collect (Armor _ _ payload) = (BL.fromStrict (BLC8.toStrict payload) :)+    collect (ClearSigned _ _ inner) = (armorPayloads [inner] ++)++looksLikeAsciiArmor :: ByteString -> Bool+looksLikeAsciiArmor =+    (armorHeaderLazy `BL.isPrefixOf`)+        . BL.dropWhile isLeadingArmorWhitespace++looksLikeAsciiArmorLenient :: ByteString -> Bool+looksLikeAsciiArmorLenient = looksLikeAsciiArmor . stripUtf8Bom++armorPayloadsOfType :: ArmorType -> [Armor] -> [ByteString]+armorPayloadsOfType atype =+    foldr collect []+  where+    collect (Armor innerType _ payload)+        | innerType == atype = (BL.fromStrict (BLC8.toStrict payload) :)+        | otherwise = id+    collect (ClearSigned _ _ inner) = (armorPayloadsOfType atype [inner] ++)++singleArmorPayloadOfType+    :: ArmorType -> [Armor] -> Either String ByteString+singleArmorPayloadOfType atype armors =+    case armorPayloadsOfType atype armors of+        [payload] -> Right payload+        [] ->+            Left+                ("ASCII armor decode returned no " ++ show atype ++ " blocks")+        payloads ->+            Left+                ( "ASCII armor decode returned "+                    ++ show (length payloads)+                    ++ " "+                    ++ show atype+                    ++ " blocks (expected exactly one)"+                )++singleClearSignedBlock+    :: [Armor]+    -> Either String ([(String, String)], ByteString, ByteString)+singleClearSignedBlock armors =+    case [ clearSignedBlockFromArmor armor | armor@ClearSigned {} <- armors+         ] of+        [Right clearSigned] -> Right clearSigned+        [Left err] -> Left err+        [] -> Left "ASCII armor decode returned no clear-signed blocks"+        clearSigneds ->+            Left+                ( "ASCII armor decode returned "+                    ++ show (length clearSigneds)+                    ++ " clear-signed blocks (expected exactly one)"+                )+  where+    clearSignedBlockFromArmor (ClearSigned hs cleartext inner) =+        case inner of+            Armor ArmorSignature _ sig ->+                Right+                    ( hs+                    , BL.fromStrict (BLC8.toStrict cleartext)+                    , BL.fromStrict (BLC8.toStrict sig)+                    )+            Armor atype _ _ ->+                Left+                    ( "clear-signed block contained inner armor type "+                        ++ show atype+                        ++ " (expected ArmorSignature)"+                    )+            ClearSigned {} ->+                Left "clear-signed block contained nested clear-signed payload"+    clearSignedBlockFromArmor _ =+        Left "internal error: expected ClearSigned armor block"++recommendedArmorType :: [Pkt] -> Maybe ArmorType+recommendedArmorType [] = Nothing+recommendedArmorType (pkt : _)+    | isPrivateKeyPacket pkt = Just ArmorPrivateKeyBlock+    | isPublicKeyPacket pkt = Just ArmorPublicKeyBlock+    | isSignaturePacket pkt = Just ArmorSignature+    | otherwise = Just ArmorMessage+  where+    isPrivateKeyPacket SecretKeyPkt {} = True+    isPrivateKeyPacket SecretSubkeyPkt {} = True+    isPrivateKeyPacket _ = False++    isPublicKeyPacket PublicKeyPkt {} = True+    isPublicKeyPacket PublicSubkeyPkt {} = True+    isPublicKeyPacket _ = False++    isSignaturePacket SignaturePkt {} = True+    isSignaturePacket _ = False++dearmorIfAsciiArmored+    :: ByteString -> Either String (Bool, ByteString)+dearmorIfAsciiArmored bs+    | looksLikeAsciiArmor bs =+        (\payload -> (True, payload)) <$> decodeSingleArmorPayload bs+    | otherwise = Right (False, bs)++dearmorIfAsciiArmoredLenient+    :: ByteString -> Either String (Bool, ByteString)+dearmorIfAsciiArmoredLenient bs+    | looksLikeAsciiArmorLenient bs =+        (\payload -> (True, payload))+            <$> decodeSingleArmorPayloadLenient (stripUtf8Bom bs)+    | otherwise = Right (False, bs)++decodeSingleArmorPayload+    :: ByteString -> Either String ByteString+decodeSingleArmorPayload bs =+    case AA.decodeLazy bs of+        Left err -> Left err+        Right armors -> singleArmorPayload armors++decodeSingleArmorPayloadLenient+    :: ByteString -> Either String ByteString+decodeSingleArmorPayloadLenient bs =+    case decodeSingleArmorPayload bs of+        Right payload -> Right payload+        Left strictErr ->+            let normalized = normalizeAsciiArmorForLenientDecode bs+             in if normalized == bs+                    then Left strictErr+                    else case decodeSingleArmorPayload normalized of+                        Left lenientErr ->+                            Left+                                ( strictErr+                                    ++ " (lenient normalization retry failed: "+                                    ++ lenientErr+                                    ++ ")"+                                )+                        Right payload -> Right payload++singleArmorPayload :: [Armor] -> Either String ByteString+singleArmorPayload armors =+    case armorPayloads armors of+        [payload] -> Right payload+        [] -> Left "ASCII armor decode succeeded but returned no blocks"+        payloads ->+            Left+                ( "ASCII armor decode returned "+                    ++ show (length payloads)+                    ++ " blocks (expected exactly one)"+                )++data WireRepInput+    = WireRepInput+    { wireRepInputRef :: WireRepRef+    , wireRepInputPayload :: ByteString+    }++wireRepRefFromInput+    :: Maybe T.Text -> ByteString -> Either String WireRepInput+wireRepRefFromInput mname bs =+    ( \(wasArmored, payload) ->+        WireRepInput+            { wireRepInputRef = BTypes.mkWireRepRef mname wasArmored payload+            , wireRepInputPayload = payload+            }+    )+        <$> dearmorIfAsciiArmored bs++data ParseState+    = ParseState+    { psOffset :: Int64+    , psIndex :: Int+    , psSource :: WireRepRef+    , psRemaining :: BL.ByteString+    }++-- | Parse packets from a source bytestream, preserving packet provenance.+parsePktsWithWireRep+    :: WireRepRef -> ByteString -> [PktWithWireRep]+parsePktsWithWireRep src input = go initialState+  where+    initialState =+        ParseState+            { psOffset = 0+            , psIndex = 0+            , psSource = src+            , psRemaining = input+            }+    go state+        | BL.null (psRemaining state) = []+        | otherwise =+            case runGetOrFail getPkt (psRemaining state) of+                Left (_, _, _) -> []+                Right (rest, consumed, pkt) ->+                    let raw = BL.take consumed (psRemaining state)+                        newState =+                            state+                                { psOffset = psOffset state + consumed+                                , psIndex = psIndex state + 1+                                , psRemaining = rest+                                }+                        pktWithSource =+                            PktWithWireRep+                                (psSource state)+                                (ByteRange (psOffset state) consumed)+                                raw+                                (psIndex state)+                                pkt+                     in pktWithSource : go newState++conduitParsePktsWithWireRep+    :: (Monad m)+    => Maybe T.Text -> ConduitT B.ByteString PktWithWireRep m ()+conduitParsePktsWithWireRep mname = go (UndecidedInput [])+  where+    go !state = do+        mchunk <- await+        case mchunk of+            Nothing -> mapM_ yield (finishConduitState mname state)+            Just chunk ->+                let !nextState = consumeConduitChunk chunk state+                 in go nextState++data ConduitParseState+    = UndecidedInput ![B.ByteString]+    | ArmoredInput ![B.ByteString]+    | BinaryInput !BinaryParseState++data BinaryParseState+    = BinaryParseState+    { bpsLength :: !Int64+    , bpsOffset :: !Int64+    , bpsIndex :: !Int+    , bpsBuffer :: !B.ByteString+    , bpsParsedRev :: [ParsedPacketChunk]+    }++data ArmorPrefixDecision+    = PrefixNeedsMore+    | PrefixIsArmored+    | PrefixIsBinary++consumeConduitChunk+    :: B.ByteString -> ConduitParseState -> ConduitParseState+consumeConduitChunk chunk (UndecidedInput chunksRev) =+    let prefixChunksRev = chunk : chunksRev+        prefix = B.concat (reverse prefixChunksRev)+     in case classifyArmorPrefix prefix of+            PrefixNeedsMore -> UndecidedInput prefixChunksRev+            PrefixIsArmored -> ArmoredInput prefixChunksRev+            PrefixIsBinary -> feedBinaryChunk prefix initialBinaryParseState+consumeConduitChunk chunk (ArmoredInput chunksRev) = ArmoredInput (chunk : chunksRev)+consumeConduitChunk chunk (BinaryInput state) = BinaryInput (advanceBinaryParseState chunk state)++finishConduitState+    :: Maybe T.Text -> ConduitParseState -> [PktWithWireRep]+finishConduitState mname (UndecidedInput chunksRev) =+    finalizeBinaryParseState+        mname+        ( advanceBinaryParseState+            (B.concat (reverse chunksRev))+            initialBinaryParseState+        )+finishConduitState mname (ArmoredInput chunksRev) =+    let input = BL.fromChunks (reverse chunksRev)+     in case wireRepRefFromInput mname input of+            Left _ -> []+            Right+                WireRepInput+                    { wireRepInputRef = src+                    , wireRepInputPayload = payload+                    } ->+                    parsePktsWithWireRep src payload+finishConduitState mname (BinaryInput state) = finalizeBinaryParseState mname state++initialBinaryParseState :: BinaryParseState+initialBinaryParseState =+    BinaryParseState+        { bpsLength = 0+        , bpsOffset = 0+        , bpsIndex = 0+        , bpsBuffer = B.empty+        , bpsParsedRev = []+        }++feedBinaryChunk+    :: B.ByteString -> BinaryParseState -> ConduitParseState+feedBinaryChunk chunk = BinaryInput . advanceBinaryParseState chunk++advanceBinaryParseState+    :: B.ByteString -> BinaryParseState -> BinaryParseState+advanceBinaryParseState chunk state =+    let !nextLength = bpsLength state + fromIntegral (B.length chunk)+        !(nextOffset, nextIndex, nextBuffer, nextParsedRev) =+            drainParsedPackets+                (bpsOffset state)+                (bpsIndex state)+                (bpsBuffer state <> chunk)+                (bpsParsedRev state)+     in BinaryParseState+            { bpsLength = nextLength+            , bpsOffset = nextOffset+            , bpsIndex = nextIndex+            , bpsBuffer = nextBuffer+            , bpsParsedRev = nextParsedRev+            }++finalizeBinaryParseState+    :: Maybe T.Text -> BinaryParseState -> [PktWithWireRep]+finalizeBinaryParseState mname state =+    let src = BTypes.mkWireRepRefWithLength mname False (bpsLength state)+     in map (toPktWithWireRep src) (reverse (bpsParsedRev state))++classifyArmorPrefix :: B.ByteString -> ArmorPrefixDecision+classifyArmorPrefix prefix =+    case B.dropWhile isLeadingArmorWhitespace prefix of+        rest+            | B.null rest -> PrefixNeedsMore+            | armorHeader `B.isPrefixOf` rest -> PrefixIsArmored+            | rest `B.isPrefixOf` armorHeader -> PrefixNeedsMore+            | otherwise -> PrefixIsBinary++armorHeader :: B.ByteString+armorHeader = B.pack (map (fromIntegral . fromEnum) "-----BEGIN PGP ")++armorHeaderLazy :: ByteString+armorHeaderLazy = BL.fromStrict armorHeader++utf8Bom :: ByteString+utf8Bom = BL.pack [0xef, 0xbb, 0xbf]++isLeadingArmorWhitespace :: Word8 -> Bool+isLeadingArmorWhitespace w = w == 0x20 || w == 0x09 || w == 0x0d || w == 0x0a++stripUtf8Bom :: ByteString -> ByteString+stripUtf8Bom bs+    | utf8Bom `BL.isPrefixOf` bs =+        BL.drop (fromIntegral (BL.length utf8Bom)) bs+    | otherwise = bs++normalizeAsciiArmorForLenientDecode :: ByteString -> ByteString+normalizeAsciiArmorForLenientDecode =+    ensureTrailingLf . normalizeLineEndings+  where+    ensureTrailingLf lbs+        | BL.null lbs = lbs+        | BL.last lbs == 0x0a = lbs+        | otherwise = lbs <> BL.singleton 0x0a+    normalizeLineEndings lbs =+        case BL.uncons lbs of+            Nothing -> BL.empty+            Just (0x0d, rest) ->+                case BL.uncons rest of+                    Just (0x0a, rest') -> BL.cons 0x0a (normalizeLineEndings rest')+                    _ -> BL.cons 0x0a (normalizeLineEndings rest)+            Just (w, rest) -> BL.cons w (normalizeLineEndings rest)++data ParsedPacketChunk+    = ParsedPacketChunk+    { ppcRange :: ByteRange+    , ppcRaw :: ByteString+    , ppcIndex :: Int+    , ppcValue :: Pkt+    }++toPktWithWireRep+    :: WireRepRef -> ParsedPacketChunk -> PktWithWireRep+toPktWithWireRep src ppc =+    PktWithWireRep+        src+        (ppcRange ppc)+        (ppcRaw ppc)+        (ppcIndex ppc)+        (ppcValue ppc)++drainParsedPackets+    :: Int64+    -> Int+    -> B.ByteString+    -> [ParsedPacketChunk]+    -> (Int64, Int, B.ByteString, [ParsedPacketChunk])+drainParsedPackets !offset !idx !buffer acc+    | B.null buffer = (offset, idx, B.empty, acc)+    | otherwise =+        case runGetOrFail getPkt (BL.fromStrict buffer) of+            Left _ -> (offset, idx, buffer, acc)+            Right (rest, consumed, pkt) ->+                let !consumedLen = fromIntegral consumed+                    !nextOffset = offset + consumed+                    !nextIdx = idx + 1+                    !nextBuffer = BL.toStrict rest+                    parsedPacket =+                        ParsedPacketChunk+                            { ppcRange = ByteRange offset consumed+                            , ppcRaw = BL.fromStrict (B.take consumedLen buffer)+                            , ppcIndex = idx+                            , ppcValue = pkt+                            }+                 in drainParsedPackets+                        nextOffset+                        nextIdx+                        nextBuffer+                        (parsedPacket : acc)
Codec/Encryption/OpenPGP/Signatures.hs view
@@ -1,1766 +1,2404 @@--- Signatures.hs: OpenPGP (RFC9580) signature verification--- Copyright © 2012-2026  Clint Adams--- This software is released under the terms of the Expat license.--- (See the LICENSE file).--{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--module Codec.Encryption.OpenPGP.Signatures-  ( SignError(..)-  , renderSignError-  , CertificationState(..)-  , certificationStateAt-  , VerificationError(..)-  , renderVerificationError-  , verifySigWith-  , verifyAgainstKeyring-  , verifyAgainstKeys-  , verifyTKWith-  , verifyUnknownTKWith-  , signCertificationWithRSA-  , signDirectKeyWithRSA-  , signKeyRevocationWithRSA-  , signSubkeyRevocationWithRSA-  , signCertRevocationWithRSA-  , signUserIDwithRSA-  , crossSignSubkeyWithRSA-  , signDataWithEd25519-  , signDataWithEd25519Legacy-  , signDataWithEd25519V6-  , signDataWithEd448-  , signDataWithEd448V6-  , signDataWithRSA-  , signDataWithRSAV6-  -- * Builder-based API (Phase 2)-  , signDataWithRSABuilder-  , signDataWithRSAV6Builder-  , signDataWithEd25519Builder-  , signDataWithEd25519V6Builder-  , signDataWithEd448Builder-  , signDataWithEd448V6Builder-  , signDataWithAlgorithmicBuilder-  -- * Text normalization mode-  , TextNormalizationMode(..)-  ) where--import Control.Applicative ((<|>))-import Control.Error.Util (hush)-import Control.Lens ((&), (^.), _1)-import Control.Monad (liftM2, when)--import Crypto.Error (eitherCryptoError)-import Crypto.Hash (hashWith)-import qualified Crypto.Hash.Algorithms as CHA-import Crypto.Number.Serialize (i2osp, os2ip)-import qualified Crypto.PubKey.DSA as DSA-import qualified Crypto.PubKey.ECC.ECDSA as ECDSA-import qualified Crypto.PubKey.Ed25519 as Ed25519-import qualified Crypto.PubKey.Ed448 as Ed448-import qualified Crypto.PubKey.RSA.PKCS15 as P15-import qualified Crypto.PubKey.RSA.Types as RSATypes--import Data.Bifunctor (first)-import Data.Binary.Put (runPut)-import qualified Data.ByteArray as BA-import qualified Data.ByteString as B-import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as BL-import Data.Either (isRight, lefts, rights)-import Data.Function (on)-import Data.IxSet.Typed ((@=))-import qualified Data.IxSet.Typed as IxSet-import qualified Data.Set as Set-import Data.List (find, intercalate, nub)-import Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NE-import qualified Data.Map.Strict as Map-import Data.Maybe (isJust, mapMaybe)-import Data.Text (Text)-import Data.Time.Clock (UTCTime(..), addUTCTime, diffUTCTime)-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import Data.Word (Word16, Word8)-import GHC.TypeLits (TypeError, ErrorMessage(..))--import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)-import Codec.Encryption.OpenPGP.Expirations-  ( isPKTimeValidWithSelfSignatures-  , keyStateAt-  , keyStateValid-  )-import Codec.Encryption.OpenPGP.Internal-  ( PktStreamContext(..)-  , emptyPSC-  , issuer-  , issuerFP-  )-import Codec.Encryption.OpenPGP.Ontology-  ( isCertRevocationSig-  , isRevocationKeySSP-  , isRevokerP-  , isSubkeyBindingSig-  , isSubkeyRevocation-  )-import Codec.Encryption.OpenPGP.SignatureQualities-  ( sigCT-  , sigHA-  , sigPKA-  , sigType-  , signatureHashedSubpacketsKnown-  , signatureSubpacketListsKnown-  )--import Codec.Encryption.OpenPGP.SerializeForSigs-  ( payloadForSig-  , putKeyforSigning-  , putPartialSigforSigning-  , putSigTrailer-  , putUforSigning-  )-import Codec.Encryption.OpenPGP.Policy (signatureV6SaltSizeForHashAlgorithm)-import Codec.Encryption.OpenPGP.Subpackets-  ( SigBuilder-  , TextNormalizationMode(..)-  , sbSigType-  , sbHashAlgo-  , sbHashedSubs-  , sbUnhashedSubs-  , sbSalt-  , sbTextNormMode-  , PrivateKeyFor-  )-import qualified Codec.Encryption.OpenPGP.Subpackets as SP-import Codec.Encryption.OpenPGP.Types-import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA-import Data.Conduit.OpenPGP.Keyring.Instances ()--data VerificationError-  = IssuerSubpacketMismatch-  | IssuerSubpacketUncheckable String-  | IssuerKeyIdProhibitedInV6Signature-  | IssuerFingerprintSubpacketMismatch-  | UnsupportedCriticalSubpacket SigType-  | UnknownCriticalPacketInStream Word8-  | BrokenCriticalPacketInStream Word8 String-  | ExternalVerificationError String-  | NonSignaturePacket-  | UnexpectedSignaturePayloadShape-  | MissingHashAlgorithm-  | HashComputationFailed String-  | UnexpectedKeyVersion-  | SignatureHashUnsupportedByAlgorithm HashAlgorithm PubKeyAlgorithm-  | KeyRevoked-  | SigningKeyUnavailableAtSignatureTime-  | MissingIssuer-  | SigningKeyNotFound (Maybe EightOctetKeyId) (Maybe Fingerprint)-  | MultipleVerificationSuccesses Int-  | UnsupportedKeyType PubKeyAlgorithm-  | SignatureMismatch PubKeyAlgorithm Fingerprint-  | SignatureShapeMismatch PubKeyAlgorithm-  | SignatureEncodingInvalid PubKeyAlgorithm String-  | SignaturePolicyHashUnsupported HashAlgorithm-  | SignaturePolicyPKAMismatch PubKeyAlgorithm PubKeyAlgorithm-  | SignatureExpired-  | CandidateKeyFailures [VerificationError]-  | InvalidSubkeyBackSignature VerificationError-    -- ^ An embedded primary-key back-signature (type 0x19) in a subkey-    -- binding signature failed to verify.-  deriving (Eq, Show)--data CertificationState-  = CertificationNotYetKnown-  | CertificationActive-  | CertificationRevoked-  deriving (Eq, Show)--renderVerificationError :: VerificationError -> String-renderVerificationError IssuerSubpacketMismatch =-  "verification failed: issuer subpacket does not match the actual signer"-renderVerificationError (IssuerSubpacketUncheckable err) =-  "verification failed: issuer subpacket cannot be checked (" ++ err ++ ")"-renderVerificationError IssuerKeyIdProhibitedInV6Signature =-  "verification failed: Issuer Key ID subpacket is prohibited in v6 signatures"-renderVerificationError IssuerFingerprintSubpacketMismatch =-  "verification failed: issuer fingerprint subpacket does not match the actual signer"-renderVerificationError (UnsupportedCriticalSubpacket sigType) =-  "verification failed: unsupported critical hashed subpacket in " ++-  show sigType ++ " signature"-renderVerificationError (UnknownCriticalPacketInStream t) =-  "verification failed: unknown critical packet type in packet sequence (" ++ show t ++ ")"-renderVerificationError (BrokenCriticalPacketInStream t err) =-  "verification failed: broken critical packet type " ++ show t ++ ": " ++ err-renderVerificationError (ExternalVerificationError err) = err-renderVerificationError NonSignaturePacket =-  "verification failed: non-signature packet encountered where signature was expected"-renderVerificationError UnexpectedSignaturePayloadShape =-  "verification failed: unexpected signature payload shape"-renderVerificationError MissingHashAlgorithm =-  "verification failed: signature payload is missing hash algorithm"-renderVerificationError (HashComputationFailed err) =-  "verification failed: hash computation error (" ++ err ++ ")"-renderVerificationError UnexpectedKeyVersion =-  "verification failed: signing key has unexpected version (only v4 and v6 are supported)"-renderVerificationError (SignatureHashUnsupportedByAlgorithm ha pka) =-  "verification failed: hash algorithm " ++ show ha ++-  " is not supported by " ++ show pka ++ " signing backend"-renderVerificationError KeyRevoked =-  "verification failed: signing key is revoked"-renderVerificationError SigningKeyUnavailableAtSignatureTime =-  "verification failed: signing key was not valid at the signature creation time"-renderVerificationError MissingIssuer =-  "verification failed: signature is missing issuer information"-renderVerificationError (SigningKeyNotFound meoki mfp) =-  "verification failed: signing key not found in keyring" ++ issuerContext meoki mfp-renderVerificationError (MultipleVerificationSuccesses n) =-  "verification failed: multiple successful key matches (" ++ show n ++ ")"-renderVerificationError (UnsupportedKeyType pka) =-  "verification failed: unsupported public key algorithm for verification (" ++ show pka ++ ")"-renderVerificationError (SignatureMismatch pka fpr) =-  "verification failed: " ++ show pka ++ " signature mismatch (signer " ++ show fpr ++ ")"-renderVerificationError (SignatureShapeMismatch pka) =-  "verification failed: malformed " ++ show pka ++ " signature encoding"-renderVerificationError (SignatureEncodingInvalid pka err) =-  "verification failed: invalid " ++ show pka ++ " key/signature encoding (" ++ err ++ ")"-renderVerificationError (SignaturePolicyHashUnsupported ha) =-  "verification failed: unsupported signature hash policy (" ++ show ha ++ ")"-renderVerificationError (SignaturePolicyPKAMismatch sigPka keyPka) =-  "verification failed: signature public-key algorithm " ++-  show sigPka ++ " does not match key algorithm " ++ show keyPka-renderVerificationError SignatureExpired =-  "verification failed: signature expired"-renderVerificationError (CandidateKeyFailures errs) =-  "verification failed: no candidate key validated the signature (" ++-  intercalate "; " (nub (map renderVerificationError errs)) ++-  ")"-renderVerificationError (InvalidSubkeyBackSignature err) =-  "verification failed: embedded primary-key back-signature verification failed: " ++-  renderVerificationError err--issuerContext ::-     Maybe EightOctetKeyId -> Maybe Fingerprint -> String-issuerContext meoki mfp =-  case (meoki, mfp) of-    (Nothing, Nothing) -> ""-    _ ->-      " (issuer-keyid=" ++-      maybe "unknown" show meoki ++-      ", issuer-fingerprint=" ++-      maybe "unknown" show mfp ++-      ")"--verificationError :: VerificationError -> Either VerificationError a-verificationError = Left--renderVerificationResult :: Either VerificationError a -> Either String a-renderVerificationResult = first renderVerificationError--data SignError-  = SignBackendError String-  | SignUnsupportedCertificationType SigType-  | SignUnsupportedKeySignatureType SigType-  | SignV6SaltSizeMismatch HashAlgorithm Word8 Int-  | SignProducedWrongLength String Int Int-  deriving (Eq, Show)--renderSignError :: SignError -> String-renderSignError (SignBackendError err) =-  "signature backend error: " ++ err-renderSignError (SignUnsupportedCertificationType st) =-  "unsupported certification signature type: " ++-  show st ++-  " (expected one of GenericCert/PersonaCert/CasualCert/PositiveCert)"-renderSignError (SignUnsupportedKeySignatureType st) =-  "unsupported key signature type: " ++-  show st ++-  " (expected SignatureDirectlyOnAKey or KeyRevocationSig)"-renderSignError (SignV6SaltSizeMismatch ha expected actual) =-  "v6 signature salt size mismatch for " ++-  show ha ++-  ": expected " ++ show expected ++ ", got " ++ show actual-renderSignError (SignProducedWrongLength algo expected actual) =-  algo ++ " produced a non-" ++ show expected ++ "-byte signature (got " ++ show actual ++ ")"--data VerifiableSignatureV where-  VerifiableSignatureV4 :: SignaturePayloadV 'SigPayloadV4 -> VerifiableSignatureV-  VerifiableSignatureV6 :: SignaturePayloadV 'SigPayloadV6 -> VerifiableSignatureV--fromSignaturePayloadVerifiableSignatureV ::-     SignaturePayload -> Maybe VerifiableSignatureV-fromSignaturePayloadVerifiableSignatureV sigPayload =-  case toSomeSignaturePayload sigPayload of-    SomeSignaturePayload (payload@SigPayloadV4Data {}) ->-      Just (VerifiableSignatureV4 payload)-    SomeSignaturePayload (payload@SigPayloadV6Data {}) ->-      Just (VerifiableSignatureV6 payload)-    _ -> Nothing--isVerifiableSignaturePayload :: SignaturePayload -> Bool-isVerifiableSignaturePayload = isJust . fromSignaturePayloadVerifiableSignatureV--toSignaturePayloadFromVerifiable :: VerifiableSignatureV -> SignaturePayload-toSignaturePayloadFromVerifiable (VerifiableSignatureV4 payload) =-  toSignaturePayload payload-toSignaturePayloadFromVerifiable (VerifiableSignatureV6 payload) =-  toSignaturePayload payload--fromPktEitherVerifiableSignatureV :: Pkt -> Either VerificationError VerifiableSignatureV-fromPktEitherVerifiableSignatureV (SignaturePkt sigPayload) =-  case fromSignaturePayloadVerifiableSignatureV sigPayload of-    Just verifiableSig -> Right verifiableSig-    Nothing ->-      verificationError UnexpectedSignaturePayloadShape-fromPktEitherVerifiableSignatureV _ =-  verificationError NonSignaturePacket--signaturePKAAndMPIsFromClass ::-     SomeSignatureV-  -> Either VerificationError (PubKeyAlgorithm, NonEmpty MPI)-signaturePKAAndMPIsFromClass =-  fmap (\(pka, _, mpis) -> (pka, mpis)) . signatureVerificationMaterialFromClass--signatureLeft16FromClass :: SomeSignatureV -> Either VerificationError Word16-signatureLeft16FromClass =-  fmap (\(_, l16, _) -> l16) . signatureVerificationMaterialFromClass--signatureVerificationMaterialFromClass ::-     SomeSignatureV-  -> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)-signatureVerificationMaterialFromClass (SomeSignatureV typedSig) =-  case typedSig of-    SignatureV3Packet (SigPayloadV3Data _ _ _ pka _ l16 mpis) ->-      Right (pka, l16, mpis)-    SignatureV4Packet (SigPayloadV4Data _ pka _ _ _ l16 mpis) ->-      Right (pka, l16, mpis)-    SignatureV6Packet (SigPayloadV6Data _ pka _ _ _ _ l16 mpis) ->-      Right (pka, l16, mpis)-    _ ->-      verificationError UnexpectedSignaturePayloadShape--verifySigWith ::-     (Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification)-  -> Pkt-  -> PktStreamContext-  -> Maybe UTCTime-  -> Either VerificationError Verification-verifySigWith vf sig@(SignaturePkt _) state mt =-  case fromPktEitherVerifiableSignatureV sig of-    Right verifiableSig ->-      let (st, hs, us, checkSubpacket, checkUnhashedSubpackets) =-            verifiableSignatureVerificationInputs verifiableSig-       in checkUnhashedSubpackets us *>-          verifyWithSubpacketChecks vf sig state mt st hs checkSubpacket-    Left err ->-      Left err-  where-    checkV4Subpacket signer i@Issuer {} = checkIssuerSubpacket (eightOctetKeyID signer) i-    checkV4Subpacket signer i@IssuerFingerprint {} =-      checkIssuerFingerprintSubpacket PKA.IssuerFingerprintV4 (fingerprint signer) i-    checkV4Subpacket _ _ = Right True-    -- RFC 9580 §5.2.3.35: v6 signatures MUST NOT include an Issuer Key ID subpacket.-    -- Treat any such subpacket as a verification error rather than merely uncheckable.-    checkV6Subpacket _ Issuer {} =-      verificationError IssuerKeyIdProhibitedInV6Signature-    checkV6Subpacket signer i@IssuerFingerprint {} =-      checkIssuerFingerprintSubpacket PKA.IssuerFingerprintV6 (fingerprint signer) i-    checkV6Subpacket _ _ = Right True-    rejectV6UnhashedIssuer (SigSubPacket _ Issuer {}) =-      verificationError IssuerKeyIdProhibitedInV6Signature-    rejectV6UnhashedIssuer _ = Right ()-    verifiableSignatureVerificationInputs ::-         VerifiableSignatureV-      ->-         ( SigType-         , [SigSubPacket]-         , [SigSubPacket]-         , SomePKPayload -> SigSubPacketPayload -> Either VerificationError Bool-         , [SigSubPacket] -> Either VerificationError ()-         )-    verifiableSignatureVerificationInputs-      (VerifiableSignatureV4 (SigPayloadV4Data st _ _ hs us _ _)) =-        (st, hs, us, checkV4Subpacket, const (Right ()))-    verifiableSignatureVerificationInputs-      (VerifiableSignatureV6 (SigPayloadV6Data st _ _ _ hs us _ _)) =-        (st, hs, us, checkV6Subpacket, mapM_ rejectV6UnhashedIssuer)-verifySigWith _ _ _ _ =-  verificationError NonSignaturePacket--verifyWithSubpacketChecks ::-     (Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification)-  -> Pkt-  -> PktStreamContext-  -> Maybe UTCTime-  -> SigType-  -> [SigSubPacket]-  -> (SomePKPayload -> SigSubPacketPayload -> Either VerificationError Bool)-  -> Either VerificationError Verification-verifyWithSubpacketChecks vf sig state mt sigType hashedSubpackets checkSubpacket = do-  mapM_ (rejectUnsupportedCriticalSubpacket sigType) hashedSubpackets-  v <- vf sig mt (payloadForSig sigType state)-  mapM_ (checkSubpacket (v ^. verificationSigner) . _sspPayload) hashedSubpackets-  warnings <--    if sigType == SubkeyBindingSig-      then verifySubkeyBackSignatures state mt hashedSubpackets-      else Right []-  isSignatureExpired sig mt *>-    pure-      (v-         { _verificationWarnings =-             _verificationWarnings v ++ warnings-         })---- | Verify embedded primary-key back-signatures (PrimaryKeyBindingSig, 0x19)--- found in the hashed subpackets of a SubkeyBindingSig.------ Per RFC 9580 §5.2.3.3, a signing-capable subkey MUST include an embedded--- PrimaryKeyBindingSig (0x19) made by the subkey.  This requirement is--- enforced strictly for v6 subkeys.  For v4 subkeys we still verify any--- embedded back-sigs that are present, but do not reject a missing one —--- real-world v4 signing subkeys predate the strict cross-certification--- mandate and widespread interoperability requires accepting them.-verifySubkeyBackSignatures ::-     PktStreamContext-  -> Maybe UTCTime-  -> [SigSubPacket]-  -> Either VerificationError [VerificationWarning]-verifySubkeyBackSignatures state mt hashedSubpackets = do-  subkeyPKP <--    maybe-      (verificationError NonSignaturePacket)-      Right-      (subkeyPKPFromPkt (lastSubkey state))-  let embeddedSigs =-        [ sp-        | SigSubPacket _ (EmbeddedSignature sp) <- hashedSubpackets-        ]-      isSigningCapable =-        any-          (\(SigSubPacket _ payload) ->-             case payload of-               KeyFlags flags -> SignDataKey `Set.member` flags-               _ -> False)-          hashedSubpackets-      isV6Subkey = _keyVersion subkeyPKP == V6-  case embeddedSigs of-    [] ->-      -- Require back-sig only for v6 signing subkeys (RFC 9580 §5.2.3.3).-      if isSigningCapable && isV6Subkey-        then Right [MissingSubkeyBackSignatureWarning]-        else Right []-    _ ->-      -- Always verify back-sigs that are present, regardless of key version.-      mapM_ (verifyOneBackSig subkeyPKP) embeddedSigs *> Right []-  where-    verifyOneBackSig subkeyPKP embSigPayload = do-      let embSigPkt = SignaturePkt embSigPayload-          backSigContext =-            emptyPSC-              { lastPrimaryKey = lastPrimaryKey state-              , lastSubkey = lastSubkey state-              }-      case verifyAgainstKey' subkeyPKP embSigPkt mt-             (payloadForSig PrimaryKeyBindingSig backSigContext) of-        Left err -> verificationError (InvalidSubkeyBackSignature err)-        Right _ -> Right ()--rejectUnsupportedCriticalSubpacket :: SigType -> SigSubPacket -> Either VerificationError ()-rejectUnsupportedCriticalSubpacket sigType (SigSubPacket isCritical payload)-  | not isCritical = Right ()-  | not (isBindingSignatureType sigType) = Right ()-  | otherwise =-      case payload of-        UserDefinedSigSub {} -> verificationError (UnsupportedCriticalSubpacket sigType)-        OtherSigSub {} -> verificationError (UnsupportedCriticalSubpacket sigType)-        _ -> Right ()--isBindingSignatureType :: SigType -> Bool-isBindingSignatureType SubkeyBindingSig = True-isBindingSignatureType PrimaryKeyBindingSig = True-isBindingSignatureType _ = False--checkIssuerSubpacket ::-     Either String EightOctetKeyId-  -> SigSubPacketPayload-  -> Either VerificationError Bool-checkIssuerSubpacket (Right signer) (Issuer i)-  | signer == i = Right True-  | otherwise = verificationError IssuerSubpacketMismatch-checkIssuerSubpacket (Left err) (Issuer _) =-  verificationError (IssuerSubpacketUncheckable err)-checkIssuerSubpacket _ _ = Right True--checkIssuerFingerprintSubpacket ::-     IssuerFingerprintVersion -> Fingerprint -> SigSubPacketPayload -> Either VerificationError Bool-checkIssuerFingerprintSubpacket expectedVersion signer (IssuerFingerprint kv i)-  | kv /= expectedVersion = verificationError IssuerFingerprintSubpacketMismatch-  | signer == i = Right True-  | otherwise = verificationError IssuerFingerprintSubpacketMismatch-checkIssuerFingerprintSubpacket _ _ _ = Right True--verifyTKWith ::-     (Pkt -> PktStreamContext -> Maybe UTCTime -> Either VerificationError Verification)-  -> Maybe UTCTime-  -> TK k-  -> Either VerificationError (TK k)-verifyTKWith vsf mt tk = do-  verifiedUnknown <- verifyUnknownTKWith vsf mt (tkToUnknown tk)-  let typedSubkeys = Map.fromList [ (keyPktToPkt kp, kp) | (kp, _) <- tk ^. tkSubs ]-      verifiedTypedSubkeys =-        mapMaybe-          (\(pkt, sigs) -> (\kp -> (kp, sigs)) <$> Map.lookup pkt typedSubkeys)-          (verifiedUnknown ^. tkuSubs)-  pure-    TK-      { _tkPrimaryKey = tk ^. tkPrimaryKey-      , _tkRevs = verifiedUnknown ^. tkuRevs-      , _tkUIDs = verifiedUnknown ^. tkuUIDs-      , _tkUAts = verifiedUnknown ^. tkuUAts-      , _tkSubs = verifiedTypedSubkeys-      }--verifyUnknownTKWith ::-     (Pkt -> PktStreamContext -> Maybe UTCTime -> Either VerificationError Verification)-  -> Maybe UTCTime-  -> TKUnknown-  -> Either VerificationError TKUnknown-verifyUnknownTKWith vsf mt tk = do-  revokers <- checkRevokers tk-  revs <- checkKeyRevocations revokers tk-  let uids = filter (not . null . snd) . checkUidSigs $ tk ^. tkuUIDs-  let uats = filter (not . null . snd) . checkUAtSigs $ tk ^. tkuUAts-  let subs = concatMap checkSub $ tk ^. tkuSubs-  return (TKUnknown (tk ^. tkuKey) revs uids uats subs)-  where-    checkRevokers =-      Right . concat . rights . map verifyRevoker . filter isRevokerP . _tkuRevs-    checkKeyRevocations ::-         [(PubKeyAlgorithm, Fingerprint)]-      -> TKUnknown-      -> Either VerificationError [SignaturePayload]-    checkKeyRevocations rs k =-      Prelude.sequence . concatMap (filterRevs rs) . rights .-      map (liftM2 fmap (,) vSig) $-      k ^.-      tkuRevs-    checkUidSigs :: [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]-    checkUidSigs =-      map-        (\(uid, sps) ->-           let verified = rights . map (\sp -> fmap ((,) sp) (vUid (uid, sp))) $ sps-            in (uid, retainNonRevokedCertifications mt verified))-    checkUAtSigs ::-        [([UserAttrSubPacket], [SignaturePayload])]-      -> [([UserAttrSubPacket], [SignaturePayload])]-    checkUAtSigs =-      map-       (\(uat, sps) ->-          let verified = rights . map (\sp -> fmap ((,) sp) (vUAt (uat, sp))) $ sps-           in (uat, retainNonRevokedCertifications mt verified))-    checkSub :: (Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])]-    checkSub (pkt, sps) =-      if revokedSub pkt sps-       then []-       else checkSub' pkt sps-    revokedSub :: Pkt -> [SignaturePayload] -> Bool-    revokedSub _ [] = False-    revokedSub p sigs =-      any (vSubSig p) (filter subkeyRevocationEffective sigs)-    checkSub' :: Pkt -> [SignaturePayload] -> [(Pkt, [SignaturePayload])]-    checkSub' p sps =-      let goodsigs =-           filter (vSubSig p) .-           filter signatureKnown .-           filter isSubkeyBindingSig $-           sps-      in if null goodsigs-           then []-           else [(p, goodsigs)]-    getHasheds = signatureHashedSubpackets-    filterRevs ::-         [(PubKeyAlgorithm, Fingerprint)]-      -> (SignaturePayload, Verification)-      -> [Either VerificationError SignaturePayload]-    filterRevs vokers spv =-      case spv of-       (s, _)-         | isV4OrV6Sig s && sigType s == Just SignatureDirectlyOnAKey ->-            [Right s | signatureKnown s]-       (s, v)-         | isV4OrV6Sig s-            , sigType s == Just KeyRevocationSig-            , Just pka <- sigPKA s ->-          if (v ^. verificationSigner == tk ^. tkuKey . _1) ||-             any-               (\(p, f) ->-                  p == pka && f == fingerprint (v ^. verificationSigner))-                vokers-             then-               if keyRevocationEffective s-                 then [verificationError KeyRevoked]-                 else [Right s | signatureKnown s]-             else [Right s | signatureKnown s]-       _ -> []-    isV4OrV6Sig = isVerifiableSignaturePayload-    vUid :: (Text, SignaturePayload) -> Either VerificationError Verification-    vUid (uid, sp) =-      vsf-        (SignaturePkt sp)-        emptyPSC-          { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)-          , lastUIDorUAt = UserIdPkt uid-          }-        Nothing-    vUAt ::-         ([UserAttrSubPacket], SignaturePayload) -> Either VerificationError Verification-    vUAt (uat, sp) =-      vsf-        (SignaturePkt sp)-        emptyPSC-          { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)-          , lastUIDorUAt = UserAttributePkt uat-          }-        Nothing-    vSig :: SignaturePayload -> Either VerificationError Verification-    vSig sp =-      vsf-        (SignaturePkt sp)-        emptyPSC {lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)}-        Nothing-    vSubSig :: Pkt -> SignaturePayload -> Bool-    vSubSig sk sp =-      isRight-        (vsf-           (SignaturePkt sp)-           emptyPSC-             { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)-             , lastSubkey = sk-             }-           mt)-    verifyRevoker ::-         SignaturePayload-      -> Either VerificationError [(PubKeyAlgorithm, Fingerprint)]-    verifyRevoker sp =-      vSig sp *>-      pure-        (map (\(SigSubPacket _ (RevocationKey _ pka fp)) -> (pka, fp)) .-         filter isRevocationKeySSP $-         getHasheds sp)-    retainNonRevokedCertifications ::-         Maybe UTCTime -> [(SignaturePayload, Verification)] -> [SignaturePayload]-    retainNonRevokedCertifications validationTime verified =-      map fst $-      filter-        ((== CertificationActive) . certificationStateAt validationTime verified)-        certifications-      where-        certifications = filter (not . isCertRevocationSig . fst) verified-    signatureKnown = signatureKnownAt mt-    subkeyRevocationEffective sp = isSubkeyRevocation sp && signatureEffectiveAt mt sp-    keyRevocationEffective sp-      | isHistoricalKeyRevocation sp = signatureEffectiveAt mt sp-      | otherwise = signatureUnexpiredAt mt sp--verifyAgainstKeyring ::-     PublicKeyring -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification-verifyAgainstKeyring kr sig mt payload = do-  let allKeys = map tkToUnknown (IxSet.toList kr)-      signerValidationTime = signatureCreationTimeFromPacket sig-      ikeys = (kr @=) <$> issuer sig-      ifpkeys = (kr @=) <$> issuerFP sig-      hintedKeys = maybe [] (map tkToUnknown . IxSet.toList) (ifpkeys <|> ikeys)-      hintedResult =-        if null hintedKeys-          then Left MissingIssuer-          else verifyFromCandidates allKeys hintedKeys sig signerValidationTime mt payload-   in case hintedResult of-        Right v -> Right v-        Left hintedErr ->-          let fallbackResult =-                verifyFromCandidates allKeys allKeys sig signerValidationTime mt payload-           in if null hintedKeys-                then-                  case fallbackResult of-                    Right v -> Right v-                    Left _ ->-                      verificationError (SigningKeyNotFound (issuer sig) (issuerFP sig))-                else-                  case fallbackResult of-                    Right v -> Right v-                    Left _ -> Left hintedErr--verifyFromCandidates ::-     [TKUnknown]-  -> [TKUnknown]-  -> Pkt-  -> Maybe UTCTime-  -> Maybe UTCTime-  -> ByteString-  -> Either VerificationError Verification-verifyFromCandidates allKeys candidateTks sig signerValidationTime verificationTime payload =-  let candidateResults =-        map-          (resolveCandidateSignerPKPs allKeys sig signerValidationTime (const True))-          candidateTks-      candidateErrors = concatMap fst candidateResults-      usablePkps = concatMap snd candidateResults-   in if null usablePkps-        then-          if null candidateErrors-            then verificationError (SigningKeyNotFound (issuer sig) (issuerFP sig))-            else verificationError (CandidateKeyFailures candidateErrors)-        else-          case verifyAgainstPKPs usablePkps sig verificationTime payload of-            Left (CandidateKeyFailures errs)-              | not (null candidateErrors) ->-                  verificationError (CandidateKeyFailures (candidateErrors ++ errs))-            other -> other--verifyAgainstKeys ::-     [TKUnknown] -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification-verifyAgainstKeys ks sig mt payload = do-  let allpkps =-        filter-          (\x ->-             (((fingerprint x ==) <$> issuerFP sig) == Just True) ||-             ((==) <$> issuer sig <*> hush (eightOctetKeyID x)) ==-             Just True)-          (concatMap (\x -> (x ^. tkuKey . _1) : mapMaybe (subkeyPKPFromPkt . fst) (_tkuSubs x)) ks)-      allCandidatePkps =-        concatMap (\x -> (x ^. tkuKey . _1) : mapMaybe (subkeyPKPFromPkt . fst) (_tkuSubs x)) ks-      normalizedCandidates-        | null allpkps = allCandidatePkps-        | otherwise = allpkps-  verifyAgainstPKPs normalizedCandidates sig mt payload--verifyAgainstPKPs ::-     [SomePKPayload] -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification-verifyAgainstPKPs pkps sig mt payload =-  case rights results of-    [] -> verificationError (CandidateKeyFailures (lefts results))-    [r] -> isSignatureExpired sig mt *> pure r-    rs -> verificationError (MultipleVerificationSuccesses (length rs))-  where-    results = map (\pkp -> verifyAgainstKey' pkp sig mt payload) pkps--resolveCandidateSignerPKPs ::-     [TKUnknown]-  -> Pkt-  -> Maybe UTCTime-  -> (SomePKPayload -> Bool)-  -> TKUnknown-  -> ([VerificationError], [SomePKPayload])-resolveCandidateSignerPKPs _ _ Nothing matchesP tk =-  ([], filter matchesP (candidatePKPs tk))-resolveCandidateSignerPKPs allKeys _ (Just validationTime) matchesP tk =-  let rawMatches = filter matchesP (candidatePKPs tk)-  in case verifyUnknownTKWith (verifySigWith (verifyAgainstKeys allKeys)) (Just validationTime) tk of-        Left err -> (replicate (length rawMatches) err, [])-        Right verifiedTK ->-          let verifiedMatches =-               map-                 (\pkp ->-                    case historicallyValidSigner validationTime (timelineValidationTK pkp verifiedTK) pkp of-                      Right () -> Right pkp-                      Left err -> Left err)-                 rawMatches-          in (lefts verifiedMatches, rights verifiedMatches)-        where-          timelineValidationTK pkp verifiedTK'-            | fingerprint pkp == fingerprint (tk ^. tkuKey . _1) = tk-            | otherwise = verifiedTK'--candidatePKPs :: TKUnknown -> [SomePKPayload]-candidatePKPs tk = (tk ^. tkuKey . _1) : mapMaybe (subkeyPKPFromPkt . fst) (tk ^. tkuSubs)--historicallyValidSigner ::   -     UTCTime -> TKUnknown -> SomePKPayload -> Either VerificationError ()-historicallyValidSigner validationTime tk pkp-  | fingerprint pkp == fingerprint (tk ^. tkuKey . _1) =-      if keyStateValid (keyStateAt validationTime tk)-         then Right ()-         else verificationError SigningKeyUnavailableAtSignatureTime-  | otherwise =-      case find (\(pkt, _) -> maybe False ((== fingerprint pkp) . fingerprint) (subkeyPKPFromPkt pkt)) (tk ^. tkuSubs) of-        Nothing -> verificationError SigningKeyUnavailableAtSignatureTime-        Just (subPkt, sigs) ->-          case subkeyPKPFromPkt subPkt of-            Nothing -> verificationError SigningKeyUnavailableAtSignatureTime-            Just subPKP ->-              if isPKTimeValidWithSelfSignatures validationTime subPKP sigs-                then Right ()-                else verificationError SigningKeyUnavailableAtSignatureTime--signatureCreationTimeFromPacket :: Pkt -> Maybe UTCTime-signatureCreationTimeFromPacket (SignaturePkt sigPayload) = signatureCreationTime sigPayload-signatureCreationTimeFromPacket _ = Nothing--signatureCreationTime :: SignaturePayload -> Maybe UTCTime-signatureCreationTime =-  fmap (posixSecondsToUTCTime . realToFrac . unThirtyTwoBitTimeStamp) . sigCT--signatureKnownAt :: Maybe UTCTime -> SignaturePayload -> Bool-signatureKnownAt Nothing _ = True-signatureKnownAt (Just validationTime) sigPayload =-  maybe False (<= validationTime) (signatureCreationTime sigPayload)--signatureEffectiveAt :: Maybe UTCTime -> SignaturePayload -> Bool-signatureEffectiveAt Nothing _ = True-signatureEffectiveAt (Just validationTime) sigPayload =-  signatureKnownAt (Just validationTime) sigPayload &&-  maybe True (validationTime <) (signatureExpirationTime sigPayload)--signatureUnexpiredAt :: Maybe UTCTime -> SignaturePayload -> Bool-signatureUnexpiredAt Nothing _ = True-signatureUnexpiredAt (Just validationTime) sigPayload =-  maybe True (validationTime <) (signatureExpirationTime sigPayload)--signatureExpirationTime :: SignaturePayload -> Maybe UTCTime-signatureExpirationTime sigPayload =-  addDurationToTime <$>-  signatureCreationTime sigPayload <*>-  signatureExpirationDuration sigPayload--signatureExpirationDuration :: SignaturePayload -> Maybe ThirtyTwoBitDuration-signatureExpirationDuration sigPayload =-  signatureHashedSubpacketsKnown sigPayload >>= firstSignatureExpirationDuration--firstSignatureExpirationDuration :: [SigSubPacket] -> Maybe ThirtyTwoBitDuration-firstSignatureExpirationDuration =-  foldr-    (\subpacket acc ->-       case subpacket of-         SigSubPacket _ (SigExpirationTime duration) -> Just duration-         _ -> acc)-    Nothing--addDurationToTime :: UTCTime -> ThirtyTwoBitDuration -> UTCTime-addDurationToTime baseTime duration =-  addUTCTime (fromIntegral (unThirtyTwoBitDuration duration)) baseTime--certificationStateAt ::-     Maybe UTCTime-  -> [(SignaturePayload, Verification)]-  -> (SignaturePayload, Verification)-  -> CertificationState-certificationStateAt validationTime verified certification@(certificationSig, _)-  | not (signatureKnownAt validationTime certificationSig) = CertificationNotYetKnown-  | not (signatureEffectiveAt validationTime certificationSig) = CertificationRevoked-  | any (`revokesCertification` certification) visibleRevocations = CertificationRevoked-  | otherwise = CertificationActive-  where-    visibleRevocations =-      filter-        (signatureEffectiveAt validationTime . fst)-        (filter (isCertRevocationSig . fst) verified)--revokesCertification ::-     (SignaturePayload, Verification)-  -> (SignaturePayload, Verification)-  -> Bool-revokesCertification (revocationSig, revocationVerification) (certificationSig, certificationVerification) =-  sameSigner && certificationPrecedesRevocation certificationSig revocationSig-  where-    sameSigner =-      fingerprint (revocationVerification ^. verificationSigner) ==-      fingerprint (certificationVerification ^. verificationSigner)--certificationPrecedesRevocation ::-     SignaturePayload -> SignaturePayload -> Bool-certificationPrecedesRevocation certificationSig revocationSig =-  case (signatureCreationTime certificationSig, signatureCreationTime revocationSig) of-    (Just certificationTime, Just revocationTime) ->-      certificationTime < revocationTime-    _ -> False--isHistoricalKeyRevocation :: SignaturePayload -> Bool-isHistoricalKeyRevocation sigPayload =-  case revocationReasonCode sigPayload of-    Just KeySuperseded -> True-    Just KeyRetiredAndNoLongerUsed -> True-    Just UserIdInfoNoLongerValid -> True-    _ -> False--revocationReasonCode :: SignaturePayload -> Maybe RevocationCode-revocationReasonCode sigPayload =-  (\(SigSubPacket _ (ReasonForRevocation reasonCode _)) -> reasonCode) <$>-  find isReasonForRevocation (signatureSubpackets sigPayload)-  where-    isReasonForRevocation (SigSubPacket _ ReasonForRevocation {}) = True-    isReasonForRevocation _ = False--signatureSubpackets :: SignaturePayload -> [SigSubPacket]-signatureSubpackets sigPayload =-  case signatureSubpacketListsKnown sigPayload of-    Just (hashed, unhashed) -> hashed ++ unhashed-    Nothing -> []--signatureHashedSubpackets :: SignaturePayload -> [SigSubPacket]-signatureHashedSubpackets sigPayload =-  maybe [] id (signatureHashedSubpacketsKnown sigPayload)--subkeyPKPFromPkt :: Pkt -> Maybe SomePKPayload-subkeyPKPFromPkt (PublicSubkeyPkt p) = Just p-subkeyPKPFromPkt (SecretSubkeyPkt p _) = Just p-subkeyPKPFromPkt _ = Nothing--verifyAgainstKey' :: SomePKPayload -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification-verifyAgainstKey' pkp sig mt payload = do-      sigClass <--        either-          (verificationError . const NonSignaturePacket)-          Right-          (fromPktEitherSomeSignatureV sig)-      let sigPayload =-            case sigClass of-              SomeSignatureV typedSig -> signaturePayloadFromSignatureV typedSig-      sigHash <--        maybe-          (verificationError MissingHashAlgorithm)-          Right-          (sigHA sigPayload)-      sigDetails <- signaturePKAAndMPIsFromClass sigClass-      enforcePKACompatibility sigPayload-      enforceSignatureHashPolicy sigHash-      _ <- isSignatureExpired sig mt-      let signedPayload = BL.toStrict (finalPayload sig payload)-      enforceLeft16Prefix sigClass sigHash signedPayload-      (\verifiedSigner -> Verification verifiedSigner sigPayload []) <$>-        verify' sigDetails pkp sigHash signedPayload-  where-    enforcePKACompatibility sigPayload =-      let sigPka = maybe (OtherPKA 0) id (sigPKA sigPayload)-          keyPka = _pkalgo pkp-       in if pkaCompatible sigPka keyPka-            then Right ()-            else verificationError (SignaturePolicyPKAMismatch sigPka keyPka)-    enforceSignatureHashPolicy sigHash =-      case sigHash of-        OtherHA {} -> verificationError (SignaturePolicyHashUnsupported sigHash)-        _ -> Right ()-    enforceLeft16Prefix sigClass sigHash signedPayload = do-      expectedLeft16 <--        either-          (verificationError . HashComputationFailed)-          Right-          (left16FromSignedPayload sigHash signedPayload)-      actualLeft16 <- signatureLeft16FromClass sigClass-      if actualLeft16 == expectedLeft16-        then Right ()-        else-          verificationError-            (SignatureMismatch (_pkalgo pkp) (fingerprint pkp))-    pkaCompatible RSA keyPka =-      keyPka `elem` [RSA, DeprecatedRSAEncryptOnly, DeprecatedRSASignOnly]-    pkaCompatible DeprecatedRSASignOnly keyPka =-      keyPka `elem` [RSA, DeprecatedRSASignOnly]-    pkaCompatible PKA.EdDSA keyPka =-      keyPka `elem` [PKA.EdDSA, PKA.Ed25519, PKA.Ed448]-    pkaCompatible PKA.Ed25519 keyPka =-      keyPka `elem` [PKA.EdDSA, PKA.Ed25519]-    pkaCompatible PKA.Ed448 keyPka =-      keyPka `elem` [PKA.EdDSA, PKA.Ed448]-    pkaCompatible sigPka keyPka = sigPka == keyPka-    verify' details pub@(PKPayload V4 _ _ _ pkey) ha pl =-      verifyByHash details pub pkey ha pl-    verify' details pub@(PKPayload V6 _ _ _ pkey) ha pl =-      verifyByHash details pub pkey ha pl-    verify' _ _ _ _ =-      verificationError UnexpectedKeyVersion-    verifyByHash details pub pkey ha pl =-      case ha of-        SHA1 -> verify'' details CHA.SHA1 pub pkey pl-        RIPEMD160 -> verify'' details CHA.RIPEMD160 pub pkey pl-        SHA224 -> verify'' details CHA.SHA224 pub pkey pl-        SHA256 -> verify'' details CHA.SHA256 pub pkey pl-        SHA384 -> verify'' details CHA.SHA384 pub pkey pl-        SHA512 -> verify'' details CHA.SHA512 pub pkey pl-        SHA3_256 -> verifyNoRSA SHA3_256 details CHA.SHA3_256 pub pkey pl-        SHA3_512 -> verifyNoRSA SHA3_512 details CHA.SHA3_512 pub pkey pl-        DeprecatedMD5 -> verify'' details CHA.MD5 pub pkey pl-        _ ->-          verificationError (SignaturePolicyHashUnsupported ha)-    verify'' (DSA, mpis) hd pub (DSAPubKey (DSA_PublicKey pkey)) bs =-      dsaVerify pub mpis hd pkey bs-    verify'' (ECDSA, mpis) hd pub (ECDSAPubKey (ECDSA_PublicKey pkey)) bs =-      ecdsaVerify pub mpis hd pkey bs-    verify'' (sigPka, mpis) hd pub (EdDSAPubKey Ed25519 pkey) bs-      | sigPka `elem` [EdDSA, PKA.Ed25519] =-          ed25519Verify sigPka pub mpis hd pkey bs-    verify'' (sigPka, mpis) hd pub (EdDSAPubKey Ed448 pkey) bs-      | sigPka `elem` [EdDSA, PKA.Ed448] =-          ed448Verify sigPka pub mpis hd pkey bs-    verify'' (RSA, mpis) hd pub (RSAPubKey (RSA_PublicKey pkey)) bs =-      rsaVerify pub mpis hd pkey bs-    verify'' (pka, _) _ _ _ _ = verificationError (UnsupportedKeyType pka)-    verifyNoRSA ha' (DSA, mpis) hd pub (DSAPubKey (DSA_PublicKey pkey)) bs =-      dsaVerify pub mpis hd pkey bs-    verifyNoRSA ha' (ECDSA, mpis) hd pub (ECDSAPubKey (ECDSA_PublicKey pkey)) bs =-      ecdsaVerify pub mpis hd pkey bs-    verifyNoRSA ha' (sigPka, mpis) hd pub (EdDSAPubKey Ed25519 pkey) bs-      | sigPka `elem` [EdDSA, PKA.Ed25519] =-          ed25519Verify sigPka pub mpis hd pkey bs-    verifyNoRSA ha' (sigPka, mpis) hd pub (EdDSAPubKey Ed448 pkey) bs-      | sigPka `elem` [EdDSA, PKA.Ed448] =-          ed448Verify sigPka pub mpis hd pkey bs-    verifyNoRSA ha' (RSA, _) _ _ _ _ =-      verificationError (SignatureHashUnsupportedByAlgorithm ha' RSA)-    verifyNoRSA _ (pka, _) _ _ _ _ = verificationError (UnsupportedKeyType pka)-    dsaVerify pub (r :| [s]) hd pkey bs =-      if DSA.verify hd pkey (dsaMPIsToSig r s) bs-        then Right pub-        else verificationError (SignatureMismatch DSA (fingerprint pub))-    dsaVerify _ _ _ _ _ = verificationError (SignatureShapeMismatch DSA)-    ecdsaVerify pub (r :| [s]) hd pkey bs =-      if ECDSA.verify hd pkey (ecdsaMPIsToSig r s) bs-        then Right pub-        else verificationError (SignatureMismatch ECDSA (fingerprint pub))-    ecdsaVerify _ _ _ _ _ = verificationError (SignatureShapeMismatch ECDSA)-    ed25519Verify sigPka pub (r :| [s]) hd pkey bs =-      case edPointToRawPublic 32 pkey of-        Left err ->-          verificationError (SignatureEncodingInvalid sigPka err)-        Right rawPub ->-          case cf2es (Ed25519.publicKey rawPub) of-            Left err ->-              verificationError (SignatureEncodingInvalid sigPka err)-            Right ep ->-              case cf2es (Ed25519.signature (pad32 (i2osp (unMPI r)) <> pad32 (i2osp (unMPI s)))) of-                Left err ->-                  verificationError (SignatureEncodingInvalid sigPka err)-                Right es ->-                  let prehash = crazyHash hd bs :: B.ByteString-                   in if Ed25519.verify ep prehash es-                        then Right pub-                        else verificationError (SignatureMismatch sigPka (fingerprint pub))-    ed25519Verify sigPka _ _ _ _ _ =-      verificationError (SignatureShapeMismatch sigPka)-    ed448Verify sigPka pub (r :| [s]) hd pkey bs =-      case edPointToRawPublic 57 pkey of-        Left err ->-          verificationError (SignatureEncodingInvalid sigPka err)-        Right rawPub ->-          case cf2es (Ed448.publicKey rawPub) of-            Left err ->-              verificationError (SignatureEncodingInvalid sigPka err)-            Right ep ->-              case cf2es (Ed448.signature (padN 57 (i2osp (unMPI r)) <> padN 57 (i2osp (unMPI s)))) of-                Left err ->-                  verificationError (SignatureEncodingInvalid sigPka err)-                Right es ->-                  let prehash = crazyHash hd bs :: B.ByteString-                   in if Ed448.verify ep prehash es-                        then Right pub-                        else verificationError (SignatureMismatch sigPka (fingerprint pub))-    ed448Verify sigPka _ _ _ _ _ =-      verificationError (SignatureShapeMismatch sigPka)-    edPointToRawPublic expectedLen (NativeEPoint (EPoint x)) =-      exactLengthPublic expectedLen "native" (i2osp x)-    edPointToRawPublic expectedLen (PrefixedNativeEPoint (EPoint x)) = do-      prefixed <- exactLengthPublic (expectedLen + 1) "prefixed-native" (i2osp x)-      if B.head prefixed /= 0x40-        then Left "prefixed-native EdDSA public key is missing the 0x40 prefix"-        else Right (B.tail prefixed)-    exactLengthPublic expectedLen label bs-      | B.length bs == expectedLen = Right bs-      | otherwise =-          Left-            ("invalid " ++ label ++ " EdDSA public key length: expected " ++-             show expectedLen ++ " octets, got " ++ show (B.length bs))-    pad32 bs =-      let l = B.length bs-       in if l >= 32-            then bs-            else B.replicate (32 - l) 0 <> bs-    padN n bs =-      let l = B.length bs-       in if l >= n-            then bs-            else B.replicate (n - l) 0 <> bs-    cf2es = either (Left . show) return . eitherCryptoError-    rsaVerify pub mpis hd pkey bs =-      if P15.verify (Just hd) pkey bs (rsaMPItoSig pkey mpis)-        then Right pub-        else verificationError (SignatureMismatch RSA (fingerprint pub))-    dsaMPIsToSig r s = DSA.Signature (unMPI r) (unMPI s)-    ecdsaMPIsToSig r s = ECDSA.Signature (unMPI r) (unMPI s)-    rsaMPItoSig pkey (s :| []) =-      let sz  = RSATypes.public_size pkey-          raw = i2osp (unMPI s)-          pad = sz - B.length raw-      in B.replicate pad 0 <> raw-    crazyHash h = BA.convert . hashWith h--isSignatureExpired :: Pkt -> Maybe UTCTime -> Either VerificationError Bool-isSignatureExpired _ Nothing = return False-isSignatureExpired s (Just t) =-      do-        sigClass <--          either-            (verificationError . const NonSignaturePacket)-            Right-            (fromPktEitherSomeSignatureV s)-        if any-             (expiredBefore t)-             (signatureHashedSubpackets-                (case sigClass of-                   SomeSignatureV typedSig -> signaturePayloadFromSignatureV typedSig))-          then verificationError SignatureExpired-          else return True-  where-    expiredBefore :: UTCTime -> SigSubPacket -> Bool-    expiredBefore ct (SigSubPacket _ (SigExpirationTime et)) =-      fromEnum ((posixSecondsToUTCTime . toEnum . fromEnum) et `diffUTCTime` ct) <-      0-    expiredBefore _ _ = False--finalPayload :: Pkt -> ByteString -> ByteString-finalPayload s pl = BL.concat [pl, sigbit, trailer s]-  where-    sigbit = runPut $ putPartialSigforSigning s-    trailer :: Pkt -> ByteString-    trailer (SignaturePkt sigPayload) =-      maybe-        BL.empty-        (const (runPut $ putSigTrailer s))-        (fromSignaturePayloadVerifiableSignatureV sigPayload)-    trailer _ = BL.empty--normalizePayloadForSigType :: SigType -> ByteString -> ByteString-normalizePayloadForSigType CanonicalTextSig =-  stripTrailingWhitespacePerLine . canonicalizeLineEndings-normalizePayloadForSigType _ = id--normalizePayloadForSigTypeWith :: TextNormalizationMode -> SigType -> ByteString -> ByteString-normalizePayloadForSigTypeWith CleartextCompat st = normalizePayloadForSigType st-normalizePayloadForSigTypeWith RFC9580Strict CanonicalTextSig = canonicalizeLineEndings-normalizePayloadForSigTypeWith RFC9580Strict _ = id--canonicalizeLineEndings :: ByteString -> ByteString-canonicalizeLineEndings = BL.pack . go . BL.unpack-  where-    go [] = []-    go (0x0d:0x0a:rest) = 0x0d : 0x0a : go rest-    go (0x0d:rest) = 0x0d : 0x0a : go rest-    go (0x0a:rest) = 0x0d : 0x0a : go rest-    go (w:rest) = w : go rest--stripTrailingWhitespacePerLine :: ByteString -> ByteString-stripTrailingWhitespacePerLine = BL.pack . go [] . BL.unpack-  where-    go lineRev [] = reverseTrimmed lineRev-    go lineRev (0x0d:0x0a:rest) =-      reverseTrimmed lineRev ++ [0x0d, 0x0a] ++ go [] rest-    go lineRev (w:rest) = go (w : lineRev) rest--    reverseTrimmed :: [Word8] -> [Word8]-    reverseTrimmed = reverse . dropWhile isTrailingWhitespace--    isTrailingWhitespace :: Word8 -> Bool-    isTrailingWhitespace w = w == 0x20 || w == 0x09--hashWithSHA512 :: B.ByteString -> B.ByteString-hashWithSHA512 = BA.convert . hashWith CHA.SHA512--hashForSignatureAlgorithm :: HashAlgorithm -> B.ByteString -> Either String B.ByteString-hashForSignatureAlgorithm ha bs =-  case ha of-    SHA1 -> Right (BA.convert (hashWith CHA.SHA1 bs))-    RIPEMD160 -> Right (BA.convert (hashWith CHA.RIPEMD160 bs))-    SHA224 -> Right (BA.convert (hashWith CHA.SHA224 bs))-    SHA256 -> Right (BA.convert (hashWith CHA.SHA256 bs))-    SHA384 -> Right (BA.convert (hashWith CHA.SHA384 bs))-    SHA512 -> Right (BA.convert (hashWith CHA.SHA512 bs))-    SHA3_256 -> Right (BA.convert (hashWith CHA.SHA3_256 bs))-    SHA3_512 -> Right (BA.convert (hashWith CHA.SHA3_512 bs))-    DeprecatedMD5 -> Right (BA.convert (hashWith CHA.MD5 bs))-    _ -> Left ("unsupported hash algorithm for left16 derivation: " ++ show ha)--left16FromHashPrefix :: B.ByteString -> Either String Word16-left16FromHashPrefix bs-  | B.length bs >= 2 = Right (fromIntegral (os2ip (B.take 2 bs)))-  | otherwise = Left "hash output too short to derive left16"--left16FromSignedPayload :: HashAlgorithm -> B.ByteString -> Either String Word16-left16FromSignedPayload ha signedPayload = do-  digest <- hashForSignatureAlgorithm ha signedPayload-  left16FromHashPrefix digest--left16FromSignedPayloadForSign :: HashAlgorithm -> B.ByteString -> Either SignError Word16-left16FromSignedPayloadForSign ha =-  first SignBackendError . left16FromSignedPayload ha--ed25519Signer :: Ed25519.SecretKey -> B.ByteString -> B.ByteString-ed25519Signer sk prehash =-  BA.convert (Ed25519.sign sk (Ed25519.toPublic sk) prehash)--ed448Signer :: Ed448.SecretKey -> B.ByteString -> B.ByteString-ed448Signer sk prehash =-  BA.convert (Ed448.sign sk (Ed448.toPublic sk) prehash)--rsaPKCS15Sign ::-     HashAlgorithm-  -> RSATypes.PrivateKey-  -> B.ByteString-  -> Either SignError B.ByteString-rsaPKCS15Sign ha prv bytes =-  case ha of-    SHA1 -> first (SignBackendError . show) (P15.sign Nothing (Just CHA.SHA1) prv bytes)-    SHA224 -> first (SignBackendError . show) (P15.sign Nothing (Just CHA.SHA224) prv bytes)-    SHA256 -> first (SignBackendError . show) (P15.sign Nothing (Just CHA.SHA256) prv bytes)-    SHA384 -> first (SignBackendError . show) (P15.sign Nothing (Just CHA.SHA384) prv bytes)-    SHA512 -> first (SignBackendError . show) (P15.sign Nothing (Just CHA.SHA512) prv bytes)-    _ ->-      Left-        (SignBackendError-           ("signature hash algorithm is not supported by RSA PKCS#1 v1.5 backend: " ++-            show ha))--validateV6SaltSize :: HashAlgorithm -> SignatureSalt -> Either SignError ()-validateV6SaltSize ha salt =-  let saltBytes = BL.toStrict (unSignatureSalt salt)-      actualSaltLen = B.length saltBytes-   in case signatureV6SaltSizeForHashAlgorithm ha of-        Nothing ->-          Left-            (SignBackendError-               ("signature hash algorithm does not define a V6 salt size: " ++ show ha))-        Just expectedSaltLen ->-          if actualSaltLen == fromIntegral expectedSaltLen-            then Right ()-            else Left (SignV6SaltSizeMismatch ha expectedSaltLen actualSaltLen)--signEdDSAV4 ::-     String-  -> Int-  -> Int-  -> (B.ByteString -> B.ByteString)-  -> TextNormalizationMode-  -> SigType-  -> PubKeyAlgorithm-  -> HashAlgorithm-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> ByteString-  -> Either SignError SignaturePayload-signEdDSAV4 algoName sigLen limbLen signer mode st pka ha has uhas payload = do-  let normalizedPayload = normalizePayloadForSigTypeWith mode st payload-      sig0 = SigV4 st pka ha has [] 0 (NE.fromList [MPI 0, MPI 0])-      prehash =-        hashWithSHA512-          (BL.toStrict (finalPayload (SignaturePkt sig0) normalizedPayload))-      sigBytes = signer prehash-  if B.length sigBytes /= sigLen-    then Left (SignProducedWrongLength algoName sigLen (B.length sigBytes))-    else-      let (r, s) = B.splitAt limbLen sigBytes-       in (\left16 ->-             SigV4-               st-               pka-               ha-               has-               uhas-               left16-               (NE.fromList [MPI (os2ip r), MPI (os2ip s)]))-            <$> first SignBackendError (left16FromHashPrefix prehash)--signEdDSAV6 ::-     String-  -> Int-  -> Int-  -> (B.ByteString -> B.ByteString)-  -> TextNormalizationMode-  -> SigType-  -> PubKeyAlgorithm-  -> HashAlgorithm-  -> SignatureSalt-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> ByteString-  -> Either SignError SignaturePayload-signEdDSAV6 algoName sigLen limbLen signer mode st pka ha salt has uhas payload = do-  validateV6SaltSize ha salt-  let normalizedPayload = normalizePayloadForSigTypeWith mode st payload-      sig0 = SigV6 st pka ha salt has [] 0 (NE.fromList [MPI 0, MPI 0])-      prehash =-        hashWithSHA512-          (BL.toStrict (finalPayload (SignaturePkt sig0) normalizedPayload))-      sigBytes = signer prehash-  if B.length sigBytes /= sigLen-    then Left (SignProducedWrongLength algoName sigLen (B.length sigBytes))-    else-      let (r, s) = B.splitAt limbLen sigBytes-       in (\left16 ->-             SigV6-               st-               pka-               ha-               salt-               has-               uhas-               left16-               (NE.fromList [MPI (os2ip r), MPI (os2ip s)]))-            <$> first SignBackendError (left16FromHashPrefix prehash)--signUserIDwithRSA :: SomePKPayload -- ^ public key "payload" of user ID being signed-  -> UserId -- ^ user ID being signed-  -> [SigSubPacket] -- ^ hashed signature subpackets-  -> [SigSubPacket] -- ^ unhashed signature subpackets-  -> RSATypes.PrivateKey -- ^ RSA signing key-  -> Either SignError SignaturePayload-signUserIDwithRSA = signCertificationWithRSA PositiveCert--signCertificationWithRSA ::-     SigType -- ^ certification type (GenericCert, PersonaCert, CasualCert, PositiveCert)-  -> SomePKPayload -- ^ public key "payload" of user ID being signed-  -> UserId -- ^ user ID being signed-  -> [SigSubPacket] -- ^ hashed signature subpackets-  -> [SigSubPacket] -- ^ unhashed signature subpackets-  -> RSATypes.PrivateKey -- ^ RSA signing key-  -> Either SignError SignaturePayload-signCertificationWithRSA st pkp uid hsigsubs usigsubs prv-  | st `elem` [GenericCert, PersonaCert, CasualCert, PositiveCert] = do-  let payloadToSign = BL.toStrict (finalPayload (SignaturePkt uidsigp) uidpayload)-  uidsigp'-    <$> left16FromSignedPayloadForSign SHA512 payloadToSign-    <*> first-          (SignBackendError . show)-          (P15.sign-             Nothing-             (Just CHA.SHA512)-             prv-             payloadToSign)-  | otherwise =-    Left (SignUnsupportedCertificationType st)-  where-    uidpayload =-      runPut-        (sequence_-           [putKeyforSigning (PublicKeyPkt pkp), putUforSigning (toPkt uid)])-    uidsigp =-      SigV4 st RSA SHA512 hsigsubs usigsubs 0 (NE.fromList [MPI 0])-    uidsigp' left16 us =-      SigV4-        st-        RSA-        SHA512-        hsigsubs-        usigsubs-        left16-        (NE.fromList [MPI (os2ip us)])--signDirectKeyWithRSA ::-     SigType -- ^ key-scoped signature type (SignatureDirectlyOnAKey or KeyRevocationSig)-  -> SomePKPayload -- ^ primary key "payload" being signed-  -> [SigSubPacket] -- ^ hashed signature subpackets-  -> [SigSubPacket] -- ^ unhashed signature subpackets-  -> RSATypes.PrivateKey -- ^ RSA signing key-  -> Either SignError SignaturePayload-signDirectKeyWithRSA st pkp hsigsubs usigsubs prv-  | st `elem` [SignatureDirectlyOnAKey, KeyRevocationSig] =-    signDataWithRSA st prv hsigsubs usigsubs keypayload-  | otherwise =-    Left (SignUnsupportedKeySignatureType st)-  where-    keypayload = runPut (putKeyforSigning (PublicKeyPkt pkp))--signKeyRevocationWithRSA :: SomePKPayload -- ^ primary key "payload" being revoked-  -> [SigSubPacket] -- ^ hashed signature subpackets-  -> [SigSubPacket] -- ^ unhashed signature subpackets-  -> RSATypes.PrivateKey -- ^ RSA signing key-  -> Either SignError SignaturePayload-signKeyRevocationWithRSA = signDirectKeyWithRSA KeyRevocationSig--signSubkeyRevocationWithRSA :: SomePKPayload -- ^ primary key "payload"-  -> SomePKPayload -- ^ public subkey "payload" being revoked-  -> [SigSubPacket] -- ^ hashed signature subpackets-  -> [SigSubPacket] -- ^ unhashed signature subpackets-  -> RSATypes.PrivateKey -- ^ RSA signing key-  -> Either SignError SignaturePayload-signSubkeyRevocationWithRSA pkp subpkp hsigsubs usigsubs prv =-  signDataWithRSA SubkeyRevocationSig prv hsigsubs usigsubs subkeypayload-  where-    subkeypayload =-      runPut-        (sequence_-           [ putKeyforSigning (PublicKeyPkt pkp)-           , putKeyforSigning (PublicSubkeyPkt subpkp)-           ])--signCertRevocationWithRSA :: SomePKPayload -- ^ primary key "payload"-  -> UserId -- ^ user ID certification being revoked-  -> [SigSubPacket] -- ^ hashed signature subpackets-  -> [SigSubPacket] -- ^ unhashed signature subpackets-  -> RSATypes.PrivateKey -- ^ RSA signing key-  -> Either SignError SignaturePayload-signCertRevocationWithRSA pkp uid hsigsubs usigsubs prv =-  signDataWithRSA CertRevocationSig prv hsigsubs usigsubs certpayload-  where-    certpayload =-      runPut-        (sequence_-           [putKeyforSigning (PublicKeyPkt pkp), putUforSigning (toPkt uid)])--crossSignSubkeyWithRSA :: SomePKPayload -- ^ public key "payload" of key being signed-  -> SomePKPayload -- ^ public subkey "payload" of key being signed-  -> [SigSubPacket] -- ^ hashed signature subpackets for binding sig-  -> [SigSubPacket] -- ^ unhashed signature subpackets for binding sig-  -> [SigSubPacket] -- ^ hashed signature subpackets for embedded sig-  -> [SigSubPacket] -- ^ unhashed signature subpackets for embedded sig-  -> RSATypes.PrivateKey -- ^ RSA signing key-  -> RSATypes.PrivateKey -- ^ RSA signing subkey-  -> Either SignError SignaturePayload-crossSignSubkeyWithRSA pkp subpkp subhsigsubs subusigsubs embhsigsubs embusigsubs prv ssb = do-  let embPayloadToSign = BL.toStrict (finalPayload (SignaturePkt embsigp) subkeypayload)-      subPayloadToSign = BL.toStrict (finalPayload (SignaturePkt subsigp) subkeypayload)-  (\embleft16 subleft16 embsig subsig ->-     subsigp' (embsigp' embleft16 embsig) subleft16 subsig)-    <$> left16FromSignedPayloadForSign SHA512 embPayloadToSign-    <*> left16FromSignedPayloadForSign SHA512 subPayloadToSign-    <*> first-          (SignBackendError . show)-          (P15.sign-             Nothing-             (Just CHA.SHA512)-             ssb-             embPayloadToSign)-    <*> first-          (SignBackendError . show)-          (P15.sign-             Nothing-             (Just CHA.SHA512)-             prv-             subPayloadToSign)-  where-    subkeypayload =-      runPut-        (sequence_-           [ putKeyforSigning (PublicKeyPkt pkp)-           , putKeyforSigning (PublicSubkeyPkt subpkp)-           ])-    embsigp =-      SigV4-        PrimaryKeyBindingSig-        RSA-        SHA512-        embhsigsubs-        embusigsubs-        0-        (NE.fromList [MPI 0])-    embsigp' left16 es =-      SigV4-        PrimaryKeyBindingSig-        RSA-        SHA512-        embhsigsubs-        embusigsubs-        left16-        (NE.fromList [MPI (os2ip es)])-    subsigp =-      SigV4 SubkeyBindingSig RSA SHA512 subhsigsubs [] 0 (NE.fromList [MPI 0])-    sspes es = SigSubPacket False (EmbeddedSignature es)-    subsigp' es left16 ss =-      SigV4-        SubkeyBindingSig-        RSA-        SHA512-        subhsigsubs-        (sspes es : subusigsubs)-        left16-        (NE.fromList [MPI (os2ip ss)])--signRSAV4Core ::-     TextNormalizationMode-  -> SigType-  -> HashAlgorithm-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> RSATypes.PrivateKey-  -> ByteString-  -> Either SignError SignaturePayload-signRSAV4Core mode st ha has uhas prv payload =-  (\left16 ss -> SigV4 st RSA ha has uhas left16 (NE.fromList [MPI (os2ip ss)]))-    <$> left16FromSignedPayloadForSign ha payloadToSign-    <*> rsaPKCS15Sign ha prv payloadToSign-  where-    sig0 = SigV4 st RSA ha has [] 0 (NE.fromList [MPI 0])-    payloadToSign = BL.toStrict (finalPayload (SignaturePkt sig0) (normalizePayloadForSigTypeWith mode st payload))--signRSAV6Core ::-     TextNormalizationMode-  -> SigType-  -> HashAlgorithm-  -> SignatureSalt-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> RSATypes.PrivateKey-  -> ByteString-  -> Either SignError SignaturePayload-signRSAV6Core mode st ha salt has uhas prv payload = do-  validateV6SaltSize ha salt-  (\left16 sigBytes -> SigV6 st RSA ha salt has uhas left16 (NE.fromList [MPI (os2ip sigBytes)]))-    <$> left16FromSignedPayloadForSign ha payloadToSign-    <*> rsaPKCS15Sign ha prv payloadToSign-  where-    sig0 = SigV6 st RSA ha salt has [] 0 (NE.fromList [MPI 0])-    payloadToSign = BL.toStrict (finalPayload (SignaturePkt sig0) (normalizePayloadForSigTypeWith mode st payload))--signDataWithRSA ::-     SigType-  -> RSATypes.PrivateKey-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithRSA st prv has uhas payload =-  signRSAV4Core CleartextCompat st SHA512 has uhas prv payload--signDataWithRSAV6 ::-     SigType-  -> SignatureSalt-  -> RSATypes.PrivateKey-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithRSAV6 st salt prv has uhas payload =-  signRSAV6Core CleartextCompat st SHA512 salt has uhas prv payload---- FIXME: clean this up-ed25519Params, ed25519LegacyParams, ed448Params :: (String, Int, Int, PubKeyAlgorithm)-ed25519Params = ("Ed25519", 64, 32, PKA.Ed25519)-ed25519LegacyParams = ("Ed25519Legacy", 64, 32, PKA.EdDSA)-ed448Params = ("Ed448", 114, 57, PKA.Ed448)--signDataWithEdDSAV4Generic ::-     (String, Int, Int, PubKeyAlgorithm)-  -> (B.ByteString -> B.ByteString)-  -> TextNormalizationMode-  -> HashAlgorithm-  -> SigType-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithEdDSAV4Generic (algoName, sigLen, limbLen, pka) signer mode ha st has uhas payload =-  signEdDSAV4 algoName sigLen limbLen signer mode st pka ha has uhas payload--signDataWithEdDSAV6Generic ::-     (String, Int, Int, PubKeyAlgorithm)-  -> (B.ByteString -> B.ByteString)-  -> TextNormalizationMode-  -> HashAlgorithm-  -> SigType-  -> SignatureSalt-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithEdDSAV6Generic (algoName, sigLen, limbLen, pka) signer mode ha st salt has uhas payload =-  signEdDSAV6 algoName sigLen limbLen signer mode st pka ha salt has uhas payload--signDataWithEd25519 ::-     SigType-  -> Ed25519.SecretKey-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithEd25519 st sk has uhas payload =-  signDataWithEdDSAV4Generic ed25519Params (ed25519Signer sk) CleartextCompat SHA512 st has uhas payload--signDataWithEd25519Legacy ::-     SigType-  -> Ed25519.SecretKey-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithEd25519Legacy st sk has uhas payload =-  signDataWithEdDSAV4Generic ed25519LegacyParams (ed25519Signer sk) CleartextCompat SHA512 st has uhas payload--signDataWithEd25519V6 ::-     SigType-  -> SignatureSalt-  -> Ed25519.SecretKey-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithEd25519V6 st salt sk has uhas payload =-  signDataWithEdDSAV6Generic ed25519Params (ed25519Signer sk) CleartextCompat SHA512 st salt has uhas payload--signDataWithEd448 ::-     SigType-  -> Ed448.SecretKey-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithEd448 st sk has uhas payload =-  signDataWithEdDSAV4Generic ed448Params (ed448Signer sk) CleartextCompat SHA512 st has uhas payload--signDataWithEd448V6 ::-     SigType-  -> SignatureSalt-  -> Ed448.SecretKey-  -> [SigSubPacket]-  -> [SigSubPacket]-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithEd448V6 st salt sk has uhas payload =-  signDataWithEdDSAV6Generic ed448Params (ed448Signer sk) CleartextCompat SHA512 st salt has uhas payload---- | Builder-based signature creation for RSA--- --- Example usage:---   builder <- sigBuilderInit BinarySig RSA SHA512---   builder' <- addHashedSubs hashedSubpackets builder---   builder'' <- addUnhashedSubs unhashedSubpackets builder'---   sig <- signDataWithRSABuilder builder'' rsaPrivateKey payload-signDataWithRSABuilder ::-     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig 'PKA.RSA-  -> RSATypes.PrivateKey-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithRSABuilder builder prv payload =-  signRSAV4Core-    (sbTextNormMode builder)-    (sbSigType builder)-    (sbHashAlgo builder)-    (sbHashedSubs builder)-    (sbUnhashedSubs builder)-    prv-    payload---- | Builder-based signature creation for RSA (v6)-signDataWithRSAV6Builder ::-     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V6Sig 'PKA.RSA-  -> RSATypes.PrivateKey-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithRSAV6Builder builder prv payload =-  signRSAV6Core-    (sbTextNormMode builder)-    (sbSigType builder)-    (sbHashAlgo builder)-    (sbSalt builder)-    (sbHashedSubs builder)-    (sbUnhashedSubs builder)-    prv-    payload---- | Builder-based signature creation for Ed25519 (v4)------ Example usage:---   builder <- sigBuilderInit BinarySig Ed25519 SHA512---   builder' <- addHashedSubs hashedSubpackets builder---   builder'' <- addUnhashedSubs unhashedSubpackets builder'---   sig <- signDataWithEd25519Builder builder'' ed25519PrivateKey payload-signDataWithEd25519Builder ::-     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig 'PKA.Ed25519-  -> Ed25519.SecretKey-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithEd25519Builder builder sk payload =-  signDataWithEdDSAV4Generic ed25519Params (ed25519Signer sk)-    (sbTextNormMode builder) (sbHashAlgo builder) (sbSigType builder)-    (sbHashedSubs builder) (sbUnhashedSubs builder) payload---- | Builder-based signature creation for Ed25519 (v6)------ Example usage:---   builder <- sigBuilderInitV6 BinarySig Ed25519 SHA512 salt---   builder' <- addHashedSubs hashedSubpackets builder---   builder'' <- addUnhashedSubs unhashedSubpackets builder'---   sig <- signDataWithEd25519V6Builder builder'' ed25519PrivateKey payload-signDataWithEd25519V6Builder ::-     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V6Sig 'PKA.Ed25519-  -> Ed25519.SecretKey-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithEd25519V6Builder builder sk payload =-  signDataWithEdDSAV6Generic ed25519Params (ed25519Signer sk)-    (sbTextNormMode builder) (sbHashAlgo builder) (sbSigType builder)-    (sbSalt builder) (sbHashedSubs builder) (sbUnhashedSubs builder) payload---- | Builder-based signature creation for Ed448 (v4)------ Example usage:---   builder <- sigBuilderInit BinarySig Ed448 SHA512---   builder' <- addHashedSubs hashedSubpackets builder---   builder'' <- addUnhashedSubs unhashedSubpackets builder'---   sig <- signDataWithEd448Builder builder'' ed448PrivateKey payload-signDataWithEd448Builder ::-     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig 'PKA.Ed448-  -> Ed448.SecretKey-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithEd448Builder builder sk payload =-  signDataWithEdDSAV4Generic ed448Params (ed448Signer sk)-    (sbTextNormMode builder) (sbHashAlgo builder) (sbSigType builder)-    (sbHashedSubs builder) (sbUnhashedSubs builder) payload---- | Builder-based signature creation for Ed448 (v6)-signDataWithEd448V6Builder ::-     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V6Sig 'PKA.Ed448-  -> Ed448.SecretKey-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithEd448V6Builder builder sk payload =-  signDataWithEdDSAV6Generic ed448Params (ed448Signer sk)-    (sbTextNormMode builder) (sbHashAlgo builder) (sbSigType builder)-    (sbSalt builder) (sbHashedSubs builder) (sbUnhashedSubs builder) payload---- | Algorithm-agnostic signature builder dispatcher (Phase 2)--- --- Dispatches to the appropriate signing function based on the private key type.--- The private key type (PrivateKeyFor algo) encodes the algorithm at the type level,--- allowing compile-time verification that the key and builder algorithm match.------ Example usage:-class BuilderSigningAlgorithm (algo :: PKA.PubKeyAlgorithm) where-  signDataWithAlgorithmicBuilderImpl-    :: SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig algo-    -> PrivateKeyFor algo-    -> ByteString-    -> Either SignError SignaturePayload--instance BuilderSigningAlgorithm 'PKA.RSA where-  signDataWithAlgorithmicBuilderImpl builder (SP.RSAPrivateKey prv) payload =-    signDataWithRSABuilder builder prv payload--instance BuilderSigningAlgorithm 'PKA.Ed25519 where-  signDataWithAlgorithmicBuilderImpl builder (SP.Ed25519PrivateKey sk) payload =-    signDataWithEd25519Builder builder sk payload--instance BuilderSigningAlgorithm 'PKA.Ed448 where-  signDataWithAlgorithmicBuilderImpl builder (SP.Ed448PrivateKey sk) payload =-    signDataWithEd448Builder builder sk payload---- | Catch-all instance that produces a compile-time error for any algorithm--- that is not supported by the algorithmic builder (e.g. DSA, ECDSA).-instance {-# OVERLAPPABLE #-}-  TypeError-    ( 'Text "signDataWithAlgorithmicBuilder does not support this algorithm."-    ':$$: 'Text "Supported algorithms: RSA, Ed25519, Ed448."-    ':$$: 'Text "For DSA or ECDSA, use signDataWith{DSA,ECDSA}Builder directly."-    )-  => BuilderSigningAlgorithm algo where-  signDataWithAlgorithmicBuilderImpl = error "unreachable: TypeError fires at compile time"--signDataWithAlgorithmicBuilder-  :: forall (algo :: PKA.PubKeyAlgorithm)-   . BuilderSigningAlgorithm algo-  => SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig algo-  -> PrivateKeyFor algo-  -> ByteString-  -> Either SignError SignaturePayload-signDataWithAlgorithmicBuilder =-  signDataWithAlgorithmicBuilderImpl+{-# LANGUAGE ConstraintKinds #-}+-- Signatures.hs: OpenPGP (RFC9580) signature verification+-- Copyright © 2012-2026  Clint Adams+-- This software is released under the terms of the Expat license.+-- (See the LICENSE file).+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Codec.Encryption.OpenPGP.Signatures+    ( SignError (..)+    , renderSignError+    , CertificationState (..)+    , certificationStateAt+    , VerificationError (..)+    , renderVerificationError+    , verifySigWith+    , verifyAgainstKeyring+    , verifyAgainstKeys+    , verifyAgainstKeysWithPolicy+    , verifyAgainstPKPs+    , verifyAgainstPKPsWithPolicy+    , verifyTKWith+    , verifyUnknownTKWith+    , signCertificationWithRSA+    , signDirectKeyWithRSA+    , signKeyRevocationWithRSA+    , signSubkeyRevocationWithRSA+    , signCertRevocationWithRSA+    , signUserIDwithRSA+    , crossSignSubkeyWithRSA+    , signDataWithEd25519+    , signDataWithEd25519Legacy+    , signDataWithEd25519V6+    , signDataWithEd448+    , signDataWithEd448V6+    , signDataWithRSA+    , signDataWithRSAV6++      -- * Builder-based API (Phase 2)+    , signDataWithRSABuilder+    , signDataWithRSAV6Builder+    , signDataWithEd25519Builder+    , signDataWithEd25519V6Builder+    , signDataWithEd448Builder+    , signDataWithEd448V6Builder+    , signDataWithAlgorithmicBuilder++      -- * Text normalization mode+    , TextNormalizationMode (..)+    ) where++import Control.Applicative ((<|>))+import Control.Error.Util (hush)+import Control.Lens ((&), (^.), _1)+import Control.Monad (liftM2, when)+import Crypto.Error (eitherCryptoError)+import Crypto.Hash (hashWith)+import qualified Crypto.Hash.Algorithms as CHA+import Crypto.Number.Serialize (i2osp, os2ip)+import qualified Crypto.PubKey.DSA as DSA+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.RSA.PKCS15 as P15+import qualified Crypto.PubKey.RSA.Types as RSATypes+import Data.Bifunctor (first)+import Data.Binary.Put (runPut)+import qualified Data.ByteArray as BA+import qualified Data.ByteString as B+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BL+import Data.Either (isRight, lefts, rights)+import Data.Function (on)+import Data.IxSet.Typed ((@=))+import qualified Data.IxSet.Typed as IxSet+import Data.List (find, intercalate, nub)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as Map+import Data.Maybe (isJust, mapMaybe)+import qualified Data.Set as Set+import Data.Text (Text)+import Data.Time.Clock (UTCTime (..), addUTCTime, diffUTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Word (Word16, Word8)+import GHC.TypeLits (ErrorMessage (..), TypeError)++import Codec.Encryption.OpenPGP.Expirations+    ( isPKTimeValidWithSelfSignatures+    , keyStateAt+    , keyStateValid+    )+import Codec.Encryption.OpenPGP.Fingerprint+    ( eightOctetKeyID+    , fingerprint+    )+import Codec.Encryption.OpenPGP.Internal+    ( PktStreamContext (..)+    , emptyPSC+    , issuer+    , issuerFP+    )+import Codec.Encryption.OpenPGP.Ontology+    ( isCertRevocationSig+    , isRevocationKeySSP+    , isRevokerP+    , isSubkeyBindingSig+    , isSubkeyRevocation+    )+import Codec.Encryption.OpenPGP.Policy+    ( VerificationPolicy (..)+    , VerificationPolicyAction (..)+    , applyVerificationPolicy+    , defaultVerificationPolicy+    , isVerificationError+    , isVerificationWarning+    , signatureV6SaltSizeForHashAlgorithm+    )+import Codec.Encryption.OpenPGP.SerializeForSigs+    ( payloadForSig+    , putKeyforSigning+    , putPartialSigforSigning+    , putSigTrailer+    , putUforSigning+    )+import Codec.Encryption.OpenPGP.SignatureQualities+    ( sigCT+    , sigHA+    , sigPKA+    , sigType+    , signatureHashedSubpacketsKnown+    , signatureSubpacketListsKnown+    )+import Codec.Encryption.OpenPGP.Subpackets+    ( PrivateKeyFor+    , SigBuilder+    , TextNormalizationMode (..)+    , sbHashAlgo+    , sbHashedSubs+    , sbSalt+    , sbSigType+    , sbTextNormMode+    , sbUnhashedSubs+    )+import qualified Codec.Encryption.OpenPGP.Subpackets as SP+import Codec.Encryption.OpenPGP.Types+import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA+import Codec.Encryption.OpenPGP.Types.Internal.Pkt+    ( VerificationWarning (..)+    )+import Data.Conduit.OpenPGP.Keyring.Instances ()++data VerificationError+    = IssuerSubpacketMismatch+    | IssuerSubpacketUncheckable String+    | IssuerKeyIdProhibitedInV6Signature+    | IssuerFingerprintSubpacketMismatch+    | UnsupportedCriticalSubpacket SigType+    | UnknownCriticalPacketInStream Word8+    | BrokenCriticalPacketInStream Word8 String+    | ExternalVerificationError String+    | NonSignaturePacket+    | UnexpectedSignaturePayloadShape+    | MissingHashAlgorithm+    | HashComputationFailed String+    | UnexpectedKeyVersion+    | SignatureHashUnsupportedByAlgorithm HashAlgorithm PubKeyAlgorithm+    | KeyRevoked+    | SigningKeyUnavailableAtSignatureTime+    | MissingIssuer+    | SigningKeyNotFound (Maybe EightOctetKeyId) (Maybe Fingerprint)+    | MultipleVerificationSuccesses Int+    | UnsupportedKeyType PubKeyAlgorithm+    | SignatureMismatch PubKeyAlgorithm Fingerprint+    | SignatureShapeMismatch PubKeyAlgorithm+    | SignatureEncodingInvalid PubKeyAlgorithm String+    | SignaturePolicyHashUnsupported HashAlgorithm+    | SignaturePolicyPKAMismatch PubKeyAlgorithm PubKeyAlgorithm+    | SignatureExpired+    | CandidateKeyFailures [VerificationError]+    | {- | An embedded primary-key back-signature (type 0x19) in a subkey+      binding signature failed to verify.+      -}+      InvalidSubkeyBackSignature VerificationError+    deriving (Eq, Show)++data CertificationState+    = CertificationNotYetKnown+    | CertificationActive+    | CertificationRevoked+    deriving (Eq, Show)++renderVerificationError :: VerificationError -> String+renderVerificationError IssuerSubpacketMismatch =+    "verification failed: issuer subpacket does not match the actual signer"+renderVerificationError (IssuerSubpacketUncheckable err) =+    "verification failed: issuer subpacket cannot be checked ("+        ++ err+        ++ ")"+renderVerificationError IssuerKeyIdProhibitedInV6Signature =+    "verification failed: Issuer Key ID subpacket is prohibited in v6 signatures"+renderVerificationError IssuerFingerprintSubpacketMismatch =+    "verification failed: issuer fingerprint subpacket does not match the actual signer"+renderVerificationError (UnsupportedCriticalSubpacket sigType) =+    "verification failed: unsupported critical hashed subpacket in "+        ++ show sigType+        ++ " signature"+renderVerificationError (UnknownCriticalPacketInStream t) =+    "verification failed: unknown critical packet type in packet sequence ("+        ++ show t+        ++ ")"+renderVerificationError (BrokenCriticalPacketInStream t err) =+    "verification failed: broken critical packet type "+        ++ show t+        ++ ": "+        ++ err+renderVerificationError (ExternalVerificationError err) = err+renderVerificationError NonSignaturePacket =+    "verification failed: non-signature packet encountered where signature was expected"+renderVerificationError UnexpectedSignaturePayloadShape =+    "verification failed: unexpected signature payload shape"+renderVerificationError MissingHashAlgorithm =+    "verification failed: signature payload is missing hash algorithm"+renderVerificationError (HashComputationFailed err) =+    "verification failed: hash computation error (" ++ err ++ ")"+renderVerificationError UnexpectedKeyVersion =+    "verification failed: signing key has unexpected version (only v4 and v6 are supported)"+renderVerificationError (SignatureHashUnsupportedByAlgorithm ha pka) =+    "verification failed: hash algorithm "+        ++ show ha+        ++ " is not supported by "+        ++ show pka+        ++ " signing backend"+renderVerificationError KeyRevoked =+    "verification failed: signing key is revoked"+renderVerificationError SigningKeyUnavailableAtSignatureTime =+    "verification failed: signing key was not valid at the signature creation time"+renderVerificationError MissingIssuer =+    "verification failed: signature is missing issuer information"+renderVerificationError (SigningKeyNotFound meoki mfp) =+    "verification failed: signing key not found in keyring"+        ++ issuerContext meoki mfp+renderVerificationError (MultipleVerificationSuccesses n) =+    "verification failed: multiple successful key matches ("+        ++ show n+        ++ ")"+renderVerificationError (UnsupportedKeyType pka) =+    "verification failed: unsupported public key algorithm for verification ("+        ++ show pka+        ++ ")"+renderVerificationError (SignatureMismatch pka fpr) =+    "verification failed: "+        ++ show pka+        ++ " signature mismatch (signer "+        ++ show fpr+        ++ ")"+renderVerificationError (SignatureShapeMismatch pka) =+    "verification failed: malformed "+        ++ show pka+        ++ " signature encoding"+renderVerificationError (SignatureEncodingInvalid pka err) =+    "verification failed: invalid "+        ++ show pka+        ++ " key/signature encoding ("+        ++ err+        ++ ")"+renderVerificationError (SignaturePolicyHashUnsupported ha) =+    "verification failed: unsupported signature hash policy ("+        ++ show ha+        ++ ")"+renderVerificationError (SignaturePolicyPKAMismatch sigPka keyPka) =+    "verification failed: signature public-key algorithm "+        ++ show sigPka+        ++ " does not match key algorithm "+        ++ show keyPka+renderVerificationError SignatureExpired =+    "verification failed: signature expired"+renderVerificationError (CandidateKeyFailures errs) =+    "verification failed: no candidate key validated the signature ("+        ++ intercalate "; " (nub (map renderVerificationError errs))+        ++ ")"+renderVerificationError (InvalidSubkeyBackSignature err) =+    "verification failed: embedded primary-key back-signature verification failed: "+        ++ renderVerificationError err++issuerContext+    :: Maybe EightOctetKeyId -> Maybe Fingerprint -> String+issuerContext meoki mfp =+    case (meoki, mfp) of+        (Nothing, Nothing) -> ""+        _ ->+            " (issuer-keyid="+                ++ maybe "unknown" show meoki+                ++ ", issuer-fingerprint="+                ++ maybe "unknown" show mfp+                ++ ")"++verificationError+    :: VerificationError -> Either VerificationError a+verificationError = Left++renderVerificationResult+    :: Either VerificationError a -> Either String a+renderVerificationResult = first renderVerificationError++data SignError+    = SignBackendError String+    | SignUnsupportedCertificationType SigType+    | SignUnsupportedKeySignatureType SigType+    | SignV6SaltSizeMismatch HashAlgorithm Word8 Int+    | SignProducedWrongLength String Int Int+    deriving (Eq, Show)++renderSignError :: SignError -> String+renderSignError (SignBackendError err) =+    "signature backend error: " ++ err+renderSignError (SignUnsupportedCertificationType st) =+    "unsupported certification signature type: "+        ++ show st+        ++ " (expected one of GenericCert/PersonaCert/CasualCert/PositiveCert)"+renderSignError (SignUnsupportedKeySignatureType st) =+    "unsupported key signature type: "+        ++ show st+        ++ " (expected SignatureDirectlyOnAKey or KeyRevocationSig)"+renderSignError (SignV6SaltSizeMismatch ha expected actual) =+    "v6 signature salt size mismatch for "+        ++ show ha+        ++ ": expected "+        ++ show expected+        ++ ", got "+        ++ show actual+renderSignError (SignProducedWrongLength algo expected actual) =+    algo+        ++ " produced a non-"+        ++ show expected+        ++ "-byte signature (got "+        ++ show actual+        ++ ")"++data VerifiableSignatureV where+    VerifiableSignatureV4+        :: SignaturePayloadV 'SigPayloadV4 -> VerifiableSignatureV+    VerifiableSignatureV6+        :: SignaturePayloadV 'SigPayloadV6 -> VerifiableSignatureV++fromSignaturePayloadVerifiableSignatureV+    :: SignaturePayload -> Maybe VerifiableSignatureV+fromSignaturePayloadVerifiableSignatureV sigPayload =+    case toSomeSignaturePayload sigPayload of+        SomeSignaturePayload (payload@SigPayloadV4Data {}) ->+            Just (VerifiableSignatureV4 payload)+        SomeSignaturePayload (payload@SigPayloadV6Data {}) ->+            Just (VerifiableSignatureV6 payload)+        _ -> Nothing++isVerifiableSignaturePayload :: SignaturePayload -> Bool+isVerifiableSignaturePayload = isJust . fromSignaturePayloadVerifiableSignatureV++toSignaturePayloadFromVerifiable+    :: VerifiableSignatureV -> SignaturePayload+toSignaturePayloadFromVerifiable (VerifiableSignatureV4 payload) =+    toSignaturePayload payload+toSignaturePayloadFromVerifiable (VerifiableSignatureV6 payload) =+    toSignaturePayload payload++fromPktEitherVerifiableSignatureV+    :: Pkt -> Either VerificationError VerifiableSignatureV+fromPktEitherVerifiableSignatureV (SignaturePkt sigPayload) =+    case fromSignaturePayloadVerifiableSignatureV sigPayload of+        Just verifiableSig -> Right verifiableSig+        Nothing ->+            verificationError UnexpectedSignaturePayloadShape+fromPktEitherVerifiableSignatureV _ =+    verificationError NonSignaturePacket++signaturePKAAndMPIsFromClass+    :: SomeSignatureV+    -> Either VerificationError (PubKeyAlgorithm, NonEmpty MPI)+signaturePKAAndMPIsFromClass =+    fmap (\(pka, _, mpis) -> (pka, mpis))+        . signatureVerificationMaterialFromClass++signatureLeft16FromClass+    :: SomeSignatureV -> Either VerificationError Word16+signatureLeft16FromClass =+    fmap (\(_, l16, _) -> l16)+        . signatureVerificationMaterialFromClass++signatureVerificationMaterialFromClass+    :: SomeSignatureV+    -> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)+signatureVerificationMaterialFromClass (SomeSignatureV typedSig) =+    case typedSig of+        SignatureV3Packet (SigPayloadV3Data _ _ _ pka _ l16 mpis) ->+            Right (pka, l16, mpis)+        SignatureV4Packet (SigPayloadV4Data _ pka _ _ _ l16 mpis) ->+            Right (pka, l16, mpis)+        SignatureV6Packet (SigPayloadV6Data _ pka _ _ _ _ l16 mpis) ->+            Right (pka, l16, mpis)+        _ ->+            verificationError UnexpectedSignaturePayloadShape++verifySigWith+    :: VerificationPolicy+    -> ( Pkt+         -> Maybe UTCTime+         -> ByteString+         -> Either VerificationError Verification+       )+    -> Pkt+    -> PktStreamContext+    -> Maybe UTCTime+    -> Either VerificationError Verification+verifySigWith policy vf sig@(SignaturePkt _) state mt =+    case fromPktEitherVerifiableSignatureV sig of+        Right verifiableSig ->+            let (st, hs, us, checkSubpacket, checkUnhashedSubpackets) =+                    verifiableSignatureVerificationInputs verifiableSig+             in checkUnhashedSubpackets us+                    *> verifyWithSubpacketChecks+                        policy+                        vf+                        sig+                        state+                        mt+                        st+                        hs+                        checkSubpacket+        Left err ->+            Left err+  where+    checkV4Subpacket signer i@Issuer {} = checkIssuerSubpacket (eightOctetKeyID signer) i+    checkV4Subpacket signer i@IssuerFingerprint {} =+        checkIssuerFingerprintSubpacket+            PKA.IssuerFingerprintV4+            (fingerprint signer)+            i+    checkV4Subpacket _ _ = Right True+    -- RFC 9580 §5.2.3.35: v6 signatures MUST NOT include an Issuer Key ID subpacket.+    -- Treat any such subpacket as a verification error rather than merely uncheckable.+    checkV6Subpacket _ Issuer {} =+        case applyVerificationPolicy+            (vpLegacyIssuerKeyIdInV6 policy)+            "Issuer Key ID subpacket is prohibited in v6 signatures" of+            Left err -> verificationError IssuerKeyIdProhibitedInV6Signature+            Right warn -> Right True -- We don't have a warning type for this yet+    checkV6Subpacket signer i@IssuerFingerprint {} =+        checkIssuerFingerprintSubpacket+            PKA.IssuerFingerprintV6+            (fingerprint signer)+            i+    checkV6Subpacket _ _ = Right True+    rejectV6UnhashedIssuer (SigSubPacket _ Issuer {}) =+        case applyVerificationPolicy+            (vpLegacyIssuerKeyIdInV6 policy)+            "Issuer Key ID subpacket is prohibited in v6 signatures" of+            Left err -> verificationError IssuerKeyIdProhibitedInV6Signature+            Right warn -> Right () -- We don't have a warning type for this yet+    rejectV6UnhashedIssuer _ = Right ()+    verifiableSignatureVerificationInputs+        :: VerifiableSignatureV+        -> ( SigType+           , [SigSubPacket]+           , [SigSubPacket]+           , SomePKPayload+             -> SigSubPacketPayload+             -> Either VerificationError Bool+           , [SigSubPacket] -> Either VerificationError ()+           )+    verifiableSignatureVerificationInputs+        (VerifiableSignatureV4 (SigPayloadV4Data st _ _ hs us _ _)) =+            (st, hs, us, checkV4Subpacket, const (Right ()))+    verifiableSignatureVerificationInputs+        (VerifiableSignatureV6 (SigPayloadV6Data st _ _ _ hs us _ _)) =+            (st, hs, us, checkV6Subpacket, mapM_ rejectV6UnhashedIssuer)+verifySigWith _ _ _ _ _ =+    verificationError NonSignaturePacket++verifyWithSubpacketChecks+    :: VerificationPolicy+    -> ( Pkt+         -> Maybe UTCTime+         -> ByteString+         -> Either VerificationError Verification+       )+    -> Pkt+    -> PktStreamContext+    -> Maybe UTCTime+    -> SigType+    -> [SigSubPacket]+    -> ( SomePKPayload+         -> SigSubPacketPayload+         -> Either VerificationError Bool+       )+    -> Either VerificationError Verification+verifyWithSubpacketChecks policy vf sig state mt sigType hashedSubpackets checkSubpacket = do+    mapM_+        (rejectUnsupportedCriticalSubpacket policy sigType)+        hashedSubpackets+    v <- vf sig mt (payloadForSig sigType state)+    mapM_+        (checkSubpacket (v ^. verificationSigner) . _sspPayload)+        hashedSubpackets+    warnings <-+        if sigType == SubkeyBindingSig+            then verifySubkeyBackSignatures policy state mt hashedSubpackets+            else Right []+    isSignatureExpired sig mt+        *> pure+            ( v+                { _verificationWarnings =+                    _verificationWarnings v ++ warnings+                }+            )++{- | Verify embedded primary-key back-signatures (PrimaryKeyBindingSig, 0x19)+found in the hashed subpackets of a SubkeyBindingSig.++Per RFC 9580 §5.2.3.3, a signing-capable subkey MUST include an embedded+PrimaryKeyBindingSig (0x19) made by the subkey.  This requirement is+enforced strictly for v6 subkeys.  For v4 subkeys we still verify any+embedded back-sigs that are present, but do not reject a missing one —+real-world v4 signing subkeys predate the strict cross-certification+mandate and widespread interoperability requires accepting them.+-}+verifySubkeyBackSignatures+    :: VerificationPolicy+    -> PktStreamContext+    -> Maybe UTCTime+    -> [SigSubPacket]+    -> Either VerificationError [VerificationWarning]+verifySubkeyBackSignatures policy state mt hashedSubpackets = do+    subkeyPKP <-+        maybe+            (verificationError NonSignaturePacket)+            Right+            (subkeyPKPFromPkt (lastSubkey state))+    let embeddedSigs =+            [ sp+            | SigSubPacket _ (EmbeddedSignature sp) <- hashedSubpackets+            ]+        isSigningCapable =+            any+                ( \(SigSubPacket _ payload) ->+                    case payload of+                        KeyFlags flags -> SignDataKey `Set.member` flags+                        _ -> False+                )+                hashedSubpackets+        isV6Subkey = _keyVersion subkeyPKP == V6+    case embeddedSigs of+        [] ->+            -- Require back-sig only for v6 signing subkeys (RFC 9580 §5.2.3.3).+            if isSigningCapable && isV6Subkey+                then case applyVerificationPolicy+                    (vpMissingSubkeyBackSignature policy)+                    "Missing subkey back-signature (v6 signing subkey)" of+                    Left err ->+                        verificationError (SignaturePolicyHashUnsupported DeprecatedMD5) -- We'll need a better error type+                    Right warn -> Right [MissingSubkeyBackSignatureWarning]+                else Right []+        _ ->+            -- Always verify back-sigs that are present, regardless of key version.+            mapM_ (verifyOneBackSig policy subkeyPKP) embeddedSigs+                *> Right []+  where+    verifyOneBackSig vp subkeyPKP embSigPayload = do+        let embSigPkt = SignaturePkt embSigPayload+            backSigContext =+                emptyPSC+                    { lastPrimaryKey = lastPrimaryKey state+                    , lastSubkey = lastSubkey state+                    }+        case verifyAgainstKeyWithPolicy+            vp+            subkeyPKP+            embSigPkt+            mt+            (payloadForSig PrimaryKeyBindingSig backSigContext) of+            Left err -> verificationError (InvalidSubkeyBackSignature err)+            Right _ -> Right ()++rejectUnsupportedCriticalSubpacket+    :: VerificationPolicy+    -> SigType+    -> SigSubPacket+    -> Either VerificationError ()+rejectUnsupportedCriticalSubpacket policy sigType (SigSubPacket isCritical payload)+    | not isCritical = Right ()+    | not (isBindingSignatureType sigType) = Right ()+    | otherwise =+        case payload of+            UserDefinedSigSub {} ->+                case applyVerificationPolicy+                    (vpUnsupportedCriticalSubpacket policy)+                    ( "Unsupported critical subpacket in "+                        ++ show sigType+                        ++ " signature"+                    ) of+                    Left err -> verificationError (UnsupportedCriticalSubpacket sigType)+                    Right warn -> Right () -- We don't have a warning type for this yet+            OtherSigSub {} ->+                case applyVerificationPolicy+                    (vpUnsupportedCriticalSubpacket policy)+                    ( "Unsupported critical subpacket in "+                        ++ show sigType+                        ++ " signature"+                    ) of+                    Left err -> verificationError (UnsupportedCriticalSubpacket sigType)+                    Right warn -> Right ()+            _ -> Right ()++isBindingSignatureType :: SigType -> Bool+isBindingSignatureType SubkeyBindingSig = True+isBindingSignatureType PrimaryKeyBindingSig = True+isBindingSignatureType _ = False++checkIssuerSubpacket+    :: Either String EightOctetKeyId+    -> SigSubPacketPayload+    -> Either VerificationError Bool+checkIssuerSubpacket (Right signer) (Issuer i)+    | signer == i = Right True+    | otherwise = verificationError IssuerSubpacketMismatch+checkIssuerSubpacket (Left err) (Issuer _) =+    verificationError (IssuerSubpacketUncheckable err)+checkIssuerSubpacket _ _ = Right True++checkIssuerFingerprintSubpacket+    :: IssuerFingerprintVersion+    -> Fingerprint+    -> SigSubPacketPayload+    -> Either VerificationError Bool+checkIssuerFingerprintSubpacket expectedVersion signer (IssuerFingerprint kv i)+    | kv /= expectedVersion =+        verificationError IssuerFingerprintSubpacketMismatch+    | signer == i = Right True+    | otherwise =+        verificationError IssuerFingerprintSubpacketMismatch+checkIssuerFingerprintSubpacket _ _ _ = Right True++verifyTKWith+    :: ( Pkt+         -> PktStreamContext+         -> Maybe UTCTime+         -> Either VerificationError Verification+       )+    -> Maybe UTCTime+    -> TK k+    -> Either VerificationError (TK k)+verifyTKWith vsf mt tk = do+    verifiedUnknown <- verifyUnknownTKWith vsf mt (tkToUnknown tk)+    let typedSubkeys =+            Map.fromList [(keyPktToPkt kp, kp) | (kp, _) <- tk ^. tkSubs]+        verifiedTypedSubkeys =+            mapMaybe+                ( \(pkt, sigs) -> (\kp -> (kp, sigs)) <$> Map.lookup pkt typedSubkeys+                )+                (verifiedUnknown ^. tkuSubs)+    pure+        TK+            { _tkPrimaryKey = tk ^. tkPrimaryKey+            , _tkRevs = verifiedUnknown ^. tkuRevs+            , _tkUIDs = verifiedUnknown ^. tkuUIDs+            , _tkUAts = verifiedUnknown ^. tkuUAts+            , _tkSubs = verifiedTypedSubkeys+            }++verifyUnknownTKWith+    :: ( Pkt+         -> PktStreamContext+         -> Maybe UTCTime+         -> Either VerificationError Verification+       )+    -> Maybe UTCTime+    -> TKUnknown+    -> Either VerificationError TKUnknown+verifyUnknownTKWith vsf mt tk = do+    revokers <- checkRevokers tk+    revs <- checkKeyRevocations revokers tk+    let uids = filter (not . null . snd) . checkUidSigs $ tk ^. tkuUIDs+    let uats = filter (not . null . snd) . checkUAtSigs $ tk ^. tkuUAts+    let subs = concatMap checkSub $ tk ^. tkuSubs+    return (TKUnknown (tk ^. tkuKey) revs uids uats subs)+  where+    checkRevokers =+        Right+            . concat+            . rights+            . map verifyRevoker+            . filter isRevokerP+            . _tkuRevs+    checkKeyRevocations+        :: [(PubKeyAlgorithm, Fingerprint)]+        -> TKUnknown+        -> Either VerificationError [SignaturePayload]+    checkKeyRevocations rs k =+        Prelude.sequence+            . concatMap (filterRevs rs)+            . rights+            . map (liftM2 fmap (,) vSig)+            $ k+                ^. tkuRevs+    checkUidSigs+        :: [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]+    checkUidSigs =+        map+            ( \(uid, sps) ->+                let verified = rights . map (\sp -> fmap ((,) sp) (vUid (uid, sp))) $ sps+                 in (uid, retainNonRevokedCertifications mt verified)+            )+    checkUAtSigs+        :: [([UserAttrSubPacket], [SignaturePayload])]+        -> [([UserAttrSubPacket], [SignaturePayload])]+    checkUAtSigs =+        map+            ( \(uat, sps) ->+                let verified = rights . map (\sp -> fmap ((,) sp) (vUAt (uat, sp))) $ sps+                 in (uat, retainNonRevokedCertifications mt verified)+            )+    checkSub+        :: (Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])]+    checkSub (pkt, sps) =+        if revokedSub pkt sps+            then []+            else checkSub' pkt sps+    revokedSub :: Pkt -> [SignaturePayload] -> Bool+    revokedSub _ [] = False+    revokedSub p sigs =+        any (vSubSig p) (filter subkeyRevocationEffective sigs)+    checkSub'+        :: Pkt -> [SignaturePayload] -> [(Pkt, [SignaturePayload])]+    checkSub' p sps =+        let goodsigs =+                filter (vSubSig p)+                    . filter signatureKnown+                    . filter isSubkeyBindingSig+                    $ sps+         in if null goodsigs+                then []+                else [(p, goodsigs)]+    getHasheds = signatureHashedSubpackets+    filterRevs+        :: [(PubKeyAlgorithm, Fingerprint)]+        -> (SignaturePayload, Verification)+        -> [Either VerificationError SignaturePayload]+    filterRevs vokers spv =+        case spv of+            (s, _)+                | isV4OrV6Sig s && sigType s == Just SignatureDirectlyOnAKey ->+                    [Right s | signatureKnown s]+            (s, v)+                | isV4OrV6Sig s+                , sigType s == Just KeyRevocationSig+                , Just pka <- sigPKA s ->+                    if (v ^. verificationSigner == tk ^. tkuKey . _1)+                        || any+                            ( \(p, f) ->+                                p == pka && f == fingerprint (v ^. verificationSigner)+                            )+                            vokers+                        then+                            if keyRevocationEffective s+                                then [verificationError KeyRevoked]+                                else [Right s | signatureKnown s]+                        else [Right s | signatureKnown s]+            _ -> []+    isV4OrV6Sig = isVerifiableSignaturePayload+    vUid+        :: (Text, SignaturePayload) -> Either VerificationError Verification+    vUid (uid, sp) =+        vsf+            (SignaturePkt sp)+            emptyPSC+                { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)+                , lastUIDorUAt = UserIdPkt uid+                }+            Nothing+    vUAt+        :: ([UserAttrSubPacket], SignaturePayload)+        -> Either VerificationError Verification+    vUAt (uat, sp) =+        vsf+            (SignaturePkt sp)+            emptyPSC+                { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)+                , lastUIDorUAt = UserAttributePkt uat+                }+            Nothing+    vSig :: SignaturePayload -> Either VerificationError Verification+    vSig sp =+        vsf+            (SignaturePkt sp)+            emptyPSC {lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)}+            Nothing+    vSubSig :: Pkt -> SignaturePayload -> Bool+    vSubSig sk sp =+        isRight+            ( vsf+                (SignaturePkt sp)+                emptyPSC+                    { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)+                    , lastSubkey = sk+                    }+                mt+            )+    verifyRevoker+        :: SignaturePayload+        -> Either VerificationError [(PubKeyAlgorithm, Fingerprint)]+    verifyRevoker sp =+        vSig sp+            *> pure+                ( map (\(SigSubPacket _ (RevocationKey _ pka fp)) -> (pka, fp))+                    . filter isRevocationKeySSP+                    $ getHasheds sp+                )+    retainNonRevokedCertifications+        :: Maybe UTCTime+        -> [(SignaturePayload, Verification)]+        -> [SignaturePayload]+    retainNonRevokedCertifications validationTime verified =+        map fst $+            filter+                ( (== CertificationActive)+                    . certificationStateAt validationTime verified+                )+                certifications+      where+        certifications = filter (not . isCertRevocationSig . fst) verified+    signatureKnown = signatureKnownAt mt+    subkeyRevocationEffective sp = isSubkeyRevocation sp && signatureEffectiveAt mt sp+    keyRevocationEffective sp+        | isHistoricalKeyRevocation sp = signatureEffectiveAt mt sp+        | otherwise = signatureUnexpiredAt mt sp++verifyAgainstKeyring+    :: PublicKeyring+    -> Pkt+    -> Maybe UTCTime+    -> ByteString+    -> Either VerificationError Verification+verifyAgainstKeyring kr sig mt payload = do+    let allKeys = map tkToUnknown (IxSet.toList kr)+        signerValidationTime = signatureCreationTimeFromPacket sig+        ikeys = (kr @=) <$> issuer sig+        ifpkeys = (kr @=) <$> issuerFP sig+        hintedKeys = maybe [] (map tkToUnknown . IxSet.toList) (ifpkeys <|> ikeys)+        hintedResult =+            if null hintedKeys+                then Left MissingIssuer+                else+                    verifyFromCandidates+                        allKeys+                        hintedKeys+                        sig+                        signerValidationTime+                        mt+                        payload+     in case hintedResult of+            Right v -> Right v+            Left hintedErr ->+                let fallbackResult =+                        verifyFromCandidates+                            allKeys+                            allKeys+                            sig+                            signerValidationTime+                            mt+                            payload+                 in if null hintedKeys+                        then case fallbackResult of+                            Right v -> Right v+                            Left _ ->+                                verificationError+                                    (SigningKeyNotFound (issuer sig) (issuerFP sig))+                        else case fallbackResult of+                            Right v -> Right v+                            Left _ -> Left hintedErr++verifyFromCandidates+    :: [TKUnknown]+    -> [TKUnknown]+    -> Pkt+    -> Maybe UTCTime+    -> Maybe UTCTime+    -> ByteString+    -> Either VerificationError Verification+verifyFromCandidates allKeys candidateTks sig signerValidationTime verificationTime payload =+    let candidateResults =+            map+                ( resolveCandidateSignerPKPs+                    allKeys+                    sig+                    signerValidationTime+                    (const True)+                )+                candidateTks+        candidateErrors = concatMap fst candidateResults+        usablePkps = concatMap snd candidateResults+     in if null usablePkps+            then+                if null candidateErrors+                    then+                        verificationError+                            (SigningKeyNotFound (issuer sig) (issuerFP sig))+                    else verificationError (CandidateKeyFailures candidateErrors)+            else case verifyAgainstPKPs usablePkps sig verificationTime payload of+                Left (CandidateKeyFailures errs)+                    | not (null candidateErrors) ->+                        verificationError+                            (CandidateKeyFailures (candidateErrors ++ errs))+                other -> other++verifyAgainstKeys+    :: [TKUnknown]+    -> Pkt+    -> Maybe UTCTime+    -> ByteString+    -> Either VerificationError Verification+verifyAgainstKeys ks sig mt payload =+    verifyAgainstKeysWithPolicy+        defaultVerificationPolicy+        ks+        sig+        mt+        payload++-- | Verify a signature against a list of keys with a custom verification policy.+verifyAgainstKeysWithPolicy+    :: VerificationPolicy+    -> [TKUnknown]+    -> Pkt+    -> Maybe UTCTime+    -> ByteString+    -> Either VerificationError Verification+verifyAgainstKeysWithPolicy policy ks sig mt payload = do+    let allpkps =+            filter+                ( \x ->+                    (((fingerprint x ==) <$> issuerFP sig) == Just True)+                        || ((==) <$> issuer sig <*> hush (eightOctetKeyID x))+                            == Just True+                )+                ( concatMap+                    ( \x ->+                        (x ^. tkuKey . _1)+                            : mapMaybe (subkeyPKPFromPkt . fst) (_tkuSubs x)+                    )+                    ks+                )+        allCandidatePkps =+            concatMap+                ( \x ->+                    (x ^. tkuKey . _1)+                        : mapMaybe (subkeyPKPFromPkt . fst) (_tkuSubs x)+                )+                ks+        normalizedCandidates+            | null allpkps = allCandidatePkps+            | otherwise = allpkps+    verifyAgainstPKPsWithPolicy+        policy+        normalizedCandidates+        sig+        mt+        payload++verifyAgainstPKPs+    :: [SomePKPayload]+    -> Pkt+    -> Maybe UTCTime+    -> ByteString+    -> Either VerificationError Verification+verifyAgainstPKPs pkps sig mt payload =+    verifyAgainstPKPsWithPolicy+        defaultVerificationPolicy+        pkps+        sig+        mt+        payload++-- | Verify a signature against a list of public key payloads with a custom verification policy.+verifyAgainstPKPsWithPolicy+    :: VerificationPolicy+    -> [SomePKPayload]+    -> Pkt+    -> Maybe UTCTime+    -> ByteString+    -> Either VerificationError Verification+verifyAgainstPKPsWithPolicy policy pkps sig mt payload =+    case rights results of+        [] -> verificationError (CandidateKeyFailures (lefts results))+        [r] -> isSignatureExpired sig mt *> pure r+        rs -> verificationError (MultipleVerificationSuccesses (length rs))+  where+    results =+        map+            (\pkp -> verifyAgainstKeyWithPolicy policy pkp sig mt payload)+            pkps++resolveCandidateSignerPKPs+    :: [TKUnknown]+    -> Pkt+    -> Maybe UTCTime+    -> (SomePKPayload -> Bool)+    -> TKUnknown+    -> ([VerificationError], [SomePKPayload])+resolveCandidateSignerPKPs _ _ Nothing matchesP tk =+    ([], filter matchesP (candidatePKPs tk))+resolveCandidateSignerPKPs allKeys _ (Just validationTime) matchesP tk =+    let rawMatches = filter matchesP (candidatePKPs tk)+     in case verifyUnknownTKWith+            ( verifySigWith+                defaultVerificationPolicy+                (verifyAgainstKeys allKeys)+            )+            (Just validationTime)+            tk of+            Left err -> (replicate (length rawMatches) err, [])+            Right verifiedTK ->+                let verifiedMatches =+                        map+                            ( \pkp ->+                                case historicallyValidSigner+                                    validationTime+                                    (timelineValidationTK pkp verifiedTK)+                                    pkp of+                                    Right () -> Right pkp+                                    Left err -> Left err+                            )+                            rawMatches+                 in (lefts verifiedMatches, rights verifiedMatches)+  where+    timelineValidationTK pkp verifiedTK'+        | fingerprint pkp == fingerprint (tk ^. tkuKey . _1) = tk+        | otherwise = verifiedTK'++candidatePKPs :: TKUnknown -> [SomePKPayload]+candidatePKPs tk =+    (tk ^. tkuKey . _1)+        : mapMaybe (subkeyPKPFromPkt . fst) (tk ^. tkuSubs)++historicallyValidSigner+    :: UTCTime+    -> TKUnknown+    -> SomePKPayload+    -> Either VerificationError ()+historicallyValidSigner validationTime tk pkp+    | fingerprint pkp == fingerprint (tk ^. tkuKey . _1) =+        if keyStateValid (keyStateAt validationTime tk)+            then Right ()+            else verificationError SigningKeyUnavailableAtSignatureTime+    | otherwise =+        case find+            ( \(pkt, _) ->+                maybe+                    False+                    ((== fingerprint pkp) . fingerprint)+                    (subkeyPKPFromPkt pkt)+            )+            (tk ^. tkuSubs) of+            Nothing -> verificationError SigningKeyUnavailableAtSignatureTime+            Just (subPkt, sigs) ->+                case subkeyPKPFromPkt subPkt of+                    Nothing -> verificationError SigningKeyUnavailableAtSignatureTime+                    Just subPKP ->+                        if isPKTimeValidWithSelfSignatures validationTime subPKP sigs+                            then Right ()+                            else verificationError SigningKeyUnavailableAtSignatureTime++signatureCreationTimeFromPacket :: Pkt -> Maybe UTCTime+signatureCreationTimeFromPacket (SignaturePkt sigPayload) = signatureCreationTime sigPayload+signatureCreationTimeFromPacket _ = Nothing++signatureCreationTime :: SignaturePayload -> Maybe UTCTime+signatureCreationTime =+    fmap+        (posixSecondsToUTCTime . realToFrac . unThirtyTwoBitTimeStamp)+        . sigCT++signatureKnownAt :: Maybe UTCTime -> SignaturePayload -> Bool+signatureKnownAt Nothing _ = True+signatureKnownAt (Just validationTime) sigPayload =+    maybe+        False+        (<= validationTime)+        (signatureCreationTime sigPayload)++signatureEffectiveAt :: Maybe UTCTime -> SignaturePayload -> Bool+signatureEffectiveAt Nothing _ = True+signatureEffectiveAt (Just validationTime) sigPayload =+    signatureKnownAt (Just validationTime) sigPayload+        && maybe+            True+            (validationTime <)+            (signatureExpirationTime sigPayload)++signatureUnexpiredAt :: Maybe UTCTime -> SignaturePayload -> Bool+signatureUnexpiredAt Nothing _ = True+signatureUnexpiredAt (Just validationTime) sigPayload =+    maybe+        True+        (validationTime <)+        (signatureExpirationTime sigPayload)++signatureExpirationTime :: SignaturePayload -> Maybe UTCTime+signatureExpirationTime sigPayload =+    addDurationToTime+        <$> signatureCreationTime sigPayload+        <*> signatureExpirationDuration sigPayload++signatureExpirationDuration+    :: SignaturePayload -> Maybe ThirtyTwoBitDuration+signatureExpirationDuration sigPayload =+    signatureHashedSubpacketsKnown sigPayload+        >>= firstSignatureExpirationDuration++firstSignatureExpirationDuration+    :: [SigSubPacket] -> Maybe ThirtyTwoBitDuration+firstSignatureExpirationDuration =+    foldr+        ( \subpacket acc ->+            case subpacket of+                SigSubPacket _ (SigExpirationTime duration) -> Just duration+                _ -> acc+        )+        Nothing++addDurationToTime :: UTCTime -> ThirtyTwoBitDuration -> UTCTime+addDurationToTime baseTime duration =+    addUTCTime+        (fromIntegral (unThirtyTwoBitDuration duration))+        baseTime++certificationStateAt+    :: Maybe UTCTime+    -> [(SignaturePayload, Verification)]+    -> (SignaturePayload, Verification)+    -> CertificationState+certificationStateAt validationTime verified certification@(certificationSig, _)+    | not (signatureKnownAt validationTime certificationSig) =+        CertificationNotYetKnown+    | not (signatureEffectiveAt validationTime certificationSig) =+        CertificationRevoked+    | any (`revokesCertification` certification) visibleRevocations =+        CertificationRevoked+    | otherwise = CertificationActive+  where+    visibleRevocations =+        filter+            (signatureEffectiveAt validationTime . fst)+            (filter (isCertRevocationSig . fst) verified)++revokesCertification+    :: (SignaturePayload, Verification)+    -> (SignaturePayload, Verification)+    -> Bool+revokesCertification (revocationSig, revocationVerification) (certificationSig, certificationVerification) =+    sameSigner+        && certificationPrecedesRevocation certificationSig revocationSig+  where+    sameSigner =+        fingerprint (revocationVerification ^. verificationSigner)+            == fingerprint (certificationVerification ^. verificationSigner)++certificationPrecedesRevocation+    :: SignaturePayload -> SignaturePayload -> Bool+certificationPrecedesRevocation certificationSig revocationSig =+    case ( signatureCreationTime certificationSig+         , signatureCreationTime revocationSig+         ) of+        (Just certificationTime, Just revocationTime) ->+            certificationTime < revocationTime+        _ -> False++isHistoricalKeyRevocation :: SignaturePayload -> Bool+isHistoricalKeyRevocation sigPayload =+    case revocationReasonCode sigPayload of+        Just KeySuperseded -> True+        Just KeyRetiredAndNoLongerUsed -> True+        Just UserIdInfoNoLongerValid -> True+        _ -> False++revocationReasonCode :: SignaturePayload -> Maybe RevocationCode+revocationReasonCode sigPayload =+    ( \(SigSubPacket _ (ReasonForRevocation reasonCode _)) -> reasonCode+    )+        <$> find isReasonForRevocation (signatureSubpackets sigPayload)+  where+    isReasonForRevocation (SigSubPacket _ ReasonForRevocation {}) = True+    isReasonForRevocation _ = False++signatureSubpackets :: SignaturePayload -> [SigSubPacket]+signatureSubpackets sigPayload =+    case signatureSubpacketListsKnown sigPayload of+        Just (hashed, unhashed) -> hashed ++ unhashed+        Nothing -> []++signatureHashedSubpackets :: SignaturePayload -> [SigSubPacket]+signatureHashedSubpackets sigPayload =+    maybe [] id (signatureHashedSubpacketsKnown sigPayload)++subkeyPKPFromPkt :: Pkt -> Maybe SomePKPayload+subkeyPKPFromPkt (PublicSubkeyPkt p) = Just p+subkeyPKPFromPkt (SecretSubkeyPkt p _) = Just p+subkeyPKPFromPkt _ = Nothing++verifyAgainstKey'+    :: SomePKPayload+    -> Pkt+    -> Maybe UTCTime+    -> ByteString+    -> Either VerificationError Verification+verifyAgainstKey' pkp sig mt payload =+    verifyAgainstKeyWithPolicy+        defaultVerificationPolicy+        pkp+        sig+        mt+        payload++{- | Verify a signature against a key with a custom verification policy.+This allows callers to control whether certain signature features+(deprecated hash algorithms, PKA mismatches, etc.) are treated as+hard errors or warnings.+-}+verifyAgainstKeyWithPolicy+    :: VerificationPolicy+    -> SomePKPayload+    -> Pkt+    -> Maybe UTCTime+    -> ByteString+    -> Either VerificationError Verification+verifyAgainstKeyWithPolicy policy pkp sig mt payload = do+    sigClass <-+        either+            (verificationError . const NonSignaturePacket)+            Right+            (fromPktEitherSomeSignatureV sig)+    let sigPayload =+            case sigClass of+                SomeSignatureV typedSig -> signaturePayloadFromSignatureV typedSig+    sigHash <-+        maybe+            (verificationError MissingHashAlgorithm)+            Right+            (sigHA sigPayload)+    sigDetails <- signaturePKAAndMPIsFromClass sigClass+    warnings <- enforcePKACompatibility policy sigPayload+    hashWarnings <- enforceSignatureHashPolicy policy sigHash+    _ <- isSignatureExpired sig mt+    let signedPayload = BL.toStrict (finalPayload sig payload)+    enforceLeft16Prefix sigClass sigHash signedPayload+    ( \verifiedSigner ->+            Verification verifiedSigner sigPayload (warnings ++ hashWarnings)+        )+        <$> verify' sigDetails pkp sigHash signedPayload+  where+    enforcePKACompatibility vp sigPayload =+        let sigPka = maybe (OtherPKA 0) id (sigPKA sigPayload)+            keyPka = _pkalgo pkp+         in if pkaCompatible sigPka keyPka+                then Right []+                else case applyVerificationPolicy+                    (vpPkaMismatch vp)+                    ( "PKA mismatch: signature uses "+                        ++ show sigPka+                        ++ " but key uses "+                        ++ show keyPka+                    ) of+                    Left err -> verificationError (SignaturePolicyPKAMismatch sigPka keyPka)+                    Right warn -> Right [PkaMismatchWarning sigPka keyPka]+    enforceSignatureHashPolicy vp sigHash =+        case sigHash of+            OtherHA {} ->+                case applyVerificationPolicy+                    (vpUnsupportedHashAlgorithm vp)+                    ("Unsupported hash algorithm: " ++ show sigHash) of+                    Left err -> verificationError (SignaturePolicyHashUnsupported sigHash)+                    Right warn -> Right [UnsupportedHashAlgorithmWarning sigHash]+            DeprecatedMD5 ->+                case applyVerificationPolicy+                    (vpDeprecatedHashAlgorithm vp)+                    ("Deprecated hash algorithm: MD5") of+                    Left err -> verificationError (SignaturePolicyHashUnsupported sigHash)+                    Right warn -> Right [DeprecatedHashAlgorithmWarning sigHash]+            SHA1 ->+                case applyVerificationPolicy+                    (vpDeprecatedHashAlgorithm vp)+                    ("Deprecated hash algorithm: SHA1") of+                    Left err -> verificationError (SignaturePolicyHashUnsupported sigHash)+                    Right warn -> Right [DeprecatedHashAlgorithmWarning sigHash]+            RIPEMD160 ->+                case applyVerificationPolicy+                    (vpDeprecatedHashAlgorithm vp)+                    ("Deprecated hash algorithm: RIPEMD160") of+                    Left err -> verificationError (SignaturePolicyHashUnsupported sigHash)+                    Right warn -> Right [DeprecatedHashAlgorithmWarning sigHash]+            _ -> Right []+    enforceLeft16Prefix sigClass sigHash signedPayload = do+        expectedLeft16 <-+            either+                (verificationError . HashComputationFailed)+                Right+                (left16FromSignedPayload sigHash signedPayload)+        actualLeft16 <- signatureLeft16FromClass sigClass+        if actualLeft16 == expectedLeft16+            then Right ()+            else+                verificationError+                    (SignatureMismatch (_pkalgo pkp) (fingerprint pkp))+    pkaCompatible RSA keyPka =+        keyPka+            `elem` [RSA, DeprecatedRSAEncryptOnly, DeprecatedRSASignOnly]+    pkaCompatible DeprecatedRSASignOnly keyPka =+        keyPka `elem` [RSA, DeprecatedRSASignOnly]+    pkaCompatible PKA.EdDSA keyPka =+        keyPka `elem` [PKA.EdDSA, PKA.Ed25519, PKA.Ed448]+    pkaCompatible PKA.Ed25519 keyPka =+        keyPka `elem` [PKA.EdDSA, PKA.Ed25519]+    pkaCompatible PKA.Ed448 keyPka =+        keyPka `elem` [PKA.EdDSA, PKA.Ed448]+    pkaCompatible sigPka keyPka = sigPka == keyPka+    verify' details pub@(PKPayload V4 _ _ _ pkey) ha pl =+        verifyByHash details pub pkey ha pl+    verify' details pub@(PKPayload V6 _ _ _ pkey) ha pl =+        verifyByHash details pub pkey ha pl+    verify' _ _ _ _ =+        verificationError UnexpectedKeyVersion+    verifyByHash details pub pkey ha pl =+        case ha of+            SHA1 -> verify'' details CHA.SHA1 pub pkey pl+            RIPEMD160 -> verify'' details CHA.RIPEMD160 pub pkey pl+            SHA224 -> verify'' details CHA.SHA224 pub pkey pl+            SHA256 -> verify'' details CHA.SHA256 pub pkey pl+            SHA384 -> verify'' details CHA.SHA384 pub pkey pl+            SHA512 -> verify'' details CHA.SHA512 pub pkey pl+            SHA3_256 -> verifyNoRSA SHA3_256 details CHA.SHA3_256 pub pkey pl+            SHA3_512 -> verifyNoRSA SHA3_512 details CHA.SHA3_512 pub pkey pl+            DeprecatedMD5 -> verify'' details CHA.MD5 pub pkey pl+            _ ->+                verificationError (SignaturePolicyHashUnsupported ha)+    verify'' (DSA, mpis) hd pub (DSAPubKey (DSA_PublicKey pkey)) bs =+        dsaVerify pub mpis hd pkey bs+    verify'' (ECDSA, mpis) hd pub (ECDSAPubKey (ECDSA_PublicKey pkey)) bs =+        ecdsaVerify pub mpis hd pkey bs+    verify'' (sigPka, mpis) hd pub (EdDSAPubKey EdSigningCurve25519 pkey) bs+        | sigPka `elem` [EdDSA, PKA.Ed25519] =+            ed25519Verify sigPka pub mpis hd pkey bs+    verify'' (sigPka, mpis) hd pub (EdDSAPubKey EdSigningCurve448 pkey) bs+        | sigPka `elem` [EdDSA, PKA.Ed448] =+            ed448Verify sigPka pub mpis hd pkey bs+    verify'' (RSA, mpis) hd pub (RSAPubKey (RSA_PublicKey pkey)) bs =+        rsaVerify pub mpis hd pkey bs+    verify'' (pka, _) _ _ _ _ = verificationError (UnsupportedKeyType pka)+    verifyNoRSA ha' (DSA, mpis) hd pub (DSAPubKey (DSA_PublicKey pkey)) bs =+        dsaVerify pub mpis hd pkey bs+    verifyNoRSA ha' (ECDSA, mpis) hd pub (ECDSAPubKey (ECDSA_PublicKey pkey)) bs =+        ecdsaVerify pub mpis hd pkey bs+    verifyNoRSA ha' (sigPka, mpis) hd pub (EdDSAPubKey EdSigningCurve25519 pkey) bs+        | sigPka `elem` [EdDSA, PKA.Ed25519] =+            ed25519Verify sigPka pub mpis hd pkey bs+    verifyNoRSA ha' (sigPka, mpis) hd pub (EdDSAPubKey EdSigningCurve448 pkey) bs+        | sigPka `elem` [EdDSA, PKA.Ed448] =+            ed448Verify sigPka pub mpis hd pkey bs+    verifyNoRSA ha' (RSA, _) _ _ _ _ =+        verificationError (SignatureHashUnsupportedByAlgorithm ha' RSA)+    verifyNoRSA _ (pka, _) _ _ _ _ = verificationError (UnsupportedKeyType pka)+    dsaVerify pub (r :| [s]) hd pkey bs =+        if DSA.verify hd pkey (dsaMPIsToSig r s) bs+            then Right pub+            else verificationError (SignatureMismatch DSA (fingerprint pub))+    dsaVerify _ _ _ _ _ = verificationError (SignatureShapeMismatch DSA)+    ecdsaVerify pub (r :| [s]) hd pkey bs =+        if ECDSA.verify hd pkey (ecdsaMPIsToSig r s) bs+            then Right pub+            else+                verificationError (SignatureMismatch ECDSA (fingerprint pub))+    ecdsaVerify _ _ _ _ _ = verificationError (SignatureShapeMismatch ECDSA)+    ed25519Verify sigPka pub (r :| [s]) hd pkey bs =+        case edPointToRawPublic 32 pkey of+            Left err ->+                verificationError (SignatureEncodingInvalid sigPka err)+            Right rawPub ->+                case cf2es (Ed25519.publicKey rawPub) of+                    Left err ->+                        verificationError (SignatureEncodingInvalid sigPka err)+                    Right ep ->+                        case cf2es+                            ( Ed25519.signature+                                (pad32 (i2osp (unMPI r)) <> pad32 (i2osp (unMPI s)))+                            ) of+                            Left err ->+                                verificationError (SignatureEncodingInvalid sigPka err)+                            Right es ->+                                let prehash = crazyHash hd bs :: B.ByteString+                                 in if Ed25519.verify ep prehash es+                                        then Right pub+                                        else+                                            verificationError (SignatureMismatch sigPka (fingerprint pub))+    ed25519Verify sigPka _ _ _ _ _ =+        verificationError (SignatureShapeMismatch sigPka)+    ed448Verify sigPka pub (r :| [s]) hd pkey bs =+        case edPointToRawPublic 57 pkey of+            Left err ->+                verificationError (SignatureEncodingInvalid sigPka err)+            Right rawPub ->+                case cf2es (Ed448.publicKey rawPub) of+                    Left err ->+                        verificationError (SignatureEncodingInvalid sigPka err)+                    Right ep ->+                        case cf2es+                            ( Ed448.signature+                                (padN 57 (i2osp (unMPI r)) <> padN 57 (i2osp (unMPI s)))+                            ) of+                            Left err ->+                                verificationError (SignatureEncodingInvalid sigPka err)+                            Right es ->+                                let prehash = crazyHash hd bs :: B.ByteString+                                 in if Ed448.verify ep prehash es+                                        then Right pub+                                        else+                                            verificationError (SignatureMismatch sigPka (fingerprint pub))+    ed448Verify sigPka _ _ _ _ _ =+        verificationError (SignatureShapeMismatch sigPka)+    edPointToRawPublic expectedLen (NativeEPoint (EPoint x)) =+        exactLengthPublic expectedLen "native" (i2osp x)+    edPointToRawPublic expectedLen (PrefixedNativeEPoint (EPoint x)) = do+        prefixed <-+            exactLengthPublic (expectedLen + 1) "prefixed-native" (i2osp x)+        if B.head prefixed /= 0x40+            then+                Left+                    "prefixed-native EdDSA public key is missing the 0x40 prefix"+            else Right (B.tail prefixed)+    exactLengthPublic expectedLen label bs+        | B.length bs == expectedLen = Right bs+        | otherwise =+            Left+                ( "invalid "+                    ++ label+                    ++ " EdDSA public key length: expected "+                    ++ show expectedLen+                    ++ " octets, got "+                    ++ show (B.length bs)+                )+    pad32 bs =+        let l = B.length bs+         in if l >= 32+                then bs+                else B.replicate (32 - l) 0 <> bs+    padN n bs =+        let l = B.length bs+         in if l >= n+                then bs+                else B.replicate (n - l) 0 <> bs+    cf2es = either (Left . show) return . eitherCryptoError+    rsaVerify pub mpis hd pkey bs =+        if P15.verify (Just hd) pkey bs (rsaMPItoSig pkey mpis)+            then Right pub+            else verificationError (SignatureMismatch RSA (fingerprint pub))+    dsaMPIsToSig r s = DSA.Signature (unMPI r) (unMPI s)+    ecdsaMPIsToSig r s = ECDSA.Signature (unMPI r) (unMPI s)+    rsaMPItoSig pkey (s :| []) =+        let sz = RSATypes.public_size pkey+            raw = i2osp (unMPI s)+            pad = sz - B.length raw+         in B.replicate pad 0 <> raw+    crazyHash h = BA.convert . hashWith h++isSignatureExpired+    :: Pkt -> Maybe UTCTime -> Either VerificationError Bool+isSignatureExpired _ Nothing = return False+isSignatureExpired s (Just t) =+    do+        sigClass <-+            either+                (verificationError . const NonSignaturePacket)+                Right+                (fromPktEitherSomeSignatureV s)+        if any+            (expiredBefore t)+            ( signatureHashedSubpackets+                ( case sigClass of+                    SomeSignatureV typedSig -> signaturePayloadFromSignatureV typedSig+                )+            )+            then verificationError SignatureExpired+            else return True+  where+    expiredBefore :: UTCTime -> SigSubPacket -> Bool+    expiredBefore ct (SigSubPacket _ (SigExpirationTime et)) =+        fromEnum+            ((posixSecondsToUTCTime . toEnum . fromEnum) et `diffUTCTime` ct)+            < 0+    expiredBefore _ _ = False++finalPayload :: Pkt -> ByteString -> ByteString+finalPayload s pl = BL.concat [pl, sigbit, trailer s]+  where+    sigbit = runPut $ putPartialSigforSigning s+    trailer :: Pkt -> ByteString+    trailer (SignaturePkt sigPayload) =+        maybe+            BL.empty+            (const (runPut $ putSigTrailer s))+            (fromSignaturePayloadVerifiableSignatureV sigPayload)+    trailer _ = BL.empty++normalizePayloadForSigType :: SigType -> ByteString -> ByteString+normalizePayloadForSigType CanonicalTextSig =+    stripTrailingWhitespacePerLine . canonicalizeLineEndings+normalizePayloadForSigType _ = id++normalizePayloadForSigTypeWith+    :: TextNormalizationMode -> SigType -> ByteString -> ByteString+normalizePayloadForSigTypeWith CleartextCompat st = normalizePayloadForSigType st+normalizePayloadForSigTypeWith RFC9580Strict CanonicalTextSig = canonicalizeLineEndings+normalizePayloadForSigTypeWith RFC9580Strict _ = id++canonicalizeLineEndings :: ByteString -> ByteString+canonicalizeLineEndings = BL.pack . go . BL.unpack+  where+    go [] = []+    go (0x0d : 0x0a : rest) = 0x0d : 0x0a : go rest+    go (0x0d : rest) = 0x0d : 0x0a : go rest+    go (0x0a : rest) = 0x0d : 0x0a : go rest+    go (w : rest) = w : go rest++stripTrailingWhitespacePerLine :: ByteString -> ByteString+stripTrailingWhitespacePerLine = BL.pack . go [] . BL.unpack+  where+    go lineRev [] = reverseTrimmed lineRev+    go lineRev (0x0d : 0x0a : rest) =+        reverseTrimmed lineRev ++ [0x0d, 0x0a] ++ go [] rest+    go lineRev (w : rest) = go (w : lineRev) rest++    reverseTrimmed :: [Word8] -> [Word8]+    reverseTrimmed = reverse . dropWhile isTrailingWhitespace++    isTrailingWhitespace :: Word8 -> Bool+    isTrailingWhitespace w = w == 0x20 || w == 0x09++hashWithSHA512 :: B.ByteString -> B.ByteString+hashWithSHA512 = BA.convert . hashWith CHA.SHA512++hashForSignatureAlgorithm+    :: HashAlgorithm -> B.ByteString -> Either String B.ByteString+hashForSignatureAlgorithm ha bs =+    case ha of+        SHA1 -> Right (BA.convert (hashWith CHA.SHA1 bs))+        RIPEMD160 -> Right (BA.convert (hashWith CHA.RIPEMD160 bs))+        SHA224 -> Right (BA.convert (hashWith CHA.SHA224 bs))+        SHA256 -> Right (BA.convert (hashWith CHA.SHA256 bs))+        SHA384 -> Right (BA.convert (hashWith CHA.SHA384 bs))+        SHA512 -> Right (BA.convert (hashWith CHA.SHA512 bs))+        SHA3_256 -> Right (BA.convert (hashWith CHA.SHA3_256 bs))+        SHA3_512 -> Right (BA.convert (hashWith CHA.SHA3_512 bs))+        DeprecatedMD5 -> Right (BA.convert (hashWith CHA.MD5 bs))+        _ ->+            Left+                ("unsupported hash algorithm for left16 derivation: " ++ show ha)++left16FromHashPrefix :: B.ByteString -> Either String Word16+left16FromHashPrefix bs+    | B.length bs >= 2 = Right (fromIntegral (os2ip (B.take 2 bs)))+    | otherwise = Left "hash output too short to derive left16"++left16FromSignedPayload+    :: HashAlgorithm -> B.ByteString -> Either String Word16+left16FromSignedPayload ha signedPayload = do+    digest <- hashForSignatureAlgorithm ha signedPayload+    left16FromHashPrefix digest++left16FromSignedPayloadForSign+    :: HashAlgorithm -> B.ByteString -> Either SignError Word16+left16FromSignedPayloadForSign ha =+    first SignBackendError . left16FromSignedPayload ha++ed25519Signer+    :: Ed25519.SecretKey -> B.ByteString -> B.ByteString+ed25519Signer sk prehash =+    BA.convert (Ed25519.sign sk (Ed25519.toPublic sk) prehash)++ed448Signer :: Ed448.SecretKey -> B.ByteString -> B.ByteString+ed448Signer sk prehash =+    BA.convert (Ed448.sign sk (Ed448.toPublic sk) prehash)++rsaPKCS15Sign+    :: HashAlgorithm+    -> RSATypes.PrivateKey+    -> B.ByteString+    -> Either SignError B.ByteString+rsaPKCS15Sign ha prv bytes =+    case ha of+        SHA1 ->+            first+                (SignBackendError . show)+                (P15.sign Nothing (Just CHA.SHA1) prv bytes)+        SHA224 ->+            first+                (SignBackendError . show)+                (P15.sign Nothing (Just CHA.SHA224) prv bytes)+        SHA256 ->+            first+                (SignBackendError . show)+                (P15.sign Nothing (Just CHA.SHA256) prv bytes)+        SHA384 ->+            first+                (SignBackendError . show)+                (P15.sign Nothing (Just CHA.SHA384) prv bytes)+        SHA512 ->+            first+                (SignBackendError . show)+                (P15.sign Nothing (Just CHA.SHA512) prv bytes)+        _ ->+            Left+                ( SignBackendError+                    ( "signature hash algorithm is not supported by RSA PKCS#1 v1.5 backend: "+                        ++ show ha+                    )+                )++validateV6SaltSize+    :: HashAlgorithm -> SignatureSalt -> Either SignError ()+validateV6SaltSize ha salt =+    let saltBytes = BL.toStrict (unSignatureSalt salt)+        actualSaltLen = B.length saltBytes+     in case signatureV6SaltSizeForHashAlgorithm ha of+            Nothing ->+                Left+                    ( SignBackendError+                        ( "signature hash algorithm does not define a V6 salt size: "+                            ++ show ha+                        )+                    )+            Just expectedSaltLen ->+                if actualSaltLen == fromIntegral expectedSaltLen+                    then Right ()+                    else+                        Left (SignV6SaltSizeMismatch ha expectedSaltLen actualSaltLen)++signEdDSAV4+    :: String+    -> Int+    -> Int+    -> (B.ByteString -> B.ByteString)+    -> TextNormalizationMode+    -> SigType+    -> PubKeyAlgorithm+    -> HashAlgorithm+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> ByteString+    -> Either SignError SignaturePayload+signEdDSAV4 algoName sigLen limbLen signer mode st pka ha has uhas payload = do+    let normalizedPayload = normalizePayloadForSigTypeWith mode st payload+        sig0 = SigV4 st pka ha has [] 0 (NE.fromList [MPI 0, MPI 0])+        prehash =+            hashWithSHA512+                (BL.toStrict (finalPayload (SignaturePkt sig0) normalizedPayload))+        sigBytes = signer prehash+    if B.length sigBytes /= sigLen+        then+            Left+                (SignProducedWrongLength algoName sigLen (B.length sigBytes))+        else+            let (r, s) = B.splitAt limbLen sigBytes+             in ( \left16 ->+                    SigV4+                        st+                        pka+                        ha+                        has+                        uhas+                        left16+                        (NE.fromList [MPI (os2ip r), MPI (os2ip s)])+                )+                    <$> first SignBackendError (left16FromHashPrefix prehash)++signEdDSAV6+    :: String+    -> Int+    -> Int+    -> (B.ByteString -> B.ByteString)+    -> TextNormalizationMode+    -> SigType+    -> PubKeyAlgorithm+    -> HashAlgorithm+    -> SignatureSalt+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> ByteString+    -> Either SignError SignaturePayload+signEdDSAV6 algoName sigLen limbLen signer mode st pka ha salt has uhas payload = do+    validateV6SaltSize ha salt+    let normalizedPayload = normalizePayloadForSigTypeWith mode st payload+        sig0 = SigV6 st pka ha salt has [] 0 (NE.fromList [MPI 0, MPI 0])+        prehash =+            hashWithSHA512+                (BL.toStrict (finalPayload (SignaturePkt sig0) normalizedPayload))+        sigBytes = signer prehash+    if B.length sigBytes /= sigLen+        then+            Left+                (SignProducedWrongLength algoName sigLen (B.length sigBytes))+        else+            let (r, s) = B.splitAt limbLen sigBytes+             in ( \left16 ->+                    SigV6+                        st+                        pka+                        ha+                        salt+                        has+                        uhas+                        left16+                        (NE.fromList [MPI (os2ip r), MPI (os2ip s)])+                )+                    <$> first SignBackendError (left16FromHashPrefix prehash)++signUserIDwithRSA+    :: SomePKPayload+    -- ^ public key "payload" of user ID being signed+    -> UserId+    -- ^ user ID being signed+    -> [SigSubPacket]+    -- ^ hashed signature subpackets+    -> [SigSubPacket]+    -- ^ unhashed signature subpackets+    -> RSATypes.PrivateKey+    -- ^ RSA signing key+    -> Either SignError SignaturePayload+signUserIDwithRSA = signCertificationWithRSA PositiveCert++signCertificationWithRSA+    :: SigType+    -- ^ certification type (GenericCert, PersonaCert, CasualCert, PositiveCert)+    -> SomePKPayload+    -- ^ public key "payload" of user ID being signed+    -> UserId+    -- ^ user ID being signed+    -> [SigSubPacket]+    -- ^ hashed signature subpackets+    -> [SigSubPacket]+    -- ^ unhashed signature subpackets+    -> RSATypes.PrivateKey+    -- ^ RSA signing key+    -> Either SignError SignaturePayload+signCertificationWithRSA st pkp uid hsigsubs usigsubs prv+    | st `elem` [GenericCert, PersonaCert, CasualCert, PositiveCert] = do+        let payloadToSign = BL.toStrict (finalPayload (SignaturePkt uidsigp) uidpayload)+        uidsigp'+            <$> left16FromSignedPayloadForSign SHA512 payloadToSign+            <*> first+                (SignBackendError . show)+                ( P15.sign+                    Nothing+                    (Just CHA.SHA512)+                    prv+                    payloadToSign+                )+    | otherwise =+        Left (SignUnsupportedCertificationType st)+  where+    uidpayload =+        runPut+            ( sequence_+                [putKeyforSigning (PublicKeyPkt pkp), putUforSigning (toPkt uid)]+            )+    uidsigp =+        SigV4 st RSA SHA512 hsigsubs usigsubs 0 (NE.fromList [MPI 0])+    uidsigp' left16 us =+        SigV4+            st+            RSA+            SHA512+            hsigsubs+            usigsubs+            left16+            (NE.fromList [MPI (os2ip us)])++signDirectKeyWithRSA+    :: SigType+    -- ^ key-scoped signature type (SignatureDirectlyOnAKey or KeyRevocationSig)+    -> SomePKPayload+    -- ^ primary key "payload" being signed+    -> [SigSubPacket]+    -- ^ hashed signature subpackets+    -> [SigSubPacket]+    -- ^ unhashed signature subpackets+    -> RSATypes.PrivateKey+    -- ^ RSA signing key+    -> Either SignError SignaturePayload+signDirectKeyWithRSA st pkp hsigsubs usigsubs prv+    | st `elem` [SignatureDirectlyOnAKey, KeyRevocationSig] =+        signDataWithRSA st prv hsigsubs usigsubs keypayload+    | otherwise =+        Left (SignUnsupportedKeySignatureType st)+  where+    keypayload = runPut (putKeyforSigning (PublicKeyPkt pkp))++signKeyRevocationWithRSA+    :: SomePKPayload+    -- ^ primary key "payload" being revoked+    -> [SigSubPacket]+    -- ^ hashed signature subpackets+    -> [SigSubPacket]+    -- ^ unhashed signature subpackets+    -> RSATypes.PrivateKey+    -- ^ RSA signing key+    -> Either SignError SignaturePayload+signKeyRevocationWithRSA = signDirectKeyWithRSA KeyRevocationSig++signSubkeyRevocationWithRSA+    :: SomePKPayload+    -- ^ primary key "payload"+    -> SomePKPayload+    -- ^ public subkey "payload" being revoked+    -> [SigSubPacket]+    -- ^ hashed signature subpackets+    -> [SigSubPacket]+    -- ^ unhashed signature subpackets+    -> RSATypes.PrivateKey+    -- ^ RSA signing key+    -> Either SignError SignaturePayload+signSubkeyRevocationWithRSA pkp subpkp hsigsubs usigsubs prv =+    signDataWithRSA+        SubkeyRevocationSig+        prv+        hsigsubs+        usigsubs+        subkeypayload+  where+    subkeypayload =+        runPut+            ( sequence_+                [ putKeyforSigning (PublicKeyPkt pkp)+                , putKeyforSigning (PublicSubkeyPkt subpkp)+                ]+            )++signCertRevocationWithRSA+    :: SomePKPayload+    -- ^ primary key "payload"+    -> UserId+    -- ^ user ID certification being revoked+    -> [SigSubPacket]+    -- ^ hashed signature subpackets+    -> [SigSubPacket]+    -- ^ unhashed signature subpackets+    -> RSATypes.PrivateKey+    -- ^ RSA signing key+    -> Either SignError SignaturePayload+signCertRevocationWithRSA pkp uid hsigsubs usigsubs prv =+    signDataWithRSA+        CertRevocationSig+        prv+        hsigsubs+        usigsubs+        certpayload+  where+    certpayload =+        runPut+            ( sequence_+                [putKeyforSigning (PublicKeyPkt pkp), putUforSigning (toPkt uid)]+            )++crossSignSubkeyWithRSA+    :: SomePKPayload+    -- ^ public key "payload" of key being signed+    -> SomePKPayload+    -- ^ public subkey "payload" of key being signed+    -> [SigSubPacket]+    -- ^ hashed signature subpackets for binding sig+    -> [SigSubPacket]+    -- ^ unhashed signature subpackets for binding sig+    -> [SigSubPacket]+    -- ^ hashed signature subpackets for embedded sig+    -> [SigSubPacket]+    -- ^ unhashed signature subpackets for embedded sig+    -> RSATypes.PrivateKey+    -- ^ RSA signing key+    -> RSATypes.PrivateKey+    -- ^ RSA signing subkey+    -> Either SignError SignaturePayload+crossSignSubkeyWithRSA pkp subpkp subhsigsubs subusigsubs embhsigsubs embusigsubs prv ssb = do+    let embPayloadToSign =+            BL.toStrict (finalPayload (SignaturePkt embsigp) subkeypayload)+        subPayloadToSign =+            BL.toStrict (finalPayload (SignaturePkt subsigp) subkeypayload)+    ( \embleft16 subleft16 embsig subsig ->+            subsigp' (embsigp' embleft16 embsig) subleft16 subsig+        )+        <$> left16FromSignedPayloadForSign SHA512 embPayloadToSign+        <*> left16FromSignedPayloadForSign SHA512 subPayloadToSign+        <*> first+            (SignBackendError . show)+            ( P15.sign+                Nothing+                (Just CHA.SHA512)+                ssb+                embPayloadToSign+            )+        <*> first+            (SignBackendError . show)+            ( P15.sign+                Nothing+                (Just CHA.SHA512)+                prv+                subPayloadToSign+            )+  where+    subkeypayload =+        runPut+            ( sequence_+                [ putKeyforSigning (PublicKeyPkt pkp)+                , putKeyforSigning (PublicSubkeyPkt subpkp)+                ]+            )+    embsigp =+        SigV4+            PrimaryKeyBindingSig+            RSA+            SHA512+            embhsigsubs+            embusigsubs+            0+            (NE.fromList [MPI 0])+    embsigp' left16 es =+        SigV4+            PrimaryKeyBindingSig+            RSA+            SHA512+            embhsigsubs+            embusigsubs+            left16+            (NE.fromList [MPI (os2ip es)])+    subsigp =+        SigV4+            SubkeyBindingSig+            RSA+            SHA512+            subhsigsubs+            []+            0+            (NE.fromList [MPI 0])+    sspes es = SigSubPacket False (EmbeddedSignature es)+    subsigp' es left16 ss =+        SigV4+            SubkeyBindingSig+            RSA+            SHA512+            subhsigsubs+            (sspes es : subusigsubs)+            left16+            (NE.fromList [MPI (os2ip ss)])++signRSAV4Core+    :: TextNormalizationMode+    -> SigType+    -> HashAlgorithm+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> RSATypes.PrivateKey+    -> ByteString+    -> Either SignError SignaturePayload+signRSAV4Core mode st ha has uhas prv payload =+    ( \left16 ss ->+        SigV4 st RSA ha has uhas left16 (NE.fromList [MPI (os2ip ss)])+    )+        <$> left16FromSignedPayloadForSign ha payloadToSign+        <*> rsaPKCS15Sign ha prv payloadToSign+  where+    sig0 = SigV4 st RSA ha has [] 0 (NE.fromList [MPI 0])+    payloadToSign =+        BL.toStrict+            ( finalPayload+                (SignaturePkt sig0)+                (normalizePayloadForSigTypeWith mode st payload)+            )++signRSAV6Core+    :: TextNormalizationMode+    -> SigType+    -> HashAlgorithm+    -> SignatureSalt+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> RSATypes.PrivateKey+    -> ByteString+    -> Either SignError SignaturePayload+signRSAV6Core mode st ha salt has uhas prv payload = do+    validateV6SaltSize ha salt+    ( \left16 sigBytes ->+            SigV6+                st+                RSA+                ha+                salt+                has+                uhas+                left16+                (NE.fromList [MPI (os2ip sigBytes)])+        )+        <$> left16FromSignedPayloadForSign ha payloadToSign+        <*> rsaPKCS15Sign ha prv payloadToSign+  where+    sig0 = SigV6 st RSA ha salt has [] 0 (NE.fromList [MPI 0])+    payloadToSign =+        BL.toStrict+            ( finalPayload+                (SignaturePkt sig0)+                (normalizePayloadForSigTypeWith mode st payload)+            )++signDataWithRSA+    :: SigType+    -> RSATypes.PrivateKey+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithRSA st prv has uhas payload =+    signRSAV4Core CleartextCompat st SHA512 has uhas prv payload++signDataWithRSAV6+    :: SigType+    -> SignatureSalt+    -> RSATypes.PrivateKey+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithRSAV6 st salt prv has uhas payload =+    signRSAV6Core CleartextCompat st SHA512 salt has uhas prv payload++-- FIXME: clean this up+ed25519Params+    , ed25519LegacyParams+    , ed448Params+        :: (String, Int, Int, PubKeyAlgorithm)+ed25519Params = ("Ed25519", 64, 32, PKA.Ed25519)+ed25519LegacyParams = ("Ed25519Legacy", 64, 32, PKA.EdDSA)+ed448Params = ("Ed448", 114, 57, PKA.Ed448)++signDataWithEdDSAV4Generic+    :: (String, Int, Int, PubKeyAlgorithm)+    -> (B.ByteString -> B.ByteString)+    -> TextNormalizationMode+    -> HashAlgorithm+    -> SigType+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithEdDSAV4Generic (algoName, sigLen, limbLen, pka) signer mode ha st has uhas payload =+    signEdDSAV4+        algoName+        sigLen+        limbLen+        signer+        mode+        st+        pka+        ha+        has+        uhas+        payload++signDataWithEdDSAV6Generic+    :: (String, Int, Int, PubKeyAlgorithm)+    -> (B.ByteString -> B.ByteString)+    -> TextNormalizationMode+    -> HashAlgorithm+    -> SigType+    -> SignatureSalt+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithEdDSAV6Generic (algoName, sigLen, limbLen, pka) signer mode ha st salt has uhas payload =+    signEdDSAV6+        algoName+        sigLen+        limbLen+        signer+        mode+        st+        pka+        ha+        salt+        has+        uhas+        payload++signDataWithEd25519+    :: SigType+    -> Ed25519.SecretKey+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithEd25519 st sk has uhas payload =+    signDataWithEdDSAV4Generic+        ed25519Params+        (ed25519Signer sk)+        CleartextCompat+        SHA512+        st+        has+        uhas+        payload++signDataWithEd25519Legacy+    :: SigType+    -> Ed25519.SecretKey+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithEd25519Legacy st sk has uhas payload =+    signDataWithEdDSAV4Generic+        ed25519LegacyParams+        (ed25519Signer sk)+        CleartextCompat+        SHA512+        st+        has+        uhas+        payload++signDataWithEd25519V6+    :: SigType+    -> SignatureSalt+    -> Ed25519.SecretKey+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithEd25519V6 st salt sk has uhas payload =+    signDataWithEdDSAV6Generic+        ed25519Params+        (ed25519Signer sk)+        CleartextCompat+        SHA512+        st+        salt+        has+        uhas+        payload++signDataWithEd448+    :: SigType+    -> Ed448.SecretKey+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithEd448 st sk has uhas payload =+    signDataWithEdDSAV4Generic+        ed448Params+        (ed448Signer sk)+        CleartextCompat+        SHA512+        st+        has+        uhas+        payload++signDataWithEd448V6+    :: SigType+    -> SignatureSalt+    -> Ed448.SecretKey+    -> [SigSubPacket]+    -> [SigSubPacket]+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithEd448V6 st salt sk has uhas payload =+    signDataWithEdDSAV6Generic+        ed448Params+        (ed448Signer sk)+        CleartextCompat+        SHA512+        st+        salt+        has+        uhas+        payload++{- | Builder-based signature creation for RSA++Example usage:+  builder <- sigBuilderInit BinarySig RSA SHA512+  builder' <- addHashedSubs hashedSubpackets builder+  builder'' <- addUnhashedSubs unhashedSubpackets builder'+  sig <- signDataWithRSABuilder builder'' rsaPrivateKey payload+-}+signDataWithRSABuilder+    :: SigBuilder+        Codec.Encryption.OpenPGP.Types.Unhashed+        Codec.Encryption.OpenPGP.Types.V4Sig+        'PKA.RSA+    -> RSATypes.PrivateKey+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithRSABuilder builder prv payload =+    signRSAV4Core+        (sbTextNormMode builder)+        (sbSigType builder)+        (sbHashAlgo builder)+        (sbHashedSubs builder)+        (sbUnhashedSubs builder)+        prv+        payload++-- | Builder-based signature creation for RSA (v6)+signDataWithRSAV6Builder+    :: SigBuilder+        Codec.Encryption.OpenPGP.Types.Unhashed+        Codec.Encryption.OpenPGP.Types.V6Sig+        'PKA.RSA+    -> RSATypes.PrivateKey+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithRSAV6Builder builder prv payload =+    signRSAV6Core+        (sbTextNormMode builder)+        (sbSigType builder)+        (sbHashAlgo builder)+        (sbSalt builder)+        (sbHashedSubs builder)+        (sbUnhashedSubs builder)+        prv+        payload++{- | Builder-based signature creation for Ed25519 (v4)++Example usage:+  builder <- sigBuilderInit BinarySig Ed25519 SHA512+  builder' <- addHashedSubs hashedSubpackets builder+  builder'' <- addUnhashedSubs unhashedSubpackets builder'+  sig <- signDataWithEd25519Builder builder'' ed25519PrivateKey payload+-}+signDataWithEd25519Builder+    :: SigBuilder+        Codec.Encryption.OpenPGP.Types.Unhashed+        Codec.Encryption.OpenPGP.Types.V4Sig+        'PKA.Ed25519+    -> Ed25519.SecretKey+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithEd25519Builder builder sk payload =+    signDataWithEdDSAV4Generic+        ed25519Params+        (ed25519Signer sk)+        (sbTextNormMode builder)+        (sbHashAlgo builder)+        (sbSigType builder)+        (sbHashedSubs builder)+        (sbUnhashedSubs builder)+        payload++{- | Builder-based signature creation for Ed25519 (v6)++Example usage:+  builder <- sigBuilderInitV6 BinarySig Ed25519 SHA512 salt+  builder' <- addHashedSubs hashedSubpackets builder+  builder'' <- addUnhashedSubs unhashedSubpackets builder'+  sig <- signDataWithEd25519V6Builder builder'' ed25519PrivateKey payload+-}+signDataWithEd25519V6Builder+    :: SigBuilder+        Codec.Encryption.OpenPGP.Types.Unhashed+        Codec.Encryption.OpenPGP.Types.V6Sig+        'PKA.Ed25519+    -> Ed25519.SecretKey+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithEd25519V6Builder builder sk payload =+    signDataWithEdDSAV6Generic+        ed25519Params+        (ed25519Signer sk)+        (sbTextNormMode builder)+        (sbHashAlgo builder)+        (sbSigType builder)+        (sbSalt builder)+        (sbHashedSubs builder)+        (sbUnhashedSubs builder)+        payload++{- | Builder-based signature creation for Ed448 (v4)++Example usage:+  builder <- sigBuilderInit BinarySig Ed448 SHA512+  builder' <- addHashedSubs hashedSubpackets builder+  builder'' <- addUnhashedSubs unhashedSubpackets builder'+  sig <- signDataWithEd448Builder builder'' ed448PrivateKey payload+-}+signDataWithEd448Builder+    :: SigBuilder+        Codec.Encryption.OpenPGP.Types.Unhashed+        Codec.Encryption.OpenPGP.Types.V4Sig+        'PKA.Ed448+    -> Ed448.SecretKey+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithEd448Builder builder sk payload =+    signDataWithEdDSAV4Generic+        ed448Params+        (ed448Signer sk)+        (sbTextNormMode builder)+        (sbHashAlgo builder)+        (sbSigType builder)+        (sbHashedSubs builder)+        (sbUnhashedSubs builder)+        payload++-- | Builder-based signature creation for Ed448 (v6)+signDataWithEd448V6Builder+    :: SigBuilder+        Codec.Encryption.OpenPGP.Types.Unhashed+        Codec.Encryption.OpenPGP.Types.V6Sig+        'PKA.Ed448+    -> Ed448.SecretKey+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithEd448V6Builder builder sk payload =+    signDataWithEdDSAV6Generic+        ed448Params+        (ed448Signer sk)+        (sbTextNormMode builder)+        (sbHashAlgo builder)+        (sbSigType builder)+        (sbSalt builder)+        (sbHashedSubs builder)+        (sbUnhashedSubs builder)+        payload++{- | Algorithm-agnostic signature builder dispatcher (Phase 2)++Dispatches to the appropriate signing function based on the private key type.+The private key type (PrivateKeyFor algo) encodes the algorithm at the type level,+allowing compile-time verification that the key and builder algorithm match.++Example usage:+-}+class BuilderSigningAlgorithm (algo :: PKA.PubKeyAlgorithm) where+    signDataWithAlgorithmicBuilderImpl+        :: SigBuilder+            Codec.Encryption.OpenPGP.Types.Unhashed+            Codec.Encryption.OpenPGP.Types.V4Sig+            algo+        -> PrivateKeyFor algo+        -> ByteString+        -> Either SignError SignaturePayload++instance BuilderSigningAlgorithm 'PKA.RSA where+    signDataWithAlgorithmicBuilderImpl builder (SP.RSAPrivateKey prv) payload =+        signDataWithRSABuilder builder prv payload++instance BuilderSigningAlgorithm 'PKA.Ed25519 where+    signDataWithAlgorithmicBuilderImpl builder (SP.Ed25519PrivateKey sk) payload =+        signDataWithEd25519Builder builder sk payload++instance BuilderSigningAlgorithm 'PKA.Ed448 where+    signDataWithAlgorithmicBuilderImpl builder (SP.Ed448PrivateKey sk) payload =+        signDataWithEd448Builder builder sk payload++{- | Catch-all instance that produces a compile-time error for any algorithm+that is not supported by the algorithmic builder (e.g. DSA, ECDSA).+-}+instance+    {-# OVERLAPPABLE #-}+    ( TypeError+        ( 'Text+            "signDataWithAlgorithmicBuilder does not support this algorithm."+            ':$$: 'Text "Supported algorithms: RSA, Ed25519, Ed448."+            ':$$: 'Text+                    "For DSA or ECDSA, use signDataWith{DSA,ECDSA}Builder directly."+        )+    )+    => BuilderSigningAlgorithm algo+    where+    signDataWithAlgorithmicBuilderImpl = error "unreachable: TypeError fires at compile time"++signDataWithAlgorithmicBuilder+    :: forall (algo :: PKA.PubKeyAlgorithm)+     . BuilderSigningAlgorithm algo+    => SigBuilder+        Codec.Encryption.OpenPGP.Types.Unhashed+        Codec.Encryption.OpenPGP.Types.V4Sig+        algo+    -> PrivateKeyFor algo+    -> ByteString+    -> Either SignError SignaturePayload+signDataWithAlgorithmicBuilder =+    signDataWithAlgorithmicBuilderImpl
Codec/Encryption/OpenPGP/Types.hs view
@@ -4,10 +4,10 @@ -- (See the LICENSE file).  module Codec.Encryption.OpenPGP.Types-  ( module X-  ) where+    ( module X+    ) where -import Codec.Encryption.OpenPGP.Types.Internal.Base as X hiding (Ed25519, Ed448)+import Codec.Encryption.OpenPGP.Types.Internal.Base as X import Codec.Encryption.OpenPGP.Types.Internal.CryptonNewtypes as X import Codec.Encryption.OpenPGP.Types.Internal.PKITypes as X import Codec.Encryption.OpenPGP.Types.Internal.PacketClass as X
Codec/Encryption/OpenPGP/Types/Internal/Base.hs view
@@ -2,1770 +2,2053 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).--{-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}--module Codec.Encryption.OpenPGP.Types.Internal.Base where--import GHC.Generics (Generic)--import Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils (prettyLBS)-import Control.Applicative ((<|>))-import Control.Arrow ((***))-import Control.Lens (makeLenses, op, Wrapped)-import Control.Monad (mzero)-import Data.Bits ((.&.))-import Data.Aeson ((.=), object)-import qualified Data.Aeson as A-import qualified Data.Aeson.Key as AK-import qualified Data.Aeson.TH as ATH-import Data.ByteArray (ByteArrayAccess)-import qualified Data.ByteString as B-import qualified Data.ByteString.Base16.Lazy as B16L-import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Char8 as BLC8-import Data.Char (toLower, toUpper)-import Data.Data (Data)-import Data.Hashable (Hashable(..))-import Data.Int (Int64)-import Data.Kind (Type)-import Data.List (unfoldr)-import Data.List.NonEmpty (NonEmpty)-import qualified Data.List.NonEmpty as NE-import Data.List.Split (chunksOf)-import Data.Maybe (fromMaybe)-import Data.Ord (comparing)-import Data.Set (Set)-import qualified Data.Set as Set-import Data.Text (Text)-import qualified Data.Text as T-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import Data.Time.Format (formatTime)-import Data.Time.Locale.Compat (defaultTimeLocale)-import Data.Typeable (Typeable)-import Data.Word (Word16, Word32, Word8)-import Network.URI (URI(..), nullURI, parseURI, uriToString)-import Numeric (readHex)-import Prettyprinter (Pretty(..), (<+>), hsep, punctuate, space)-import Data.IORef (IORef, atomicModifyIORef', newIORef)-import System.IO.Unsafe (unsafePerformIO)--type Exportability = Bool--type TrustLevel = Word8--type TrustAmount = Word8--type AlmostPublicDomainRegex = ByteString--type Revocability = Bool--type RevocationReason = Text--type KeyServer = ByteString--type SignatureHash = ByteString--type PacketVersion = Word8--type V3Expiration = Word16--type CompressedDataPayload = ByteString--type FileName = ByteString--type ImageData = ByteString--type NestedFlag = Bool---- | Phantom types for tracking subpacket classification and signature version--- These types are never instantiated; they exist purely for compile-time type safety.---- | Phantom marker for hashed subpackets (included in signature hash computation)-data Hashed---- | Phantom marker for unhashed subpackets (not included in signature hash computation)-data Unhashed---- | Phantom marker for v4 signatures (8-octet issuer, no salt)-data V4Sig---- | Phantom marker for v6 signatures (fingerprint issuer, requires salt)-data V6Sig--data ByteRange =-  ByteRange-    { _rangeOffset :: Int64-    , _rangeLength :: Int64-    }-  deriving (Data, Eq, Generic, Ord, Show, Typeable)--newtype WireRepSourceId =-  WireRepSourceId-    { _unWireRepSourceId :: Int64-    }-  deriving (Data, Eq, Generic, Ord, Show, Typeable)--data WireRepRef =-  WireRepRef-    { _wireRepSourceId :: WireRepSourceId-    , _wireRepLength :: Int64-    , _wireRepName :: Maybe Text-    , _wireRepWasOriginallyArmored :: Bool-    }-  deriving (Data, Eq, Generic, Ord, Show, Typeable)--type WireRepRefs = NonEmpty WireRepRef--wireRepRef :: ByteString -> WireRepRef-wireRepRef = mkWireRepRefWithLength Nothing False . BL.length--namedWireRepRef :: Text -> ByteString -> WireRepRef-namedWireRepRef name = mkWireRepRefWithLength (Just name) False . BL.length--mkWireRepRefWithLength ::-     Maybe Text -> Bool -> Int64 -> WireRepRef-mkWireRepRefWithLength mname wasOriginallyArmored payloadLen =-  WireRepRef-    { _wireRepSourceId = freshWireRepSourceId payloadLen-    , _wireRepLength = payloadLen-    , _wireRepName = mname-    , _wireRepWasOriginallyArmored = wasOriginallyArmored-    }--mkWireRepRef :: Maybe Text -> Bool -> ByteString -> WireRepRef-mkWireRepRef mname wasOriginallyArmored =-  mkWireRepRefWithLength mname wasOriginallyArmored . BL.length--wireRepSourceCounter :: IORef Int64-wireRepSourceCounter = unsafePerformIO (newIORef 0)-{-# NOINLINE wireRepSourceCounter #-}--freshWireRepSourceId :: Int64 -> WireRepSourceId-freshWireRepSourceId !_ =-  unsafePerformIO $-    atomicModifyIORef' wireRepSourceCounter (\n -> let n' = n + 1 in (n', WireRepSourceId n'))-{-# NOINLINE freshWireRepSourceId #-}--rangeEnd :: ByteRange -> Int64-rangeEnd r = _rangeOffset r + _rangeLength r--spanByteRanges :: [ByteRange] -> Maybe ByteRange-spanByteRanges [] = Nothing-spanByteRanges (r:rs) =-  let start = minimum (_rangeOffset <$> (r : rs))-      ending = maximum (rangeEnd <$> (r : rs))-   in Just (ByteRange start (ending - start))--$(makeLenses ''ByteRange)-$(makeLenses ''WireRepRef)--class (Eq a, Ord a) =>-      FutureFlag a-  where-  fromFFlag :: a -> Int-  toFFlag :: Int -> a--class (Eq a, Ord a) =>-      FutureVal a-  where-  fromFVal :: a -> Word8-  toFVal :: Word8 -> a--data SymmetricAlgorithm-  = Plaintext-  | IDEA-  | TripleDES-  | CAST5-  | Blowfish-  | ReservedSAFER-  | ReservedDES-  | AES128-  | AES192-  | AES256-  | Twofish-  | Camellia128-  | Camellia192-  | Camellia256-  | OtherSA Word8-  deriving (Data, Generic, Show, Typeable)--instance Eq SymmetricAlgorithm where-  (==) a b = fromFVal a == fromFVal b--instance Ord SymmetricAlgorithm where-  compare = comparing fromFVal--instance FutureVal SymmetricAlgorithm where-  fromFVal Plaintext = 0-  fromFVal IDEA = 1-  fromFVal TripleDES = 2-  fromFVal CAST5 = 3-  fromFVal Blowfish = 4-  fromFVal ReservedSAFER = 5-  fromFVal ReservedDES = 6-  fromFVal AES128 = 7-  fromFVal AES192 = 8-  fromFVal AES256 = 9-  fromFVal Twofish = 10-  fromFVal Camellia128 = 11-  fromFVal Camellia192 = 12-  fromFVal Camellia256 = 13-  fromFVal (OtherSA o) = o-  toFVal 0 = Plaintext-  toFVal 1 = IDEA-  toFVal 2 = TripleDES-  toFVal 3 = CAST5-  toFVal 4 = Blowfish-  toFVal 5 = ReservedSAFER-  toFVal 6 = ReservedDES-  toFVal 7 = AES128-  toFVal 8 = AES192-  toFVal 9 = AES256-  toFVal 10 = Twofish-  toFVal 11 = Camellia128-  toFVal 12 = Camellia192-  toFVal 13 = Camellia256-  toFVal o = OtherSA o--instance Hashable SymmetricAlgorithm--instance Pretty SymmetricAlgorithm where-  pretty Plaintext = pretty "plaintext"-  pretty IDEA = pretty "IDEA"-  pretty TripleDES = pretty "3DES"-  pretty CAST5 = pretty "CAST-128"-  pretty Blowfish = pretty "Blowfish"-  pretty ReservedSAFER = pretty "(reserved) SAFER"-  pretty ReservedDES = pretty "(reserved) DES"-  pretty AES128 = pretty "AES-128"-  pretty AES192 = pretty "AES-192"-  pretty AES256 = pretty "AES-256"-  pretty Twofish = pretty "Twofish"-  pretty Camellia128 = pretty "Camellia-128"-  pretty Camellia192 = pretty "Camellia-192"-  pretty Camellia256 = pretty "Camellia-256"-  pretty (OtherSA sa) = pretty "unknown symmetric algorithm" <+> pretty sa--$(ATH.deriveJSON ATH.defaultOptions ''SymmetricAlgorithm)--data NotationFlag-  = HumanReadable-  | OtherNF Word8-  deriving (Data, Generic, Show, Typeable)--mkNotationFlag :: Word8 -> NotationFlag-mkNotationFlag o-  | o' == 0 = HumanReadable-  | otherwise = OtherNF o'-  where-    o' = o .&. 0x0f--instance Eq NotationFlag where-  (==) a b = fromFFlag a == fromFFlag b--instance Ord NotationFlag where-  compare = comparing fromFFlag--instance FutureFlag NotationFlag where-  fromFFlag HumanReadable = 0-  fromFFlag (OtherNF o) = fromIntegral (o .&. 0x0f)-  toFFlag 0 = HumanReadable-  toFFlag o = mkNotationFlag (fromIntegral o)--instance Hashable NotationFlag--instance Pretty NotationFlag where-  pretty HumanReadable = pretty "human-readable"-  pretty (OtherNF o) = pretty "unknown notation flag type" <+> pretty o--$(ATH.deriveJSON ATH.defaultOptions ''NotationFlag)--newtype ThirtyTwoBitTimeStamp =-  ThirtyTwoBitTimeStamp-    { unThirtyTwoBitTimeStamp :: Word32-    }-  deriving ( Bounded-           , Data-           , Enum-           , Eq-           , Generic-           , Hashable-           , Integral-           , Num-           , Ord-           , Real-           , Show-           , Typeable-           )--instance Wrapped ThirtyTwoBitTimeStamp--instance Pretty ThirtyTwoBitTimeStamp where-  pretty =-    pretty .-    formatTime defaultTimeLocale "%Y%m%d-%H%M%S" .-    posixSecondsToUTCTime . realToFrac--$(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitTimeStamp)--durU :: (Integral a, Show a) => a -> Maybe (String, a)-durU x-  | x >= 31557600 = Just ((++ "y") . show $ x `div` 31557600, x `mod` 31557600)-  | x >= 2629800 = Just ((++ "m") . show $ x `div` 2629800, x `mod` 2629800)-  | x >= 86400 = Just ((++ "d") . show $ x `div` 86400, x `mod` 86400)-  | x > 0 = Just ((++ "s") . show $ x, 0)-  | otherwise = Nothing--newtype ThirtyTwoBitDuration =-  ThirtyTwoBitDuration-    { unThirtyTwoBitDuration :: Word32-    }-  deriving ( Bounded-           , Data-           , Enum-           , Eq-           , Generic-           , Hashable-           , Integral-           , Num-           , Ord-           , Real-           , Show-           , Typeable-           )--instance Wrapped ThirtyTwoBitDuration--instance Pretty ThirtyTwoBitDuration where-  pretty = pretty . concat . unfoldr durU . op ThirtyTwoBitDuration--$(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitDuration)--data RevocationClass-  = SensitiveRK-  | RClOther Word8-  deriving (Data, Generic, Show, Typeable)--mkRevocationClass :: Word8 -> RevocationClass-mkRevocationClass i-  | i' == 1 = SensitiveRK-  | otherwise = RClOther i'-  where-    i' = i .&. 0x07--instance Eq RevocationClass where-  (==) a b = fromFFlag a == fromFFlag b--instance Ord RevocationClass where-  compare = comparing fromFFlag--instance FutureFlag RevocationClass where-  fromFFlag SensitiveRK = 1-  fromFFlag (RClOther i) = fromIntegral (i .&. 0x07)-  toFFlag 1 = SensitiveRK-  toFFlag i = mkRevocationClass (fromIntegral i)--instance Hashable RevocationClass--instance Pretty RevocationClass where-  pretty SensitiveRK = pretty "sensitive"-  pretty (RClOther o) = pretty "unknown revocation class" <+> pretty o--$(ATH.deriveJSON ATH.defaultOptions ''RevocationClass)--data PubKeyAlgorithm-  = RSA-  | DeprecatedRSAEncryptOnly-  | DeprecatedRSASignOnly-  | ElgamalEncryptOnly-  | DSA-  | ECDH-  | ECDSA-  | ForbiddenElgamal-  | DH-  | EdDSA-  | X25519-  | X448-  | Ed25519-  | Ed448-  | OtherPKA Word8-  deriving (Show, Data, Generic, Typeable)--instance Eq PubKeyAlgorithm where-  (==) a b = fromFVal a == fromFVal b--instance Ord PubKeyAlgorithm where-  compare = comparing fromFVal--instance FutureVal PubKeyAlgorithm where-  fromFVal RSA = 1-  fromFVal DeprecatedRSAEncryptOnly = 2-  fromFVal DeprecatedRSASignOnly = 3-  fromFVal ElgamalEncryptOnly = 16-  fromFVal DSA = 17-  fromFVal ECDH = 18-  fromFVal ECDSA = 19-  fromFVal ForbiddenElgamal = 20-  fromFVal DH = 21-  fromFVal EdDSA = 22-  fromFVal X25519 = 25-  fromFVal X448 = 26-  fromFVal Ed25519 = 27-  fromFVal Ed448 = 28-  fromFVal (OtherPKA o) = o-  toFVal 1 = RSA-  toFVal 2 = DeprecatedRSAEncryptOnly-  toFVal 3 = DeprecatedRSASignOnly-  toFVal 16 = ElgamalEncryptOnly-  toFVal 17 = DSA-  toFVal 18 = ECDH-  toFVal 19 = ECDSA-  toFVal 20 = ForbiddenElgamal-  toFVal 21 = DH-  toFVal 22 = EdDSA-  toFVal 25 = X25519-  toFVal 26 = X448-  toFVal 27 = Ed25519-  toFVal 28 = Ed448-  toFVal o = OtherPKA o--instance Hashable PubKeyAlgorithm--instance Pretty PubKeyAlgorithm where-  pretty RSA = pretty "RSA"-  pretty DeprecatedRSAEncryptOnly = pretty "(deprecated) RSA encrypt-only"-  pretty DeprecatedRSASignOnly = pretty "(deprecated) RSA sign-only"-  pretty ElgamalEncryptOnly = pretty "Elgamal encrypt-only"-  pretty DSA = pretty "DSA"-  pretty ECDH = pretty "ECDH"-  pretty ECDSA = pretty "ECDSA"-  pretty ForbiddenElgamal = pretty "(forbidden) Elgamal"-  pretty DH = pretty "DH"-  pretty EdDSA = pretty "EdDSA"-  pretty X25519 = pretty "X25519"-  pretty X448 = pretty "X448"-  pretty Ed25519 = pretty "Ed25519"-  pretty Ed448 = pretty "Ed448"-  pretty (OtherPKA pka) = pretty "unknown pubkey algorithm type" <+> pretty pka--$(ATH.deriveJSON ATH.defaultOptions ''PubKeyAlgorithm)---- | An OpenPGP fingerprint.  Length depends on key version:--- 16 bytes (v3/MD5), 20 bytes (v4/SHA-1), or 32 bytes (v6/SHA-256).-newtype Fingerprint =-  Fingerprint-    { unFingerprint :: ByteString-    }-  deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Wrapped Fingerprint--instance Read Fingerprint where-  readsPrec _ s =-    let ws = hexToW8s (filter (/= ' ') s)-    in if null ws-         then []-         else [(Fingerprint (BL.pack (map fst ws)), snd (last ws))]--instance Hashable Fingerprint--instance Pretty Fingerprint where-  pretty = pretty . bsToHexUpper . unFingerprint---- FIXME: we should not be exporting this-key :: String -> AK.Key-key = AK.fromText . T.pack--instance A.ToJSON Fingerprint where-  toJSON e = object [key "fpr" .= (A.toJSON . show . pretty) e]--instance A.FromJSON Fingerprint where-  parseJSON (A.Object v) = Fingerprint . read <$> v A..: key "fpr"-  parseJSON _ = mzero--newtype SpacedFingerprint =-  SpacedFingerprint-    { unSpacedFingerprint :: Fingerprint-    }-  deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Wrapped SpacedFingerprint--instance Pretty SpacedFingerprint where-  pretty =-    hsep .-    punctuate space .-    map hsep .-    chunksOf 5 .-    map pretty . chunksOf 4 . bsToHexUpper . unFingerprint . op SpacedFingerprint--bsToHexUpper :: ByteString -> String-bsToHexUpper = map toUpper . BLC8.unpack . B16L.encode--hexToW8s :: ReadS Word8-hexToW8s = concatMap readHex . chunksOf 2 . map toLower--newtype EightOctetKeyId =-  EightOctetKeyId-    { unEOKI :: ByteString-    }-  deriving (Data, Eq, Generic, Ord, Typeable)--instance Wrapped EightOctetKeyId--instance Pretty EightOctetKeyId where-  pretty = pretty . bsToHexUpper . op EightOctetKeyId--instance Show EightOctetKeyId where-  show = bsToHexUpper . op EightOctetKeyId--instance Read EightOctetKeyId where-  readsPrec _ =-    map ((EightOctetKeyId . BL.pack *** concat) . unzip) . chunksOf 8 . hexToW8s--instance Hashable EightOctetKeyId--instance A.ToJSON EightOctetKeyId where-  toJSON e = object [key "eoki" .= (bsToHexUpper . op EightOctetKeyId) e]--instance A.FromJSON EightOctetKeyId where-  parseJSON (A.Object v) = EightOctetKeyId . read <$> v A..: key "eoki"-  parseJSON _ = mzero--data KeyIdentifier-  = KeyIdentifierWildcard-  | KeyIdentifierEightOctet EightOctetKeyId-  | KeyIdentifierFingerprint Fingerprint-  deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Pretty KeyIdentifier where-  pretty KeyIdentifierWildcard = pretty "wildcard"-  pretty (KeyIdentifierEightOctet kid) = pretty "key-id" <+> pretty kid-  pretty (KeyIdentifierFingerprint fp) = pretty "fingerprint" <+> pretty fp--instance A.ToJSON KeyIdentifier where-  toJSON KeyIdentifierWildcard = object [key "wildcard" .= A.Bool True]-  toJSON (KeyIdentifierEightOctet kid) = object [key "keyId" .= kid]-  toJSON (KeyIdentifierFingerprint fp) = object [key "fingerprint" .= fp]--instance A.FromJSON KeyIdentifier where-  parseJSON (A.Object v) =-    ((v A..: key "wildcard") >>= \isWildcard ->-      if isWildcard then pure KeyIdentifierWildcard else mzero)-    <|> (KeyIdentifierEightOctet <$> v A..: key "keyId")-    <|> (KeyIdentifierFingerprint <$> v A..: key "fingerprint")-  parseJSON _ = mzero--newtype NotationName =-  NotationName-    { unNotationName :: ByteString-    }-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)--instance Pretty NotationName where-  pretty = prettyLBS . unNotationName--instance Wrapped NotationName--instance A.ToJSON NotationName where-  toJSON nn = object [key "notationname" .= show (op NotationName nn)]--instance A.FromJSON NotationName where-  parseJSON (A.Object v) = NotationName . read <$> v A..: key "notationname"-  parseJSON _ = mzero--newtype NotationValue =-  NotationValue-    { unNotationValue :: ByteString-    }-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)--instance Pretty NotationValue where-  pretty = prettyLBS . unNotationValue--instance Wrapped NotationValue--instance A.ToJSON NotationValue where-  toJSON nv = object [key "notationvalue" .= show (op NotationValue nv)]--instance A.FromJSON NotationValue where-  parseJSON (A.Object v) =-    NotationValue . read <$> v A..: key "notationvalue"-  parseJSON _ = mzero--data HashAlgorithm-  = DeprecatedMD5-  | SHA1-  | RIPEMD160-  | SHA256-  | SHA384-  | SHA512-  | SHA224-  | SHA3_256-  | SHA3_512-  | OtherHA Word8-  deriving (Data, Generic, Show, Typeable)--instance Eq HashAlgorithm where-  (==) a b = fromFVal a == fromFVal b--instance Ord HashAlgorithm where-  compare = comparing fromFVal--instance FutureVal HashAlgorithm where-  fromFVal DeprecatedMD5 = 1-  fromFVal SHA1 = 2-  fromFVal RIPEMD160 = 3-  fromFVal SHA256 = 8-  fromFVal SHA384 = 9-  fromFVal SHA512 = 10-  fromFVal SHA224 = 11-  fromFVal SHA3_256 = 12-  fromFVal SHA3_512 = 14-  fromFVal (OtherHA o) = o-  toFVal 1 = DeprecatedMD5-  toFVal 2 = SHA1-  toFVal 3 = RIPEMD160-  toFVal 8 = SHA256-  toFVal 9 = SHA384-  toFVal 10 = SHA512-  toFVal 11 = SHA224-  toFVal 12 = SHA3_256-  toFVal 14 = SHA3_512-  toFVal o = OtherHA o--instance Hashable HashAlgorithm--instance Pretty HashAlgorithm where-  pretty DeprecatedMD5 = pretty "(deprecated) MD5"-  pretty SHA1 = pretty "SHA-1"-  pretty RIPEMD160 = pretty "RIPEMD-160"-  pretty SHA256 = pretty "SHA-256"-  pretty SHA384 = pretty "SHA-384"-  pretty SHA512 = pretty "SHA-512"-  pretty SHA224 = pretty "SHA-224"-  pretty SHA3_256 = pretty "SHA3-256"-  pretty SHA3_512 = pretty "SHA3-512"-  pretty (OtherHA ha) = pretty "unknown hash algorithm type" <+> pretty ha--$(ATH.deriveJSON ATH.defaultOptions ''HashAlgorithm)--data CompressionAlgorithm-  = Uncompressed-  | ZIP-  | ZLIB-  | BZip2-  | OtherCA Word8-  deriving (Show, Data, Generic, Typeable)--instance Eq CompressionAlgorithm where-  (==) a b = fromFVal a == fromFVal b--instance Ord CompressionAlgorithm where-  compare = comparing fromFVal--instance FutureVal CompressionAlgorithm where-  fromFVal Uncompressed = 0-  fromFVal ZIP = 1-  fromFVal ZLIB = 2-  fromFVal BZip2 = 3-  fromFVal (OtherCA o) = o-  toFVal 0 = Uncompressed-  toFVal 1 = ZIP-  toFVal 2 = ZLIB-  toFVal 3 = BZip2-  toFVal o = OtherCA o--instance Hashable CompressionAlgorithm--instance Pretty CompressionAlgorithm where-  pretty Uncompressed = pretty "uncompressed"-  pretty ZIP = pretty "ZIP"-  pretty ZLIB = pretty "zlib"-  pretty BZip2 = pretty "bzip2"-  pretty (OtherCA ca) =-    pretty "unknown compression algorithm type" <+> pretty ca--$(ATH.deriveJSON ATH.defaultOptions ''CompressionAlgorithm)--data AEADAlgorithm-  = EAX-  | OCB-  | GCM-  | OtherAEADAlgo Word8-  deriving (Show, Data, Generic, Typeable)--instance Eq AEADAlgorithm where-  (==) a b = fromFVal a == fromFVal b--instance Ord AEADAlgorithm where-  compare = comparing fromFVal--instance FutureVal AEADAlgorithm where-  fromFVal EAX = 1-  fromFVal OCB = 2-  fromFVal GCM = 3-  fromFVal (OtherAEADAlgo o) = o-  toFVal 1 = EAX-  toFVal 2 = OCB-  toFVal 3 = GCM-  toFVal o = OtherAEADAlgo o--instance Hashable AEADAlgorithm--instance Pretty AEADAlgorithm where-  pretty EAX = pretty "EAX"-  pretty OCB = pretty "OCB"-  pretty GCM = pretty "GCM"-  pretty (OtherAEADAlgo aa) = pretty "unknown AEAD algorithm type" <+> pretty aa--$(ATH.deriveJSON ATH.defaultOptions ''AEADAlgorithm)--data KSPFlag-  = NoModify-  | KSPOther Int-  deriving (Data, Generic, Show, Typeable)--instance Eq KSPFlag where-  (==) a b = fromFFlag a == fromFFlag b--instance Ord KSPFlag where-  compare = comparing fromFFlag--instance FutureFlag KSPFlag where-  fromFFlag NoModify = 0-  fromFFlag (KSPOther i) = fromIntegral i-  toFFlag 0 = NoModify-  toFFlag i = KSPOther (fromIntegral i)--instance Hashable KSPFlag--instance Pretty KSPFlag where-  pretty NoModify = pretty "no-modify"-  pretty (KSPOther o) =-    pretty "unknown keyserver preference flag type" <+> pretty o--$(ATH.deriveJSON ATH.defaultOptions ''KSPFlag)--data KeyFlag-  = GroupKey-  | AuthKey-  | SplitKey-  | EncryptStorageKey-  | EncryptCommunicationsKey-  | SignDataKey-  | CertifyKeysKey-  | KFOther Int-  deriving (Data, Generic, Show, Typeable)--instance Eq KeyFlag where-  (==) a b = fromFFlag a == fromFFlag b--instance Ord KeyFlag where-  compare = comparing fromFFlag--instance FutureFlag KeyFlag where-  fromFFlag GroupKey = 0-  fromFFlag AuthKey = 2-  fromFFlag SplitKey = 3-  fromFFlag EncryptStorageKey = 4-  fromFFlag EncryptCommunicationsKey = 5-  fromFFlag SignDataKey = 6-  fromFFlag CertifyKeysKey = 7-  fromFFlag (KFOther i) = fromIntegral i-  toFFlag 0 = GroupKey-  toFFlag 2 = AuthKey-  toFFlag 3 = SplitKey-  toFFlag 4 = EncryptStorageKey-  toFFlag 5 = EncryptCommunicationsKey-  toFFlag 6 = SignDataKey-  toFFlag 7 = CertifyKeysKey-  toFFlag i = KFOther (fromIntegral i)--instance Hashable KeyFlag--instance Pretty KeyFlag where-  pretty GroupKey = pretty "group"-  pretty AuthKey = pretty "auth"-  pretty SplitKey = pretty "split"-  pretty EncryptStorageKey = pretty "encrypt-storage"-  pretty EncryptCommunicationsKey = pretty "encrypt-communications"-  pretty SignDataKey = pretty "sign-data"-  pretty CertifyKeysKey = pretty "certify-keys"-  pretty (KFOther o) = pretty "unknown key flag type" <+> pretty o--$(ATH.deriveJSON ATH.defaultOptions ''KeyFlag)--data RevocationCode-  = NoReason-  | KeySuperseded-  | KeyMaterialCompromised-  | KeyRetiredAndNoLongerUsed-  | UserIdInfoNoLongerValid-  | RCoOther Word8-  deriving (Data, Generic, Show, Typeable)--instance Eq RevocationCode where-  (==) a b = fromFVal a == fromFVal b--instance Ord RevocationCode where-  compare = comparing fromFVal--instance FutureVal RevocationCode where-  fromFVal NoReason = 0-  fromFVal KeySuperseded = 1-  fromFVal KeyMaterialCompromised = 2-  fromFVal KeyRetiredAndNoLongerUsed = 3-  fromFVal UserIdInfoNoLongerValid = 32-  fromFVal (RCoOther o) = o-  toFVal 0 = NoReason-  toFVal 1 = KeySuperseded-  toFVal 2 = KeyMaterialCompromised-  toFVal 3 = KeyRetiredAndNoLongerUsed-  toFVal 32 = UserIdInfoNoLongerValid-  toFVal o = RCoOther o--instance Hashable RevocationCode--instance Pretty RevocationCode where-  pretty NoReason = pretty "no reason"-  pretty KeySuperseded = pretty "key superseded"-  pretty KeyMaterialCompromised = pretty "key material compromised"-  pretty KeyRetiredAndNoLongerUsed = pretty "key retired and no longer used"-  pretty UserIdInfoNoLongerValid = pretty "user-ID info no longer valid"-  pretty (RCoOther o) = pretty "unknown revocation code" <+> pretty o--$(ATH.deriveJSON ATH.defaultOptions ''RevocationCode)--data FeatureFlag-  = FeatureSEIPDv1-  | FeatureSEIPDv2-  | FeatureOther Int-  deriving (Data, Generic, Show, Typeable)--instance Eq FeatureFlag where-  (==) a b = fromFFlag a == fromFFlag b--instance Ord FeatureFlag where-  compare = comparing fromFFlag--instance FutureFlag FeatureFlag where-  fromFFlag FeatureSEIPDv1 = 7-  fromFFlag FeatureSEIPDv2 = 4-  fromFFlag (FeatureOther i) = fromIntegral i-  toFFlag 7 = FeatureSEIPDv1-  toFFlag 4 = FeatureSEIPDv2-  toFFlag i = FeatureOther (fromIntegral i)--instance Hashable FeatureFlag--instance Pretty FeatureFlag where-  pretty FeatureSEIPDv1 = pretty "seipd-v1"-  pretty FeatureSEIPDv2 = pretty "seipd-v2"-  pretty (FeatureOther o) = pretty "unknown feature flag type" <+> pretty o--$(ATH.deriveJSON ATH.defaultOptions ''FeatureFlag)--newtype URL =-  URL-    { unURL :: URI-    }-  deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Wrapped URL--instance Hashable URL where-  hashWithSalt salt (URL (URI s a p q f)) =-    salt `hashWithSalt` s `hashWithSalt` show a `hashWithSalt` p `hashWithSalt`-    q `hashWithSalt`-    f--instance Pretty URL where-  pretty = pretty . (\uri -> uriToString id uri "") . op URL--instance A.ToJSON URL where-  toJSON u = object [key "uri" .= (\uri -> uriToString id uri "") (op URL u)]--instance A.FromJSON URL where-  parseJSON (A.Object v) =-    URL . fromMaybe nullURI . parseURI <$> v A..: key "uri"-  parseJSON _ = mzero--data SigType-  = BinarySig-  | CanonicalTextSig-  | StandaloneSig-  | GenericCert-  | PersonaCert-  | CasualCert-  | PositiveCert-  | SubkeyBindingSig-  | PrimaryKeyBindingSig-  | SignatureDirectlyOnAKey-  | KeyRevocationSig-  | SubkeyRevocationSig-  | CertRevocationSig-  | TimestampSig-  | ThirdPartyConfirmationSig-  | OtherSig Word8-  deriving (Data, Generic, Show, Typeable)--instance Eq SigType where-  (==) a b = fromFVal a == fromFVal b--instance Ord SigType where-  compare = comparing fromFVal--instance FutureVal SigType where-  fromFVal BinarySig = 0x00-  fromFVal CanonicalTextSig = 0x01-  fromFVal StandaloneSig = 0x02-  fromFVal GenericCert = 0x10-  fromFVal PersonaCert = 0x11-  fromFVal CasualCert = 0x12-  fromFVal PositiveCert = 0x13-  fromFVal SubkeyBindingSig = 0x18-  fromFVal PrimaryKeyBindingSig = 0x19-  fromFVal SignatureDirectlyOnAKey = 0x1F-  fromFVal KeyRevocationSig = 0x20-  fromFVal SubkeyRevocationSig = 0x28-  fromFVal CertRevocationSig = 0x30-  fromFVal TimestampSig = 0x40-  fromFVal ThirdPartyConfirmationSig = 0x50-  fromFVal (OtherSig o) = o-  toFVal 0x00 = BinarySig-  toFVal 0x01 = CanonicalTextSig-  toFVal 0x02 = StandaloneSig-  toFVal 0x10 = GenericCert-  toFVal 0x11 = PersonaCert-  toFVal 0x12 = CasualCert-  toFVal 0x13 = PositiveCert-  toFVal 0x18 = SubkeyBindingSig-  toFVal 0x19 = PrimaryKeyBindingSig-  toFVal 0x1F = SignatureDirectlyOnAKey-  toFVal 0x20 = KeyRevocationSig-  toFVal 0x28 = SubkeyRevocationSig-  toFVal 0x30 = CertRevocationSig-  toFVal 0x40 = TimestampSig-  toFVal 0x50 = ThirdPartyConfirmationSig-  toFVal o = OtherSig o--instance Hashable SigType--instance Pretty SigType where-  pretty BinarySig = pretty "binary"-  pretty CanonicalTextSig = pretty "canonical-pretty"-  pretty StandaloneSig = pretty "standalone"-  pretty GenericCert = pretty "generic"-  pretty PersonaCert = pretty "persona"-  pretty CasualCert = pretty "casual"-  pretty PositiveCert = pretty "positive"-  pretty SubkeyBindingSig = pretty "subkey-binding"-  pretty PrimaryKeyBindingSig = pretty "primary-key-binding"-  pretty SignatureDirectlyOnAKey = pretty "signature directly on a key"-  pretty KeyRevocationSig = pretty "key-revocation"-  pretty SubkeyRevocationSig = pretty "subkey-revocation"-  pretty CertRevocationSig = pretty "cert-revocation"-  pretty TimestampSig = pretty "timestamp"-  pretty ThirdPartyConfirmationSig = pretty "third-party-confirmation"-  pretty (OtherSig o) = pretty "unknown signature type" <+> pretty o--$(ATH.deriveJSON ATH.defaultOptions ''SigType)--newtype MPI =-  MPI-    { unMPI :: Integer-    }-  deriving (Data, Eq, Generic, Show, Typeable)--instance Wrapped MPI--instance Ord MPI where-  compare (MPI a) (MPI b) = compare a b--instance Hashable MPI--instance Pretty MPI where-  pretty = pretty . op MPI--$(ATH.deriveJSON ATH.defaultOptions ''MPI)--newtype SignatureSalt =-  SignatureSalt-    { unSignatureSalt :: ByteString-    }-  deriving (Data, Eq, Generic, Show, Typeable)--instance Ord SignatureSalt where-  compare (SignatureSalt a) (SignatureSalt b) = compare a b--instance Hashable SignatureSalt--instance Pretty SignatureSalt where-  pretty (SignatureSalt bs) = prettyLBS bs--instance A.ToJSON SignatureSalt where-  toJSON (SignatureSalt bs) = A.toJSON (BL.unpack bs)--data SignaturePayloadVersion-  = SigPayloadV3-  | SigPayloadV4-  | SigPayloadV6-  | SigPayloadVOther-  deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Hashable SignaturePayloadVersion--data SignaturePayloadV (v :: SignaturePayloadVersion) where-  SigPayloadV3Data ::-       SigType-    -> ThirtyTwoBitTimeStamp-    -> EightOctetKeyId-    -> PubKeyAlgorithm-    -> HashAlgorithm-    -> Word16-    -> NonEmpty MPI-    -> SignaturePayloadV 'SigPayloadV3-  SigPayloadV4Data ::-       SigType-    -> PubKeyAlgorithm-    -> HashAlgorithm-    -> [SigSubPacket]-    -> [SigSubPacket]-    -> Word16-    -> NonEmpty MPI-    -> SignaturePayloadV 'SigPayloadV4-  SigPayloadV6Data ::-       SigType-    -> PubKeyAlgorithm-    -> HashAlgorithm-    -> SignatureSalt-    -> [SigSubPacket]-    -> [SigSubPacket]-    -> Word16-    -> NonEmpty MPI-    -> SignaturePayloadV 'SigPayloadV6-  SigPayloadOtherData ::-       Word8-    -> ByteString-    -> SignaturePayloadV 'SigPayloadVOther--deriving instance Eq (SignaturePayloadV v)-deriving instance Show (SignaturePayloadV v)--data SomeSignaturePayload where-  SomeSignaturePayload :: SignaturePayloadV v -> SomeSignaturePayload--toSignaturePayload :: SignaturePayloadV v -> SignaturePayload-toSignaturePayload (SigPayloadV3Data st ts eoki pka ha w16 mpis) =-  SigV3 st ts eoki pka ha w16 mpis-toSignaturePayload (SigPayloadV4Data st pka ha hsps usps w16 mpis) =-  SigV4 st pka ha hsps usps w16 mpis-toSignaturePayload (SigPayloadV6Data st pka ha salt hsps usps w16 mpis) =-  SigV6 st pka ha salt hsps usps w16 mpis-toSignaturePayload (SigPayloadOtherData v bs) =-  SigVOther v bs--toSomeSignaturePayload :: SignaturePayload -> SomeSignaturePayload-toSomeSignaturePayload (SigV3 st ts eoki pka ha w16 mpis) =-  SomeSignaturePayload (SigPayloadV3Data st ts eoki pka ha w16 mpis)-toSomeSignaturePayload (SigV4 st pka ha hsps usps w16 mpis) =-  SomeSignaturePayload (SigPayloadV4Data st pka ha hsps usps w16 mpis)-toSomeSignaturePayload (SigV6 st pka ha salt hsps usps w16 mpis) =-  SomeSignaturePayload (SigPayloadV6Data st pka ha salt hsps usps w16 mpis)-toSomeSignaturePayload (SigVOther v bs) =-  SomeSignaturePayload (SigPayloadOtherData v bs)--signaturePayloadVersion :: SignaturePayload -> SignaturePayloadVersion-signaturePayloadVersion (SigV3 _ _ _ _ _ _ _) = SigPayloadV3-signaturePayloadVersion (SigV4 _ _ _ _ _ _ _) = SigPayloadV4-signaturePayloadVersion (SigV6 _ _ _ _ _ _ _ _) = SigPayloadV6-signaturePayloadVersion (SigVOther _ _) = SigPayloadVOther--asSignaturePayloadV3 :: SignaturePayload -> Either String (SignaturePayloadV 'SigPayloadV3)-asSignaturePayloadV3 (SigV3 st ts eoki pka ha w16 mpis) =-  Right (SigPayloadV3Data st ts eoki pka ha w16 mpis)-asSignaturePayloadV3 _ =-  Left "Cannot coerce non-v3 SignaturePayload to SignaturePayloadV3"--asSignaturePayloadV4 :: SignaturePayload -> Either String (SignaturePayloadV 'SigPayloadV4)-asSignaturePayloadV4 (SigV4 st pka ha hsps usps w16 mpis) =-  Right (SigPayloadV4Data st pka ha hsps usps w16 mpis)-asSignaturePayloadV4 _ =-  Left "Cannot coerce non-v4 SignaturePayload to SignaturePayloadV4"--asSignaturePayloadV6 :: SignaturePayload -> Either String (SignaturePayloadV 'SigPayloadV6)-asSignaturePayloadV6 (SigV6 st pka ha salt hsps usps w16 mpis) =-  Right (SigPayloadV6Data st pka ha salt hsps usps w16 mpis)-asSignaturePayloadV6 _ =-  Left "Cannot coerce non-v6 SignaturePayload to SignaturePayloadV6"--asSignaturePayloadOther :: SignaturePayload -> Either String (SignaturePayloadV 'SigPayloadVOther)-asSignaturePayloadOther (SigVOther v bs) =-  Right (SigPayloadOtherData v bs)-asSignaturePayloadOther _ =-  Left "Cannot coerce known-version SignaturePayload to SignaturePayloadVOther"--data SignaturePayload-  = SigV3-      SigType-      ThirtyTwoBitTimeStamp-      EightOctetKeyId-      PubKeyAlgorithm-      HashAlgorithm-      Word16-      (NonEmpty MPI)-  | SigV4-      SigType-      PubKeyAlgorithm-      HashAlgorithm-      [SigSubPacket]-      [SigSubPacket]-      Word16-      (NonEmpty MPI)-  | SigV6-      SigType-      PubKeyAlgorithm-      HashAlgorithm-      SignatureSalt-      [SigSubPacket]-      [SigSubPacket]-      Word16-      (NonEmpty MPI)-  | SigVOther Word8 ByteString-  deriving (Data, Eq, Generic, Show, Typeable)--instance Hashable SignaturePayload--instance Ord SignaturePayload where-  compare (SigV3 st1 ts1 eoki1 pka1 ha1 w161 mpis1)-          (SigV3 st2 ts2 eoki2 pka2 ha2 w162 mpis2) =-    compare st1 st2 <> compare ts1 ts2 <> compare eoki1 eoki2 <>-    compare pka1 pka2 <> compare ha1 ha2 <> compare w161 w162 <>-    compare (NE.toList mpis1) (NE.toList mpis2)-  compare (SigV4 st1 pka1 ha1 hsp1 usp1 w161 mpis1)-          (SigV4 st2 pka2 ha2 hsp2 usp2 w162 mpis2) =-    compare st1 st2 <> compare pka1 pka2 <> compare ha1 ha2 <>-    compare hsp1 hsp2 <> compare usp1 usp2 <> compare w161 w162 <>-    compare (NE.toList mpis1) (NE.toList mpis2)-  compare (SigV6 st1 pka1 ha1 salt1 hsp1 usp1 w161 mpis1)-          (SigV6 st2 pka2 ha2 salt2 hsp2 usp2 w162 mpis2) =-    compare st1 st2 <> compare pka1 pka2 <> compare ha1 ha2 <>-    compare salt1 salt2 <> compare hsp1 hsp2 <> compare usp1 usp2 <>-    compare w161 w162 <> compare (NE.toList mpis1) (NE.toList mpis2)-  compare (SigVOther t1 bs1) (SigVOther t2 bs2) = compare t1 t2 <> compare bs1 bs2-  compare SigV3 {} SigV4 {} = LT-  compare SigV3 {} SigV6 {} = LT-  compare SigV3 {} SigVOther {} = LT-  compare SigV4 {} SigV3 {} = GT-  compare SigV4 {} SigV6 {} = LT-  compare SigV4 {} SigVOther {} = LT-  compare SigV6 {} SigV3 {} = GT-  compare SigV6 {} SigV4 {} = GT-  compare SigV6 {} SigVOther {} = LT-  compare SigVOther {} SigV3 {} = GT-  compare SigVOther {} SigV4 {} = GT-  compare SigVOther {} SigV6 {} = GT--instance Pretty SignaturePayload where-  pretty (SigV3 st ts eoki pka ha w16 mpis) =-    pretty "signature v3" <> pretty ':' <+>-    pretty st <+>-    pretty ts <+>-    pretty eoki <+>-    pretty pka <+> pretty ha <+> pretty w16 <+> (pretty . NE.toList) mpis-  pretty (SigV4 st pka ha hsps usps w16 mpis) =-    pretty "signature v4" <> pretty ':' <+>-    pretty st <+>-    pretty pka <+>-    pretty ha <+>-    pretty hsps <+> pretty usps <+> pretty w16 <+> (pretty . NE.toList) mpis-  pretty (SigV6 st pka ha salt hsps usps w16 mpis) =-    pretty "signature v6" <> pretty ':' <+>-    pretty st <+>-    pretty pka <+>-    pretty ha <+>-    pretty salt <+>-    pretty hsps <+> pretty usps <+> pretty w16 <+> (pretty . NE.toList) mpis-  pretty (SigVOther t bs) =-    pretty "unknown signature v" <> pretty t <> pretty ':' <+>-    pretty (BL.unpack bs)--instance A.ToJSON SignaturePayload where-  toJSON (SigV3 st ts eoki pka ha w16 mpis) =-    A.toJSON (st, ts, eoki, pka, ha, w16, NE.toList mpis)-  toJSON (SigV4 st pka ha hsps usps w16 mpis) =-    A.toJSON (st, pka, ha, hsps, usps, w16, NE.toList mpis)-  toJSON (SigV6 st pka ha salt hsps usps w16 mpis) =-    A.toJSON (st, pka, ha, salt, hsps, usps, w16, NE.toList mpis)-  toJSON (SigVOther t bs) = A.toJSON (t, BL.unpack bs)--data IssuerFingerprintVersion-  = IssuerFingerprintV4-  | IssuerFingerprintV6-  deriving (Data, Eq, Generic, Show, Typeable)--instance Ord IssuerFingerprintVersion where-  IssuerFingerprintV4 `compare` IssuerFingerprintV4 = EQ-  IssuerFingerprintV4 `compare` IssuerFingerprintV6 = LT-  IssuerFingerprintV6 `compare` IssuerFingerprintV4 = GT-  IssuerFingerprintV6 `compare` IssuerFingerprintV6 = EQ--instance Hashable IssuerFingerprintVersion--instance Pretty IssuerFingerprintVersion where-  pretty IssuerFingerprintV4 = pretty "4"-  pretty IssuerFingerprintV6 = pretty "6"--instance A.ToJSON IssuerFingerprintVersion where-  toJSON IssuerFingerprintV4 = A.toJSON (4 :: Word8)-  toJSON IssuerFingerprintV6 = A.toJSON (6 :: Word8)--instance A.FromJSON IssuerFingerprintVersion where-  parseJSON (A.Number n) = case round n of-   4 -> pure IssuerFingerprintV4-   6 -> pure IssuerFingerprintV6-   _ -> mzero-  parseJSON _ = mzero--issuerFingerprintVersionToPacketVersion :: IssuerFingerprintVersion -> PacketVersion-issuerFingerprintVersionToPacketVersion IssuerFingerprintV4 = 4-issuerFingerprintVersionToPacketVersion IssuerFingerprintV6 = 6--packetVersionToIssuerFingerprintVersion :: PacketVersion -> Maybe IssuerFingerprintVersion-packetVersionToIssuerFingerprintVersion 4 = Just IssuerFingerprintV4-packetVersionToIssuerFingerprintVersion 6 = Just IssuerFingerprintV6-packetVersionToIssuerFingerprintVersion _ = Nothing--data SigSubPacketPayload-  = SigCreationTime ThirtyTwoBitTimeStamp-  | SigExpirationTime ThirtyTwoBitDuration-  | ExportableCertification Exportability-  | TrustSignature TrustLevel TrustAmount-  | RegularExpression AlmostPublicDomainRegex-  | Revocable Revocability-  | KeyExpirationTime ThirtyTwoBitDuration-  | PreferredSymmetricAlgorithms [SymmetricAlgorithm]-  | RevocationKey (Set RevocationClass) PubKeyAlgorithm Fingerprint-  | Issuer EightOctetKeyId-  | NotationData (Set NotationFlag) NotationName NotationValue-  | PreferredHashAlgorithms [HashAlgorithm]-  | PreferredCompressionAlgorithms [CompressionAlgorithm]-  | KeyServerPreferences (Set KSPFlag)-  | PreferredKeyServer KeyServer-  | PrimaryUserId Bool-  | PolicyURL URL-  | KeyFlags (Set KeyFlag)-  | SignersUserId Text-  | ReasonForRevocation RevocationCode RevocationReason-  | Features (Set FeatureFlag)-  | SignatureTarget PubKeyAlgorithm HashAlgorithm SignatureHash-  | EmbeddedSignature SignaturePayload-  | IssuerFingerprint IssuerFingerprintVersion Fingerprint-  | UserDefinedSigSub Word8 ByteString-  | OtherSigSub Word8 ByteString-  deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Hashable SigSubPacketPayload--instance Pretty SigSubPacketPayload where-  pretty (SigCreationTime ts) = pretty "creation-time" <+> pretty ts-  pretty (SigExpirationTime d) = pretty "sig expiration time" <+> pretty d-  pretty (ExportableCertification e) =-    pretty "exportable certification" <+> pretty e-  pretty (TrustSignature tl ta) =-    pretty "trust signature" <+> pretty tl <+> pretty ta-  pretty (RegularExpression apdre) =-    pretty "regular expression" <+> prettyLBS apdre-  pretty (Revocable r) = pretty "revocable" <+> pretty r-  pretty (KeyExpirationTime d) = pretty "key expiration time" <+> pretty d-  pretty (PreferredSymmetricAlgorithms sas) =-    pretty "preferred symmetric algorithms" <+> pretty sas-  pretty (RevocationKey rcs pka tof) =-    pretty "revocation key" <+>-    pretty (Set.toList rcs) <+> pretty pka <+> pretty tof-  pretty (Issuer eoki) = pretty "issuer" <+> pretty eoki-  pretty (NotationData nfs nn nv) =-    pretty "notation data" <+>-    pretty (Set.toList nfs) <+> pretty nn <+> pretty nv-  pretty (PreferredHashAlgorithms phas) =-    pretty "preferred hash algorithms" <+> pretty phas-  pretty (PreferredCompressionAlgorithms pcas) =-    pretty "preferred compression algorithms" <+> pretty pcas-  pretty (KeyServerPreferences kspfs) =-    pretty "keyserver preferences" <+> pretty (Set.toList kspfs)-  pretty (PreferredKeyServer ks) = pretty "preferred keyserver" <+> prettyLBS ks-  pretty (PrimaryUserId p) =-    (if p-       then mempty-       else pretty "NOT ") <>-    pretty "primary user-ID"-  pretty (PolicyURL u) = pretty "policy URL" <+> pretty u-  pretty (KeyFlags kfs) = pretty "key flags" <+> pretty (Set.toList kfs)-  pretty (SignersUserId u) = pretty "signer's user-ID" <+> pretty u-  pretty (ReasonForRevocation rc rr) =-    pretty "reason for revocation" <+> pretty rc <+> pretty rr-  pretty (Features ffs) = pretty "features" <+> pretty (Set.toList ffs)-  pretty (SignatureTarget pka ha sh) =-    pretty "signature target" <+> pretty pka <+> pretty ha <+> prettyLBS sh-  pretty (EmbeddedSignature sp) = pretty "embedded signature" <+> pretty sp-  pretty (IssuerFingerprint kv ifp) =-    pretty "issuer fingerprint (v" <> pretty kv <> pretty ")" <+> pretty ifp-  pretty (UserDefinedSigSub t bs) =-    pretty "user-defined signature subpacket type" <+>-    pretty t <+> pretty (BL.unpack bs)-  pretty (OtherSigSub t bs) =-    pretty "unknown signature subpacket type" <+> pretty t <+> prettyLBS bs--instance A.ToJSON SigSubPacketPayload where-  toJSON (SigCreationTime ts) = object [key "sigCreationTime" .= ts]-  toJSON (SigExpirationTime d) = object [key "sigExpirationTime" .= d]-  toJSON (ExportableCertification e) =-    object [key "exportableCertification" .= e]-  toJSON (TrustSignature tl ta) = object [key "trustSignature" .= (tl, ta)]-  toJSON (RegularExpression apdre) =-    object [key "regularExpression" .= BL.unpack apdre]-  toJSON (Revocable r) = object [key "revocable" .= r]-  toJSON (KeyExpirationTime d) = object [key "keyExpirationTime" .= d]-  toJSON (PreferredSymmetricAlgorithms sas) =-    object [key "preferredSymmetricAlgorithms" .= sas]-  toJSON (RevocationKey rcs pka tof) =-    object [key "revocationKey" .= (rcs, pka, tof)]-  toJSON (Issuer eoki) = object [key "issuer" .= eoki]-  toJSON (NotationData nfs (NotationName nn) (NotationValue nv)) =-    object [key "notationData" .= (nfs, BL.unpack nn, BL.unpack nv)]-  toJSON (PreferredHashAlgorithms phas) =-    object [key "preferredHashAlgorithms" .= phas]-  toJSON (PreferredCompressionAlgorithms pcas) =-    object [key "preferredCompressionAlgorithms" .= pcas]-  toJSON (KeyServerPreferences kspfs) =-    object [key "keyServerPreferences" .= kspfs]-  toJSON (PreferredKeyServer ks) =-    object [key "preferredKeyServer" .= show ks]-  toJSON (PrimaryUserId p) = object [key "primaryUserId" .= p]-  toJSON (PolicyURL u) = object [key "policyURL" .= u]-  toJSON (KeyFlags kfs) = object [key "keyFlags" .= kfs]-  toJSON (SignersUserId u) = object [key "signersUserId" .= u]-  toJSON (ReasonForRevocation rc rr) =-    object [key "reasonForRevocation" .= (rc, rr)]-  toJSON (Features ffs) = object [key "features" .= ffs]-  toJSON (SignatureTarget pka ha sh) =-    object [key "signatureTarget" .= (pka, ha, BL.unpack sh)]-  toJSON (EmbeddedSignature sp) = object [key "embeddedSignature" .= sp]-  toJSON (IssuerFingerprint kv ifp) =-    object [key "issuerFingerprint" .= (kv, ifp)]-  toJSON (UserDefinedSigSub t bs) =-    object [key "userDefinedSigSub" .= (t, BL.unpack bs)]-  toJSON (OtherSigSub t bs) = object [key "otherSigSub" .= (t, BL.unpack bs)]--uc3 :: (a -> b -> c -> d) -> (a, b, c) -> d-uc3 f ~(a, b, c) = f a b c--instance A.FromJSON SigSubPacketPayload where-  parseJSON (A.Object v) =-    (SigCreationTime <$> v A..: key "sigCreationTime") <|>-    (SigExpirationTime <$> v A..: key "sigExpirationTime") <|>-    (ExportableCertification <$> v A..: key "exportableCertification") <|>-    (uncurry TrustSignature <$> v A..: key "trustSignature") <|>-    (RegularExpression . BL.pack <$> v A..: key "regularExpression") <|>-    (Revocable <$> v A..: key "revocable") <|>-    (KeyExpirationTime <$> v A..: key "keyExpirationTime") <|>-    (PreferredSymmetricAlgorithms <$>-     v A..: key "preferredSymmetricAlgorithms") <|>-    (uc3 RevocationKey <$> v A..: key "revocationKey") <|>-    (Issuer <$> v A..: key "issuer") <|>-    (uc3 NotationData <$> v A..: key "notationData")-  parseJSON _ = mzero--data SigSubPacket =-  SigSubPacket-    { _sspCriticality :: Bool-    , _sspPayload :: SigSubPacketPayload-    }-  deriving (Data, Eq, Generic, Show, Typeable)--instance Ord SigSubPacket where-  compare (SigSubPacket crit1 payload1) (SigSubPacket crit2 payload2) =-    compare crit1 crit2 <> compare payload1 payload2--instance Pretty SigSubPacket where-  pretty x =-    (if _sspCriticality x-       then pretty '*'-       else mempty) <>-    (pretty . _sspPayload) x--instance Hashable SigSubPacket--instance A.ToJSON SigSubPacket-instance A.FromJSON SigSubPacket--$(makeLenses ''SigSubPacket)---- | Type-safe subpacket list with phantom types to distinguish hashed vs unhashed--- and signature version constraints (v4 vs v6).--- The type parameters erase at runtime; they exist purely for compile-time safety.-newtype SubpacketList (hashedness :: Type) (version :: Type) = SubpacketList [SigSubPacket]-  deriving (Show, Eq, Ord, Generic, Data, Typeable)--instance Functor (SubpacketList h) where-  fmap _ (SubpacketList sps) = SubpacketList sps---- | Extract the underlying list from a phantom-typed SubpacketList--- This is typically used internally during serialization/deserialization-fromSubpacketList :: SubpacketList h v -> [SigSubPacket]-fromSubpacketList (SubpacketList sps) = sps---- | Wrap a plain list into a phantom-typed SubpacketList--- Warning: This circumvents type safety; use only for trusted sources (e.g., parsing)-toSubpacketList :: [SigSubPacket] -> SubpacketList h v-toSubpacketList = SubpacketList---- | Create an empty hashed subpacket list for a given signature version-emptyHashedSubpackets :: SubpacketList Hashed v-emptyHashedSubpackets = SubpacketList []---- | Create an empty unhashed subpacket list for a given signature version-emptyUnhashedSubpackets :: SubpacketList Unhashed v-emptyUnhashedSubpackets = SubpacketList []---- | Append a subpacket to a hashed list, preserving phantom type-consHashedSubpacket :: SigSubPacket -> SubpacketList Hashed v -> SubpacketList Hashed v-consHashedSubpacket sp (SubpacketList sps) = SubpacketList (sp : sps)---- | Append a subpacket to an unhashed list, preserving phantom type-consUnhashedSubpacket :: SigSubPacket -> SubpacketList Unhashed v -> SubpacketList Unhashed v-consUnhashedSubpacket sp (SubpacketList sps) = SubpacketList (sp : sps)--data KeyVersion-  = DeprecatedV3-  | V4-  | V6-  deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Hashable KeyVersion--instance Pretty KeyVersion where-  pretty DeprecatedV3 = pretty "(deprecated) v3"-  pretty V4 = pretty "v4"-  pretty V6 = pretty "v6"--$(ATH.deriveJSON ATH.defaultOptions ''KeyVersion)--newtype IV =-  IV-    { unIV :: B.ByteString-    }-  deriving ( ByteArrayAccess-           , Data-           , Eq-           , Generic-           , Hashable-           , Semigroup-           , Monoid-           , Show-           , Typeable-           )--instance Wrapped IV--instance Ord IV where-  compare (IV b1) (IV b2) = compare b1 b2--instance Pretty IV where-  pretty = pretty . ("iv:" ++) . bsToHexUpper . BL.fromStrict . op IV--instance A.ToJSON IV where-  toJSON = A.toJSON . show . op IV--data DataType-  = BinaryData-  | TextData-  | UTF8Data-  | OtherData Word8-  deriving (Show, Data, Generic, Typeable)--instance Hashable DataType--instance Eq DataType where-  (==) a b = fromFVal a == fromFVal b--instance Ord DataType where-  compare = comparing fromFVal--instance FutureVal DataType where-  fromFVal BinaryData = fromIntegral . fromEnum $ 'b'-  fromFVal TextData = fromIntegral . fromEnum $ 't'-  fromFVal UTF8Data = fromIntegral . fromEnum $ 'u'-  fromFVal (OtherData o) = o-  toFVal 0x62 = BinaryData-  toFVal 0x74 = TextData-  toFVal 0x75 = UTF8Data-  toFVal o = OtherData o--instance Pretty DataType where-  pretty BinaryData = pretty "binary"-  pretty TextData = pretty "text"-  pretty UTF8Data = pretty "UTF-8"-  pretty (OtherData o) = pretty "other data type " <+> pretty o--$(ATH.deriveJSON ATH.defaultOptions ''DataType)--newtype SessionKey =-  SessionKey-    { unSessionKey :: B.ByteString-    }-  deriving (Data, Eq, Generic, Hashable, Show, Typeable)--instance Wrapped SessionKey--instance Ord SessionKey where-  compare (SessionKey b1) (SessionKey b2) = compare b1 b2--newtype Salt =-  Salt-    { unSalt :: B.ByteString-    }-  deriving (Data, Eq, Generic, Hashable, Show, Typeable)--instance Wrapped Salt--instance Ord Salt where-  compare (Salt b1) (Salt b2) = compare b1 b2--instance Pretty Salt where-  pretty = pretty . ("salt:" ++) . bsToHexUpper . BL.fromStrict . op Salt--instance A.ToJSON Salt where-  toJSON = A.toJSON . show . op Salt--newtype Salt8 =-  Salt8-    { unSalt8 :: B.ByteString-    }-  deriving (Data, Eq, Generic, Hashable, Show, Typeable)--instance Wrapped Salt8--instance Ord Salt8 where-  compare (Salt8 b1) (Salt8 b2) = compare b1 b2--instance Pretty Salt8 where-  pretty = pretty . ("salt8:" ++) . bsToHexUpper . BL.fromStrict . op Salt8--instance A.ToJSON Salt8 where-  toJSON = A.toJSON . show . op Salt8--newtype Salt16 =-  Salt16-    { unSalt16 :: B.ByteString-    }-  deriving (Data, Eq, Generic, Hashable, Show, Typeable)--instance Wrapped Salt16--instance Ord Salt16 where-  compare (Salt16 b1) (Salt16 b2) = compare b1 b2--instance Pretty Salt16 where-  pretty = pretty . ("salt16:" ++) . bsToHexUpper . BL.fromStrict . op Salt16--instance A.ToJSON Salt16 where-  toJSON = A.toJSON . show . op Salt16--salt8FromSalt :: Salt -> Maybe Salt8-salt8FromSalt (Salt bs)-  | B.length bs == 8 = Just (Salt8 bs)-  | otherwise = Nothing--salt16FromSalt :: Salt -> Maybe Salt16-salt16FromSalt (Salt bs)-  | B.length bs == 16 = Just (Salt16 bs)-  | otherwise = Nothing--saltFromSalt8 :: Salt8 -> Salt-saltFromSalt8 (Salt8 bs) = Salt bs--saltFromSalt16 :: Salt16 -> Salt-saltFromSalt16 (Salt16 bs) = Salt bs--newtype IterationCount =-  IterationCount-    { unIterationCount :: Int-    }-  deriving ( Bounded-           , Data-           , Enum-           , Eq-           , Generic-           , Hashable-           , Integral-           , Num-           , Ord-           , Real-           , Show-           , Typeable-           )--instance Wrapped IterationCount--instance Pretty IterationCount where-  pretty = pretty . op IterationCount--$(ATH.deriveJSON ATH.defaultOptions ''IterationCount)--data S2K-  = Simple HashAlgorithm-  | Salted HashAlgorithm Salt8-  | IteratedSalted HashAlgorithm Salt8 IterationCount-  | Argon2 Salt16 Word8 Word8 Word8-  | OtherS2K Word8 ByteString-  deriving (Data, Eq, Generic, Show, Typeable)--instance Hashable S2K--instance Ord S2K where-  compare (Simple ha1) (Simple ha2) = compare ha1 ha2-  compare (Salted ha1 s1) (Salted ha2 s2) = compare ha1 ha2 <> compare s1 s2-  compare (IteratedSalted ha1 s1 ic1) (IteratedSalted ha2 s2 ic2) =-    compare ha1 ha2 <> compare s1 s2 <> compare ic1 ic2-  compare (Argon2 salt1 t1 p1 em1) (Argon2 salt2 t2 p2 em2) =-    compare salt1 salt2 <> compare t1 t2 <> compare p1 p2 <> compare em1 em2-  compare (OtherS2K t1 bs1) (OtherS2K t2 bs2) = compare t1 t2 <> compare bs1 bs2-  compare Simple {} Salted {} = LT-  compare Simple {} IteratedSalted {} = LT-  compare Simple {} Argon2 {} = LT-  compare Simple {} OtherS2K {} = LT-  compare Salted {} Simple {} = GT-  compare Salted {} IteratedSalted {} = LT-  compare Salted {} Argon2 {} = LT-  compare Salted {} OtherS2K {} = LT-  compare IteratedSalted {} Simple {} = GT-  compare IteratedSalted {} Salted {} = GT-  compare IteratedSalted {} Argon2 {} = LT-  compare IteratedSalted {} OtherS2K {} = LT-  compare Argon2 {} Simple {} = GT-  compare Argon2 {} Salted {} = GT-  compare Argon2 {} IteratedSalted {} = GT-  compare Argon2 {} OtherS2K {} = LT-  compare OtherS2K {} _ = GT--instance Pretty S2K where-  pretty (Simple ha) = pretty "simple S2K," <+> pretty ha-  pretty (Salted ha salt) = pretty "salted S2K," <+> pretty ha <+> pretty salt-  pretty (IteratedSalted ha salt icount) =-    pretty "iterated-salted S2K," <+>-    pretty ha <+> pretty salt <+> pretty icount-  pretty (Argon2 salt t p em) =-    pretty "Argon2 S2K," <+>-    pretty salt <+> pretty t <+> pretty p <+> pretty em-  pretty (OtherS2K t bs) =-    pretty "unknown S2K type" <+> pretty t <+> pretty (bsToHexUpper bs)--instance A.ToJSON S2K where-  toJSON (Simple ha) = A.toJSON ha-  toJSON (Salted ha salt) = A.toJSON (ha, salt)-  toJSON (IteratedSalted ha salt icount) = A.toJSON (ha, salt, icount)-  toJSON (Argon2 salt t p em) = A.toJSON (salt, t, p, em)-  toJSON (OtherS2K t bs) = A.toJSON (t, BL.unpack bs)--data ImageFormat-  = JPEG-  | OtherImage Word8-  deriving (Data, Generic, Show, Typeable)--instance Eq ImageFormat where-  (==) a b = fromFVal a == fromFVal b--instance Ord ImageFormat where-  compare = comparing fromFVal--instance FutureVal ImageFormat where-  fromFVal JPEG = 1-  fromFVal (OtherImage o) = o-  toFVal 1 = JPEG-  toFVal o = OtherImage o--instance Hashable ImageFormat--instance Pretty ImageFormat where-  pretty JPEG = pretty "JPEG"-  pretty (OtherImage o) = pretty "unknown image format" <+> pretty o--$(ATH.deriveJSON ATH.defaultOptions ''ImageFormat)--newtype ImageHeader =-  ImageHV1 ImageFormat-  deriving (Data, Eq, Generic, Show, Typeable)--instance Ord ImageHeader where-  compare (ImageHV1 a) (ImageHV1 b) = compare a b--instance Hashable ImageHeader--instance Pretty ImageHeader where-  pretty (ImageHV1 f) = pretty "imghdr v1" <+> pretty f--$(ATH.deriveJSON ATH.defaultOptions ''ImageHeader)--data UserAttrSubPacket-  = ImageAttribute ImageHeader ImageData-  | OtherUASub Word8 ByteString-  deriving (Data, Eq, Generic, Show, Typeable)--instance Hashable UserAttrSubPacket--instance Ord UserAttrSubPacket where-  compare (ImageAttribute h1 d1) (ImageAttribute h2 d2) =-    compare h1 h2 <> compare d1 d2-  compare (ImageAttribute _ _) (OtherUASub _ _) = LT-  compare (OtherUASub _ _) (ImageAttribute _ _) = GT-  compare (OtherUASub t1 b1) (OtherUASub t2 b2) = compare t1 t2 <> compare b1 b2--instance Pretty UserAttrSubPacket where-  pretty (ImageAttribute ih d) =-    pretty "image-attribute" <+> pretty ih <+> pretty (BL.unpack d)-  pretty (OtherUASub t bs) =-    pretty "unknown attribute type" <> pretty t <+> pretty (BL.unpack bs)--instance A.ToJSON UserAttrSubPacket where-  toJSON (ImageAttribute ih d) = A.toJSON (ih, BL.unpack d)-  toJSON (OtherUASub t bs) = A.toJSON (t, BL.unpack bs)--data ECCCurve-  = NISTP256-  | NISTP384-  | NISTP521-  | Curve25519-  | Curve448-  deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Pretty ECCCurve where-  pretty NISTP256 = pretty "NIST P-256"-  pretty NISTP384 = pretty "NIST P-384"-  pretty NISTP521 = pretty "NIST P-521"-  pretty Curve25519 = pretty "Curve25519"-  pretty Curve448 = pretty "Curve448"--instance Hashable ECCCurve---- Packet stream wrapper used to provide an EOF-delimited Binary instance.-newtype Block a =-  Block-    { unBlock :: [a]-    } -- intentionally not encoded as a list length prefix-  deriving (Show, Eq)+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}++module Codec.Encryption.OpenPGP.Types.Internal.Base+    ( KeyVersion (..)+    , IV (..)+    , S2K (..)+    , SymmetricAlgorithm (..)+    , AEADAlgorithm (..)+    , PubKeyAlgorithm (..)+    , ThirtyTwoBitTimeStamp (..)+    , ThirtyTwoBitDuration (..)+    , Exportability+    , TrustLevel+    , TrustAmount+    , AlmostPublicDomainRegex+    , Revocability+    , RevocationReason+    , KeyServer+    , SignatureHash+    , PacketVersion+    , V3Expiration+    , CompressedDataPayload+    , FileName+    , ImageData+    , NestedFlag+    , HashAlgorithm (..)+    , bsToHexUpper+    , Hashed+    , Unhashed+    , V4Sig+    , V6Sig+    , ByteRange (..)+    , WireRepSourceId (..)+    , WireRepRef (..)+    , WireRepRefs+    , wireRepRef+    , namedWireRepRef+    , mkWireRepRefWithLength+    , mkWireRepRef+    , SignaturePayload (..)+    , Fingerprint (..)+    , SessionKey (..)+    , SigType (..)+    , SignatureSalt (..)+    , Salt (..)+    , Salt8 (..)+    , Salt16 (..)+    , CompressionAlgorithm (..)+    , LiteralDataType (..)+    , UserAttrSubPacket (..)+    , EightOctetKeyId (..)+    , MPI (..)+    , SignaturePayloadVersion (..)+    , SignaturePayloadV (..)+    , SomeSignaturePayload (..)+    , toSignaturePayload+    , toSomeSignaturePayload+    , signaturePayloadVersion+    , asSignaturePayloadV3+    , asSignaturePayloadV4+    , asSignaturePayloadV6+    , asSignaturePayloadOther+    , FutureVal (..)+    , SigSubPacket (..)+    , SigSubPacketPayload (..)+    , ECCCurve (..)+    , IssuerFingerprintVersion (..)+    , IterationCount (..)+    , salt8FromSalt+    , salt16FromSalt+    , saltFromSalt8+    , saltFromSalt16+    , Block (..)+    , FutureFlag (..)+    , ImageHeader (..)+    , issuerFingerprintVersionToPacketVersion+    , packetVersionToIssuerFingerprintVersion+    , NotationName (..)+    , NotationValue (..)+    , URL (..)+    , RevocationClass (..)+    , SubpacketList (..)+    , fromSubpacketList+    , toSubpacketList+    , emptyHashedSubpackets+    , emptyUnhashedSubpackets+    , consHashedSubpacket+    , consUnhashedSubpacket+    , spanByteRanges+    , RevocationCode (..)+    , KeyFlag (..)+    , KeyIdentifier (..)+    , FeatureFlag (..)+    , NotationFlag (..)+    , KSPFlag (..)+    , mkRevocationClass+    , mkNotationFlag+    , SpacedFingerprint (..)+    , ImageFormat (..)+    ) where++import Control.Applicative ((<|>))+import Control.Arrow ((***))+import Control.Lens (Wrapped, makeLenses, op)+import Control.Monad (mzero)+import Data.Aeson (object, (.=))+import qualified Data.Aeson as A+import qualified Data.Aeson.Key as AK+import qualified Data.Aeson.TH as ATH+import Data.Bits ((.&.))+import Data.ByteArray (ByteArrayAccess)+import qualified Data.ByteString as B+import qualified Data.ByteString.Base16.Lazy as B16L+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC8+import Data.Char (toLower, toUpper)+import Data.Data (Data)+import Data.Hashable (Hashable (..))+import Data.IORef (IORef, atomicModifyIORef', newIORef)+import Data.Int (Int64)+import Data.Kind (Type)+import Data.List (unfoldr)+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE+import Data.List.Split (chunksOf)+import Data.Maybe (fromMaybe)+import Data.Ord (comparing)+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Text (Text)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Time.Format (formatTime)+import Data.Time.Locale.Compat (defaultTimeLocale)+import Data.Typeable (Typeable)+import Data.Word (Word16, Word32, Word8)+import GHC.Generics (Generic)+import Network.URI (URI (..), nullURI, parseURI, uriToString)+import Numeric (readHex)+import Prettyprinter (Pretty (..), hsep, punctuate, space, (<+>))+import System.IO.Unsafe (unsafePerformIO)++import Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils+    ( prettyLBS+    )++type Exportability = Bool++type TrustLevel = Word8++type TrustAmount = Word8++type AlmostPublicDomainRegex = ByteString++type Revocability = Bool++type RevocationReason = Text++type KeyServer = ByteString++type SignatureHash = ByteString++type PacketVersion = Word8++type V3Expiration = Word16++type CompressedDataPayload = ByteString++type FileName = ByteString++type ImageData = ByteString++type NestedFlag = Bool++{- | Phantom types for tracking subpacket classification and signature version+These types are never instantiated; they exist purely for compile-time type safety.+-}++-- | Phantom marker for hashed subpackets (included in signature hash computation)+data Hashed++-- | Phantom marker for unhashed subpackets (not included in signature hash computation)+data Unhashed++-- | Phantom marker for v4 signatures (8-octet issuer, no salt)+data V4Sig++-- | Phantom marker for v6 signatures (fingerprint issuer, requires salt)+data V6Sig++data ByteRange+    = ByteRange+    { _rangeOffset :: Int64+    , _rangeLength :: Int64+    }+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++newtype WireRepSourceId+    = WireRepSourceId+    { _unWireRepSourceId :: Int64+    }+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++data WireRepRef+    = WireRepRef+    { _wireRepSourceId :: WireRepSourceId+    , _wireRepLength :: Int64+    , _wireRepName :: Maybe Text+    , _wireRepWasOriginallyArmored :: Bool+    }+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++type WireRepRefs = NonEmpty WireRepRef++-- FIXME: these functions should be moved into a separate module+wireRepRef :: ByteString -> WireRepRef+wireRepRef = mkWireRepRefWithLength Nothing False . BL.length++namedWireRepRef :: Text -> ByteString -> WireRepRef+namedWireRepRef name = mkWireRepRefWithLength (Just name) False . BL.length++mkWireRepRefWithLength+    :: Maybe Text -> Bool -> Int64 -> WireRepRef+mkWireRepRefWithLength mname wasOriginallyArmored payloadLen =+    WireRepRef+        { _wireRepSourceId = freshWireRepSourceId payloadLen+        , _wireRepLength = payloadLen+        , _wireRepName = mname+        , _wireRepWasOriginallyArmored = wasOriginallyArmored+        }++mkWireRepRef :: Maybe Text -> Bool -> ByteString -> WireRepRef+mkWireRepRef mname wasOriginallyArmored =+    mkWireRepRefWithLength mname wasOriginallyArmored . BL.length++wireRepSourceCounter :: IORef Int64+wireRepSourceCounter = unsafePerformIO (newIORef 0)+{-# NOINLINE wireRepSourceCounter #-}+freshWireRepSourceId :: Int64 -> WireRepSourceId+freshWireRepSourceId !_ =+    unsafePerformIO $+        atomicModifyIORef'+            wireRepSourceCounter+            ( \n ->+                let n' = n + 1+                 in (n', WireRepSourceId n')+            )+{-# NOINLINE freshWireRepSourceId #-}+rangeEnd :: ByteRange -> Int64+rangeEnd r = _rangeOffset r + _rangeLength r++spanByteRanges :: [ByteRange] -> Maybe ByteRange+spanByteRanges [] = Nothing+spanByteRanges (r : rs) =+    let start = minimum (_rangeOffset <$> (r : rs))+        ending = maximum (rangeEnd <$> (r : rs))+     in Just (ByteRange start (ending - start))++$(makeLenses ''ByteRange)++$(makeLenses ''WireRepRef)++class+    (Eq a, Ord a) =>+    FutureFlag a+    where+    fromFFlag :: a -> Int+    toFFlag :: Int -> a++class+    (Eq a, Ord a) =>+    FutureVal a+    where+    fromFVal :: a -> Word8+    toFVal :: Word8 -> a++data SymmetricAlgorithm+    = Plaintext+    | IDEA+    | TripleDES+    | CAST5+    | Blowfish+    | ReservedSAFER+    | ReservedDES+    | AES128+    | AES192+    | AES256+    | Twofish+    | Camellia128+    | Camellia192+    | Camellia256+    | OtherSA Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq SymmetricAlgorithm where+    (==) a b = fromFVal a == fromFVal b++instance Ord SymmetricAlgorithm where+    compare = comparing fromFVal++instance FutureVal SymmetricAlgorithm where+    fromFVal Plaintext = 0+    fromFVal IDEA = 1+    fromFVal TripleDES = 2+    fromFVal CAST5 = 3+    fromFVal Blowfish = 4+    fromFVal ReservedSAFER = 5+    fromFVal ReservedDES = 6+    fromFVal AES128 = 7+    fromFVal AES192 = 8+    fromFVal AES256 = 9+    fromFVal Twofish = 10+    fromFVal Camellia128 = 11+    fromFVal Camellia192 = 12+    fromFVal Camellia256 = 13+    fromFVal (OtherSA o) = o+    toFVal 0 = Plaintext+    toFVal 1 = IDEA+    toFVal 2 = TripleDES+    toFVal 3 = CAST5+    toFVal 4 = Blowfish+    toFVal 5 = ReservedSAFER+    toFVal 6 = ReservedDES+    toFVal 7 = AES128+    toFVal 8 = AES192+    toFVal 9 = AES256+    toFVal 10 = Twofish+    toFVal 11 = Camellia128+    toFVal 12 = Camellia192+    toFVal 13 = Camellia256+    toFVal o = OtherSA o++instance Hashable SymmetricAlgorithm++instance Pretty SymmetricAlgorithm where+    pretty Plaintext = pretty "plaintext"+    pretty IDEA = pretty "IDEA"+    pretty TripleDES = pretty "3DES"+    pretty CAST5 = pretty "CAST-128"+    pretty Blowfish = pretty "Blowfish"+    pretty ReservedSAFER = pretty "(reserved) SAFER"+    pretty ReservedDES = pretty "(reserved) DES"+    pretty AES128 = pretty "AES-128"+    pretty AES192 = pretty "AES-192"+    pretty AES256 = pretty "AES-256"+    pretty Twofish = pretty "Twofish"+    pretty Camellia128 = pretty "Camellia-128"+    pretty Camellia192 = pretty "Camellia-192"+    pretty Camellia256 = pretty "Camellia-256"+    pretty (OtherSA sa) = pretty "unknown symmetric algorithm" <+> pretty sa++$(ATH.deriveJSON ATH.defaultOptions ''SymmetricAlgorithm)++data NotationFlag+    = HumanReadable+    | OtherNF Word8+    deriving (Data, Generic, Show, Typeable)++mkNotationFlag :: Word8 -> NotationFlag+mkNotationFlag o+    | o' == 0 = HumanReadable+    | otherwise = OtherNF o'+  where+    o' = o .&. 0x0f++instance Eq NotationFlag where+    (==) a b = fromFFlag a == fromFFlag b++instance Ord NotationFlag where+    compare = comparing fromFFlag++instance FutureFlag NotationFlag where+    fromFFlag HumanReadable = 0+    fromFFlag (OtherNF o) = fromIntegral (o .&. 0x0f)+    toFFlag 0 = HumanReadable+    toFFlag o = mkNotationFlag (fromIntegral o)++instance Hashable NotationFlag++instance Pretty NotationFlag where+    pretty HumanReadable = pretty "human-readable"+    pretty (OtherNF o) = pretty "unknown notation flag type" <+> pretty o++$(ATH.deriveJSON ATH.defaultOptions ''NotationFlag)++newtype ThirtyTwoBitTimeStamp+    = ThirtyTwoBitTimeStamp+    { unThirtyTwoBitTimeStamp :: Word32+    }+    deriving+        ( Bounded+        , Data+        , Enum+        , Eq+        , Generic+        , Hashable+        , Integral+        , Num+        , Ord+        , Real+        , Show+        , Typeable+        )++instance Wrapped ThirtyTwoBitTimeStamp++instance Pretty ThirtyTwoBitTimeStamp where+    pretty =+        pretty+            . formatTime defaultTimeLocale "%Y%m%d-%H%M%S"+            . posixSecondsToUTCTime+            . realToFrac++$(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitTimeStamp)++durU :: (Integral a, Show a) => a -> Maybe (String, a)+durU x+    | x >= 31557600 =+        Just ((++ "y") . show $ x `div` 31557600, x `mod` 31557600)+    | x >= 2629800 =+        Just ((++ "m") . show $ x `div` 2629800, x `mod` 2629800)+    | x >= 86400 =+        Just ((++ "d") . show $ x `div` 86400, x `mod` 86400)+    | x > 0 = Just ((++ "s") . show $ x, 0)+    | otherwise = Nothing++newtype ThirtyTwoBitDuration+    = ThirtyTwoBitDuration+    { unThirtyTwoBitDuration :: Word32+    }+    deriving+        ( Bounded+        , Data+        , Enum+        , Eq+        , Generic+        , Hashable+        , Integral+        , Num+        , Ord+        , Real+        , Show+        , Typeable+        )++instance Wrapped ThirtyTwoBitDuration++instance Pretty ThirtyTwoBitDuration where+    pretty = pretty . concat . unfoldr durU . op ThirtyTwoBitDuration++$(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitDuration)++data RevocationClass+    = SensitiveRK+    | RClOther Word8+    deriving (Data, Generic, Show, Typeable)++mkRevocationClass :: Word8 -> RevocationClass+mkRevocationClass i+    | i' == 1 = SensitiveRK+    | otherwise = RClOther i'+  where+    i' = i .&. 0x07++instance Eq RevocationClass where+    (==) a b = fromFFlag a == fromFFlag b++instance Ord RevocationClass where+    compare = comparing fromFFlag++instance FutureFlag RevocationClass where+    fromFFlag SensitiveRK = 1+    fromFFlag (RClOther i) = fromIntegral (i .&. 0x07)+    toFFlag 1 = SensitiveRK+    toFFlag i = mkRevocationClass (fromIntegral i)++instance Hashable RevocationClass++instance Pretty RevocationClass where+    pretty SensitiveRK = pretty "sensitive"+    pretty (RClOther o) = pretty "unknown revocation class" <+> pretty o++$(ATH.deriveJSON ATH.defaultOptions ''RevocationClass)++data PubKeyAlgorithm+    = RSA+    | DeprecatedRSAEncryptOnly+    | DeprecatedRSASignOnly+    | ElgamalEncryptOnly+    | DSA+    | ECDH+    | ECDSA+    | ForbiddenElgamal+    | DH+    | EdDSA+    | X25519+    | X448+    | Ed25519+    | Ed448+    | MLDSA65Ed25519 -- ID 30: ML-DSA-65+Ed25519+    | MLDSA87Ed448 -- ID 31: ML-DSA-87+Ed448+    | SLHDSASHAKE128s -- ID 32: SLH-DSA-SHAKE-128s+    | SLHDSASHAKE128f -- ID 33: SLH-DSA-SHAKE-128f+    | SLHDSASHAKE256s -- ID 34: SLH-DSA-SHAKE-256s+    | MLKEM768X25519 -- ID 35: ML-KEM-768+X25519+    | MLKEM1024X448 -- ID 36: ML-KEM-1024+X448+    | OtherPKA Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq PubKeyAlgorithm where+    (==) a b = fromFVal a == fromFVal b++instance Ord PubKeyAlgorithm where+    compare = comparing fromFVal++instance FutureVal PubKeyAlgorithm where+    fromFVal RSA = 1+    fromFVal DeprecatedRSAEncryptOnly = 2+    fromFVal DeprecatedRSASignOnly = 3+    fromFVal ElgamalEncryptOnly = 16+    fromFVal DSA = 17+    fromFVal ECDH = 18+    fromFVal ECDSA = 19+    fromFVal ForbiddenElgamal = 20+    fromFVal DH = 21+    fromFVal EdDSA = 22+    fromFVal X25519 = 25+    fromFVal X448 = 26+    fromFVal Ed25519 = 27+    fromFVal Ed448 = 28+    fromFVal MLDSA65Ed25519 = 30+    fromFVal MLDSA87Ed448 = 31+    fromFVal SLHDSASHAKE128s = 32+    fromFVal SLHDSASHAKE128f = 33+    fromFVal SLHDSASHAKE256s = 34+    fromFVal MLKEM768X25519 = 35+    fromFVal MLKEM1024X448 = 36+    fromFVal (OtherPKA o) = o+    toFVal 1 = RSA+    toFVal 2 = DeprecatedRSAEncryptOnly+    toFVal 3 = DeprecatedRSASignOnly+    toFVal 16 = ElgamalEncryptOnly+    toFVal 17 = DSA+    toFVal 18 = ECDH+    toFVal 19 = ECDSA+    toFVal 20 = ForbiddenElgamal+    toFVal 21 = DH+    toFVal 22 = EdDSA+    toFVal 25 = X25519+    toFVal 26 = X448+    toFVal 27 = Ed25519+    toFVal 28 = Ed448+    toFVal 30 = MLDSA65Ed25519+    toFVal 31 = MLDSA87Ed448+    toFVal 32 = SLHDSASHAKE128s+    toFVal 33 = SLHDSASHAKE128f+    toFVal 34 = SLHDSASHAKE256s+    toFVal 35 = MLKEM768X25519+    toFVal 36 = MLKEM1024X448+    toFVal o = OtherPKA o++instance Hashable PubKeyAlgorithm++instance Pretty PubKeyAlgorithm where+    pretty RSA = pretty "RSA"+    pretty DeprecatedRSAEncryptOnly = pretty "(deprecated) RSA encrypt-only"+    pretty DeprecatedRSASignOnly = pretty "(deprecated) RSA sign-only"+    pretty ElgamalEncryptOnly = pretty "Elgamal encrypt-only"+    pretty DSA = pretty "DSA"+    pretty ECDH = pretty "ECDH"+    pretty ECDSA = pretty "ECDSA"+    pretty ForbiddenElgamal = pretty "(forbidden) Elgamal"+    pretty DH = pretty "DH"+    pretty EdDSA = pretty "EdDSA"+    pretty X25519 = pretty "X25519"+    pretty X448 = pretty "X448"+    pretty Ed25519 = pretty "Ed25519"+    pretty Ed448 = pretty "Ed448"+    pretty MLDSA65Ed25519 = pretty "ML-DSA-65+Ed25519"+    pretty MLDSA87Ed448 = pretty "ML-DSA-87+Ed448"+    pretty SLHDSASHAKE128s = pretty "SLH-DSA-SHAKE-128s"+    pretty SLHDSASHAKE128f = pretty "SLH-DSA-SHAKE-128f"+    pretty SLHDSASHAKE256s = pretty "SLH-DSA-SHAKE-256s"+    pretty MLKEM768X25519 = pretty "ML-KEM-768+X25519"+    pretty MLKEM1024X448 = pretty "ML-KEM-1024+X448"+    pretty (OtherPKA pka) = pretty "unknown pubkey algorithm type" <+> pretty pka++$(ATH.deriveJSON ATH.defaultOptions ''PubKeyAlgorithm)++{- | An OpenPGP fingerprint.  Length depends on key version:+16 bytes (v3/MD5), 20 bytes (v4/SHA-1), or 32 bytes (v6/SHA-256).+-}+newtype Fingerprint+    = Fingerprint+    { unFingerprint :: ByteString+    }+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Wrapped Fingerprint++instance Read Fingerprint where+    readsPrec _ s =+        let ws = hexToW8s (filter (/= ' ') s)+         in if null ws+                then []+                else [(Fingerprint (BL.pack (map fst ws)), snd (last ws))]++instance Hashable Fingerprint++instance Pretty Fingerprint where+    pretty = pretty . bsToHexUpper . unFingerprint++instance A.ToJSON Fingerprint where+    toJSON e = object [AK.fromString "fpr" .= (A.toJSON . show . pretty) e]++instance A.FromJSON Fingerprint where+    parseJSON (A.Object v) = Fingerprint . read <$> v A..: AK.fromString "fpr"+    parseJSON _ = mzero++newtype SpacedFingerprint+    = SpacedFingerprint+    { unSpacedFingerprint :: Fingerprint+    }+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Wrapped SpacedFingerprint++instance Pretty SpacedFingerprint where+    pretty =+        hsep+            . punctuate space+            . map hsep+            . chunksOf 5+            . map pretty+            . chunksOf 4+            . bsToHexUpper+            . unFingerprint+            . op SpacedFingerprint++bsToHexUpper :: ByteString -> String+bsToHexUpper = map toUpper . BLC8.unpack . B16L.encode++hexToW8s :: ReadS Word8+hexToW8s = concatMap readHex . chunksOf 2 . map toLower++newtype EightOctetKeyId+    = EightOctetKeyId+    { unEOKI :: ByteString+    }+    deriving (Data, Eq, Generic, Ord, Typeable)++instance Wrapped EightOctetKeyId++instance Pretty EightOctetKeyId where+    pretty = pretty . bsToHexUpper . op EightOctetKeyId++instance Show EightOctetKeyId where+    show = bsToHexUpper . op EightOctetKeyId++instance Read EightOctetKeyId where+    readsPrec _ =+        map ((EightOctetKeyId . BL.pack *** concat) . unzip)+            . chunksOf 8+            . hexToW8s++instance Hashable EightOctetKeyId++instance A.ToJSON EightOctetKeyId where+    toJSON e =+        object+            [AK.fromString "eoki" .= (bsToHexUpper . op EightOctetKeyId) e]++instance A.FromJSON EightOctetKeyId where+    parseJSON (A.Object v) =+        EightOctetKeyId . read <$> v A..: AK.fromString "eoki"+    parseJSON _ = mzero++data KeyIdentifier+    = KeyIdentifierWildcard+    | KeyIdentifierEightOctet EightOctetKeyId+    | KeyIdentifierFingerprint Fingerprint+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Pretty KeyIdentifier where+    pretty KeyIdentifierWildcard = pretty "wildcard"+    pretty (KeyIdentifierEightOctet kid) = pretty "key-id" <+> pretty kid+    pretty (KeyIdentifierFingerprint fp) = pretty "fingerprint" <+> pretty fp++instance A.ToJSON KeyIdentifier where+    toJSON KeyIdentifierWildcard =+        object [AK.fromString "wildcard" .= A.Bool True]+    toJSON (KeyIdentifierEightOctet kid) = object [AK.fromString "keyId" .= kid]+    toJSON (KeyIdentifierFingerprint fp) =+        object [AK.fromString "fingerprint" .= fp]++instance A.FromJSON KeyIdentifier where+    parseJSON (A.Object v) =+        ( (v A..: AK.fromString "wildcard") >>= \isWildcard ->+            if isWildcard+                then pure KeyIdentifierWildcard+                else mzero+        )+            <|> (KeyIdentifierEightOctet <$> v A..: AK.fromString "keyId")+            <|> (KeyIdentifierFingerprint <$> v A..: AK.fromString "fingerprint")+    parseJSON _ = mzero++newtype NotationName+    = NotationName+    { unNotationName :: ByteString+    }+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)++instance Pretty NotationName where+    pretty = prettyLBS . unNotationName++instance Wrapped NotationName++instance A.ToJSON NotationName where+    toJSON nn =+        object+            [AK.fromString "notationname" .= show (op NotationName nn)]++instance A.FromJSON NotationName where+    parseJSON (A.Object v) =+        NotationName . read <$> v A..: AK.fromString "notationname"+    parseJSON _ = mzero++newtype NotationValue+    = NotationValue+    { unNotationValue :: ByteString+    }+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)++instance Pretty NotationValue where+    pretty = prettyLBS . unNotationValue++instance Wrapped NotationValue++instance A.ToJSON NotationValue where+    toJSON nv =+        object+            [AK.fromString "notationvalue" .= show (op NotationValue nv)]++instance A.FromJSON NotationValue where+    parseJSON (A.Object v) =+        NotationValue . read <$> v A..: AK.fromString "notationvalue"+    parseJSON _ = mzero++data HashAlgorithm+    = DeprecatedMD5+    | SHA1+    | RIPEMD160+    | SHA256+    | SHA384+    | SHA512+    | SHA224+    | SHA3_256+    | SHA3_512+    | OtherHA Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq HashAlgorithm where+    (==) a b = fromFVal a == fromFVal b++instance Ord HashAlgorithm where+    compare = comparing fromFVal++instance FutureVal HashAlgorithm where+    fromFVal DeprecatedMD5 = 1+    fromFVal SHA1 = 2+    fromFVal RIPEMD160 = 3+    fromFVal SHA256 = 8+    fromFVal SHA384 = 9+    fromFVal SHA512 = 10+    fromFVal SHA224 = 11+    fromFVal SHA3_256 = 12+    fromFVal SHA3_512 = 14+    fromFVal (OtherHA o) = o+    toFVal 1 = DeprecatedMD5+    toFVal 2 = SHA1+    toFVal 3 = RIPEMD160+    toFVal 8 = SHA256+    toFVal 9 = SHA384+    toFVal 10 = SHA512+    toFVal 11 = SHA224+    toFVal 12 = SHA3_256+    toFVal 14 = SHA3_512+    toFVal o = OtherHA o++instance Hashable HashAlgorithm++instance Pretty HashAlgorithm where+    pretty DeprecatedMD5 = pretty "(deprecated) MD5"+    pretty SHA1 = pretty "SHA-1"+    pretty RIPEMD160 = pretty "RIPEMD-160"+    pretty SHA256 = pretty "SHA-256"+    pretty SHA384 = pretty "SHA-384"+    pretty SHA512 = pretty "SHA-512"+    pretty SHA224 = pretty "SHA-224"+    pretty SHA3_256 = pretty "SHA3-256"+    pretty SHA3_512 = pretty "SHA3-512"+    pretty (OtherHA ha) = pretty "unknown hash algorithm type" <+> pretty ha++$(ATH.deriveJSON ATH.defaultOptions ''HashAlgorithm)++data CompressionAlgorithm+    = Uncompressed+    | ZIP+    | ZLIB+    | BZip2+    | OtherCA Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq CompressionAlgorithm where+    (==) a b = fromFVal a == fromFVal b++instance Ord CompressionAlgorithm where+    compare = comparing fromFVal++instance FutureVal CompressionAlgorithm where+    fromFVal Uncompressed = 0+    fromFVal ZIP = 1+    fromFVal ZLIB = 2+    fromFVal BZip2 = 3+    fromFVal (OtherCA o) = o+    toFVal 0 = Uncompressed+    toFVal 1 = ZIP+    toFVal 2 = ZLIB+    toFVal 3 = BZip2+    toFVal o = OtherCA o++instance Hashable CompressionAlgorithm++instance Pretty CompressionAlgorithm where+    pretty Uncompressed = pretty "uncompressed"+    pretty ZIP = pretty "ZIP"+    pretty ZLIB = pretty "zlib"+    pretty BZip2 = pretty "bzip2"+    pretty (OtherCA ca) =+        pretty "unknown compression algorithm type" <+> pretty ca++$(ATH.deriveJSON ATH.defaultOptions ''CompressionAlgorithm)++data AEADAlgorithm+    = EAX+    | OCB+    | GCM+    | OtherAEADAlgo Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq AEADAlgorithm where+    (==) a b = fromFVal a == fromFVal b++instance Ord AEADAlgorithm where+    compare = comparing fromFVal++instance FutureVal AEADAlgorithm where+    fromFVal EAX = 1+    fromFVal OCB = 2+    fromFVal GCM = 3+    fromFVal (OtherAEADAlgo o) = o+    toFVal 1 = EAX+    toFVal 2 = OCB+    toFVal 3 = GCM+    toFVal o = OtherAEADAlgo o++instance Hashable AEADAlgorithm++instance Pretty AEADAlgorithm where+    pretty EAX = pretty "EAX"+    pretty OCB = pretty "OCB"+    pretty GCM = pretty "GCM"+    pretty (OtherAEADAlgo aa) = pretty "unknown AEAD algorithm type" <+> pretty aa++$(ATH.deriveJSON ATH.defaultOptions ''AEADAlgorithm)++data KSPFlag+    = NoModify+    | KSPOther Int+    deriving (Data, Generic, Show, Typeable)++instance Eq KSPFlag where+    (==) a b = fromFFlag a == fromFFlag b++instance Ord KSPFlag where+    compare = comparing fromFFlag++instance FutureFlag KSPFlag where+    fromFFlag NoModify = 0+    fromFFlag (KSPOther i) = fromIntegral i+    toFFlag 0 = NoModify+    toFFlag i = KSPOther (fromIntegral i)++instance Hashable KSPFlag++instance Pretty KSPFlag where+    pretty NoModify = pretty "no-modify"+    pretty (KSPOther o) =+        pretty "unknown keyserver preference flag type" <+> pretty o++$(ATH.deriveJSON ATH.defaultOptions ''KSPFlag)++data KeyFlag+    = GroupKey+    | AuthKey+    | SplitKey+    | EncryptStorageKey+    | EncryptCommunicationsKey+    | SignDataKey+    | CertifyKeysKey+    | KFOther Int+    deriving (Data, Generic, Show, Typeable)++instance Eq KeyFlag where+    (==) a b = fromFFlag a == fromFFlag b++instance Ord KeyFlag where+    compare = comparing fromFFlag++instance FutureFlag KeyFlag where+    fromFFlag GroupKey = 0+    fromFFlag AuthKey = 2+    fromFFlag SplitKey = 3+    fromFFlag EncryptStorageKey = 4+    fromFFlag EncryptCommunicationsKey = 5+    fromFFlag SignDataKey = 6+    fromFFlag CertifyKeysKey = 7+    fromFFlag (KFOther i) = fromIntegral i+    toFFlag 0 = GroupKey+    toFFlag 2 = AuthKey+    toFFlag 3 = SplitKey+    toFFlag 4 = EncryptStorageKey+    toFFlag 5 = EncryptCommunicationsKey+    toFFlag 6 = SignDataKey+    toFFlag 7 = CertifyKeysKey+    toFFlag i = KFOther (fromIntegral i)++instance Hashable KeyFlag++instance Pretty KeyFlag where+    pretty GroupKey = pretty "group"+    pretty AuthKey = pretty "auth"+    pretty SplitKey = pretty "split"+    pretty EncryptStorageKey = pretty "encrypt-storage"+    pretty EncryptCommunicationsKey = pretty "encrypt-communications"+    pretty SignDataKey = pretty "sign-data"+    pretty CertifyKeysKey = pretty "certify-keys"+    pretty (KFOther o) = pretty "unknown key flag type" <+> pretty o++$(ATH.deriveJSON ATH.defaultOptions ''KeyFlag)++data RevocationCode+    = NoReason+    | KeySuperseded+    | KeyMaterialCompromised+    | KeyRetiredAndNoLongerUsed+    | UserIdInfoNoLongerValid+    | RCoOther Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq RevocationCode where+    (==) a b = fromFVal a == fromFVal b++instance Ord RevocationCode where+    compare = comparing fromFVal++instance FutureVal RevocationCode where+    fromFVal NoReason = 0+    fromFVal KeySuperseded = 1+    fromFVal KeyMaterialCompromised = 2+    fromFVal KeyRetiredAndNoLongerUsed = 3+    fromFVal UserIdInfoNoLongerValid = 32+    fromFVal (RCoOther o) = o+    toFVal 0 = NoReason+    toFVal 1 = KeySuperseded+    toFVal 2 = KeyMaterialCompromised+    toFVal 3 = KeyRetiredAndNoLongerUsed+    toFVal 32 = UserIdInfoNoLongerValid+    toFVal o = RCoOther o++instance Hashable RevocationCode++instance Pretty RevocationCode where+    pretty NoReason = pretty "no reason"+    pretty KeySuperseded = pretty "key superseded"+    pretty KeyMaterialCompromised = pretty "key material compromised"+    pretty KeyRetiredAndNoLongerUsed = pretty "key retired and no longer used"+    pretty UserIdInfoNoLongerValid = pretty "user-ID info no longer valid"+    pretty (RCoOther o) = pretty "unknown revocation code" <+> pretty o++$(ATH.deriveJSON ATH.defaultOptions ''RevocationCode)++data FeatureFlag+    = FeatureSEIPDv1+    | FeatureSEIPDv2+    | FeatureOther Int+    deriving (Data, Generic, Show, Typeable)++instance Eq FeatureFlag where+    (==) a b = fromFFlag a == fromFFlag b++instance Ord FeatureFlag where+    compare = comparing fromFFlag++instance FutureFlag FeatureFlag where+    fromFFlag FeatureSEIPDv1 = 7+    fromFFlag FeatureSEIPDv2 = 4+    fromFFlag (FeatureOther i) = fromIntegral i+    toFFlag 7 = FeatureSEIPDv1+    toFFlag 4 = FeatureSEIPDv2+    toFFlag i = FeatureOther (fromIntegral i)++instance Hashable FeatureFlag++instance Pretty FeatureFlag where+    pretty FeatureSEIPDv1 = pretty "seipd-v1"+    pretty FeatureSEIPDv2 = pretty "seipd-v2"+    pretty (FeatureOther o) = pretty "unknown feature flag type" <+> pretty o++$(ATH.deriveJSON ATH.defaultOptions ''FeatureFlag)++newtype URL+    = URL+    { unURL :: URI+    }+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Wrapped URL++instance Hashable URL where+    hashWithSalt salt (URL (URI s a p q f)) =+        salt+            `hashWithSalt` s+            `hashWithSalt` show a+            `hashWithSalt` p+            `hashWithSalt` q+            `hashWithSalt` f++instance Pretty URL where+    pretty = pretty . (\uri -> uriToString id uri "") . op URL++instance A.ToJSON URL where+    toJSON u =+        object+            [ AK.fromString "uri" .= (\uri -> uriToString id uri "") (op URL u)+            ]++instance A.FromJSON URL where+    parseJSON (A.Object v) =+        URL . fromMaybe nullURI . parseURI <$> v A..: AK.fromString "uri"+    parseJSON _ = mzero++data SigType+    = BinarySig+    | CanonicalTextSig+    | StandaloneSig+    | GenericCert+    | PersonaCert+    | CasualCert+    | PositiveCert+    | SubkeyBindingSig+    | PrimaryKeyBindingSig+    | SignatureDirectlyOnAKey+    | KeyRevocationSig+    | SubkeyRevocationSig+    | CertRevocationSig+    | TimestampSig+    | ThirdPartyConfirmationSig+    | OtherSig Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq SigType where+    (==) a b = fromFVal a == fromFVal b++instance Ord SigType where+    compare = comparing fromFVal++instance FutureVal SigType where+    fromFVal BinarySig = 0x00+    fromFVal CanonicalTextSig = 0x01+    fromFVal StandaloneSig = 0x02+    fromFVal GenericCert = 0x10+    fromFVal PersonaCert = 0x11+    fromFVal CasualCert = 0x12+    fromFVal PositiveCert = 0x13+    fromFVal SubkeyBindingSig = 0x18+    fromFVal PrimaryKeyBindingSig = 0x19+    fromFVal SignatureDirectlyOnAKey = 0x1F+    fromFVal KeyRevocationSig = 0x20+    fromFVal SubkeyRevocationSig = 0x28+    fromFVal CertRevocationSig = 0x30+    fromFVal TimestampSig = 0x40+    fromFVal ThirdPartyConfirmationSig = 0x50+    fromFVal (OtherSig o) = o+    toFVal 0x00 = BinarySig+    toFVal 0x01 = CanonicalTextSig+    toFVal 0x02 = StandaloneSig+    toFVal 0x10 = GenericCert+    toFVal 0x11 = PersonaCert+    toFVal 0x12 = CasualCert+    toFVal 0x13 = PositiveCert+    toFVal 0x18 = SubkeyBindingSig+    toFVal 0x19 = PrimaryKeyBindingSig+    toFVal 0x1F = SignatureDirectlyOnAKey+    toFVal 0x20 = KeyRevocationSig+    toFVal 0x28 = SubkeyRevocationSig+    toFVal 0x30 = CertRevocationSig+    toFVal 0x40 = TimestampSig+    toFVal 0x50 = ThirdPartyConfirmationSig+    toFVal o = OtherSig o++instance Hashable SigType++instance Pretty SigType where+    pretty BinarySig = pretty "binary"+    pretty CanonicalTextSig = pretty "canonical-pretty"+    pretty StandaloneSig = pretty "standalone"+    pretty GenericCert = pretty "generic"+    pretty PersonaCert = pretty "persona"+    pretty CasualCert = pretty "casual"+    pretty PositiveCert = pretty "positive"+    pretty SubkeyBindingSig = pretty "subkey-binding"+    pretty PrimaryKeyBindingSig = pretty "primary-key-binding"+    pretty SignatureDirectlyOnAKey = pretty "signature directly on a key"+    pretty KeyRevocationSig = pretty "key-revocation"+    pretty SubkeyRevocationSig = pretty "subkey-revocation"+    pretty CertRevocationSig = pretty "cert-revocation"+    pretty TimestampSig = pretty "timestamp"+    pretty ThirdPartyConfirmationSig = pretty "third-party-confirmation"+    pretty (OtherSig o) = pretty "unknown signature type" <+> pretty o++$(ATH.deriveJSON ATH.defaultOptions ''SigType)++newtype MPI+    = MPI+    { unMPI :: Integer+    }+    deriving (Data, Eq, Generic, Show, Typeable)++instance Wrapped MPI++instance Ord MPI where+    compare (MPI a) (MPI b) = compare a b++instance Hashable MPI++instance Pretty MPI where+    pretty = pretty . op MPI++$(ATH.deriveJSON ATH.defaultOptions ''MPI)++newtype SignatureSalt+    = SignatureSalt+    { unSignatureSalt :: ByteString+    }+    deriving (Data, Eq, Generic, Show, Typeable)++instance Ord SignatureSalt where+    compare (SignatureSalt a) (SignatureSalt b) = compare a b++instance Hashable SignatureSalt++instance Pretty SignatureSalt where+    pretty (SignatureSalt bs) = prettyLBS bs++instance A.ToJSON SignatureSalt where+    toJSON (SignatureSalt bs) = A.toJSON (BL.unpack bs)++data SignaturePayloadVersion+    = SigPayloadV3+    | SigPayloadV4+    | SigPayloadV6+    | SigPayloadVOther+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Hashable SignaturePayloadVersion++data SignaturePayloadV (v :: SignaturePayloadVersion) where+    SigPayloadV3Data+        :: SigType+        -> ThirtyTwoBitTimeStamp+        -> EightOctetKeyId+        -> PubKeyAlgorithm+        -> HashAlgorithm+        -> Word16+        -> NonEmpty MPI+        -> SignaturePayloadV 'SigPayloadV3+    SigPayloadV4Data+        :: SigType+        -> PubKeyAlgorithm+        -> HashAlgorithm+        -> [SigSubPacket]+        -> [SigSubPacket]+        -> Word16+        -> NonEmpty MPI+        -> SignaturePayloadV 'SigPayloadV4+    SigPayloadV6Data+        :: SigType+        -> PubKeyAlgorithm+        -> HashAlgorithm+        -> SignatureSalt+        -> [SigSubPacket]+        -> [SigSubPacket]+        -> Word16+        -> NonEmpty MPI+        -> SignaturePayloadV 'SigPayloadV6+    SigPayloadOtherData+        :: Word8 -> ByteString -> SignaturePayloadV 'SigPayloadVOther++deriving instance Eq (SignaturePayloadV v)++deriving instance Show (SignaturePayloadV v)++data SomeSignaturePayload where+    SomeSignaturePayload+        :: SignaturePayloadV v -> SomeSignaturePayload++-- FIXME: these functions belong in a separate module+toSignaturePayload :: SignaturePayloadV v -> SignaturePayload+toSignaturePayload (SigPayloadV3Data st ts eoki pka ha w16 mpis) =+    SigV3 st ts eoki pka ha w16 mpis+toSignaturePayload (SigPayloadV4Data st pka ha hsps usps w16 mpis) =+    SigV4 st pka ha hsps usps w16 mpis+toSignaturePayload (SigPayloadV6Data st pka ha salt hsps usps w16 mpis) =+    SigV6 st pka ha salt hsps usps w16 mpis+toSignaturePayload (SigPayloadOtherData v bs) = SigVOther v bs++toSomeSignaturePayload+    :: SignaturePayload -> SomeSignaturePayload+toSomeSignaturePayload (SigV3 st ts eoki pka ha w16 mpis) =+    SomeSignaturePayload+        (SigPayloadV3Data st ts eoki pka ha w16 mpis)+toSomeSignaturePayload (SigV4 st pka ha hsps usps w16 mpis) =+    SomeSignaturePayload+        (SigPayloadV4Data st pka ha hsps usps w16 mpis)+toSomeSignaturePayload (SigV6 st pka ha salt hsps usps w16 mpis) =+    SomeSignaturePayload+        (SigPayloadV6Data st pka ha salt hsps usps w16 mpis)+toSomeSignaturePayload (SigVOther v bs) =+    SomeSignaturePayload (SigPayloadOtherData v bs)++signaturePayloadVersion+    :: SignaturePayload -> SignaturePayloadVersion+signaturePayloadVersion (SigV3 _ _ _ _ _ _ _) = SigPayloadV3+signaturePayloadVersion (SigV4 _ _ _ _ _ _ _) = SigPayloadV4+signaturePayloadVersion (SigV6 _ _ _ _ _ _ _ _) = SigPayloadV6+signaturePayloadVersion (SigVOther _ _) = SigPayloadVOther++asSignaturePayloadV3+    :: SignaturePayload+    -> Either String (SignaturePayloadV 'SigPayloadV3)+asSignaturePayloadV3 (SigV3 st ts eoki pka ha w16 mpis) =+    Right (SigPayloadV3Data st ts eoki pka ha w16 mpis)+asSignaturePayloadV3 _ =+    Left+        "Cannot coerce non-v3 SignaturePayload to SignaturePayloadV3"++asSignaturePayloadV4+    :: SignaturePayload+    -> Either String (SignaturePayloadV 'SigPayloadV4)+asSignaturePayloadV4 (SigV4 st pka ha hsps usps w16 mpis) =+    Right (SigPayloadV4Data st pka ha hsps usps w16 mpis)+asSignaturePayloadV4 _ =+    Left+        "Cannot coerce non-v4 SignaturePayload to SignaturePayloadV4"++asSignaturePayloadV6+    :: SignaturePayload+    -> Either String (SignaturePayloadV 'SigPayloadV6)+asSignaturePayloadV6 (SigV6 st pka ha salt hsps usps w16 mpis) =+    Right (SigPayloadV6Data st pka ha salt hsps usps w16 mpis)+asSignaturePayloadV6 _ =+    Left+        "Cannot coerce non-v6 SignaturePayload to SignaturePayloadV6"++asSignaturePayloadOther+    :: SignaturePayload+    -> Either String (SignaturePayloadV 'SigPayloadVOther)+asSignaturePayloadOther (SigVOther v bs) = Right (SigPayloadOtherData v bs)+asSignaturePayloadOther _ =+    Left+        "Cannot coerce known-version SignaturePayload to SignaturePayloadVOther"++data SignaturePayload+    = SigV3+        SigType+        ThirtyTwoBitTimeStamp+        EightOctetKeyId+        PubKeyAlgorithm+        HashAlgorithm+        Word16+        (NonEmpty MPI)+    | SigV4+        SigType+        PubKeyAlgorithm+        HashAlgorithm+        [SigSubPacket]+        [SigSubPacket]+        Word16+        (NonEmpty MPI)+    | SigV6+        SigType+        PubKeyAlgorithm+        HashAlgorithm+        SignatureSalt+        [SigSubPacket]+        [SigSubPacket]+        Word16+        (NonEmpty MPI)+    | SigVOther Word8 ByteString+    deriving (Data, Eq, Generic, Show, Typeable)++instance Hashable SignaturePayload++instance Ord SignaturePayload where+    compare (SigV3 st1 ts1 eoki1 pka1 ha1 w161 mpis1) (SigV3 st2 ts2 eoki2 pka2 ha2 w162 mpis2) =+        compare st1 st2+            <> compare ts1 ts2+            <> compare eoki1 eoki2+            <> compare pka1 pka2+            <> compare ha1 ha2+            <> compare w161 w162+            <> compare (NE.toList mpis1) (NE.toList mpis2)+    compare (SigV4 st1 pka1 ha1 hsp1 usp1 w161 mpis1) (SigV4 st2 pka2 ha2 hsp2 usp2 w162 mpis2) =+        compare st1 st2+            <> compare pka1 pka2+            <> compare ha1 ha2+            <> compare hsp1 hsp2+            <> compare usp1 usp2+            <> compare w161 w162+            <> compare (NE.toList mpis1) (NE.toList mpis2)+    compare (SigV6 st1 pka1 ha1 salt1 hsp1 usp1 w161 mpis1) (SigV6 st2 pka2 ha2 salt2 hsp2 usp2 w162 mpis2) =+        compare st1 st2+            <> compare pka1 pka2+            <> compare ha1 ha2+            <> compare salt1 salt2+            <> compare hsp1 hsp2+            <> compare usp1 usp2+            <> compare w161 w162+            <> compare (NE.toList mpis1) (NE.toList mpis2)+    compare (SigVOther t1 bs1) (SigVOther t2 bs2) =+        compare t1 t2 <> compare bs1 bs2+    compare SigV3 {} SigV4 {} = LT+    compare SigV3 {} SigV6 {} = LT+    compare SigV3 {} SigVOther {} = LT+    compare SigV4 {} SigV3 {} = GT+    compare SigV4 {} SigV6 {} = LT+    compare SigV4 {} SigVOther {} = LT+    compare SigV6 {} SigV3 {} = GT+    compare SigV6 {} SigV4 {} = GT+    compare SigV6 {} SigVOther {} = LT+    compare SigVOther {} SigV3 {} = GT+    compare SigVOther {} SigV4 {} = GT+    compare SigVOther {} SigV6 {} = GT++instance Pretty SignaturePayload where+    pretty (SigV3 st ts eoki pka ha w16 mpis) =+        pretty "signature v3"+            <> pretty ':'+            <+> pretty st+            <+> pretty ts+            <+> pretty eoki+            <+> pretty pka+            <+> pretty ha+            <+> pretty w16+            <+> (pretty . NE.toList) mpis+    pretty (SigV4 st pka ha hsps usps w16 mpis) =+        pretty "signature v4"+            <> pretty ':'+            <+> pretty st+            <+> pretty pka+            <+> pretty ha+            <+> pretty hsps+            <+> pretty usps+            <+> pretty w16+            <+> (pretty . NE.toList) mpis+    pretty (SigV6 st pka ha salt hsps usps w16 mpis) =+        pretty "signature v6"+            <> pretty ':'+            <+> pretty st+            <+> pretty pka+            <+> pretty ha+            <+> pretty salt+            <+> pretty hsps+            <+> pretty usps+            <+> pretty w16+            <+> (pretty . NE.toList) mpis+    pretty (SigVOther t bs) =+        pretty "unknown signature v"+            <> pretty t+            <> pretty ':'+            <+> pretty (BL.unpack bs)++instance A.ToJSON SignaturePayload where+    toJSON (SigV3 st ts eoki pka ha w16 mpis) =+        A.toJSON (st, ts, eoki, pka, ha, w16, NE.toList mpis)+    toJSON (SigV4 st pka ha hsps usps w16 mpis) =+        A.toJSON (st, pka, ha, hsps, usps, w16, NE.toList mpis)+    toJSON (SigV6 st pka ha salt hsps usps w16 mpis) =+        A.toJSON (st, pka, ha, salt, hsps, usps, w16, NE.toList mpis)+    toJSON (SigVOther t bs) = A.toJSON (t, BL.unpack bs)++data IssuerFingerprintVersion+    = IssuerFingerprintV4+    | IssuerFingerprintV6+    deriving (Data, Eq, Generic, Show, Typeable)++instance Ord IssuerFingerprintVersion where+    IssuerFingerprintV4 `compare` IssuerFingerprintV4 = EQ+    IssuerFingerprintV4 `compare` IssuerFingerprintV6 = LT+    IssuerFingerprintV6 `compare` IssuerFingerprintV4 = GT+    IssuerFingerprintV6 `compare` IssuerFingerprintV6 = EQ++instance Hashable IssuerFingerprintVersion++instance Pretty IssuerFingerprintVersion where+    pretty IssuerFingerprintV4 = pretty "4"+    pretty IssuerFingerprintV6 = pretty "6"++instance A.ToJSON IssuerFingerprintVersion where+    toJSON IssuerFingerprintV4 = A.toJSON (4 :: Word8)+    toJSON IssuerFingerprintV6 = A.toJSON (6 :: Word8)++instance A.FromJSON IssuerFingerprintVersion where+    parseJSON (A.Number n) =+        case round n of+            4 -> pure IssuerFingerprintV4+            6 -> pure IssuerFingerprintV6+            _ -> mzero+    parseJSON _ = mzero++-- FIXME: these functions should be in a separate module+issuerFingerprintVersionToPacketVersion+    :: IssuerFingerprintVersion -> PacketVersion+issuerFingerprintVersionToPacketVersion IssuerFingerprintV4 = 4+issuerFingerprintVersionToPacketVersion IssuerFingerprintV6 = 6++packetVersionToIssuerFingerprintVersion+    :: PacketVersion -> Maybe IssuerFingerprintVersion+packetVersionToIssuerFingerprintVersion 4 = Just IssuerFingerprintV4+packetVersionToIssuerFingerprintVersion 6 = Just IssuerFingerprintV6+packetVersionToIssuerFingerprintVersion _ = Nothing++data SigSubPacketPayload+    = SigCreationTime ThirtyTwoBitTimeStamp+    | SigExpirationTime ThirtyTwoBitDuration+    | ExportableCertification Exportability+    | TrustSignature TrustLevel TrustAmount+    | RegularExpression AlmostPublicDomainRegex+    | Revocable Revocability+    | KeyExpirationTime ThirtyTwoBitDuration+    | PreferredSymmetricAlgorithms [SymmetricAlgorithm]+    | RevocationKey (Set RevocationClass) PubKeyAlgorithm Fingerprint+    | Issuer EightOctetKeyId+    | NotationData (Set NotationFlag) NotationName NotationValue+    | PreferredHashAlgorithms [HashAlgorithm]+    | PreferredCompressionAlgorithms [CompressionAlgorithm]+    | KeyServerPreferences (Set KSPFlag)+    | PreferredKeyServer KeyServer+    | PrimaryUserId Bool+    | PolicyURL URL+    | KeyFlags (Set KeyFlag)+    | SignersUserId Text+    | ReasonForRevocation RevocationCode RevocationReason+    | Features (Set FeatureFlag)+    | SignatureTarget PubKeyAlgorithm HashAlgorithm SignatureHash+    | EmbeddedSignature SignaturePayload+    | IssuerFingerprint IssuerFingerprintVersion Fingerprint+    | IntendedRecipient IssuerFingerprintVersion Fingerprint+    | PreferredAEADCiphersuites [(SymmetricAlgorithm, AEADAlgorithm)]+    | UserDefinedSigSub Word8 ByteString+    | OtherSigSub Word8 ByteString+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Hashable SigSubPacketPayload++instance Pretty SigSubPacketPayload where+    pretty (SigCreationTime ts) = pretty "creation-time" <+> pretty ts+    pretty (SigExpirationTime d) = pretty "sig expiration time" <+> pretty d+    pretty (ExportableCertification e) =+        pretty "exportable certification" <+> pretty e+    pretty (TrustSignature tl ta) =+        pretty "trust signature" <+> pretty tl <+> pretty ta+    pretty (RegularExpression apdre) =+        pretty "regular expression" <+> prettyLBS apdre+    pretty (Revocable r) = pretty "revocable" <+> pretty r+    pretty (KeyExpirationTime d) = pretty "key expiration time" <+> pretty d+    pretty (PreferredSymmetricAlgorithms sas) =+        pretty "preferred symmetric algorithms" <+> pretty sas+    pretty (IntendedRecipient kv fp) =+        pretty "intended recipient (v"+            <> pretty kv+            <> pretty ")"+            <+> pretty fp+    pretty (RevocationKey rcs pka tof) =+        pretty "revocation key"+            <+> pretty (Set.toList rcs)+            <+> pretty pka+            <+> pretty tof+    pretty (Issuer eoki) = pretty "issuer" <+> pretty eoki+    pretty (NotationData nfs nn nv) =+        pretty "notation data"+            <+> pretty (Set.toList nfs)+            <+> pretty nn+            <+> pretty nv+    pretty (PreferredHashAlgorithms phas) =+        pretty "preferred hash algorithms" <+> pretty phas+    pretty (PreferredCompressionAlgorithms pcas) =+        pretty "preferred compression algorithms" <+> pretty pcas+    pretty (KeyServerPreferences kspfs) =+        pretty "keyserver preferences" <+> pretty (Set.toList kspfs)+    pretty (PreferredKeyServer ks) = pretty "preferred keyserver" <+> prettyLBS ks+    pretty (PrimaryUserId p) =+        ( if p+            then mempty+            else pretty "NOT "+        )+            <> pretty "primary user-ID"+    pretty (PolicyURL u) = pretty "policy URL" <+> pretty u+    pretty (KeyFlags kfs) = pretty "key flags" <+> pretty (Set.toList kfs)+    pretty (SignersUserId u) = pretty "signer's user-ID" <+> pretty u+    pretty (ReasonForRevocation rc rr) =+        pretty "reason for revocation" <+> pretty rc <+> pretty rr+    pretty (Features ffs) = pretty "features" <+> pretty (Set.toList ffs)+    pretty (SignatureTarget pka ha sh) =+        pretty "signature target"+            <+> pretty pka+            <+> pretty ha+            <+> prettyLBS sh+    pretty (EmbeddedSignature sp) = pretty "embedded signature" <+> pretty sp+    pretty (IssuerFingerprint kv ifp) =+        pretty "issuer fingerprint (v"+            <> pretty kv+            <> pretty ")"+            <+> pretty ifp+    pretty (PreferredAEADCiphersuites ps) =+        pretty "preferred AEAD ciphersuites"+            <+> pretty ps+    pretty (UserDefinedSigSub t bs) =+        pretty "user-defined signature subpacket type"+            <+> pretty t+            <+> pretty (BL.unpack bs)+    pretty (OtherSigSub t bs) =+        pretty "unknown signature subpacket type"+            <+> pretty t+            <+> prettyLBS bs++instance A.ToJSON SigSubPacketPayload where+    toJSON (SigCreationTime ts) = object [AK.fromString "sigCreationTime" .= ts]+    toJSON (SigExpirationTime d) = object [AK.fromString "sigExpirationTime" .= d]+    toJSON (ExportableCertification e) =+        object [AK.fromString "exportableCertification" .= e]+    toJSON (TrustSignature tl ta) =+        object [AK.fromString "trustSignature" .= (tl, ta)]+    toJSON (RegularExpression apdre) =+        object [AK.fromString "regularExpression" .= BL.unpack apdre]+    toJSON (Revocable r) = object [AK.fromString "revocable" .= r]+    toJSON (KeyExpirationTime d) = object [AK.fromString "keyExpirationTime" .= d]+    toJSON (PreferredSymmetricAlgorithms sas) =+        object [AK.fromString "preferredSymmetricAlgorithms" .= sas]+    toJSON (RevocationKey rcs pka tof) =+        object [AK.fromString "revocationKey" .= (rcs, pka, tof)]+    toJSON (Issuer eoki) = object [AK.fromString "issuer" .= eoki]+    toJSON (NotationData nfs (NotationName nn) (NotationValue nv)) =+        object+            [ AK.fromString "notationData" .= (nfs, BL.unpack nn, BL.unpack nv)+            ]+    toJSON (PreferredHashAlgorithms phas) =+        object [AK.fromString "preferredHashAlgorithms" .= phas]+    toJSON (PreferredCompressionAlgorithms pcas) =+        object [AK.fromString "preferredCompressionAlgorithms" .= pcas]+    toJSON (KeyServerPreferences kspfs) =+        object [AK.fromString "keyServerPreferences" .= kspfs]+    toJSON (PreferredKeyServer ks) =+        object [AK.fromString "preferredKeyServer" .= show ks]+    toJSON (PrimaryUserId p) = object [AK.fromString "primaryUserId" .= p]+    toJSON (PolicyURL u) = object [AK.fromString "policyURL" .= u]+    toJSON (KeyFlags kfs) = object [AK.fromString "keyFlags" .= kfs]+    toJSON (SignersUserId u) = object [AK.fromString "signersUserId" .= u]+    toJSON (ReasonForRevocation rc rr) =+        object [AK.fromString "reasonForRevocation" .= (rc, rr)]+    toJSON (Features ffs) = object [AK.fromString "features" .= ffs]+    toJSON (SignatureTarget pka ha sh) =+        object+            [AK.fromString "signatureTarget" .= (pka, ha, BL.unpack sh)]+    toJSON (EmbeddedSignature sp) =+        object [AK.fromString "embeddedSignature" .= sp]+    toJSON (IssuerFingerprint kv ifp) =+        object [AK.fromString "issuerFingerprint" .= (kv, ifp)]+    toJSON (IntendedRecipient kv ifp) =+        object [AK.fromString "intendedRecipient" .= (kv, ifp)]+    toJSON (PreferredAEADCiphersuites ps) =+        object [AK.fromString "preferredAEADCiphersuites" .= ps]+    toJSON (UserDefinedSigSub t bs) =+        object [AK.fromString "userDefinedSigSub" .= (t, BL.unpack bs)]+    toJSON (OtherSigSub t bs) =+        object [AK.fromString "otherSigSub" .= (t, BL.unpack bs)]++uc3 :: (a -> b -> c -> d) -> (a, b, c) -> d+uc3 f ~(a, b, c) = f a b c++instance A.FromJSON SigSubPacketPayload where+    parseJSON (A.Object v) =+        (SigCreationTime <$> v A..: AK.fromString "sigCreationTime")+            <|> (SigExpirationTime <$> v A..: AK.fromString "sigExpirationTime")+            <|> ( ExportableCertification+                    <$> v A..: AK.fromString "exportableCertification"+                )+            <|> (uncurry TrustSignature <$> v A..: AK.fromString "trustSignature")+            <|> ( RegularExpression . BL.pack+                    <$> v A..: AK.fromString "regularExpression"+                )+            <|> (Revocable <$> v A..: AK.fromString "revocable")+            <|> (KeyExpirationTime <$> v A..: AK.fromString "keyExpirationTime")+            <|> ( PreferredSymmetricAlgorithms+                    <$> v A..: AK.fromString "preferredSymmetricAlgorithms"+                )+            <|> (uc3 RevocationKey <$> v A..: AK.fromString "revocationKey")+            <|> (Issuer <$> v A..: AK.fromString "issuer")+            <|> (uc3 NotationData <$> v A..: AK.fromString "notationData")+            <|> ( uncurry IssuerFingerprint+                    <$> v A..: AK.fromString "issuerFingerprint"+                )+            <|> ( uncurry IntendedRecipient+                    <$> v A..: AK.fromString "intendedRecipient"+                )+            <|> ( PreferredAEADCiphersuites+                    <$> v A..: AK.fromString "preferredAEADCiphersuites"+                )+    parseJSON _ = mzero++data SigSubPacket+    = SigSubPacket+    { _sspCriticality :: Bool+    , _sspPayload :: SigSubPacketPayload+    }+    deriving (Data, Eq, Generic, Show, Typeable)++instance Ord SigSubPacket where+    compare (SigSubPacket crit1 payload1) (SigSubPacket crit2 payload2) =+        compare crit1 crit2 <> compare payload1 payload2++instance Pretty SigSubPacket where+    pretty x =+        ( if _sspCriticality x+            then pretty '*'+            else mempty+        )+            <> (pretty . _sspPayload) x++instance Hashable SigSubPacket++instance A.ToJSON SigSubPacket++instance A.FromJSON SigSubPacket++$(makeLenses ''SigSubPacket)++-- FIXME: the SubpacketList type and associated functions should be moved into a separate module++{- | Type-safe subpacket list with phantom types to distinguish hashed vs unhashed+and signature version constraints (v4 vs v6).+-}+newtype SubpacketList (hashedness :: Type) (version :: Type)+    = SubpacketList [SigSubPacket]+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Functor (SubpacketList h) where+    fmap _ (SubpacketList sps) = SubpacketList sps++-- | Extract the underlying list from a phantom-typed SubpacketList+fromSubpacketList :: SubpacketList h v -> [SigSubPacket]+fromSubpacketList (SubpacketList sps) = sps++-- | Wrap a plain list into a phantom-typed SubpacketList+toSubpacketList :: [SigSubPacket] -> SubpacketList h v+toSubpacketList = SubpacketList++-- | Create an empty hashed subpacket list for a given signature version+emptyHashedSubpackets :: SubpacketList Hashed v+emptyHashedSubpackets = SubpacketList []++-- | Create an empty unhashed subpacket list for a given signature version+emptyUnhashedSubpackets :: SubpacketList Unhashed v+emptyUnhashedSubpackets = SubpacketList []++-- | Append a subpacket to a hashed list, preserving phantom type+consHashedSubpacket+    :: SigSubPacket -> SubpacketList Hashed v -> SubpacketList Hashed v+consHashedSubpacket sp (SubpacketList sps) = SubpacketList (sp : sps)++-- | Append a subpacket to an unhashed list, preserving phantom type+consUnhashedSubpacket+    :: SigSubPacket+    -> SubpacketList Unhashed v+    -> SubpacketList Unhashed v+consUnhashedSubpacket sp (SubpacketList sps) = SubpacketList (sp : sps)++data KeyVersion+    = DeprecatedV3+    | V4+    | V6+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Hashable KeyVersion++instance Pretty KeyVersion where+    pretty DeprecatedV3 = pretty "(deprecated) v3"+    pretty V4 = pretty "v4"+    pretty V6 = pretty "v6"++$(ATH.deriveJSON ATH.defaultOptions ''KeyVersion)++newtype IV+    = IV+    { unIV :: B.ByteString+    }+    deriving+        ( ByteArrayAccess+        , Data+        , Eq+        , Generic+        , Hashable+        , Monoid+        , Semigroup+        , Show+        , Typeable+        )++instance Wrapped IV++instance Ord IV where+    compare (IV b1) (IV b2) = compare b1 b2++instance Pretty IV where+    pretty = pretty . ("iv:" ++) . bsToHexUpper . BL.fromStrict . op IV++instance A.ToJSON IV where+    toJSON = A.toJSON . show . op IV++data LiteralDataType+    = BinaryData+    | TextData+    | UTF8Data+    | OtherData Word8+    deriving (Data, Generic, Show, Typeable)++instance Hashable LiteralDataType++instance Eq LiteralDataType where+    (==) a b = fromFVal a == fromFVal b++instance Ord LiteralDataType where+    compare = comparing fromFVal++instance FutureVal LiteralDataType where+    fromFVal BinaryData = fromIntegral . fromEnum $ 'b'+    fromFVal TextData = fromIntegral . fromEnum $ 't'+    fromFVal UTF8Data = fromIntegral . fromEnum $ 'u'+    fromFVal (OtherData o) = o+    toFVal 0x62 = BinaryData+    toFVal 0x74 = TextData+    toFVal 0x75 = UTF8Data+    toFVal o = OtherData o++instance Pretty LiteralDataType where+    pretty BinaryData = pretty "binary"+    pretty TextData = pretty "text"+    pretty UTF8Data = pretty "UTF-8"+    pretty (OtherData o) = pretty "other data type " <+> pretty o++$(ATH.deriveJSON ATH.defaultOptions ''LiteralDataType)++newtype SessionKey+    = SessionKey+    { unSessionKey :: B.ByteString+    }+    deriving (Data, Eq, Generic, Hashable, Show, Typeable)++instance Wrapped SessionKey++instance Ord SessionKey where+    compare (SessionKey b1) (SessionKey b2) = compare b1 b2++newtype Salt+    = Salt+    { unSalt :: B.ByteString+    }+    deriving (Data, Eq, Generic, Hashable, Show, Typeable)++instance Wrapped Salt++instance Ord Salt where+    compare (Salt b1) (Salt b2) = compare b1 b2++instance Pretty Salt where+    pretty = pretty . ("salt:" ++) . bsToHexUpper . BL.fromStrict . op Salt++instance A.ToJSON Salt where+    toJSON = A.toJSON . show . op Salt++newtype Salt8+    = Salt8+    { unSalt8 :: B.ByteString+    }+    deriving (Data, Eq, Generic, Hashable, Show, Typeable)++instance Wrapped Salt8++instance Ord Salt8 where+    compare (Salt8 b1) (Salt8 b2) = compare b1 b2++instance Pretty Salt8 where+    pretty =+        pretty . ("salt8:" ++) . bsToHexUpper . BL.fromStrict . op Salt8++instance A.ToJSON Salt8 where+    toJSON = A.toJSON . show . op Salt8++newtype Salt16+    = Salt16+    { unSalt16 :: B.ByteString+    }+    deriving (Data, Eq, Generic, Hashable, Show, Typeable)++instance Wrapped Salt16++instance Ord Salt16 where+    compare (Salt16 b1) (Salt16 b2) = compare b1 b2++instance Pretty Salt16 where+    pretty =+        pretty+            . ("salt16:" ++)+            . bsToHexUpper+            . BL.fromStrict+            . op Salt16++instance A.ToJSON Salt16 where+    toJSON = A.toJSON . show . op Salt16++-- FIXME: these functions should be in a separate module+salt8FromSalt :: Salt -> Maybe Salt8+salt8FromSalt (Salt bs)+    | B.length bs == 8 = Just (Salt8 bs)+    | otherwise = Nothing++salt16FromSalt :: Salt -> Maybe Salt16+salt16FromSalt (Salt bs)+    | B.length bs == 16 = Just (Salt16 bs)+    | otherwise = Nothing++saltFromSalt8 :: Salt8 -> Salt+saltFromSalt8 (Salt8 bs) = Salt bs++saltFromSalt16 :: Salt16 -> Salt+saltFromSalt16 (Salt16 bs) = Salt bs++newtype IterationCount+    = IterationCount+    { unIterationCount :: Int+    }+    deriving+        ( Bounded+        , Data+        , Enum+        , Eq+        , Generic+        , Hashable+        , Integral+        , Num+        , Ord+        , Real+        , Show+        , Typeable+        )++instance Wrapped IterationCount++instance Pretty IterationCount where+    pretty = pretty . op IterationCount++$(ATH.deriveJSON ATH.defaultOptions ''IterationCount)++data S2K+    = Simple HashAlgorithm+    | Salted HashAlgorithm Salt8+    | IteratedSalted HashAlgorithm Salt8 IterationCount+    | Argon2 Salt16 Word8 Word8 Word8+    | OtherS2K Word8 ByteString+    deriving (Data, Eq, Generic, Show, Typeable)++instance Hashable S2K++instance Ord S2K where+    compare (Simple ha1) (Simple ha2) = compare ha1 ha2+    compare (Salted ha1 s1) (Salted ha2 s2) = compare ha1 ha2 <> compare s1 s2+    compare (IteratedSalted ha1 s1 ic1) (IteratedSalted ha2 s2 ic2) =+        compare ha1 ha2 <> compare s1 s2 <> compare ic1 ic2+    compare (Argon2 salt1 t1 p1 em1) (Argon2 salt2 t2 p2 em2) =+        compare salt1 salt2+            <> compare t1 t2+            <> compare p1 p2+            <> compare em1 em2+    compare (OtherS2K t1 bs1) (OtherS2K t2 bs2) = compare t1 t2 <> compare bs1 bs2+    compare Simple {} Salted {} = LT+    compare Simple {} IteratedSalted {} = LT+    compare Simple {} Argon2 {} = LT+    compare Simple {} OtherS2K {} = LT+    compare Salted {} Simple {} = GT+    compare Salted {} IteratedSalted {} = LT+    compare Salted {} Argon2 {} = LT+    compare Salted {} OtherS2K {} = LT+    compare IteratedSalted {} Simple {} = GT+    compare IteratedSalted {} Salted {} = GT+    compare IteratedSalted {} Argon2 {} = LT+    compare IteratedSalted {} OtherS2K {} = LT+    compare Argon2 {} Simple {} = GT+    compare Argon2 {} Salted {} = GT+    compare Argon2 {} IteratedSalted {} = GT+    compare Argon2 {} OtherS2K {} = LT+    compare OtherS2K {} _ = GT++instance Pretty S2K where+    pretty (Simple ha) = pretty "simple S2K," <+> pretty ha+    pretty (Salted ha salt) = pretty "salted S2K," <+> pretty ha <+> pretty salt+    pretty (IteratedSalted ha salt icount) =+        pretty "iterated-salted S2K,"+            <+> pretty ha+            <+> pretty salt+            <+> pretty icount+    pretty (Argon2 salt t p em) =+        pretty "Argon2 S2K,"+            <+> pretty salt+            <+> pretty t+            <+> pretty p+            <+> pretty em+    pretty (OtherS2K t bs) =+        pretty "unknown S2K type"+            <+> pretty t+            <+> pretty (bsToHexUpper bs)++instance A.ToJSON S2K where+    toJSON (Simple ha) = A.toJSON ha+    toJSON (Salted ha salt) = A.toJSON (ha, salt)+    toJSON (IteratedSalted ha salt icount) = A.toJSON (ha, salt, icount)+    toJSON (Argon2 salt t p em) = A.toJSON (salt, t, p, em)+    toJSON (OtherS2K t bs) = A.toJSON (t, BL.unpack bs)++data ImageFormat+    = JPEG+    | OtherImage Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq ImageFormat where+    (==) a b = fromFVal a == fromFVal b++instance Ord ImageFormat where+    compare = comparing fromFVal++instance FutureVal ImageFormat where+    fromFVal JPEG = 1+    fromFVal (OtherImage o) = o+    toFVal 1 = JPEG+    toFVal o = OtherImage o++instance Hashable ImageFormat++instance Pretty ImageFormat where+    pretty JPEG = pretty "JPEG"+    pretty (OtherImage o) = pretty "unknown image format" <+> pretty o++$(ATH.deriveJSON ATH.defaultOptions ''ImageFormat)++newtype ImageHeader+    = ImageHV1 ImageFormat+    deriving (Data, Eq, Generic, Show, Typeable)++instance Ord ImageHeader where+    compare (ImageHV1 a) (ImageHV1 b) = compare a b++instance Hashable ImageHeader++instance Pretty ImageHeader where+    pretty (ImageHV1 f) = pretty "imghdr v1" <+> pretty f++$(ATH.deriveJSON ATH.defaultOptions ''ImageHeader)++data UserAttrSubPacket+    = ImageAttribute ImageHeader ImageData+    | OtherUASub Word8 ByteString+    deriving (Data, Eq, Generic, Show, Typeable)++instance Hashable UserAttrSubPacket++instance Ord UserAttrSubPacket where+    compare (ImageAttribute h1 d1) (ImageAttribute h2 d2) =+        compare h1 h2 <> compare d1 d2+    compare (ImageAttribute _ _) (OtherUASub _ _) = LT+    compare (OtherUASub _ _) (ImageAttribute _ _) = GT+    compare (OtherUASub t1 b1) (OtherUASub t2 b2) = compare t1 t2 <> compare b1 b2++instance Pretty UserAttrSubPacket where+    pretty (ImageAttribute ih d) =+        pretty "image-attribute" <+> pretty ih <+> pretty (BL.unpack d)+    pretty (OtherUASub t bs) =+        pretty "unknown attribute type"+            <> pretty t+            <+> pretty (BL.unpack bs)++instance A.ToJSON UserAttrSubPacket where+    toJSON (ImageAttribute ih d) = A.toJSON (ih, BL.unpack d)+    toJSON (OtherUASub t bs) = A.toJSON (t, BL.unpack bs)++-- FIXME: should this be merged with EdSigningCurve somehow?+data ECCCurve+    = NISTP256+    | NISTP384+    | NISTP521+    | Curve25519+    | Curve448+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Pretty ECCCurve where+    pretty NISTP256 = pretty "NIST P-256"+    pretty NISTP384 = pretty "NIST P-384"+    pretty NISTP521 = pretty "NIST P-521"+    pretty Curve25519 = pretty "Curve25519"+    pretty Curve448 = pretty "Curve448"++instance Hashable ECCCurve++-- Packet stream wrapper used to provide an EOF-delimited Binary instance.+newtype Block a+    = Block+    { unBlock :: [a]+    } -- intentionally not encoded as a list length prefix+    deriving (Eq, Show)
Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs view
@@ -2,58 +2,56 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).- {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}  module Codec.Encryption.OpenPGP.Types.Internal.PKITypes where -import GHC.Generics (Generic)--import Codec.Encryption.OpenPGP.Types.Internal.Base hiding (Ed25519, Ed448)-import Codec.Encryption.OpenPGP.Types.Internal.CryptonNewtypes- import qualified Data.Aeson as A import qualified Data.ByteString as B import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL-import Data.Data (Data(..))+import Data.Data (Data (..)) import qualified Data.Data as DData-import Data.Hashable (Hashable(..))+import Data.Hashable (Hashable (..)) import Data.Ord (comparing) import Data.Typeable (Typeable) import Data.Word (Word16)-import Prettyprinter (Pretty(..), (<+>))+import GHC.Generics (Generic)+import Prettyprinter (Pretty (..), (<+>)) -data EdSigningCurve =-  Ed25519-  | Ed448-  deriving (Data, Eq, Generic, Ord, Show, Typeable)+import Codec.Encryption.OpenPGP.Types.Internal.Base+import Codec.Encryption.OpenPGP.Types.Internal.CryptonNewtypes +data EdSigningCurve+    = EdSigningCurve25519+    | EdSigningCurve448+    deriving (Data, Eq, Generic, Ord, Show, Typeable)+ instance Hashable EdSigningCurve  instance Pretty EdSigningCurve where-  pretty Ed25519 = pretty "Ed25519"-  pretty Ed448 = pretty "Ed448"+    pretty EdSigningCurve25519 = pretty "Ed25519"+    pretty EdSigningCurve448 = pretty "Ed448"  instance A.FromJSON EdSigningCurve  instance A.ToJSON EdSigningCurve -newtype EPoint =-  EPoint+newtype EPoint+    = EPoint     { unEPoint :: Integer     }-  deriving (Data, Eq, Generic, Ord, Pretty, Show, Typeable)+    deriving (Data, Eq, Generic, Ord, Pretty, Show, Typeable)  instance Hashable EPoint @@ -62,263 +60,228 @@ instance A.ToJSON EPoint  data EdPoint-  = PrefixedNativeEPoint EPoint-  | NativeEPoint EPoint-  deriving (Data, Eq, Generic, Ord, Show, Typeable)+    = PrefixedNativeEPoint EPoint+    | NativeEPoint EPoint+    deriving (Data, Eq, Generic, Ord, Show, Typeable)  instance Hashable EdPoint  instance Pretty EdPoint where-  pretty (PrefixedNativeEPoint ep) = pretty "prefixed-native" <+> pretty ep-  pretty (NativeEPoint ep) = pretty "native" <+> pretty ep+    pretty (PrefixedNativeEPoint ep) = pretty "prefixed-native" <+> pretty ep+    pretty (NativeEPoint ep) = pretty "native" <+> pretty ep  instance A.FromJSON EdPoint  instance A.ToJSON EdPoint  data PKey-  = RSAPubKey RSA_PublicKey-  | DSAPubKey DSA_PublicKey-  | ElGamalPubKey Integer Integer Integer-  | ECDHPubKey PKey HashAlgorithm SymmetricAlgorithm-  | ECDSAPubKey ECDSA_PublicKey-  | EdDSAPubKey EdSigningCurve EdPoint-  | UnknownPKey ByteString-  deriving (Data, Eq, Generic, Ord, Show, Typeable)+    = RSAPubKey RSA_PublicKey+    | DSAPubKey DSA_PublicKey+    | ElGamalPubKey Integer Integer Integer+    | ECDHPubKey PKey HashAlgorithm SymmetricAlgorithm+    | ECDSAPubKey ECDSA_PublicKey+    | EdDSAPubKey EdSigningCurve EdPoint+    | MLKEMPubKey B.ByteString+    | MLDSAPubKey B.ByteString+    | SLHDSAPubKey B.ByteString+    | UnknownPKey ByteString+    deriving (Data, Eq, Generic, Ord, Show, Typeable)  instance Hashable PKey  instance Pretty PKey where-  pretty (RSAPubKey p) = pretty "RSA" <+> pretty p-  pretty (DSAPubKey p) = pretty "DSA" <+> pretty p-  pretty (ElGamalPubKey p g y) =-    pretty "Elgamal" <+> pretty p <+> pretty g <+> pretty y-  pretty (ECDHPubKey p ha sa) =-    pretty "ECDH" <+> pretty p <+> pretty ha <+> pretty sa-  pretty (ECDSAPubKey p) = pretty "ECDSA" <+> pretty p-  pretty (EdDSAPubKey c ep) = pretty c <+> pretty ep-  pretty (UnknownPKey bs) = pretty "<unknown>" <+> pretty (bsToHexUpper bs)+    pretty (RSAPubKey p) = pretty "RSA" <+> pretty p+    pretty (DSAPubKey p) = pretty "DSA" <+> pretty p+    pretty (ElGamalPubKey p g y) =+        pretty "Elgamal" <+> pretty p <+> pretty g <+> pretty y+    pretty (ECDHPubKey p ha sa) =+        pretty "ECDH" <+> pretty p <+> pretty ha <+> pretty sa+    pretty (ECDSAPubKey p) = pretty "ECDSA" <+> pretty p+    pretty (EdDSAPubKey c ep) = pretty c <+> pretty ep+    pretty (MLKEMPubKey bs) = pretty "ML-KEM" <+> pretty (bsToHexUpper (BL.fromStrict bs))+    pretty (MLDSAPubKey bs) = pretty "ML-DSA" <+> pretty (bsToHexUpper (BL.fromStrict bs))+    pretty (SLHDSAPubKey bs) = pretty "SLH-DSA" <+> pretty (bsToHexUpper (BL.fromStrict bs))+    pretty (UnknownPKey bs) = pretty "<unknown>" <+> pretty (bsToHexUpper bs)  instance A.ToJSON PKey where-  toJSON (RSAPubKey p) = A.toJSON p-  toJSON (DSAPubKey p) = A.toJSON p-  toJSON (ElGamalPubKey p g y) = A.toJSON (p, g, y)-  toJSON (ECDHPubKey p ha sa) = A.toJSON (p, ha, sa)-  toJSON (ECDSAPubKey p) = A.toJSON p-  toJSON (EdDSAPubKey c ep) = A.toJSON (c, ep)-  toJSON (UnknownPKey bs) = A.toJSON (BL.unpack bs)+    toJSON (RSAPubKey p) = A.toJSON p+    toJSON (DSAPubKey p) = A.toJSON p+    toJSON (ElGamalPubKey p g y) = A.toJSON (p, g, y)+    toJSON (ECDHPubKey p ha sa) = A.toJSON (p, ha, sa)+    toJSON (ECDSAPubKey p) = A.toJSON p+    toJSON (EdDSAPubKey c ep) = A.toJSON (c, ep)+    toJSON (MLKEMPubKey bs) = A.toJSON (B.unpack bs)+    toJSON (MLDSAPubKey bs) = A.toJSON (B.unpack bs)+    toJSON (SLHDSAPubKey bs) = A.toJSON (B.unpack bs)+    toJSON (UnknownPKey bs) = A.toJSON (BL.unpack bs)  data SKey-  = RSAPrivateKey RSA_PrivateKey-  | DSAPrivateKey DSA_PrivateKey-  | ElGamalPrivateKey Integer-  | ECDHPrivateKey ECDSA_PrivateKey-  | ECDSAPrivateKey ECDSA_PrivateKey-  | EdDSAPrivateKey EdSigningCurve B.ByteString-  | X25519PrivateKey B.ByteString-  | X448PrivateKey B.ByteString-  | UnknownSKey ByteString-  deriving (Data, Eq, Generic, Show, Typeable)+    = RSAPrivateKey RSA_PrivateKey+    | DSAPrivateKey DSA_PrivateKey+    | ElGamalPrivateKey Integer+    | ECDHPrivateKey ECDSA_PrivateKey+    | ECDSAPrivateKey ECDSA_PrivateKey+    | EdDSAPrivateKey EdSigningCurve B.ByteString+    | X25519PrivateKey B.ByteString+    | X448PrivateKey B.ByteString+    | MLKEMPrivateKey B.ByteString+    | MLDSAPrivateKey B.ByteString+    | SLHDSAPrivateKey B.ByteString+    | UnknownSKey ByteString+    deriving (Data, Eq, Generic, Ord, Show, Typeable)  instance Hashable SKey -instance Ord SKey where-  compare (RSAPrivateKey rsa1) (RSAPrivateKey rsa2) = compare rsa1 rsa2-  compare (DSAPrivateKey dsa1) (DSAPrivateKey dsa2) = compare dsa1 dsa2-  compare (ElGamalPrivateKey x1) (ElGamalPrivateKey x2) = compare x1 x2-  compare (ECDHPrivateKey ecdsa1) (ECDHPrivateKey ecdsa2) = compare ecdsa1 ecdsa2-  compare (ECDSAPrivateKey ecdsa1) (ECDSAPrivateKey ecdsa2) = compare ecdsa1 ecdsa2-  compare (EdDSAPrivateKey curve1 bs1) (EdDSAPrivateKey curve2 bs2) =-    compare curve1 curve2 <> compare bs1 bs2-  compare (X25519PrivateKey bs1) (X25519PrivateKey bs2) = compare bs1 bs2-  compare (X448PrivateKey bs1) (X448PrivateKey bs2) = compare bs1 bs2-  compare (UnknownSKey bs1) (UnknownSKey bs2) = compare bs1 bs2-  compare RSAPrivateKey {} DSAPrivateKey {} = LT-  compare RSAPrivateKey {} ElGamalPrivateKey {} = LT-  compare RSAPrivateKey {} ECDHPrivateKey {} = LT-  compare RSAPrivateKey {} ECDSAPrivateKey {} = LT-  compare RSAPrivateKey {} EdDSAPrivateKey {} = LT-  compare RSAPrivateKey {} X25519PrivateKey {} = LT-  compare RSAPrivateKey {} X448PrivateKey {} = LT-  compare RSAPrivateKey {} UnknownSKey {} = LT-  compare DSAPrivateKey {} RSAPrivateKey {} = GT-  compare DSAPrivateKey {} ElGamalPrivateKey {} = LT-  compare DSAPrivateKey {} ECDHPrivateKey {} = LT-  compare DSAPrivateKey {} ECDSAPrivateKey {} = LT-  compare DSAPrivateKey {} EdDSAPrivateKey {} = LT-  compare DSAPrivateKey {} X25519PrivateKey {} = LT-  compare DSAPrivateKey {} X448PrivateKey {} = LT-  compare DSAPrivateKey {} UnknownSKey {} = LT-  compare ElGamalPrivateKey {} RSAPrivateKey {} = GT-  compare ElGamalPrivateKey {} DSAPrivateKey {} = GT-  compare ElGamalPrivateKey {} ECDHPrivateKey {} = LT-  compare ElGamalPrivateKey {} ECDSAPrivateKey {} = LT-  compare ElGamalPrivateKey {} EdDSAPrivateKey {} = LT-  compare ElGamalPrivateKey {} X25519PrivateKey {} = LT-  compare ElGamalPrivateKey {} X448PrivateKey {} = LT-  compare ElGamalPrivateKey {} UnknownSKey {} = LT-  compare ECDHPrivateKey {} RSAPrivateKey {} = GT-  compare ECDHPrivateKey {} DSAPrivateKey {} = GT-  compare ECDHPrivateKey {} ElGamalPrivateKey {} = GT-  compare ECDHPrivateKey {} ECDSAPrivateKey {} = LT-  compare ECDHPrivateKey {} EdDSAPrivateKey {} = LT-  compare ECDHPrivateKey {} X25519PrivateKey {} = LT-  compare ECDHPrivateKey {} X448PrivateKey {} = LT-  compare ECDHPrivateKey {} UnknownSKey {} = LT-  compare ECDSAPrivateKey {} RSAPrivateKey {} = GT-  compare ECDSAPrivateKey {} DSAPrivateKey {} = GT-  compare ECDSAPrivateKey {} ElGamalPrivateKey {} = GT-  compare ECDSAPrivateKey {} ECDHPrivateKey {} = GT-  compare ECDSAPrivateKey {} EdDSAPrivateKey {} = LT-  compare ECDSAPrivateKey {} X25519PrivateKey {} = LT-  compare ECDSAPrivateKey {} X448PrivateKey {} = LT-  compare ECDSAPrivateKey {} UnknownSKey {} = LT-  compare EdDSAPrivateKey {} RSAPrivateKey {} = GT-  compare EdDSAPrivateKey {} DSAPrivateKey {} = GT-  compare EdDSAPrivateKey {} ElGamalPrivateKey {} = GT-  compare EdDSAPrivateKey {} ECDHPrivateKey {} = GT-  compare EdDSAPrivateKey {} ECDSAPrivateKey {} = GT-  compare EdDSAPrivateKey {} X25519PrivateKey {} = LT-  compare EdDSAPrivateKey {} X448PrivateKey {} = LT-  compare EdDSAPrivateKey {} UnknownSKey {} = LT-  compare X25519PrivateKey {} RSAPrivateKey {} = GT-  compare X25519PrivateKey {} DSAPrivateKey {} = GT-  compare X25519PrivateKey {} ElGamalPrivateKey {} = GT-  compare X25519PrivateKey {} ECDHPrivateKey {} = GT-  compare X25519PrivateKey {} ECDSAPrivateKey {} = GT-  compare X25519PrivateKey {} EdDSAPrivateKey {} = GT-  compare X25519PrivateKey {} X448PrivateKey {} = LT-  compare X25519PrivateKey {} UnknownSKey {} = LT-  compare X448PrivateKey {} RSAPrivateKey {} = GT-  compare X448PrivateKey {} DSAPrivateKey {} = GT-  compare X448PrivateKey {} ElGamalPrivateKey {} = GT-  compare X448PrivateKey {} ECDHPrivateKey {} = GT-  compare X448PrivateKey {} ECDSAPrivateKey {} = GT-  compare X448PrivateKey {} EdDSAPrivateKey {} = GT-  compare X448PrivateKey {} X25519PrivateKey {} = GT-  compare X448PrivateKey {} UnknownSKey {} = LT-  compare UnknownSKey {} _ = GT- instance Pretty SKey where-  pretty (RSAPrivateKey p) = pretty "RSA" <+> pretty p-  pretty (DSAPrivateKey p) = pretty "DSA" <+> pretty p-  pretty (ElGamalPrivateKey p) = pretty "Elgamal" <+> pretty p-  pretty (ECDHPrivateKey p) = pretty "ECDH" <+> pretty p-  pretty (ECDSAPrivateKey p) = pretty "ECDSA" <+> pretty p-  pretty (EdDSAPrivateKey c bs) =-    pretty c <+> pretty (bsToHexUpper (BL.fromStrict bs))-  pretty (X25519PrivateKey bs) = pretty "X25519" <+> pretty (bsToHexUpper (BL.fromStrict bs))-  pretty (X448PrivateKey bs) = pretty "X448" <+> pretty (bsToHexUpper (BL.fromStrict bs))-  pretty (UnknownSKey bs) = pretty "<unknown>" <+> pretty (bsToHexUpper bs)+    pretty (RSAPrivateKey p) = pretty "RSA" <+> pretty p+    pretty (DSAPrivateKey p) = pretty "DSA" <+> pretty p+    pretty (ElGamalPrivateKey p) = pretty "Elgamal" <+> pretty p+    pretty (ECDHPrivateKey p) = pretty "ECDH" <+> pretty p+    pretty (ECDSAPrivateKey p) = pretty "ECDSA" <+> pretty p+    pretty (EdDSAPrivateKey c bs) =+        pretty c <+> pretty (bsToHexUpper (BL.fromStrict bs))+    pretty (X25519PrivateKey bs) = pretty "X25519" <+> pretty (bsToHexUpper (BL.fromStrict bs))+    pretty (X448PrivateKey bs) = pretty "X448" <+> pretty (bsToHexUpper (BL.fromStrict bs))+    pretty (MLKEMPrivateKey bs) =+        pretty "ML-KEM-priv" <+> pretty (bsToHexUpper (BL.fromStrict bs))+    pretty (MLDSAPrivateKey bs) =+        pretty "ML-DSA-priv" <+> pretty (bsToHexUpper (BL.fromStrict bs))+    pretty (SLHDSAPrivateKey bs) =+        pretty "SLH-DSA-priv"+            <+> pretty (bsToHexUpper (BL.fromStrict bs))+    pretty (UnknownSKey bs) = pretty "<unknown>" <+> pretty (bsToHexUpper bs)  instance A.ToJSON SKey where-  toJSON (RSAPrivateKey k) = A.toJSON k-  toJSON (DSAPrivateKey k) = A.toJSON k-  toJSON (ElGamalPrivateKey k) = A.toJSON k-  toJSON (ECDHPrivateKey k) = A.toJSON k-  toJSON (ECDSAPrivateKey k) = A.toJSON k-  toJSON (EdDSAPrivateKey c bs) = A.toJSON (c, B.unpack bs)-  toJSON (X25519PrivateKey bs) = A.toJSON (B.unpack bs)-  toJSON (X448PrivateKey bs) = A.toJSON (B.unpack bs)-  toJSON (UnknownSKey bs) = A.toJSON (BL.unpack bs)+    toJSON (RSAPrivateKey k) = A.toJSON k+    toJSON (DSAPrivateKey k) = A.toJSON k+    toJSON (ElGamalPrivateKey k) = A.toJSON k+    toJSON (ECDHPrivateKey k) = A.toJSON k+    toJSON (ECDSAPrivateKey k) = A.toJSON k+    toJSON (EdDSAPrivateKey c bs) = A.toJSON (c, B.unpack bs)+    toJSON (X25519PrivateKey bs) = A.toJSON (B.unpack bs)+    toJSON (X448PrivateKey bs) = A.toJSON (B.unpack bs)+    toJSON (MLKEMPrivateKey bs) = A.toJSON (B.unpack bs)+    toJSON (MLDSAPrivateKey bs) = A.toJSON (B.unpack bs)+    toJSON (SLHDSAPrivateKey bs) = A.toJSON (B.unpack bs)+    toJSON (UnknownSKey bs) = A.toJSON (BL.unpack bs)  data PKPayload (v :: KeyVersion) where-  PKPayloadV3 ::-       ThirtyTwoBitTimeStamp-    -> V3Expiration-    -> PubKeyAlgorithm-    -> PKey-    -> PKPayload 'DeprecatedV3-  PKPayloadV4 ::-       ThirtyTwoBitTimeStamp-    -> PubKeyAlgorithm-    -> PKey-    -> PKPayload 'V4-  PKPayloadV6 ::-       ThirtyTwoBitTimeStamp-    -> PubKeyAlgorithm-    -> PKey-    -> PKPayload 'V6+    PKPayloadV3+        :: ThirtyTwoBitTimeStamp+        -> V3Expiration+        -> PubKeyAlgorithm+        -> PKey+        -> PKPayload 'DeprecatedV3+    PKPayloadV4+        :: ThirtyTwoBitTimeStamp+        -> PubKeyAlgorithm+        -> PKey+        -> PKPayload 'V4+    PKPayloadV6+        :: ThirtyTwoBitTimeStamp+        -> PubKeyAlgorithm+        -> PKey+        -> PKPayload 'V6  deriving instance Eq (PKPayload v) deriving instance Ord (PKPayload v) deriving instance Show (PKPayload v)  instance Hashable (PKPayload v) where-  hashWithSalt s = hashWithSalt s . pkPayloadFields+    hashWithSalt s = hashWithSalt s . pkPayloadFields  instance Pretty (PKPayload v) where-  pretty pkp =-    let (kv, ts, v3e, pka, p) = pkPayloadFields pkp-     in pretty kv <+> pretty ts <+> pretty v3e <+> pretty pka <+> pretty p+    pretty pkp =+        let (kv, ts, v3e, pka, p) = pkPayloadFields pkp+         in pretty kv+                <+> pretty ts+                <+> pretty v3e+                <+> pretty pka+                <+> pretty p  instance A.ToJSON (PKPayload v) where-  toJSON = A.toJSON . pkPayloadFields+    toJSON = A.toJSON . pkPayloadFields  data SomePKPayload where-  SomePKPayload :: PKPayload v -> SomePKPayload+    SomePKPayload :: PKPayload v -> SomePKPayload  deriving instance Show SomePKPayload deriving instance Typeable SomePKPayload  pkPayloadDataType :: DData.DataType pkPayloadDataType =-  DData.mkDataType-    "Codec.Encryption.OpenPGP.Types.Internal.PKITypes.SomePKPayload"-    [pkPayloadConstr]+    DData.mkDataType+        "Codec.Encryption.OpenPGP.Types.Internal.PKITypes.SomePKPayload"+        [pkPayloadConstr]  pkPayloadConstr :: DData.Constr pkPayloadConstr = DData.mkConstr pkPayloadDataType "PKPayload" [] DData.Prefix  instance Data SomePKPayload where-  gfoldl f z (PKPayload kv ts v3e pka p) =-    z PKPayload `f` kv `f` ts `f` v3e `f` pka `f` p-  gunfold k z c-    | c == pkPayloadConstr = k (k (k (k (k (z PKPayload)))))-    | otherwise = error "gunfold: invalid constructor for SomePKPayload"-  toConstr _ = pkPayloadConstr-  dataTypeOf _ = pkPayloadDataType+    gfoldl f z (PKPayload kv ts v3e pka p) =+        z PKPayload `f` kv `f` ts `f` v3e `f` pka `f` p+    gunfold k z c+        | c == pkPayloadConstr = k (k (k (k (k (z PKPayload)))))+        | otherwise =+            error "gunfold: invalid constructor for SomePKPayload"+    toConstr _ = pkPayloadConstr+    dataTypeOf _ = pkPayloadDataType  instance Eq SomePKPayload where-  a == b = somePKPayloadFields a == somePKPayloadFields b+    a == b = somePKPayloadFields a == somePKPayloadFields b  instance Ord SomePKPayload where-  compare = comparing somePKPayloadFields+    compare = comparing somePKPayloadFields  instance Hashable SomePKPayload where-  hashWithSalt s = hashWithSalt s . somePKPayloadFields+    hashWithSalt s = hashWithSalt s . somePKPayloadFields  instance Pretty SomePKPayload where-  pretty (PKPayload kv ts v3e pka p) =-    pretty kv <+> pretty ts <+> pretty v3e <+> pretty pka <+> pretty p+    pretty (PKPayload kv ts v3e pka p) =+        pretty kv+            <+> pretty ts+            <+> pretty v3e+            <+> pretty pka+            <+> pretty p  instance A.ToJSON SomePKPayload where-  toJSON = A.toJSON . somePKPayloadFields+    toJSON = A.toJSON . somePKPayloadFields -pkPayloadFields ::-     PKPayload v-  -> (KeyVersion, ThirtyTwoBitTimeStamp, V3Expiration, PubKeyAlgorithm, PKey)+pkPayloadFields+    :: PKPayload v+    -> ( KeyVersion+       , ThirtyTwoBitTimeStamp+       , V3Expiration+       , PubKeyAlgorithm+       , PKey+       ) pkPayloadFields (PKPayloadV3 ts v3e pka p) = (DeprecatedV3, ts, v3e, pka, p) pkPayloadFields (PKPayloadV4 ts pka p) = (V4, ts, 0, pka, p) pkPayloadFields (PKPayloadV6 ts pka p) = (V6, ts, 0, pka, p) -somePKPayloadFields ::-     SomePKPayload-  -> (KeyVersion, ThirtyTwoBitTimeStamp, V3Expiration, PubKeyAlgorithm, PKey)+somePKPayloadFields+    :: SomePKPayload+    -> ( KeyVersion+       , ThirtyTwoBitTimeStamp+       , V3Expiration+       , PubKeyAlgorithm+       , PKey+       ) somePKPayloadFields (SomePKPayload pkp) = pkPayloadFields pkp -pattern PKPayload ::-     KeyVersion-  -> ThirtyTwoBitTimeStamp-  -> V3Expiration-  -> PubKeyAlgorithm-  -> PKey-  -> SomePKPayload-pattern PKPayload kv ts v3e pka p <- (somePKPayloadFields -> (kv, ts, v3e, pka, p))-  where-    PKPayload DeprecatedV3 ts v3e pka p = SomePKPayload (PKPayloadV3 ts v3e pka p)-    PKPayload V4 ts _ pka p = SomePKPayload (PKPayloadV4 ts pka p)-    PKPayload V6 ts _ pka p = SomePKPayload (PKPayloadV6 ts pka p)+pattern PKPayload+    :: KeyVersion+    -> ThirtyTwoBitTimeStamp+    -> V3Expiration+    -> PubKeyAlgorithm+    -> PKey+    -> SomePKPayload+pattern PKPayload kv ts v3e pka p <-+    (somePKPayloadFields -> (kv, ts, v3e, pka, p))+    where+        PKPayload DeprecatedV3 ts v3e pka p = SomePKPayload (PKPayloadV3 ts v3e pka p)+        PKPayload V4 ts _ pka p = SomePKPayload (PKPayloadV4 ts pka p)+        PKPayload V6 ts _ pka p = SomePKPayload (PKPayloadV6 ts pka p)  {-# COMPLETE PKPayload #-} @@ -338,67 +301,88 @@ _pubkey (PKPayload _ _ _ _ p) = p  data SKAddendum-  = SUS16bit SymmetricAlgorithm S2K IV ByteString-  | SUSSHA1 SymmetricAlgorithm S2K IV ByteString-  | SUSAEAD SymmetricAlgorithm AEADAlgorithm S2K IV ByteString-  | SUSym SymmetricAlgorithm IV ByteString-  | SUUnencrypted SKey Word16-  deriving (Data, Eq, Generic, Show, Typeable)+    = SUS16bit SymmetricAlgorithm S2K IV ByteString+    | SUSSHA1 SymmetricAlgorithm S2K IV ByteString+    | SUSAEAD SymmetricAlgorithm AEADAlgorithm S2K IV ByteString+    | SUSym SymmetricAlgorithm IV ByteString+    | SUUnencrypted SKey Word16+    deriving (Data, Eq, Generic, Show, Typeable)  instance Ord SKAddendum where-  compare (SUS16bit sa1 s2k1 iv1 bs1) (SUS16bit sa2 s2k2 iv2 bs2) =-    compare sa1 sa2 <> compare s2k1 s2k2 <> compare iv1 iv2 <> compare bs1 bs2-  compare (SUSSHA1 sa1 s2k1 iv1 bs1) (SUSSHA1 sa2 s2k2 iv2 bs2) =-    compare sa1 sa2 <> compare s2k1 s2k2 <> compare iv1 iv2 <> compare bs1 bs2-  compare (SUSAEAD sa1 aa1 s2k1 iv1 bs1) (SUSAEAD sa2 aa2 s2k2 iv2 bs2) =-    compare sa1 sa2 <> compare aa1 aa2 <> compare s2k1 s2k2 <> compare iv1 iv2 <>-    compare bs1 bs2-  compare (SUSym sa1 iv1 bs1) (SUSym sa2 iv2 bs2) =-    compare sa1 sa2 <> compare iv1 iv2 <> compare bs1 bs2-  compare (SUUnencrypted sk1 ck1) (SUUnencrypted sk2 ck2) =-    compare sk1 sk2 <> compare ck1 ck2-  compare SUS16bit {} SUSSHA1 {} = LT-  compare SUS16bit {} SUSAEAD {} = LT-  compare SUS16bit {} SUSym {} = LT-  compare SUS16bit {} SUUnencrypted {} = LT-  compare SUSSHA1 {} SUS16bit {} = GT-  compare SUSSHA1 {} SUSAEAD {} = LT-  compare SUSSHA1 {} SUSym {} = LT-  compare SUSSHA1 {} SUUnencrypted {} = LT-  compare SUSAEAD {} SUS16bit {} = GT-  compare SUSAEAD {} SUSSHA1 {} = GT-  compare SUSAEAD {} SUSym {} = LT-  compare SUSAEAD {} SUUnencrypted {} = LT-  compare SUSym {} SUS16bit {} = GT-  compare SUSym {} SUSSHA1 {} = GT-  compare SUSym {} SUSAEAD {} = GT-  compare SUSym {} SUUnencrypted {} = LT-  compare SUUnencrypted {} _ = GT+    compare (SUS16bit sa1 s2k1 iv1 bs1) (SUS16bit sa2 s2k2 iv2 bs2) =+        compare sa1 sa2+            <> compare s2k1 s2k2+            <> compare iv1 iv2+            <> compare bs1 bs2+    compare (SUSSHA1 sa1 s2k1 iv1 bs1) (SUSSHA1 sa2 s2k2 iv2 bs2) =+        compare sa1 sa2+            <> compare s2k1 s2k2+            <> compare iv1 iv2+            <> compare bs1 bs2+    compare (SUSAEAD sa1 aa1 s2k1 iv1 bs1) (SUSAEAD sa2 aa2 s2k2 iv2 bs2) =+        compare sa1 sa2+            <> compare aa1 aa2+            <> compare s2k1 s2k2+            <> compare iv1 iv2+            <> compare bs1 bs2+    compare (SUSym sa1 iv1 bs1) (SUSym sa2 iv2 bs2) =+        compare sa1 sa2 <> compare iv1 iv2 <> compare bs1 bs2+    compare (SUUnencrypted sk1 ck1) (SUUnencrypted sk2 ck2) =+        compare sk1 sk2 <> compare ck1 ck2+    compare SUS16bit {} SUSSHA1 {} = LT+    compare SUS16bit {} SUSAEAD {} = LT+    compare SUS16bit {} SUSym {} = LT+    compare SUS16bit {} SUUnencrypted {} = LT+    compare SUSSHA1 {} SUS16bit {} = GT+    compare SUSSHA1 {} SUSAEAD {} = LT+    compare SUSSHA1 {} SUSym {} = LT+    compare SUSSHA1 {} SUUnencrypted {} = LT+    compare SUSAEAD {} SUS16bit {} = GT+    compare SUSAEAD {} SUSSHA1 {} = GT+    compare SUSAEAD {} SUSym {} = LT+    compare SUSAEAD {} SUUnencrypted {} = LT+    compare SUSym {} SUS16bit {} = GT+    compare SUSym {} SUSSHA1 {} = GT+    compare SUSym {} SUSAEAD {} = GT+    compare SUSym {} SUUnencrypted {} = LT+    compare SUUnencrypted {} _ = GT  instance Hashable SKAddendum  instance Pretty SKAddendum where-  pretty (SUS16bit sa s2k iv bs) =-    pretty "SUS16bit" <+>-    pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)-  pretty (SUSSHA1 sa s2k iv bs) =-    pretty "SUSSHA1" <+>-    pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs)-  pretty (SUSAEAD sa aa s2k iv bs) =-    pretty "SUSAEAD" <+>-    pretty sa <+> pretty aa <+> pretty s2k <+> pretty iv <+>-    pretty (bsToHexUpper bs)-  pretty (SUSym sa iv bs) =-    pretty "SUSym" <+> pretty sa <+> pretty iv <+> pretty (bsToHexUpper bs)-  pretty (SUUnencrypted s ck) =-    pretty "SUUnencrypted" <+> pretty s <+> pretty ck+    pretty (SUS16bit sa s2k iv bs) =+        pretty "SUS16bit"+            <+> pretty sa+            <+> pretty s2k+            <+> pretty iv+            <+> pretty (bsToHexUpper bs)+    pretty (SUSSHA1 sa s2k iv bs) =+        pretty "SUSSHA1"+            <+> pretty sa+            <+> pretty s2k+            <+> pretty iv+            <+> pretty (bsToHexUpper bs)+    pretty (SUSAEAD sa aa s2k iv bs) =+        pretty "SUSAEAD"+            <+> pretty sa+            <+> pretty aa+            <+> pretty s2k+            <+> pretty iv+            <+> pretty (bsToHexUpper bs)+    pretty (SUSym sa iv bs) =+        pretty "SUSym"+            <+> pretty sa+            <+> pretty iv+            <+> pretty (bsToHexUpper bs)+    pretty (SUUnencrypted s ck) =+        pretty "SUUnencrypted" <+> pretty s <+> pretty ck  instance A.ToJSON SKAddendum where-  toJSON (SUS16bit sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs)-  toJSON (SUSSHA1 sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs)-  toJSON (SUSAEAD sa aa s2k iv bs) = A.toJSON (sa, aa, s2k, iv, BL.unpack bs)-  toJSON (SUSym sa iv bs) = A.toJSON (sa, iv, BL.unpack bs)-  toJSON (SUUnencrypted s ck) = A.toJSON (s, ck)+    toJSON (SUS16bit sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs)+    toJSON (SUSSHA1 sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs)+    toJSON (SUSAEAD sa aa s2k iv bs) = A.toJSON (sa, aa, s2k, iv, BL.unpack bs)+    toJSON (SUSym sa iv bs) = A.toJSON (sa, iv, BL.unpack bs)+    toJSON (SUUnencrypted s ck) = A.toJSON (s, ck)  class LegacyKeyVersion (v :: KeyVersion) @@ -407,65 +391,65 @@ instance LegacyKeyVersion 'V4  data SKAddendumV (v :: KeyVersion) where-  SKA16bit ::-       LegacyKeyVersion v-    => SymmetricAlgorithm-    -> S2K-    -> IV-    -> ByteString-    -> SKAddendumV v-  SKASHA1Legacy ::-       LegacyKeyVersion v-    => SymmetricAlgorithm-    -> S2K-    -> IV-    -> ByteString-    -> SKAddendumV v-  SKASHA1V6 ::-       SymmetricAlgorithm-    -> S2K-    -> IV-    -> ByteString-    -> SKAddendumV 'V6-  SKAAEADV6 ::-       SymmetricAlgorithm-    -> AEADAlgorithm-    -> S2K-    -> IV-    -> ByteString-    -> SKAddendumV 'V6-  SKAAEADLegacy ::-       LegacyKeyVersion v-    => SymmetricAlgorithm-    -> AEADAlgorithm-    -> S2K-    -> IV-    -> ByteString-    -> SKAddendumV v-  SKASymLegacy ::-       LegacyKeyVersion v-    => SymmetricAlgorithm-    -> IV-    -> ByteString-    -> SKAddendumV v-  SKASymV6 ::-       SymmetricAlgorithm-    -> IV-    -> ByteString-    -> SKAddendumV 'V6-  SKAUnencryptedLegacy ::-       LegacyKeyVersion v-    => SKey-    -> Word16-    -> SKAddendumV v-  SKAUnencryptedV6 ::-       SKey-    -> SKAddendumV 'V6+    SKA16bit+        :: (LegacyKeyVersion v)+        => SymmetricAlgorithm+        -> S2K+        -> IV+        -> ByteString+        -> SKAddendumV v+    SKASHA1Legacy+        :: (LegacyKeyVersion v)+        => SymmetricAlgorithm+        -> S2K+        -> IV+        -> ByteString+        -> SKAddendumV v+    SKASHA1V6+        :: SymmetricAlgorithm+        -> S2K+        -> IV+        -> ByteString+        -> SKAddendumV 'V6+    SKAAEADV6+        :: SymmetricAlgorithm+        -> AEADAlgorithm+        -> S2K+        -> IV+        -> ByteString+        -> SKAddendumV 'V6+    SKAAEADLegacy+        :: (LegacyKeyVersion v)+        => SymmetricAlgorithm+        -> AEADAlgorithm+        -> S2K+        -> IV+        -> ByteString+        -> SKAddendumV v+    SKASymLegacy+        :: (LegacyKeyVersion v)+        => SymmetricAlgorithm+        -> IV+        -> ByteString+        -> SKAddendumV v+    SKASymV6+        :: SymmetricAlgorithm+        -> IV+        -> ByteString+        -> SKAddendumV 'V6+    SKAUnencryptedLegacy+        :: (LegacyKeyVersion v)+        => SKey+        -> Word16+        -> SKAddendumV v+    SKAUnencryptedV6+        :: SKey+        -> SKAddendumV 'V6  deriving instance Show (SKAddendumV v)  data SomeSKAddendumV where-  SomeSKAddendumV :: SKAddendumV v -> SomeSKAddendumV+    SomeSKAddendumV :: SKAddendumV v -> SomeSKAddendumV  deriving instance Show SomeSKAddendumV @@ -480,44 +464,69 @@ toSKAddendum (SKAUnencryptedLegacy sk checksum) = SUUnencrypted sk checksum toSKAddendum (SKAUnencryptedV6 sk) = SUUnencrypted sk 0 -fromSKAddendumForKeyVersion ::-     KeyVersion-  -> SKAddendum-  -> Either String SomeSKAddendumV+fromSKAddendumForKeyVersion+    :: KeyVersion+    -> SKAddendum+    -> Either String SomeSKAddendumV fromSKAddendumForKeyVersion DeprecatedV3 (SUS16bit sa s2k iv bs) =-  Right (SomeSKAddendumV (SKA16bit sa s2k iv bs :: SKAddendumV 'DeprecatedV3))+    Right+        ( SomeSKAddendumV+            (SKA16bit sa s2k iv bs :: SKAddendumV 'DeprecatedV3)+        ) fromSKAddendumForKeyVersion DeprecatedV3 (SUSSHA1 sa s2k iv bs) =-  Right (SomeSKAddendumV (SKASHA1Legacy sa s2k iv bs :: SKAddendumV 'DeprecatedV3))+    Right+        ( SomeSKAddendumV+            (SKASHA1Legacy sa s2k iv bs :: SKAddendumV 'DeprecatedV3)+        ) fromSKAddendumForKeyVersion DeprecatedV3 (SUSym sa iv bs) =-  Right (SomeSKAddendumV (SKASymLegacy sa iv bs :: SKAddendumV 'DeprecatedV3))+    Right+        ( SomeSKAddendumV+            (SKASymLegacy sa iv bs :: SKAddendumV 'DeprecatedV3)+        ) fromSKAddendumForKeyVersion DeprecatedV3 (SUUnencrypted sk checksum) =-  Right (SomeSKAddendumV (SKAUnencryptedLegacy sk checksum :: SKAddendumV 'DeprecatedV3))+    Right+        ( SomeSKAddendumV+            (SKAUnencryptedLegacy sk checksum :: SKAddendumV 'DeprecatedV3)+        ) fromSKAddendumForKeyVersion DeprecatedV3 (SUSAEAD sa aa s2k iv bs) =-  Right (SomeSKAddendumV (SKAAEADLegacy sa aa s2k iv bs :: SKAddendumV 'DeprecatedV3))+    Right+        ( SomeSKAddendumV+            (SKAAEADLegacy sa aa s2k iv bs :: SKAddendumV 'DeprecatedV3)+        ) fromSKAddendumForKeyVersion V4 (SUS16bit sa s2k iv bs) =-  Right (SomeSKAddendumV (SKA16bit sa s2k iv bs :: SKAddendumV 'V4))+    Right+        (SomeSKAddendumV (SKA16bit sa s2k iv bs :: SKAddendumV 'V4)) fromSKAddendumForKeyVersion V4 (SUSSHA1 sa s2k iv bs) =-  Right (SomeSKAddendumV (SKASHA1Legacy sa s2k iv bs :: SKAddendumV 'V4))+    Right+        (SomeSKAddendumV (SKASHA1Legacy sa s2k iv bs :: SKAddendumV 'V4)) fromSKAddendumForKeyVersion V4 (SUSym sa iv bs) =-  Right (SomeSKAddendumV (SKASymLegacy sa iv bs :: SKAddendumV 'V4))+    Right+        (SomeSKAddendumV (SKASymLegacy sa iv bs :: SKAddendumV 'V4)) fromSKAddendumForKeyVersion V4 (SUUnencrypted sk checksum) =-  Right (SomeSKAddendumV (SKAUnencryptedLegacy sk checksum :: SKAddendumV 'V4))+    Right+        ( SomeSKAddendumV+            (SKAUnencryptedLegacy sk checksum :: SKAddendumV 'V4)+        ) fromSKAddendumForKeyVersion V4 (SUSAEAD sa aa s2k iv bs) =-  Right (SomeSKAddendumV (SKAAEADLegacy sa aa s2k iv bs :: SKAddendumV 'V4))+    Right+        ( SomeSKAddendumV+            (SKAAEADLegacy sa aa s2k iv bs :: SKAddendumV 'V4)+        ) fromSKAddendumForKeyVersion V6 (SUS16bit _ _ _ _) =-  Left "v6 secret keys must not use 16-bit checksum protected secret key addendums"+    Left+        "v6 secret keys must not use 16-bit checksum protected secret key addendums" fromSKAddendumForKeyVersion V6 (SUSSHA1 sa s2k iv bs) =-  Right (SomeSKAddendumV (SKASHA1V6 sa s2k iv bs))+    Right (SomeSKAddendumV (SKASHA1V6 sa s2k iv bs)) fromSKAddendumForKeyVersion V6 (SUSAEAD sa aa s2k iv bs) =-  Right (SomeSKAddendumV (SKAAEADV6 sa aa s2k iv bs))+    Right (SomeSKAddendumV (SKAAEADV6 sa aa s2k iv bs)) fromSKAddendumForKeyVersion V6 (SUSym sa iv bs) =-  Right (SomeSKAddendumV (SKASymV6 sa iv bs))+    Right (SomeSKAddendumV (SKASymV6 sa iv bs)) fromSKAddendumForKeyVersion V6 (SUUnencrypted sk _) =-  Right (SomeSKAddendumV (SKAUnencryptedV6 sk))+    Right (SomeSKAddendumV (SKAUnencryptedV6 sk)) -fromSKAddendumForPKPayload ::-     SomePKPayload-  -> SKAddendum-  -> Either String SomeSKAddendumV+fromSKAddendumForPKPayload+    :: SomePKPayload+    -> SKAddendum+    -> Either String SomeSKAddendumV fromSKAddendumForPKPayload pkp =-  fromSKAddendumForKeyVersion (_keyVersion pkp)+    fromSKAddendumForKeyVersion (_keyVersion pkp)
Codec/Encryption/OpenPGP/Types/Internal/PacketClass.hs view
@@ -2,7 +2,6 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).- {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}@@ -16,588 +15,645 @@  module Codec.Encryption.OpenPGP.Types.Internal.PacketClass where -import Codec.Encryption.OpenPGP.Types.Internal.Base-import Codec.Encryption.OpenPGP.Types.Internal.PKITypes-import Codec.Encryption.OpenPGP.Types.Internal.Pkt- import Control.Lens (makeLenses) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Data (Data)+import qualified Data.Kind import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) import Data.Typeable (Typeable) import Data.Word (Word8)-import qualified Data.Kind-import Prettyprinter (Pretty(..))+import Prettyprinter (Pretty (..)) +import Codec.Encryption.OpenPGP.Types.Internal.Base+import Codec.Encryption.OpenPGP.Types.Internal.PKITypes+import Codec.Encryption.OpenPGP.Types.Internal.Pkt+ class Packet a where-  data PacketType a :: Data.Kind.Type-  packetType :: a -> PacketType a-  packetCode :: PacketType a -> Word8-  dynamicPacketCode :: a -> Word8-  toPkt :: a -> Pkt-  fromPktMaybe :: Pkt -> Maybe a-  fromPktEither :: Pkt -> Either String a-  -  fromPktMaybe = either (const Nothing) Just . fromPktEither-  dynamicPacketCode = packetCode . packetType+    data PacketType a :: Data.Kind.Type+    packetType :: a -> PacketType a+    packetCode :: PacketType a -> Word8+    dynamicPacketCode :: a -> Word8+    toPkt :: a -> Pkt+    fromPktMaybe :: Pkt -> Maybe a+    fromPktEither :: Pkt -> Either String a +    fromPktMaybe = either (const Nothing) Just . fromPktEither+    dynamicPacketCode = packetCode . packetType+ coercionError :: String -> Pkt -> Either String a coercionError expected pkt =-  Left-    ("Cannot coerce non-" ++-     expected ++ " packet (tag " ++ show (pktTag pkt) ++ ")")+    Left+        ( "Cannot coerce non-"+            ++ expected+            ++ " packet (tag "+            ++ show (pktTag pkt)+            ++ ")"+        )  data PKESK (v :: PKESKPayloadVersion) where-  PKESK3Packet ::-       PacketVersion-    -> EightOctetKeyId-    -> PubKeyAlgorithm-    -> NonEmpty MPI-    -> PKESK 'PKESKV3-  PKESK6Packet ::-       BL.ByteString-    -> PubKeyAlgorithm-    -> BL.ByteString-    -> PKESK 'PKESKV6+    PKESK3Packet+        :: PacketVersion+        -> EightOctetKeyId+        -> PubKeyAlgorithm+        -> NonEmpty MPI+        -> PKESK 'PKESKV3+    PKESK6Packet+        :: BL.ByteString+        -> PubKeyAlgorithm+        -> BL.ByteString+        -> PKESK 'PKESKV6  deriving instance Eq (PKESK v) deriving instance Show (PKESK v)  instance Packet (PKESK 'PKESKV3) where-  data PacketType (PKESK 'PKESKV3) = PKESKType-                                    deriving (Show, Eq)-  packetType _ = PKESKType-  packetCode _ = 1-  toPkt (PKESK3Packet version keyid pka mpis) =-    PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 version keyid pka mpis))-  fromPktEither (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ keyid pka mpis))) =-    Right (PKESK3Packet 3 keyid pka mpis)-  fromPktEither (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 _ _ _))) =-    Left "Cannot coerce PKESKv6 packet to PKESKv3"-  fromPktEither pkt = coercionError "PKESK" pkt+    data PacketType (PKESK 'PKESKV3) = PKESKType+        deriving (Eq, Show)+    packetType _ = PKESKType+    packetCode _ = 1+    toPkt (PKESK3Packet version keyid pka mpis) =+        PKESKPkt+            (PKESKPayloadV3Packet (PKESKPayloadV3 version keyid pka mpis))+    fromPktEither (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ keyid pka mpis))) =+        Right (PKESK3Packet 3 keyid pka mpis)+    fromPktEither (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 _ _ _))) =+        Left "Cannot coerce PKESKv6 packet to PKESKv3"+    fromPktEither pkt = coercionError "PKESK" pkt  instance Pretty (PKESK 'PKESKV3) where-  pretty = pretty . toPkt+    pretty = pretty . toPkt  instance Packet (PKESK 'PKESKV6) where-  data PacketType (PKESK 'PKESKV6) = PKESK6Type-                                    deriving (Show, Eq)-  packetType _ = PKESK6Type-  packetCode _ = 1-  toPkt (PKESK6Packet recipientKeyIdentifier pka esk) =-    PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 recipientKeyIdentifier pka esk))-  fromPktEither (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 recipientKeyIdentifier pka esk))) =-    Right (PKESK6Packet recipientKeyIdentifier pka esk)-  fromPktEither (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ _ _ _))) =-    Left "Cannot coerce PKESKv3 packet to PKESKv6"-  fromPktEither pkt = coercionError "PKESKv6" pkt+    data PacketType (PKESK 'PKESKV6) = PKESK6Type+        deriving (Eq, Show)+    packetType _ = PKESK6Type+    packetCode _ = 1+    toPkt (PKESK6Packet recipientKeyIdentifier pka esk) =+        PKESKPkt+            ( PKESKPayloadV6Packet+                (PKESKPayloadV6 recipientKeyIdentifier pka esk)+            )+    fromPktEither+        ( PKESKPkt+                ( PKESKPayloadV6Packet+                        (PKESKPayloadV6 recipientKeyIdentifier pka esk)+                    )+            ) =+            Right (PKESK6Packet recipientKeyIdentifier pka esk)+    fromPktEither (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ _ _ _))) =+        Left "Cannot coerce PKESKv3 packet to PKESKv6"+    fromPktEither pkt = coercionError "PKESKv6" pkt  instance Pretty (PKESK 'PKESKV6) where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -newtype Signature =-  Signature+newtype Signature+    = Signature     { _signaturePayload :: SignaturePayload     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet Signature where-  data PacketType Signature = SignatureType-                              deriving (Show, Eq)-  packetType _ = SignatureType-  packetCode _ = 2-  toPkt (Signature a) = SignaturePkt a-  fromPktMaybe (SignaturePkt a) = Just (Signature a)-  fromPktMaybe _ = Nothing-  fromPktEither (SignaturePkt a) = Right (Signature a)-  fromPktEither pkt = coercionError "Signature" pkt+    data PacketType Signature = SignatureType+        deriving (Eq, Show)+    packetType _ = SignatureType+    packetCode _ = 2+    toPkt (Signature a) = SignaturePkt a+    fromPktMaybe (SignaturePkt a) = Just (Signature a)+    fromPktMaybe _ = Nothing+    fromPktEither (SignaturePkt a) = Right (Signature a)+    fromPktEither pkt = coercionError "Signature" pkt  instance Pretty Signature where-  pretty = pretty . toPkt+    pretty = pretty . toPkt  data SignatureV (v :: SignaturePayloadVersion) where-  SignatureV3Packet :: SignaturePayloadV 'SigPayloadV3 -> SignatureV 'SigPayloadV3-  SignatureV4Packet :: SignaturePayloadV 'SigPayloadV4 -> SignatureV 'SigPayloadV4-  SignatureV6Packet :: SignaturePayloadV 'SigPayloadV6 -> SignatureV 'SigPayloadV6-  SignatureVOtherPacket :: SignaturePayloadV 'SigPayloadVOther -> SignatureV 'SigPayloadVOther+    SignatureV3Packet+        :: SignaturePayloadV 'SigPayloadV3 -> SignatureV 'SigPayloadV3+    SignatureV4Packet+        :: SignaturePayloadV 'SigPayloadV4 -> SignatureV 'SigPayloadV4+    SignatureV6Packet+        :: SignaturePayloadV 'SigPayloadV6 -> SignatureV 'SigPayloadV6+    SignatureVOtherPacket+        :: SignaturePayloadV 'SigPayloadVOther+        -> SignatureV 'SigPayloadVOther  deriving instance Eq (SignatureV v) deriving instance Show (SignatureV v)  data SomeSignatureV where-  SomeSignatureV :: SignatureV v -> SomeSignatureV+    SomeSignatureV :: SignatureV v -> SomeSignatureV -signaturePayloadFromSignatureV :: SignatureV v -> SignaturePayload+signaturePayloadFromSignatureV+    :: SignatureV v -> SignaturePayload signaturePayloadFromSignatureV (SignatureV3Packet payload) = toSignaturePayload payload signaturePayloadFromSignatureV (SignatureV4Packet payload) = toSignaturePayload payload signaturePayloadFromSignatureV (SignatureV6Packet payload) = toSignaturePayload payload signaturePayloadFromSignatureV (SignatureVOtherPacket payload) = toSignaturePayload payload -fromPktEitherSomeSignatureV :: Pkt -> Either String SomeSignatureV+fromPktEitherSomeSignatureV+    :: Pkt -> Either String SomeSignatureV fromPktEitherSomeSignatureV (SignaturePkt payload) =-  Right (someSignatureVFromPayload payload)+    Right (someSignatureVFromPayload payload) fromPktEitherSomeSignatureV pkt =-  coercionError "Signature" pkt+    coercionError "Signature" pkt  someSignatureVFromPayload :: SignaturePayload -> SomeSignatureV someSignatureVFromPayload payload =-  case toSomeSignaturePayload payload of-    SomeSignaturePayload (typedPayload@SigPayloadV3Data {}) ->-      SomeSignatureV (SignatureV3Packet typedPayload)-    SomeSignaturePayload (typedPayload@SigPayloadV4Data {}) ->-      SomeSignatureV (SignatureV4Packet typedPayload)-    SomeSignaturePayload (typedPayload@SigPayloadV6Data {}) ->-      SomeSignatureV (SignatureV6Packet typedPayload)-    SomeSignaturePayload (typedPayload@SigPayloadOtherData {}) ->-      SomeSignatureV (SignatureVOtherPacket typedPayload)+    case toSomeSignaturePayload payload of+        SomeSignaturePayload (typedPayload@SigPayloadV3Data {}) ->+            SomeSignatureV (SignatureV3Packet typedPayload)+        SomeSignaturePayload (typedPayload@SigPayloadV4Data {}) ->+            SomeSignatureV (SignatureV4Packet typedPayload)+        SomeSignaturePayload (typedPayload@SigPayloadV6Data {}) ->+            SomeSignatureV (SignatureV6Packet typedPayload)+        SomeSignaturePayload (typedPayload@SigPayloadOtherData {}) ->+            SomeSignatureV (SignatureVOtherPacket typedPayload)  instance Packet (SignatureV 'SigPayloadV3) where-  data PacketType (SignatureV 'SigPayloadV3) = SignatureV3Type-                                             deriving (Show, Eq)-  packetType _ = SignatureV3Type-  packetCode _ = 2-  toPkt = SignaturePkt . signaturePayloadFromSignatureV-  fromPktEither (SignaturePkt payload) =-    SignatureV3Packet <$> asSignaturePayloadV3 payload-  fromPktEither pkt = coercionError "SignatureV3" pkt+    data PacketType (SignatureV 'SigPayloadV3) = SignatureV3Type+        deriving (Eq, Show)+    packetType _ = SignatureV3Type+    packetCode _ = 2+    toPkt = SignaturePkt . signaturePayloadFromSignatureV+    fromPktEither (SignaturePkt payload) =+        SignatureV3Packet <$> asSignaturePayloadV3 payload+    fromPktEither pkt = coercionError "SignatureV3" pkt  instance Pretty (SignatureV 'SigPayloadV3) where-  pretty = pretty . toPkt+    pretty = pretty . toPkt  instance Packet (SignatureV 'SigPayloadV4) where-  data PacketType (SignatureV 'SigPayloadV4) = SignatureV4Type-                                             deriving (Show, Eq)-  packetType _ = SignatureV4Type-  packetCode _ = 2-  toPkt = SignaturePkt . signaturePayloadFromSignatureV-  fromPktEither (SignaturePkt payload) =-    SignatureV4Packet <$> asSignaturePayloadV4 payload-  fromPktEither pkt = coercionError "SignatureV4" pkt+    data PacketType (SignatureV 'SigPayloadV4) = SignatureV4Type+        deriving (Eq, Show)+    packetType _ = SignatureV4Type+    packetCode _ = 2+    toPkt = SignaturePkt . signaturePayloadFromSignatureV+    fromPktEither (SignaturePkt payload) =+        SignatureV4Packet <$> asSignaturePayloadV4 payload+    fromPktEither pkt = coercionError "SignatureV4" pkt  instance Pretty (SignatureV 'SigPayloadV4) where-  pretty = pretty . toPkt+    pretty = pretty . toPkt  instance Packet (SignatureV 'SigPayloadV6) where-  data PacketType (SignatureV 'SigPayloadV6) = SignatureV6Type-                                             deriving (Show, Eq)-  packetType _ = SignatureV6Type-  packetCode _ = 2-  toPkt = SignaturePkt . signaturePayloadFromSignatureV-  fromPktEither (SignaturePkt payload) =-    SignatureV6Packet <$> asSignaturePayloadV6 payload-  fromPktEither pkt = coercionError "SignatureV6" pkt+    data PacketType (SignatureV 'SigPayloadV6) = SignatureV6Type+        deriving (Eq, Show)+    packetType _ = SignatureV6Type+    packetCode _ = 2+    toPkt = SignaturePkt . signaturePayloadFromSignatureV+    fromPktEither (SignaturePkt payload) =+        SignatureV6Packet <$> asSignaturePayloadV6 payload+    fromPktEither pkt = coercionError "SignatureV6" pkt  instance Pretty (SignatureV 'SigPayloadV6) where-  pretty = pretty . toPkt+    pretty = pretty . toPkt  instance Packet (SignatureV 'SigPayloadVOther) where-  data PacketType (SignatureV 'SigPayloadVOther) = SignatureVOtherType-                                                 deriving (Show, Eq)-  packetType _ = SignatureVOtherType-  packetCode _ = 2-  toPkt = SignaturePkt . signaturePayloadFromSignatureV-  fromPktEither (SignaturePkt payload) =-    SignatureVOtherPacket <$> asSignaturePayloadOther payload-  fromPktEither pkt = coercionError "SignatureVOther" pkt+    data PacketType (SignatureV 'SigPayloadVOther) = SignatureVOtherType+        deriving (Eq, Show)+    packetType _ = SignatureVOtherType+    packetCode _ = 2+    toPkt = SignaturePkt . signaturePayloadFromSignatureV+    fromPktEither (SignaturePkt payload) =+        SignatureVOtherPacket <$> asSignaturePayloadOther payload+    fromPktEither pkt = coercionError "SignatureVOther" pkt  instance Pretty (SignatureV 'SigPayloadVOther) where-  pretty = pretty . toPkt+    pretty = pretty . toPkt  data SKESK (v :: SKESKPayloadVersion) where-  SKESK4Packet ::-       SymmetricAlgorithm-    -> S2K-    -> Maybe BL.ByteString-    -> SKESK 'SKESKV4-  SKESK6Packet ::-       SymmetricAlgorithm-    -> AEADAlgorithm-    -> S2K-    -> BL.ByteString-    -> BL.ByteString-    -> BL.ByteString-    -> SKESK 'SKESKV6+    SKESK4Packet+        :: SymmetricAlgorithm+        -> S2K+        -> Maybe BL.ByteString+        -> SKESK 'SKESKV4+    SKESK6Packet+        :: SymmetricAlgorithm+        -> AEADAlgorithm+        -> S2K+        -> BL.ByteString+        -> BL.ByteString+        -> BL.ByteString+        -> SKESK 'SKESKV6  deriving instance Eq (SKESK v) deriving instance Show (SKESK v)  instance Packet (SKESK 'SKESKV4) where-  data PacketType (SKESK 'SKESKV4) = SKESKType-                                    deriving (Show, Eq)-  packetType _ = SKESKType-  packetCode _ = 3-  toPkt (SKESK4Packet symalgo s2k esk) =-    SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 symalgo s2k esk))-  fromPktEither (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 symalgo s2k esk))) =-    Right (SKESK4Packet symalgo s2k esk)-  fromPktEither (SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 _ _ _ _ _ _))) =-    Left "Cannot coerce SKESKv6 packet to SKESKv4"-  fromPktEither pkt = coercionError "SKESK" pkt+    data PacketType (SKESK 'SKESKV4) = SKESKType+        deriving (Eq, Show)+    packetType _ = SKESKType+    packetCode _ = 3+    toPkt (SKESK4Packet symalgo s2k esk) =+        SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 symalgo s2k esk))+    fromPktEither (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 symalgo s2k esk))) =+        Right (SKESK4Packet symalgo s2k esk)+    fromPktEither (SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 _ _ _ _ _ _))) =+        Left "Cannot coerce SKESKv6 packet to SKESKv4"+    fromPktEither pkt = coercionError "SKESK" pkt  instance Pretty (SKESK 'SKESKV4) where-  pretty = pretty . toPkt+    pretty = pretty . toPkt  instance Packet (SKESK 'SKESKV6) where-  data PacketType (SKESK 'SKESKV6) = SKESK6Type-                                    deriving (Show, Eq)-  packetType _ = SKESK6Type-  packetCode _ = 3-  toPkt (SKESK6Packet symalgo aead s2k iv esk tag) =-    SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 symalgo aead s2k iv esk tag))-  fromPktEither (SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 symalgo aead s2k iv esk tag))) =-    Right (SKESK6Packet symalgo aead s2k iv esk tag)-  fromPktEither (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 _ _ _))) =-    Left "Cannot coerce SKESKv4 packet to SKESKv6"-  fromPktEither pkt = coercionError "SKESKv6" pkt+    data PacketType (SKESK 'SKESKV6) = SKESK6Type+        deriving (Eq, Show)+    packetType _ = SKESK6Type+    packetCode _ = 3+    toPkt (SKESK6Packet symalgo aead s2k iv esk tag) =+        SKESKPkt+            (SKESKPayloadV6Packet (SKESKPayloadV6 symalgo aead s2k iv esk tag))+    fromPktEither+        ( SKESKPkt+                (SKESKPayloadV6Packet (SKESKPayloadV6 symalgo aead s2k iv esk tag))+            ) =+            Right (SKESK6Packet symalgo aead s2k iv esk tag)+    fromPktEither (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 _ _ _))) =+        Left "Cannot coerce SKESKv4 packet to SKESKv6"+    fromPktEither pkt = coercionError "SKESKv6" pkt  instance Pretty (SKESK 'SKESKV6) where-  pretty = pretty . toPkt+    pretty = pretty . toPkt  data OnePassSignature (v :: OnePassSignatureVersion) where-  OnePassSignatureV3Packet ::-       PacketVersion-    -> SigType-    -> HashAlgorithm-    -> PubKeyAlgorithm-    -> EightOctetKeyId-    -> NestedFlag-    -> OnePassSignature 'OPSV3-  OnePassSignatureV6Packet ::-       SigType-    -> HashAlgorithm-    -> PubKeyAlgorithm-    -> SignatureSalt-    -> ByteString-    -> NestedFlag-    -> OnePassSignature 'OPSV6+    OnePassSignatureV3Packet+        :: PacketVersion+        -> SigType+        -> HashAlgorithm+        -> PubKeyAlgorithm+        -> EightOctetKeyId+        -> NestedFlag+        -> OnePassSignature 'OPSV3+    OnePassSignatureV6Packet+        :: SigType+        -> HashAlgorithm+        -> PubKeyAlgorithm+        -> SignatureSalt+        -> ByteString+        -> NestedFlag+        -> OnePassSignature 'OPSV6  deriving instance Eq (OnePassSignature v) deriving instance Show (OnePassSignature v)  instance Packet (OnePassSignature 'OPSV3) where-  data PacketType (OnePassSignature 'OPSV3) = OnePassSignatureType-                                            deriving (Show, Eq)-  packetType _ = OnePassSignatureType-  packetCode _ = 4-  toPkt (OnePassSignatureV3Packet a b c d e f) =-    OnePassSignaturePkt (OPSPayloadV3Packet (OPSPayloadV3 a b c d e f))-  fromPktEither (OnePassSignaturePkt (OPSPayloadV3Packet (OPSPayloadV3 a b c d e f))) =-    Right (OnePassSignatureV3Packet a b c d e f)-  fromPktEither pkt = coercionError "OnePassSignature" pkt+    data PacketType (OnePassSignature 'OPSV3) = OnePassSignatureType+        deriving (Eq, Show)+    packetType _ = OnePassSignatureType+    packetCode _ = 4+    toPkt (OnePassSignatureV3Packet a b c d e f) =+        OnePassSignaturePkt+            (OPSPayloadV3Packet (OPSPayloadV3 a b c d e f))+    fromPktEither+        ( OnePassSignaturePkt+                (OPSPayloadV3Packet (OPSPayloadV3 a b c d e f))+            ) =+            Right (OnePassSignatureV3Packet a b c d e f)+    fromPktEither pkt = coercionError "OnePassSignature" pkt  instance Pretty (OnePassSignature 'OPSV3) where-  pretty = pretty . toPkt+    pretty = pretty . toPkt  instance Packet (OnePassSignature 'OPSV6) where-  data PacketType (OnePassSignature 'OPSV6) = OnePassSignatureV6Type-                                            deriving (Show, Eq)-  packetType _ = OnePassSignatureV6Type-  packetCode _ = 4-  toPkt (OnePassSignatureV6Packet a b c d e f) =-    OnePassSignaturePkt (OPSPayloadV6Packet (OPSPayloadV6 a b c d e f))-  fromPktEither (OnePassSignaturePkt (OPSPayloadV6Packet (OPSPayloadV6 a b c d e f))) =-    Right (OnePassSignatureV6Packet a b c d e f)-  fromPktEither pkt = coercionError "OnePassSignatureV6" pkt+    data PacketType (OnePassSignature 'OPSV6) = OnePassSignatureV6Type+        deriving (Eq, Show)+    packetType _ = OnePassSignatureV6Type+    packetCode _ = 4+    toPkt (OnePassSignatureV6Packet a b c d e f) =+        OnePassSignaturePkt+            (OPSPayloadV6Packet (OPSPayloadV6 a b c d e f))+    fromPktEither+        ( OnePassSignaturePkt+                (OPSPayloadV6Packet (OPSPayloadV6 a b c d e f))+            ) =+            Right (OnePassSignatureV6Packet a b c d e f)+    fromPktEither pkt = coercionError "OnePassSignatureV6" pkt  instance Pretty (OnePassSignature 'OPSV6) where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -data SecretKey =-  SecretKey+data SecretKey+    = SecretKey     { _secretKeyPKPayload :: SomePKPayload     , _secretKeySKAddendum :: SKAddendum     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet SecretKey where-  data PacketType SecretKey = SecretKeyType-                              deriving (Show, Eq)-  packetType _ = SecretKeyType-  packetCode _ = 5-  toPkt (SecretKey a b) = SecretKeyPkt a b-  fromPktEither (SecretKeyPkt a b) = Right (SecretKey a b)-  fromPktEither pkt = coercionError "SecretKey" pkt+    data PacketType SecretKey = SecretKeyType+        deriving (Eq, Show)+    packetType _ = SecretKeyType+    packetCode _ = 5+    toPkt (SecretKey a b) = SecretKeyPkt a b+    fromPktEither (SecretKeyPkt a b) = Right (SecretKey a b)+    fromPktEither pkt = coercionError "SecretKey" pkt  instance Pretty SecretKey where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -newtype PublicKey =-  PublicKey+newtype PublicKey+    = PublicKey     { _publicKeyPKPayload :: SomePKPayload     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet PublicKey where-  data PacketType PublicKey = PublicKeyType-                              deriving (Show, Eq)-  packetType _ = PublicKeyType-  packetCode _ = 6-  toPkt (PublicKey a) = PublicKeyPkt a-  fromPktEither (PublicKeyPkt a) = Right (PublicKey a)-  fromPktEither pkt = coercionError "PublicKey" pkt+    data PacketType PublicKey = PublicKeyType+        deriving (Eq, Show)+    packetType _ = PublicKeyType+    packetCode _ = 6+    toPkt (PublicKey a) = PublicKeyPkt a+    fromPktEither (PublicKeyPkt a) = Right (PublicKey a)+    fromPktEither pkt = coercionError "PublicKey" pkt  instance Pretty PublicKey where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -data SecretSubkey =-  SecretSubkey+data SecretSubkey+    = SecretSubkey     { _secretSubkeyPKPayload :: SomePKPayload     , _secretSubkeySKAddendum :: SKAddendum     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet SecretSubkey where-  data PacketType SecretSubkey = SecretSubkeyType-                                 deriving (Show, Eq)-  packetType _ = SecretSubkeyType-  packetCode _ = 7-  toPkt (SecretSubkey a b) = SecretSubkeyPkt a b-  fromPktEither (SecretSubkeyPkt a b) = Right (SecretSubkey a b)-  fromPktEither pkt = coercionError "SecretSubkey" pkt+    data PacketType SecretSubkey = SecretSubkeyType+        deriving (Eq, Show)+    packetType _ = SecretSubkeyType+    packetCode _ = 7+    toPkt (SecretSubkey a b) = SecretSubkeyPkt a b+    fromPktEither (SecretSubkeyPkt a b) = Right (SecretSubkey a b)+    fromPktEither pkt = coercionError "SecretSubkey" pkt  instance Pretty SecretSubkey where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -data CompressedData =-  CompressedData+data CompressedData+    = CompressedData     { _compressedDataCompressionAlgorithm :: CompressionAlgorithm     , _compressedDataPayload :: CompressedDataPayload     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet CompressedData where-  data PacketType CompressedData = CompressedDataType-                                   deriving (Show, Eq)-  packetType _ = CompressedDataType-  packetCode _ = 8-  toPkt (CompressedData a b) = CompressedDataPkt a b-  fromPktEither (CompressedDataPkt a b) = Right (CompressedData a b)-  fromPktEither pkt = coercionError "CompressedData" pkt+    data PacketType CompressedData = CompressedDataType+        deriving (Eq, Show)+    packetType _ = CompressedDataType+    packetCode _ = 8+    toPkt (CompressedData a b) = CompressedDataPkt a b+    fromPktEither (CompressedDataPkt a b) = Right (CompressedData a b)+    fromPktEither pkt = coercionError "CompressedData" pkt  instance Pretty CompressedData where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -newtype SymEncData =-  SymEncData+newtype SymEncData+    = SymEncData     { _symEncDataPayload :: ByteString     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet SymEncData where-  data PacketType SymEncData = SymEncDataType-                               deriving (Show, Eq)-  packetType _ = SymEncDataType-  packetCode _ = 9-  toPkt (SymEncData a) = SymEncDataPkt a-  fromPktEither (SymEncDataPkt a) = Right (SymEncData a)-  fromPktEither pkt = coercionError "SymEncData" pkt+    data PacketType SymEncData = SymEncDataType+        deriving (Eq, Show)+    packetType _ = SymEncDataType+    packetCode _ = 9+    toPkt (SymEncData a) = SymEncDataPkt a+    fromPktEither (SymEncDataPkt a) = Right (SymEncData a)+    fromPktEither pkt = coercionError "SymEncData" pkt  instance Pretty SymEncData where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -newtype Marker =-  Marker+newtype Marker+    = Marker     { _markerPayload :: ByteString     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet Marker where-  data PacketType Marker = MarkerType-                           deriving (Show, Eq)-  packetType _ = MarkerType-  packetCode _ = 10-  toPkt (Marker a) = MarkerPkt a-  fromPktEither (MarkerPkt a) = Right (Marker a)-  fromPktEither pkt = coercionError "Marker" pkt+    data PacketType Marker = MarkerType+        deriving (Eq, Show)+    packetType _ = MarkerType+    packetCode _ = 10+    toPkt (Marker a) = MarkerPkt a+    fromPktEither (MarkerPkt a) = Right (Marker a)+    fromPktEither pkt = coercionError "Marker" pkt  instance Pretty Marker where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -data LiteralData =-  LiteralData-    { _literalDataDataType :: DataType+data LiteralData+    = LiteralData+    { _literalDataDataType :: LiteralDataType     , _literalDataFileName :: FileName     , _literalDataTimeStamp :: ThirtyTwoBitTimeStamp     , _literalDataPayload :: ByteString     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet LiteralData where-  data PacketType LiteralData = LiteralDataType-                                deriving (Show, Eq)-  packetType _ = LiteralDataType-  packetCode _ = 11-  toPkt (LiteralData a b c d) = LiteralDataPkt a b c d-  fromPktEither (LiteralDataPkt a b c d) = Right (LiteralData a b c d)-  fromPktEither pkt = coercionError "LiteralData" pkt+    data PacketType LiteralData = LiteralDataType+        deriving (Eq, Show)+    packetType _ = LiteralDataType+    packetCode _ = 11+    toPkt (LiteralData a b c d) = LiteralDataPkt a b c d+    fromPktEither (LiteralDataPkt a b c d) = Right (LiteralData a b c d)+    fromPktEither pkt = coercionError "LiteralData" pkt  instance Pretty LiteralData where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -newtype Trust =-  Trust+newtype Trust+    = Trust     { _trustPayload :: ByteString     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet Trust where-  data PacketType Trust = TrustType-                          deriving (Show, Eq)-  packetType _ = TrustType-  packetCode _ = 12-  toPkt (Trust a) = TrustPkt a-  fromPktEither (TrustPkt a) = Right (Trust a)-  fromPktEither pkt = coercionError "Trust" pkt+    data PacketType Trust = TrustType+        deriving (Eq, Show)+    packetType _ = TrustType+    packetCode _ = 12+    toPkt (Trust a) = TrustPkt a+    fromPktEither (TrustPkt a) = Right (Trust a)+    fromPktEither pkt = coercionError "Trust" pkt  instance Pretty Trust where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -newtype UserId =-  UserId+newtype UserId+    = UserId     { _userIdPayload :: Text     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet UserId where-  data PacketType UserId = UserIdType-                           deriving (Show, Eq)-  packetType _ = UserIdType-  packetCode _ = 13-  toPkt (UserId a) = UserIdPkt a-  fromPktEither (UserIdPkt a) = Right (UserId a)-  fromPktEither pkt = coercionError "UserId" pkt+    data PacketType UserId = UserIdType+        deriving (Eq, Show)+    packetType _ = UserIdType+    packetCode _ = 13+    toPkt (UserId a) = UserIdPkt a+    fromPktEither (UserIdPkt a) = Right (UserId a)+    fromPktEither pkt = coercionError "UserId" pkt  instance Pretty UserId where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -newtype PublicSubkey =-  PublicSubkey+newtype PublicSubkey+    = PublicSubkey     { _publicSubkeyPKPayload :: SomePKPayload     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet PublicSubkey where-  data PacketType PublicSubkey = PublicSubkeyType-                                 deriving (Show, Eq)-  packetType _ = PublicSubkeyType-  packetCode _ = 14-  toPkt (PublicSubkey a) = PublicSubkeyPkt a-  fromPktEither (PublicSubkeyPkt a) = Right (PublicSubkey a)-  fromPktEither pkt = coercionError "PublicSubkey" pkt+    data PacketType PublicSubkey = PublicSubkeyType+        deriving (Eq, Show)+    packetType _ = PublicSubkeyType+    packetCode _ = 14+    toPkt (PublicSubkey a) = PublicSubkeyPkt a+    fromPktEither (PublicSubkeyPkt a) = Right (PublicSubkey a)+    fromPktEither pkt = coercionError "PublicSubkey" pkt  instance Pretty PublicSubkey where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -newtype UserAttribute =-  UserAttribute+newtype UserAttribute+    = UserAttribute     { _userAttributeSubPackets :: [UserAttrSubPacket]     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet UserAttribute where-  data PacketType UserAttribute = UserAttributeType-                                  deriving (Show, Eq)-  packetType _ = UserAttributeType-  packetCode _ = 17-  toPkt (UserAttribute a) = UserAttributePkt a-  fromPktEither (UserAttributePkt a) = Right (UserAttribute a)-  fromPktEither pkt = coercionError "UserAttribute" pkt+    data PacketType UserAttribute = UserAttributeType+        deriving (Eq, Show)+    packetType _ = UserAttributeType+    packetCode _ = 17+    toPkt (UserAttribute a) = UserAttributePkt a+    fromPktEither (UserAttributePkt a) = Right (UserAttribute a)+    fromPktEither pkt = coercionError "UserAttribute" pkt  instance Pretty UserAttribute where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -data SymEncIntegrityProtectedData =-  SymEncIntegrityProtectedData-    { _symEncIntegrityProtectedDataPacketVersion :: PacketVersion-    , _symEncIntegrityProtectedDataPayload :: ByteString-    }-  | SymEncIntegrityProtectedDataV2-      SymmetricAlgorithm-      AEADAlgorithm-      Word8-      Salt-      ByteString-  deriving (Data, Eq, Show, Typeable)+data SymEncIntegrityProtectedData+    = SymEncIntegrityProtectedData+        { _symEncIntegrityProtectedDataPacketVersion :: PacketVersion+        , _symEncIntegrityProtectedDataPayload :: ByteString+        }+    | SymEncIntegrityProtectedDataV2+        SymmetricAlgorithm+        AEADAlgorithm+        Word8+        Salt+        ByteString+    deriving (Data, Eq, Show, Typeable)  instance Packet SymEncIntegrityProtectedData where-  data PacketType-       SymEncIntegrityProtectedData = SymEncIntegrityProtectedDataType-                                        deriving (Show, Eq)-  packetType _ = SymEncIntegrityProtectedDataType-  packetCode _ = 18-  toPkt (SymEncIntegrityProtectedData a b) = SymEncIntegrityProtectedDataPkt (SEIPD1 a b)-  toPkt (SymEncIntegrityProtectedDataV2 a b c d e) =-    SymEncIntegrityProtectedDataPkt (SEIPD2 a b c d e)-  fromPktEither (SymEncIntegrityProtectedDataPkt (SEIPD1 a b)) =-    Right (SymEncIntegrityProtectedData a b)-  fromPktEither (SymEncIntegrityProtectedDataPkt (SEIPD2 a b c d e)) =-    Right (SymEncIntegrityProtectedDataV2 a b c d e)-  fromPktEither pkt = coercionError "SymEncIntegrityProtectedData" pkt+    data+        PacketType+            SymEncIntegrityProtectedData+        = SymEncIntegrityProtectedDataType+        deriving (Eq, Show)+    packetType _ = SymEncIntegrityProtectedDataType+    packetCode _ = 18+    toPkt (SymEncIntegrityProtectedData a b) = SymEncIntegrityProtectedDataPkt (SEIPD1 a b)+    toPkt (SymEncIntegrityProtectedDataV2 a b c d e) =+        SymEncIntegrityProtectedDataPkt (SEIPD2 a b c d e)+    fromPktEither (SymEncIntegrityProtectedDataPkt (SEIPD1 a b)) =+        Right (SymEncIntegrityProtectedData a b)+    fromPktEither (SymEncIntegrityProtectedDataPkt (SEIPD2 a b c d e)) =+        Right (SymEncIntegrityProtectedDataV2 a b c d e)+    fromPktEither pkt = coercionError "SymEncIntegrityProtectedData" pkt  instance Pretty SymEncIntegrityProtectedData where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -newtype ModificationDetectionCode =-  ModificationDetectionCode+newtype ModificationDetectionCode+    = ModificationDetectionCode     { _modificationDetectionCodePayload :: ByteString     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet ModificationDetectionCode where-  data PacketType-       ModificationDetectionCode = ModificationDetectionCodeType-                                     deriving (Show, Eq)-  packetType _ = ModificationDetectionCodeType-  packetCode _ = 19-  toPkt (ModificationDetectionCode a) = ModificationDetectionCodePkt a-  fromPktEither (ModificationDetectionCodePkt a) = Right (ModificationDetectionCode a)-  fromPktEither pkt = coercionError "ModificationDetectionCode" pkt+    data+        PacketType+            ModificationDetectionCode+        = ModificationDetectionCodeType+        deriving (Eq, Show)+    packetType _ = ModificationDetectionCodeType+    packetCode _ = 19+    toPkt (ModificationDetectionCode a) = ModificationDetectionCodePkt a+    fromPktEither (ModificationDetectionCodePkt a) = Right (ModificationDetectionCode a)+    fromPktEither pkt = coercionError "ModificationDetectionCode" pkt  instance Pretty ModificationDetectionCode where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -data OtherPacket =-  OtherPacket+newtype Padding+    = Padding+    { _padding :: ByteString+    }+    deriving (Data, Eq, Show, Typeable)++instance Packet Padding where+    data+        PacketType+            Padding+        = PaddingType+        deriving (Eq, Show)+    packetType _ = PaddingType+    packetCode _ = 21+    toPkt (Padding a) = PaddingPkt a+    fromPktEither (PaddingPkt a) = Right (Padding a)+    fromPktEither pkt = coercionError "Padding" pkt++instance Pretty Padding where+    pretty = pretty . toPkt++data OtherPacket+    = OtherPacket     { _otherPacketType :: Word8     , _otherPacketPayload :: ByteString     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet OtherPacket where-  data PacketType OtherPacket = OtherPacketType-                                deriving (Show, Eq)-  packetType _ = OtherPacketType-  packetCode _ = error "OtherPacket has no static packet type code"-  dynamicPacketCode = _otherPacketType-  toPkt (OtherPacket a b) = OtherPacketPkt a b-  fromPktEither (OtherPacketPkt a b) = Right (OtherPacket a b)-  fromPktEither pkt = coercionError "OtherPacket" pkt+    data PacketType OtherPacket = OtherPacketType+        deriving (Eq, Show)+    packetType _ = OtherPacketType+    packetCode _ = error "OtherPacket has no static packet type code"+    dynamicPacketCode = _otherPacketType+    toPkt (OtherPacket a b) = OtherPacketPkt a b+    fromPktEither (OtherPacketPkt a b) = Right (OtherPacket a b)+    fromPktEither pkt = coercionError "OtherPacket" pkt  instance Pretty OtherPacket where-  pretty = pretty . toPkt+    pretty = pretty . toPkt -data BrokenPacket =-  BrokenPacket+data BrokenPacket+    = BrokenPacket     { _brokenPacketParseError :: String     , _brokenPacketType :: Word8     , _brokenPacketPayload :: ByteString     }-  deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Show, Typeable)  instance Packet BrokenPacket where-  data PacketType BrokenPacket = BrokenPacketType-                                 deriving (Show, Eq)-  packetType _ = BrokenPacketType-  packetCode _ = error "BrokenPacket has no static packet type code"-  dynamicPacketCode = _brokenPacketType-  toPkt (BrokenPacket a b c) = BrokenPacketPkt a b c-  fromPktEither (BrokenPacketPkt a b c) = Right (BrokenPacket a b c)-  fromPktEither pkt = coercionError "BrokenPacket" pkt+    data PacketType BrokenPacket = BrokenPacketType+        deriving (Eq, Show)+    packetType _ = BrokenPacketType+    packetCode _ = error "BrokenPacket has no static packet type code"+    dynamicPacketCode = _brokenPacketType+    toPkt (BrokenPacket a b c) = BrokenPacketPkt a b c+    fromPktEither (BrokenPacketPkt a b c) = Right (BrokenPacket a b c)+    fromPktEither pkt = coercionError "BrokenPacket" pkt  instance Pretty BrokenPacket where-  pretty = pretty . toPkt+    pretty = pretty . toPkt  $(makeLenses ''Signature)
Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs view
@@ -2,470 +2,571 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).- {-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-}  module Codec.Encryption.OpenPGP.Types.Internal.Pkt where -import GHC.Generics (Generic)--import Codec.Encryption.OpenPGP.Types.Internal.Base-import Codec.Encryption.OpenPGP.Types.Internal.PKITypes--import Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils (prettyLBS) import Control.Lens (makeLenses)-import Data.Aeson ((.=), object)+import Data.Aeson (object, (.=)) import qualified Data.Aeson as A+import qualified Data.Aeson.Key as AK import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL-import Data.Data (Data(..), Constr, mkDataType, mkConstr, Fixity(Prefix))+import Data.Data+    ( Constr+    , Data (..)+    , Fixity (Prefix)+    , mkConstr+    , mkDataType+    ) import qualified Data.Data as DD-import Data.Hashable (Hashable(..))+import Data.Hashable (Hashable (..)) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) import Data.Text (Text)-import qualified Data.Text as T import Data.Time.Clock (UTCTime) import Data.Typeable (Typeable) import Data.Word (Word8)-import Prettyprinter (Pretty(..), (<+>))+import GHC.Generics (Generic)+import Prettyprinter (Pretty (..), (<+>)) +import Codec.Encryption.OpenPGP.Types.Internal.Base+import Codec.Encryption.OpenPGP.Types.Internal.PKITypes+import Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils+    ( prettyLBS+    )+ data PKESKPayloadVersion = PKESKV3 | PKESKV6-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable) -data PKESKPayloadV3 =-  PKESKPayloadV3-    PacketVersion-    EightOctetKeyId-    PubKeyAlgorithm-    (NonEmpty MPI)-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+data PKESKPayloadV3+    = PKESKPayloadV3+        PacketVersion+        EightOctetKeyId+        PubKeyAlgorithm+        (NonEmpty MPI)+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable) -data PKESKPayloadV6 =-  PKESKPayloadV6-    BL.ByteString-    PubKeyAlgorithm-    BL.ByteString-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+data PKESKPayloadV6+    = PKESKPayloadV6+        BL.ByteString+        PubKeyAlgorithm+        BL.ByteString+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)  data PKESKPayload-  = PKESKPayloadV3Packet PKESKPayloadV3-  | PKESKPayloadV6Packet PKESKPayloadV6-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+    = PKESKPayloadV3Packet PKESKPayloadV3+    | PKESKPayloadV6Packet PKESKPayloadV6+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)  data SKESKPayloadVersion = SKESKV4 | SKESKV6-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable) -data SKESKPayloadV4 =-  SKESKPayloadV4-    SymmetricAlgorithm-    S2K-    (Maybe BL.ByteString)-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+data SKESKPayloadV4+    = SKESKPayloadV4+        SymmetricAlgorithm+        S2K+        (Maybe BL.ByteString)+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable) -data SKESKPayloadV6 =-  SKESKPayloadV6-    SymmetricAlgorithm-    AEADAlgorithm-    S2K-    BL.ByteString-    BL.ByteString-    BL.ByteString-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+data SKESKPayloadV6+    = SKESKPayloadV6+        SymmetricAlgorithm+        AEADAlgorithm+        S2K+        BL.ByteString+        BL.ByteString+        BL.ByteString+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)  data SKESKPayload-  = SKESKPayloadV4Packet SKESKPayloadV4-  | SKESKPayloadV6Packet SKESKPayloadV6-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+    = SKESKPayloadV4Packet SKESKPayloadV4+    | SKESKPayloadV6Packet SKESKPayloadV6+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)  data OnePassSignatureVersion = OPSV3 | OPSV6-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable) -data OPSPayloadV3 =-  OPSPayloadV3-    PacketVersion-    SigType-    HashAlgorithm-    PubKeyAlgorithm-    EightOctetKeyId-    NestedFlag-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+data OPSPayloadV3+    = OPSPayloadV3+        PacketVersion+        SigType+        HashAlgorithm+        PubKeyAlgorithm+        EightOctetKeyId+        NestedFlag+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable) -data OPSPayloadV6 =-  OPSPayloadV6-    SigType-    HashAlgorithm-    PubKeyAlgorithm-    SignatureSalt-    BL.ByteString-    NestedFlag-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+data OPSPayloadV6+    = OPSPayloadV6+        SigType+        HashAlgorithm+        PubKeyAlgorithm+        SignatureSalt+        BL.ByteString+        NestedFlag+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)  data OnePassSignaturePayload-  = OPSPayloadV3Packet OPSPayloadV3-  | OPSPayloadV6Packet OPSPayloadV6-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+    = OPSPayloadV3Packet OPSPayloadV3+    | OPSPayloadV6Packet OPSPayloadV6+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)  data SEIPDPayload-  = SEIPD1 PacketVersion BL.ByteString-  | SEIPD2 SymmetricAlgorithm AEADAlgorithm Word8 Salt BL.ByteString-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+    = SEIPD1 PacketVersion BL.ByteString+    | SEIPD2 SymmetricAlgorithm AEADAlgorithm Word8 Salt BL.ByteString+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)  data KeyPktKind-  = PublicPkt-  | SecretPkt-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+    = PublicPkt+    | SecretPkt+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)  data KeyPktRole-  = KeyPktPrimary-  | KeyPktSubkey-  deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)+    = KeyPktPrimary+    | KeyPktSubkey+    deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)  data KeyPkt (k :: KeyPktKind) where-  KeyPktPublicPrimary :: SomePKPayload -> KeyPkt 'PublicPkt-  KeyPktPublicSubkey :: SomePKPayload -> KeyPkt 'PublicPkt-  KeyPktSecretPrimary :: SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt-  KeyPktSecretSubkey :: SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt+    KeyPktPublicPrimary :: SomePKPayload -> KeyPkt 'PublicPkt+    KeyPktPublicSubkey :: SomePKPayload -> KeyPkt 'PublicPkt+    KeyPktSecretPrimary+        :: SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt+    KeyPktSecretSubkey+        :: SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt  deriving instance Eq (KeyPkt k) deriving instance Show (KeyPkt k)  instance Ord (KeyPkt k) where-  compare = comparing keyPktToPkt+    compare = comparing keyPktToPkt  instance Hashable (KeyPkt k) where-  hashWithSalt s kp = hashWithSalt s (keyPktToPkt kp)+    hashWithSalt s kp = hashWithSalt s (keyPktToPkt kp)  instance Typeable k => Data (KeyPkt k) where-  gfoldl f z (KeyPktPublicPrimary pkp)     = z KeyPktPublicPrimary `f` pkp-  gfoldl f z (KeyPktPublicSubkey pkp)      = z KeyPktPublicSubkey `f` pkp-  gfoldl f z (KeyPktSecretPrimary pkp ska) = z KeyPktSecretPrimary `f` pkp `f` ska-  gfoldl f z (KeyPktSecretSubkey pkp ska)  = z KeyPktSecretSubkey `f` pkp `f` ska+    gfoldl f z (KeyPktPublicPrimary pkp) = z KeyPktPublicPrimary `f` pkp+    gfoldl f z (KeyPktPublicSubkey pkp) = z KeyPktPublicSubkey `f` pkp+    gfoldl f z (KeyPktSecretPrimary pkp ska) = z KeyPktSecretPrimary `f` pkp `f` ska+    gfoldl f z (KeyPktSecretSubkey pkp ska) = z KeyPktSecretSubkey `f` pkp `f` ska -  toConstr (KeyPktPublicPrimary _)     = conKeyPktPublicPrimary-  toConstr (KeyPktPublicSubkey _)      = conKeyPktPublicSubkey-  toConstr (KeyPktSecretPrimary _ _)   = conKeyPktSecretPrimary-  toConstr (KeyPktSecretSubkey _ _)    = conKeyPktSecretSubkey+    toConstr (KeyPktPublicPrimary _) = conKeyPktPublicPrimary+    toConstr (KeyPktPublicSubkey _) = conKeyPktPublicSubkey+    toConstr (KeyPktSecretPrimary _ _) = conKeyPktSecretPrimary+    toConstr (KeyPktSecretSubkey _ _) = conKeyPktSecretSubkey -  dataTypeOf _ = tyKeyPkt+    dataTypeOf _ = tyKeyPkt -  gunfold _ _ _ = error "KeyPkt: gunfold not supported for GADT"+    gunfold _ _ _ = error "KeyPkt: gunfold not supported for GADT"  tyKeyPkt :: DD.DataType-tyKeyPkt = mkDataType "Codec.Encryption.OpenPGP.Types.Internal.Pkt.KeyPkt"-  [ conKeyPktPublicPrimary-  , conKeyPktPublicSubkey-  , conKeyPktSecretPrimary-  , conKeyPktSecretSubkey-  ]+tyKeyPkt =+    mkDataType+        "Codec.Encryption.OpenPGP.Types.Internal.Pkt.KeyPkt"+        [ conKeyPktPublicPrimary+        , conKeyPktPublicSubkey+        , conKeyPktSecretPrimary+        , conKeyPktSecretSubkey+        ] -conKeyPktPublicPrimary, conKeyPktPublicSubkey,-  conKeyPktSecretPrimary, conKeyPktSecretSubkey :: Constr+conKeyPktPublicPrimary+    , conKeyPktPublicSubkey+    , conKeyPktSecretPrimary+    , conKeyPktSecretSubkey+        :: Constr conKeyPktPublicPrimary = mkConstr tyKeyPkt "KeyPktPublicPrimary" [] Prefix-conKeyPktPublicSubkey  = mkConstr tyKeyPkt "KeyPktPublicSubkey"  [] Prefix+conKeyPktPublicSubkey = mkConstr tyKeyPkt "KeyPktPublicSubkey" [] Prefix conKeyPktSecretPrimary = mkConstr tyKeyPkt "KeyPktSecretPrimary" [] Prefix-conKeyPktSecretSubkey  = mkConstr tyKeyPkt "KeyPktSecretSubkey"  [] Prefix+conKeyPktSecretSubkey = mkConstr tyKeyPkt "KeyPktSecretSubkey" [] Prefix  data SomeKeyPkt where-  SomeKeyPkt :: KeyPkt k -> SomeKeyPkt+    SomeKeyPkt :: KeyPkt k -> SomeKeyPkt  deriving instance Show SomeKeyPkt  instance Eq SomeKeyPkt where-  SomeKeyPkt left == SomeKeyPkt right = someKeyPktToPkt (SomeKeyPkt left) == someKeyPktToPkt (SomeKeyPkt right)+    SomeKeyPkt left == SomeKeyPkt right =+        someKeyPktToPkt (SomeKeyPkt left)+            == someKeyPktToPkt (SomeKeyPkt right)  data KeyPktCoercionError-  = NotAKeyPacket Pkt-  | ExpectedPublicKeyPacket Pkt-  | ExpectedSecretKeyPacket Pkt-  deriving (Eq, Show)+    = NotAKeyPacket Pkt+    | ExpectedPublicKeyPacket Pkt+    | ExpectedSecretKeyPacket Pkt+    deriving (Eq, Show)  -- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a data Pkt-  = PKESKPkt PKESKPayload-  | SignaturePkt SignaturePayload-  | SKESKPkt SKESKPayload-  | OnePassSignaturePkt OnePassSignaturePayload-  | SecretKeyPkt SomePKPayload SKAddendum-  | PublicKeyPkt SomePKPayload-  | SecretSubkeyPkt SomePKPayload SKAddendum-  | CompressedDataPkt CompressionAlgorithm CompressedDataPayload-  | SymEncDataPkt ByteString-  | MarkerPkt ByteString-  | LiteralDataPkt DataType FileName ThirtyTwoBitTimeStamp ByteString-  | TrustPkt ByteString-  | UserIdPkt Text-  | PublicSubkeyPkt SomePKPayload-  | UserAttributePkt [UserAttrSubPacket]-  | SymEncIntegrityProtectedDataPkt SEIPDPayload-  | ModificationDetectionCodePkt ByteString-  | OtherPacketPkt Word8 ByteString-  | BrokenPacketPkt String Word8 ByteString-  deriving (Data, Eq, Generic, Show, Typeable)+    = PKESKPkt PKESKPayload+    | SignaturePkt SignaturePayload+    | SKESKPkt SKESKPayload+    | OnePassSignaturePkt OnePassSignaturePayload+    | SecretKeyPkt SomePKPayload SKAddendum+    | PublicKeyPkt SomePKPayload+    | SecretSubkeyPkt SomePKPayload SKAddendum+    | CompressedDataPkt CompressionAlgorithm CompressedDataPayload+    | SymEncDataPkt ByteString+    | MarkerPkt ByteString+    | LiteralDataPkt+        LiteralDataType+        FileName+        ThirtyTwoBitTimeStamp+        ByteString+    | TrustPkt ByteString+    | UserIdPkt Text+    | PublicSubkeyPkt SomePKPayload+    | UserAttributePkt [UserAttrSubPacket]+    | SymEncIntegrityProtectedDataPkt SEIPDPayload+    | ModificationDetectionCodePkt ByteString+    | PaddingPkt ByteString+    | OtherPacketPkt Word8 ByteString+    | BrokenPacketPkt String Word8 ByteString+    deriving (Data, Eq, Generic, Show, Typeable) -data PktWithWireRep =-  PktWithWireRep+data PktWithWireRep+    = PktWithWireRep     { _pktWireRepRef :: WireRepRef     , _pktRange :: ByteRange     , _pktRaw :: ByteString     , _pktIndex :: Int     , _pktValue :: Pkt     }-  deriving (Data, Eq, Generic, Show, Typeable)+    deriving (Data, Eq, Generic, Show, Typeable)  instance Hashable Pkt  instance Ord Pkt where-  compare p1 p2 = comparing pktTag p1 p2 <> compareFields p1 p2-    where-      compareFields (PKESKPkt pkesk1) (PKESKPkt pkesk2) = compare pkesk1 pkesk2-      compareFields (SignaturePkt sp1) (SignaturePkt sp2) = compare sp1 sp2-      compareFields (SKESKPkt skesk1) (SKESKPkt skesk2) = compare skesk1 skesk2-      compareFields (OnePassSignaturePkt ops1) (OnePassSignaturePkt ops2) = compare ops1 ops2-      compareFields (SecretKeyPkt pkp1 ska1) (SecretKeyPkt pkp2 ska2) =-        compare pkp1 pkp2 <> compare ska1 ska2-      compareFields (PublicKeyPkt pkp1) (PublicKeyPkt pkp2) = compare pkp1 pkp2-      compareFields (SecretSubkeyPkt pkp1 ska1) (SecretSubkeyPkt pkp2 ska2) =-        compare pkp1 pkp2 <> compare ska1 ska2-      compareFields (CompressedDataPkt ca1 cdp1) (CompressedDataPkt ca2 cdp2) =-        compare ca1 ca2 <> compare cdp1 cdp2-      compareFields (SymEncDataPkt bs1) (SymEncDataPkt bs2) = compare bs1 bs2-      compareFields (MarkerPkt bs1) (MarkerPkt bs2) = compare bs1 bs2-      compareFields (LiteralDataPkt dt1 fn1 ts1 bs1) (LiteralDataPkt dt2 fn2 ts2 bs2) =-        compare dt1 dt2 <> compare fn1 fn2 <> compare ts1 ts2 <> compare bs1 bs2-      compareFields (TrustPkt bs1) (TrustPkt bs2) = compare bs1 bs2-      compareFields (UserIdPkt u1) (UserIdPkt u2) = compare u1 u2-      compareFields (PublicSubkeyPkt pkp1) (PublicSubkeyPkt pkp2) = compare pkp1 pkp2-      compareFields (UserAttributePkt us1) (UserAttributePkt us2) = compare us1 us2-      compareFields (SymEncIntegrityProtectedDataPkt seipd1) (SymEncIntegrityProtectedDataPkt seipd2) = compare seipd1 seipd2-      compareFields (ModificationDetectionCodePkt bs1) (ModificationDetectionCodePkt bs2) = compare bs1 bs2-      compareFields (OtherPacketPkt t1 bs1) (OtherPacketPkt t2 bs2) = compare t1 t2 <> compare bs1 bs2-      compareFields (BrokenPacketPkt s1 t1 bs1) (BrokenPacketPkt s2 t2 bs2) =-        compare s1 s2 <> compare t1 t2 <> compare bs1 bs2-      compareFields _ _ = EQ+    compare p1 p2 = comparing pktTag p1 p2 <> compareFields p1 p2+      where+        compareFields (PKESKPkt pkesk1) (PKESKPkt pkesk2) = compare pkesk1 pkesk2+        compareFields (SignaturePkt sp1) (SignaturePkt sp2) = compare sp1 sp2+        compareFields (SKESKPkt skesk1) (SKESKPkt skesk2) = compare skesk1 skesk2+        compareFields (OnePassSignaturePkt ops1) (OnePassSignaturePkt ops2) = compare ops1 ops2+        compareFields (SecretKeyPkt pkp1 ska1) (SecretKeyPkt pkp2 ska2) =+            compare pkp1 pkp2 <> compare ska1 ska2+        compareFields (PublicKeyPkt pkp1) (PublicKeyPkt pkp2) = compare pkp1 pkp2+        compareFields (SecretSubkeyPkt pkp1 ska1) (SecretSubkeyPkt pkp2 ska2) =+            compare pkp1 pkp2 <> compare ska1 ska2+        compareFields (CompressedDataPkt ca1 cdp1) (CompressedDataPkt ca2 cdp2) =+            compare ca1 ca2 <> compare cdp1 cdp2+        compareFields (SymEncDataPkt bs1) (SymEncDataPkt bs2) = compare bs1 bs2+        compareFields (MarkerPkt bs1) (MarkerPkt bs2) = compare bs1 bs2+        compareFields (LiteralDataPkt dt1 fn1 ts1 bs1) (LiteralDataPkt dt2 fn2 ts2 bs2) =+            compare dt1 dt2+                <> compare fn1 fn2+                <> compare ts1 ts2+                <> compare bs1 bs2+        compareFields (TrustPkt bs1) (TrustPkt bs2) = compare bs1 bs2+        compareFields (UserIdPkt u1) (UserIdPkt u2) = compare u1 u2+        compareFields (PublicSubkeyPkt pkp1) (PublicSubkeyPkt pkp2) = compare pkp1 pkp2+        compareFields (UserAttributePkt us1) (UserAttributePkt us2) = compare us1 us2+        compareFields (SymEncIntegrityProtectedDataPkt seipd1) (SymEncIntegrityProtectedDataPkt seipd2) = compare seipd1 seipd2+        compareFields (ModificationDetectionCodePkt bs1) (ModificationDetectionCodePkt bs2) = compare bs1 bs2+        compareFields (OtherPacketPkt t1 bs1) (OtherPacketPkt t2 bs2) = compare t1 t2 <> compare bs1 bs2+        compareFields (BrokenPacketPkt s1 t1 bs1) (BrokenPacketPkt s2 t2 bs2) =+            compare s1 s2 <> compare t1 t2 <> compare bs1 bs2+        compareFields _ _ = EQ  instance Ord PktWithWireRep where-  compare p1 p2 =-    comparing _pktValue p1 p2 <>-    comparing _pktRaw p1 p2 <>-    comparing _pktWireRepRef p1 p2 <>-    comparing _pktRange p1 p2 <>-    comparing _pktIndex p1 p2+    compare p1 p2 =+        comparing _pktValue p1 p2+            <> comparing _pktRaw p1 p2+            <> comparing _pktWireRepRef p1 p2+            <> comparing _pktRange p1 p2+            <> comparing _pktIndex p1 p2  wireRepOfPkt :: PktWithWireRep -> WireRepRef wireRepOfPkt = _pktWireRepRef -packetsFromWireRep :: WireRepRef -> [PktWithWireRep] -> [PktWithWireRep]+packetsFromWireRep+    :: WireRepRef -> [PktWithWireRep] -> [PktWithWireRep] packetsFromWireRep src = filter ((== src) . wireRepOfPkt)  instance Pretty Pkt where-  pretty (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 pv eoki pka mpis))) =-    pretty "PKESK v" <> pretty pv <> pretty ':' <+>-    pretty eoki <+> pretty pka <+> (pretty . NE.toList) mpis-  pretty (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 recipientKeyIdentifier pka esk))) =-    pretty "PKESK v6:" <+>-    pretty "recipient key identifier" <+>-    pretty (bsToHexUpper recipientKeyIdentifier) <+>-    pretty pka <+> pretty (bsToHexUpper esk)-  pretty (SignaturePkt sp) = pretty sp-  pretty (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k mbs))) =-    pretty "SKESK v4:" <+>-    pretty sa <+> pretty s2k <+> pretty (fmap bsToHexUpper mbs)-  pretty (SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag))) =-    pretty "SKESK v6:" <+>-    pretty sa <+>-    pretty aa <+>-    pretty s2k <+>-    pretty (bsToHexUpper iv) <+>-    pretty (bsToHexUpper esk) <+>-    pretty (bsToHexUpper tag)-  pretty (OnePassSignaturePkt (OPSPayloadV3Packet (OPSPayloadV3 pv st ha pka eoki nestedflag))) =-    pretty "one-pass signature v" <> pretty pv <> pretty ':' <+>-    pretty st <+> pretty ha <+> pretty pka <+> pretty eoki <+> pretty nestedflag-  pretty (OnePassSignaturePkt (OPSPayloadV6Packet (OPSPayloadV6 st ha pka salt signerFingerprint nestedflag))) =-    pretty "one-pass signature v6:" <+>-    pretty st <+>-    pretty ha <+>-    pretty pka <+> pretty salt <+> pretty (bsToHexUpper signerFingerprint) <+>-    pretty nestedflag-  pretty (SecretKeyPkt pkp ska) =-    pretty "secret key:" <+> pretty pkp <+> pretty ska-  pretty (PublicKeyPkt pkp) = pretty "public key:" <+> pretty pkp-  pretty (SecretSubkeyPkt pkp ska) =-    pretty "secret subkey:" <+> pretty pkp <+> pretty ska-  pretty (CompressedDataPkt ca cdp) =-    pretty "compressed-data:" <+> pretty ca <+> prettyLBS cdp-  pretty (SymEncDataPkt bs) =-    pretty "symmetrically-encrypted-data:" <+> pretty (bsToHexUpper bs)-  pretty (MarkerPkt bs) = pretty "marker:" <+> pretty (bsToHexUpper bs)-  pretty (LiteralDataPkt dt fn ts bs) =-    pretty "literal-data" <+>-    pretty dt <+> prettyLBS fn <+> pretty ts <+> pretty (bsToHexUpper bs)-  pretty (TrustPkt bs) = pretty "trust:" <+> pretty (BL.unpack bs)-  pretty (UserIdPkt u) = pretty "user-ID:" <+> pretty u-  pretty (PublicSubkeyPkt pkp) = pretty "public subkey:" <+> pretty pkp-  pretty (UserAttributePkt us) = pretty "user-attribute:" <+> pretty us-  pretty (SymEncIntegrityProtectedDataPkt (SEIPD1 pv bs)) =-    pretty "symmetrically-encrypted-integrity-protected-data v" <> pretty pv <>-    pretty ':' <+>-    pretty (bsToHexUpper bs)-  pretty (SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize salt bs)) =-    pretty "symmetrically-encrypted-integrity-protected-data v2:" <+>-    pretty sa <+> pretty aa <+> pretty chunkSize <+> pretty salt <+>-    pretty (bsToHexUpper bs)-  pretty (ModificationDetectionCodePkt bs) =-    pretty "MDC:" <+> pretty (bsToHexUpper bs)-  pretty (OtherPacketPkt t bs) =-    pretty "unknown packet type" <+>-    pretty t <> pretty ':' <+> pretty (bsToHexUpper bs)-  pretty (BrokenPacketPkt s t bs) =-    pretty "BROKEN packet (" <> pretty s <> pretty ')' <+>-    pretty t <> pretty ':' <+> pretty (bsToHexUpper bs)+    pretty (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 pv eoki pka mpis))) =+        pretty "PKESK v"+            <> pretty pv+            <> pretty ':'+            <+> pretty eoki+            <+> pretty pka+            <+> (pretty . NE.toList) mpis+    pretty+        ( PKESKPkt+                ( PKESKPayloadV6Packet+                        (PKESKPayloadV6 recipientKeyIdentifier pka esk)+                    )+            ) =+            pretty "PKESK v6:"+                <+> pretty "recipient key identifier"+                <+> pretty (bsToHexUpper recipientKeyIdentifier)+                <+> pretty pka+                <+> pretty (bsToHexUpper esk)+    pretty (SignaturePkt sp) = pretty sp+    pretty (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k mbs))) =+        pretty "SKESK v4:"+            <+> pretty sa+            <+> pretty s2k+            <+> pretty (fmap bsToHexUpper mbs)+    pretty+        ( SKESKPkt+                (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag))+            ) =+            pretty "SKESK v6:"+                <+> pretty sa+                <+> pretty aa+                <+> pretty s2k+                <+> pretty (bsToHexUpper iv)+                <+> pretty (bsToHexUpper esk)+                <+> pretty (bsToHexUpper tag)+    pretty+        ( OnePassSignaturePkt+                (OPSPayloadV3Packet (OPSPayloadV3 pv st ha pka eoki nestedflag))+            ) =+            pretty "one-pass signature v"+                <> pretty pv+                <> pretty ':'+                <+> pretty st+                <+> pretty ha+                <+> pretty pka+                <+> pretty eoki+                <+> pretty nestedflag+    pretty+        ( OnePassSignaturePkt+                ( OPSPayloadV6Packet+                        (OPSPayloadV6 st ha pka salt signerFingerprint nestedflag)+                    )+            ) =+            pretty "one-pass signature v6:"+                <+> pretty st+                <+> pretty ha+                <+> pretty pka+                <+> pretty salt+                <+> pretty (bsToHexUpper signerFingerprint)+                <+> pretty nestedflag+    pretty (SecretKeyPkt pkp ska) =+        pretty "secret key:" <+> pretty pkp <+> pretty ska+    pretty (PublicKeyPkt pkp) = pretty "public key:" <+> pretty pkp+    pretty (SecretSubkeyPkt pkp ska) =+        pretty "secret subkey:" <+> pretty pkp <+> pretty ska+    pretty (CompressedDataPkt ca cdp) =+        pretty "compressed-data:" <+> pretty ca <+> prettyLBS cdp+    pretty (SymEncDataPkt bs) =+        pretty "symmetrically-encrypted-data:"+            <+> pretty (bsToHexUpper bs)+    pretty (MarkerPkt bs) = pretty "marker:" <+> pretty (bsToHexUpper bs)+    pretty (LiteralDataPkt dt fn ts bs) =+        pretty "literal-data"+            <+> pretty dt+            <+> prettyLBS fn+            <+> pretty ts+            <+> pretty (bsToHexUpper bs)+    pretty (TrustPkt bs) = pretty "trust:" <+> pretty (BL.unpack bs)+    pretty (UserIdPkt u) = pretty "user-ID:" <+> pretty u+    pretty (PublicSubkeyPkt pkp) = pretty "public subkey:" <+> pretty pkp+    pretty (UserAttributePkt us) = pretty "user-attribute:" <+> pretty us+    pretty (SymEncIntegrityProtectedDataPkt (SEIPD1 pv bs)) =+        pretty "symmetrically-encrypted-integrity-protected-data v"+            <> pretty pv+            <> pretty ':'+            <+> pretty (bsToHexUpper bs)+    pretty (SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize salt bs)) =+        pretty "symmetrically-encrypted-integrity-protected-data v2:"+            <+> pretty sa+            <+> pretty aa+            <+> pretty chunkSize+            <+> pretty salt+            <+> pretty (bsToHexUpper bs)+    pretty (ModificationDetectionCodePkt bs) =+        pretty "MDC:" <+> pretty (bsToHexUpper bs)+    pretty (PaddingPkt bs) =+        pretty "Padding:" <+> pretty (bsToHexUpper bs)+    pretty (OtherPacketPkt t bs) =+        pretty "unknown packet type"+            <+> pretty t+            <> pretty ':'+            <+> pretty (bsToHexUpper bs)+    pretty (BrokenPacketPkt s t bs) =+        pretty "BROKEN packet ("+            <> pretty s+            <> pretty ')'+            <+> pretty t+            <> pretty ':'+            <+> pretty (bsToHexUpper bs)  instance A.ToJSON Pkt where-  toJSON (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 pv eoki pka mpis))) =-    object-      [ key "pkesk" .=+    toJSON (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 pv eoki pka mpis))) =         object-          [ key "version" .= pv-          , key "keyid" .= eoki-          , key "pkalgo" .= pka-          , key "mpis" .= NE.toList mpis-          ]-      ]-  toJSON (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 recipientKeyIdentifier pka esk))) =-    object-      [ key "pkesk_v6" .=+            [ AK.fromString "pkesk"+                .= object+                    [ AK.fromString "version" .= pv+                    , AK.fromString "keyid" .= eoki+                    , AK.fromString "pkalgo" .= pka+                    , AK.fromString "mpis" .= NE.toList mpis+                    ]+            ]+    toJSON+        ( PKESKPkt+                ( PKESKPayloadV6Packet+                        (PKESKPayloadV6 recipientKeyIdentifier pka esk)+                    )+            ) =+            object+                [ AK.fromString "pkesk"+                    .= object+                        [ AK.fromString "version" .= (6 :: PacketVersion)+                        , AK.fromString "recipient_key_identifier"+                            .= BL.unpack recipientKeyIdentifier+                        , AK.fromString "pkalgo" .= pka+                        , AK.fromString "esk" .= BL.unpack esk+                        ]+                ]+    toJSON (SignaturePkt sp) = object [AK.fromString "signature" .= sp]+    toJSON (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k mbs))) =         object-          [ key "recipient_key_identifier" .= BL.unpack recipientKeyIdentifier-          , key "pkalgo" .= pka-          , key "esk" .= BL.unpack esk-          ]-      ]-  toJSON (SignaturePkt sp) = object [key "signature" .= sp]-  toJSON (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k mbs))) =-    object-      [ key "skesk" .=+            [ AK.fromString "skesk"+                .= object+                    [ AK.fromString "version" .= (4 :: PacketVersion)+                    , AK.fromString "symalgo" .= sa+                    , AK.fromString "s2k" .= s2k+                    , AK.fromString "data" .= maybe mempty BL.unpack mbs+                    ]+            ]+    toJSON+        ( SKESKPkt+                (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag))+            ) =+            object+                [ AK.fromString "skesk"+                    .= object+                        [ AK.fromString "version" .= (6 :: PacketVersion)+                        , AK.fromString "symalgo" .= sa+                        , AK.fromString "aead" .= aa+                        , AK.fromString "s2k" .= s2k+                        , AK.fromString "iv" .= BL.unpack iv+                        , AK.fromString "esk" .= BL.unpack esk+                        , AK.fromString "tag" .= BL.unpack tag+                        ]+                ]+    toJSON+        ( OnePassSignaturePkt+                (OPSPayloadV3Packet (OPSPayloadV3 pv st ha pka eoki nestedflag))+            ) =+            object+                [ AK.fromString "onepasssignature"+                    .= object+                        [ AK.fromString "version" .= pv+                        , AK.fromString "sigtype" .= st+                        , AK.fromString "hashalgo" .= ha+                        , AK.fromString "pkalgo" .= pka+                        , AK.fromString "keyid" .= eoki+                        , AK.fromString "nested" .= nestedflag+                        ]+                ]+    toJSON+        ( OnePassSignaturePkt+                ( OPSPayloadV6Packet+                        (OPSPayloadV6 st ha pka salt signerFingerprint nestedflag)+                    )+            ) =+            object+                [ AK.fromString "onepasssignature"+                    .= object+                        [ AK.fromString "version" .= (6 :: Word8)+                        , AK.fromString "sigtype" .= st+                        , AK.fromString "hashalgo" .= ha+                        , AK.fromString "pkalgo" .= pka+                        , AK.fromString "salt" .= salt+                        , AK.fromString "fingerprint" .= BL.unpack signerFingerprint+                        , AK.fromString "nested" .= nestedflag+                        ]+                ]+    toJSON (SecretKeyPkt pkp ska) =         object-          [ key "version" .= (4 :: PacketVersion)-          , key "symalgo" .= sa-          , key "s2k" .= s2k-          , key "data" .= maybe mempty BL.unpack mbs-          ]-      ]-  toJSON (SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag))) =-    object-      [ key "skesk-v6" .=+            [ AK.fromString "secretkey"+                .= object+                    [AK.fromString "public" .= pkp, AK.fromString "secret" .= ska]+            ]+    toJSON (PublicKeyPkt pkp) = object [AK.fromString "publickey" .= pkp]+    toJSON (SecretSubkeyPkt pkp ska) =         object-          [ key "version" .= (6 :: PacketVersion)-          , key "symalgo" .= sa-          , key "aead" .= aa-          , key "s2k" .= s2k-          , key "iv" .= BL.unpack iv-          , key "esk" .= BL.unpack esk-          , key "tag" .= BL.unpack tag-          ]-      ]-  toJSON (OnePassSignaturePkt (OPSPayloadV3Packet (OPSPayloadV3 pv st ha pka eoki nestedflag))) =-    object-      [ key "onepasssignature" .=+            [ AK.fromString "secretsubkey"+                .= object+                    [AK.fromString "public" .= pkp, AK.fromString "secret" .= ska]+            ]+    toJSON (CompressedDataPkt ca cdp) =         object-          [ key "version" .= pv-          , key "sigtype" .= st-          , key "hashalgo" .= ha-          , key "pkalgo" .= pka-          , key "keyid" .= eoki-          , key "nested" .= nestedflag-          ]-      ]-  toJSON (OnePassSignaturePkt (OPSPayloadV6Packet (OPSPayloadV6 st ha pka salt signerFingerprint nestedflag))) =-    object-      [ key "onepasssignature_v6" .=+            [ AK.fromString "compresseddata"+                .= object+                    [ AK.fromString "compressionalgo" .= ca+                    , AK.fromString "data" .= BL.unpack cdp+                    ]+            ]+    toJSON (SymEncDataPkt bs) = object [AK.fromString "symencdata" .= BL.unpack bs]+    toJSON (MarkerPkt bs) = object [AK.fromString "marker" .= BL.unpack bs]+    toJSON (LiteralDataPkt dt fn ts bs) =         object-          [ key "version" .= (6 :: Word8)-          , key "sigtype" .= st-          , key "hashalgo" .= ha-          , key "pkalgo" .= pka-          , key "salt" .= salt-          , key "fingerprint" .= BL.unpack signerFingerprint-          , key "nested" .= nestedflag-          ]-      ]-  toJSON (SecretKeyPkt pkp ska) =-    object-      [ key "secretkey" .=-        object [key "public" .= pkp, key "secret" .= ska]-      ]-  toJSON (PublicKeyPkt pkp) = object [key "publickey" .= pkp]-  toJSON (SecretSubkeyPkt pkp ska) =-    object-      [ key "secretsubkey" .=-        object [key "public" .= pkp, key "secret" .= ska]-      ]-  toJSON (CompressedDataPkt ca cdp) =-    object-      [ key "compresseddata" .=-        object [key "compressionalgo" .= ca, key "data" .= BL.unpack cdp]-      ]-  toJSON (SymEncDataPkt bs) = object [key "symencdata" .= BL.unpack bs]-  toJSON (MarkerPkt bs) = object [key "marker" .= BL.unpack bs]-  toJSON (LiteralDataPkt dt fn ts bs) =-    object-      [ key "literaldata" .=+            [ AK.fromString "literaldata"+                .= object+                    [ AK.fromString "dt" .= dt+                    , AK.fromString "filename" .= BL.unpack fn+                    , AK.fromString "ts" .= ts+                    , AK.fromString "data" .= BL.unpack bs+                    ]+            ]+    toJSON (TrustPkt bs) = object [AK.fromString "trust" .= BL.unpack bs]+    toJSON (UserIdPkt u) = object [AK.fromString "userid" .= u]+    toJSON (PublicSubkeyPkt pkp) = object [AK.fromString "publicsubkkey" .= pkp]+    toJSON (UserAttributePkt us) = object [AK.fromString "userattribute" .= us]+    toJSON (SymEncIntegrityProtectedDataPkt (SEIPD1 pv bs)) =         object-          [ key "dt" .= dt-          , key "filename" .= BL.unpack fn-          , key "ts" .= ts-          , key "data" .= BL.unpack bs-          ]-      ]-  toJSON (TrustPkt bs) = object [key "trust" .= BL.unpack bs]-  toJSON (UserIdPkt u) = object [key "userid" .= u]-  toJSON (PublicSubkeyPkt pkp) = object [key "publicsubkkey" .= pkp]-  toJSON (UserAttributePkt us) = object [key "userattribute" .= us]-  toJSON (SymEncIntegrityProtectedDataPkt (SEIPD1 pv bs)) =-    object-      [ key "symencipd" .=-        object [key "version" .= pv, key "data" .= BL.unpack bs]-      ]-  toJSON (SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize salt bs)) =-    object-      [ key "symencipd_v2" .=+            [ AK.fromString "symencipd"+                .= object+                    [ AK.fromString "version" .= pv+                    , AK.fromString "data" .= BL.unpack bs+                    ]+            ]+    toJSON (SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize salt bs)) =         object-          [ key "symalgo" .= sa-          , key "aeadalgo" .= aa-          , key "chunksize" .= chunkSize-          , key "salt" .= salt-          , key "data" .= BL.unpack bs-          ]-      ]-  toJSON (ModificationDetectionCodePkt bs) =-    object [key "mdc" .= BL.unpack bs]-  toJSON (OtherPacketPkt t bs) =-    object-      [ key "otherpacket" .=-        object [key "tag" .= t, key "data" .= BL.unpack bs]-      ]-  toJSON (BrokenPacketPkt s t bs) =-    object-      [ key "brokenpacket" .=+            [ AK.fromString "symencipd"+                .= object+                    [ AK.fromString "version" .= (2 :: PacketVersion)+                    , AK.fromString "symalgo" .= sa+                    , AK.fromString "aeadalgo" .= aa+                    , AK.fromString "chunksize" .= chunkSize+                    , AK.fromString "salt" .= salt+                    , AK.fromString "data" .= BL.unpack bs+                    ]+            ]+    toJSON (ModificationDetectionCodePkt bs) =+        object [AK.fromString "mdc" .= BL.unpack bs]+    toJSON (PaddingPkt bs) =+        object [AK.fromString "padding" .= BL.unpack bs]+    toJSON (OtherPacketPkt t bs) =         object-          [ key "error" .= s-          , key "tag" .= t-          , key "data" .= BL.unpack bs-          ]-      ]+            [ AK.fromString "otherpacket"+                .= object+                    [AK.fromString "tag" .= t, AK.fromString "data" .= BL.unpack bs]+            ]+    toJSON (BrokenPacketPkt s t bs) =+        object+            [ AK.fromString "brokenpacket"+                .= object+                    [ AK.fromString "error" .= s+                    , AK.fromString "tag" .= t+                    , AK.fromString "data" .= BL.unpack bs+                    ]+            ]  pktTag :: Pkt -> Word8 pktTag PKESKPkt {} = 1@@ -485,16 +586,17 @@ pktTag (UserAttributePkt _) = 17 pktTag SymEncIntegrityProtectedDataPkt {} = 18 pktTag (ModificationDetectionCodePkt _) = 19+pktTag (PaddingPkt _) = 21 pktTag (OtherPacketPkt t _) = t pktTag (BrokenPacketPkt _ t _) = t -- is this the right thing to do?  renderKeyPktCoercionError :: KeyPktCoercionError -> String renderKeyPktCoercionError (NotAKeyPacket pkt) =-  "Expected a key packet, got tag " ++ show (pktTag pkt)+    "Expected a key packet, got tag " ++ show (pktTag pkt) renderKeyPktCoercionError (ExpectedPublicKeyPacket pkt) =-  "Expected a public key packet, got tag " ++ show (pktTag pkt)+    "Expected a public key packet, got tag " ++ show (pktTag pkt) renderKeyPktCoercionError (ExpectedSecretKeyPacket pkt) =-  "Expected a secret key packet, got tag " ++ show (pktTag pkt)+    "Expected a secret key packet, got tag " ++ show (pktTag pkt)  keyPktRole :: KeyPkt k -> KeyPktRole keyPktRole KeyPktPublicPrimary {} = KeyPktPrimary@@ -521,7 +623,8 @@ secretKeyPktSKAddendum (KeyPktSecretPrimary _ ska) = ska secretKeyPktSKAddendum (KeyPktSecretSubkey _ ska) = ska -mkPrimaryKeyPkt :: SomePKPayload -> Maybe SKAddendum -> SomeKeyPkt+mkPrimaryKeyPkt+    :: SomePKPayload -> Maybe SKAddendum -> SomeKeyPkt mkPrimaryKeyPkt pkp Nothing = SomeKeyPkt (KeyPktPublicPrimary pkp) mkPrimaryKeyPkt pkp (Just ska) = SomeKeyPkt (KeyPktSecretPrimary pkp ska) @@ -542,7 +645,8 @@ someKeyPktToPkt :: SomeKeyPkt -> Pkt someKeyPktToPkt (SomeKeyPkt keyPkt) = keyPktToPkt keyPkt -pktToSomeKeyPktEither :: Pkt -> Either KeyPktCoercionError SomeKeyPkt+pktToSomeKeyPktEither+    :: Pkt -> Either KeyPktCoercionError SomeKeyPkt pktToSomeKeyPktEither (PublicKeyPkt pkp) = Right (SomeKeyPkt (KeyPktPublicPrimary pkp)) pktToSomeKeyPktEither (PublicSubkeyPkt pkp) = Right (SomeKeyPkt (KeyPktPublicSubkey pkp)) pktToSomeKeyPktEither (SecretKeyPkt pkp ska) = Right (SomeKeyPkt (KeyPktSecretPrimary pkp ska))@@ -552,7 +656,8 @@ pktToSomeKeyPkt :: Pkt -> Maybe SomeKeyPkt pktToSomeKeyPkt = either (const Nothing) Just . pktToSomeKeyPktEither -pktToPublicKeyPktEither :: Pkt -> Either KeyPktCoercionError (KeyPkt 'PublicPkt)+pktToPublicKeyPktEither+    :: Pkt -> Either KeyPktCoercionError (KeyPkt 'PublicPkt) pktToPublicKeyPktEither (PublicKeyPkt pkp) = Right (KeyPktPublicPrimary pkp) pktToPublicKeyPktEither (PublicSubkeyPkt pkp) = Right (KeyPktPublicSubkey pkp) pktToPublicKeyPktEither pkt = Left (ExpectedPublicKeyPacket pkt)@@ -560,7 +665,8 @@ pktToPublicKeyPkt :: Pkt -> Maybe (KeyPkt 'PublicPkt) pktToPublicKeyPkt = either (const Nothing) Just . pktToPublicKeyPktEither -pktToSecretKeyPktEither :: Pkt -> Either KeyPktCoercionError (KeyPkt 'SecretPkt)+pktToSecretKeyPktEither+    :: Pkt -> Either KeyPktCoercionError (KeyPkt 'SecretPkt) pktToSecretKeyPktEither (SecretKeyPkt pkp ska) = Right (KeyPktSecretPrimary pkp ska) pktToSecretKeyPktEither (SecretSubkeyPkt pkp ska) = Right (KeyPktSecretSubkey pkp ska) pktToSecretKeyPktEither pkt = Left (ExpectedSecretKeyPacket pkt)@@ -568,25 +674,36 @@ pktToSecretKeyPkt :: Pkt -> Maybe (KeyPkt 'SecretPkt) pktToSecretKeyPkt = either (const Nothing) Just . pktToSecretKeyPktEither --- | Convert secret key/subkey packets to their public-key packet forms.--- Non-secret packets are returned unchanged.+{- | Convert secret key/subkey packets to their public-key packet forms.+Non-secret packets are returned unchanged.+-} publicKeyPacketOf :: Pkt -> Pkt publicKeyPacketOf pkt =-  maybe pkt (keyPktToPkt . keyPktToPublicView) (pktToSecretKeyPkt pkt)+    maybe+        pkt+        (keyPktToPkt . keyPktToPublicView)+        (pktToSecretKeyPkt pkt) -data Verification =-  Verification+data Verification+    = Verification     { _verificationSigner :: SomePKPayload     , _verificationSignature :: SignaturePayload     , _verificationWarnings :: [VerificationWarning]     }  data VerificationWarning-  = MissingSubkeyBackSignatureWarning-  deriving (Eq, Show)+    = MissingSubkeyBackSignatureWarning+    | DeprecatedHashAlgorithmWarning HashAlgorithm+    | UnsupportedHashAlgorithmWarning HashAlgorithm+    | PkaMismatchWarning PubKeyAlgorithm PubKeyAlgorithm+    | UnsupportedCriticalSubpacketWarning SigType+    | LegacyIssuerKeyIdInV6Warning+    | InvalidSignatureContextWarning SigType+    | ExpiredSignatureWarning+    deriving (Eq, Show) -data SOPVVerification =-  SOPVVerification+data SOPVVerification+    = SOPVVerification     { _sopvvDateStamp :: UTCTime     , _sopvvFingerprint :: Fingerprint     , _sopvvPrimaryFingerprint :: Fingerprint
Data/Conduit/OpenPGP/Decrypt.hs view
@@ -2,2483 +2,2929 @@ -- Copyright © 2013-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).--{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE TypeApplications #-}--module Data.Conduit.OpenPGP.Decrypt-  ( conduitDecrypt-  , conduitDecryptWithReport-  , DecryptOptions(..)-  , DecryptKeyResolution(..)-  , PKESKRecipientKey(..)-  , PKESKAttemptFailureKind(..)-  , PKESKAttemptFailure(..)-  , DecryptOutcome(..)-  , DecryptReport(..)-  , DecryptSessionKeyResolutionReport(..)-  , DecryptSessionKeyResolutionPath(..)-  , PKESKResolverAttempt(..)-  , PKESKResolverAttemptAction(..)-  , decryptSEIPDv2Payload-  ) where--import Codec.Encryption.OpenPGP.BlockCipher (renderCipherError, keySize)-import Control.Exception (SomeException, displayException, try)-import Control.Applicative ((<|>))-import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.IO.Unlift (MonadUnliftIO)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)-import Control.Monad.Trans.Resource (MonadResource, MonadThrow)-import qualified "crypton" Crypto.Cipher.Types as CCT-import qualified Crypto.Error as CE-import qualified Crypto.Hash as CH-import qualified Crypto.Hash.Algorithms as CHA-import Crypto.KDF.HKDF (expand, extract)-import Crypto.Number.Serialize (i2osp, os2ip)-import qualified Crypto.PubKey.Curve25519 as C25519-import qualified Crypto.PubKey.Curve448 as C448-import qualified Crypto.PubKey.ECC.DH as ECCDH-import qualified Crypto.PubKey.ECC.ECDSA as ECDSA-import qualified Crypto.PubKey.ECC.Types as ECCT-import qualified Crypto.PubKey.RSA.PKCS15 as P15-import qualified Crypto.PubKey.RSA.Types as RSATypes-import Data.Binary (get)-import Data.Binary.Put (putWord64be, runPut)-import Data.Bits (countLeadingZeros, shiftL, shiftR, xor)-import Data.Bifunctor (first)-import qualified Data.ByteArray as BA-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import Data.Conduit-import qualified Data.Conduit.Binary as CB-import qualified Data.Conduit.List as CL-import Data.Conduit.OpenPGP.Compression (conduitDecompress)-import Data.Conduit.Serialization.Binary (conduitGet)-import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef)-import Data.List (intercalate, nub)-import Data.List.NonEmpty (NonEmpty(..))-import Data.Maybe (catMaybes, isNothing, mapMaybe)-import Data.Word (Word16, Word8, Word64)--import Codec.Encryption.OpenPGP.CFB (decryptOpenPGPCfb, decryptPreservingNonce, validateSEIPD1MDC, calculateMDC)-import Codec.Encryption.OpenPGP.Internal (leftPadTo)-import Codec.Encryption.OpenPGP.Internal.CryptoAES (withAESCipher)-import Codec.Encryption.OpenPGP.Internal.CryptoECDH-  ( normalizeMontgomeryPublic-  , buildECDHKDFParam-  , deriveECDHKek-  )-import Codec.Encryption.OpenPGP.Fingerprint (fingerprint)-import Codec.Encryption.OpenPGP.Internal.CryptoSEIPDv2-  ( aeadModeAndNonceSizeForSEIPDv2-  , decryptSKESK6SessionKey-  , deriveSKESK6KEK-  , seipdv2SymmetricKeySize-  )-import Codec.Encryption.OpenPGP.Policy-  ( DecryptPolicy(..)-  , defaultDecryptPolicy-  , validateTable30PolicyForRecipient-  )-import Codec.Encryption.OpenPGP.Internal.RFC7253OCB (decryptWithOCBRFC7253With)-import Codec.Encryption.OpenPGP.S2K-  ( decodeOpenPGPEncodedSessionKey-  , renderEncodedSessionKeyError-  , renderS2KError-  , S2KError(..)-  , skesk2Key-  , skesk2SessionKey-  , string2Key-  )-import Codec.Encryption.OpenPGP.Types-import Codec.Encryption.OpenPGP.SecretKey (decryptPrivateKey)-import Control.Lens ((.~), ix)-import Data.Conduit.OpenPGP.Keyring.Instances ()-import qualified Data.IxSet.Typed as IxSet--data RecursorState =-  RecursorState-    { _depth :: Int-    , _pendingESKs :: [PendingESK]-    , _lastNonce :: Maybe B.ByteString-    , _lastClearText :: Maybe B.ByteString-    , _decryptPolicy :: DecryptPolicy-    }-  deriving (Eq, Show)--def :: RecursorState-def = RecursorState 0 [] Nothing Nothing defaultDecryptPolicy--data DecryptStreamPhase-  = ActiveDecryptPhase-  | FinishedDecryptPhase-  | MalformedDecryptPhase--data DecryptStreamState (phase :: DecryptStreamPhase) where-  ActiveDecryptState ::-       RecursorState-    -> DecryptStreamState 'ActiveDecryptPhase-  FinishedDecryptState ::-       RecursorState-    -> Bool-    -> DecryptStreamState 'FinishedDecryptPhase-  MalformedDecryptState ::-       RecursorState-    -> String-    -> DecryptStreamState 'MalformedDecryptPhase--data SomeDecryptStreamState where-  SomeDecryptStreamState ::-       DecryptStreamState phase-    -> SomeDecryptStreamState--data PendingESK-  = PendingPKESK PKESKPayload-  | PendingSKESK SKESKPayload-  deriving (Eq, Show)--data EncryptedPayloadVersion-  = LegacyEncryptedPayloadVersion-  | SEIPDv2EncryptedPayloadVersion--data EncryptedPayloadFlavor (v :: EncryptedPayloadVersion) where-  LegacyEncryptedPayload :: EncryptedPayloadFlavor 'LegacyEncryptedPayloadVersion-  SEIPDv2EncryptedPayload ::-       SymmetricAlgorithm-    -> AEADAlgorithm-    -> EncryptedPayloadFlavor 'SEIPDv2EncryptedPayloadVersion--type InputCallback m = String -> m BL.ByteString--data PKESKRecipientKey =-  PKESKRecipientKey-    { pkeskRecipientPKPayload :: Maybe SomePKPayload-    -- ^ Public key payload for the recipient.  Required for X25519, X448,-    -- and ECDH unwrap paths; may be 'Nothing' for RSA.-    , pkeskRecipientSKey :: SKey-    -- ^ Corresponding secret key.-    }--data PKESKAttemptFailure =- PKESKAttemptFailure-   { pkeskAttemptFailureKeyContext :: Maybe (KeyVersion, PubKeyAlgorithm)-   , pkeskAttemptFailureKind :: PKESKAttemptFailureKind-   , pkeskAttemptFailureReason :: String-   }- deriving (Eq, Show)--data PKESKAttemptFailureKind- = PKESKAttemptUnwrapFailed- | PKESKAttemptSessionMaterialDecodeFailed- deriving (Eq, Show)--data PKESKResolverError- = ResolverPolicyDenied String- | ResolverBackendUnavailable String- | ResolverInvalidResponse String- deriving (Eq, Show)--data PKESKResolveRequest =- PKESKResolveRequest-   { reqPKESK :: PKESKPayload-   , reqProbePacket :: Pkt-   , reqIsWildcardRecipient :: Bool-   , reqAttemptIndex :: Int-   , reqPreviousFailures :: [PKESKAttemptFailure]-   }- deriving (Eq, Show)--data PKESKResolveAction- = ResolveWith PKESKRecipientKey- | ResolveSkip- | ResolveExhausted- | ResolveFail PKESKResolverError--type PKESKResolver m = PKESKResolveRequest -> m PKESKResolveAction---- | Build a stateful 'PKESKResolver' that iterates over a pre-populated--- candidate list. The returned resolver yields candidates in order and--- returns 'ResolveExhausted' once the list is depleted.--- | How to resolve secret keys for PKESK-encrypted messages.-data DecryptKeyResolution- = DecryptWithoutPKESK-   -- ^ Do not attempt PKESK decryption; fall through to manual session-key-   -- input via the passphrase callback instead.- | DecryptWithKeyring SecretKeyring-   -- ^ Resolve secret keys from a 'SecretKeyring'. Only unencrypted secret-   -- keys (not passphrase-protected) are used. For passphrase-protected keys,-   -- use 'DecryptWithKeyringAndPassphrase'.- | DecryptWithKeyringAndPassphrase SecretKeyring (SomePKPayload -> IO (Maybe BL.ByteString))-   -- ^ Resolve secret keys from a 'SecretKeyring', unlocking passphrase--   -- protected keys using the provided callback. The callback receives the-   -- public key payload and returns the passphrase, or 'Nothing' to skip.- | DecryptWithUnwrapCandidatesCallback (KeyIdentifier -> PubKeyAlgorithm -> IO [PKESKRecipientKey])-   -- ^ Preferred callback form for non-keyring key material. The callback-   -- receives a typed key identifier (8-octet key ID, fingerprint, or-   -- wildcard) plus the packet public-key algorithm, then returns all-   -- matching candidates in priority order. hOpenPGP iterates candidates-   -- deterministically without re-calling the callback for each retry.---- | Canonical decrypt configuration.------ Most callers should prefer 'conduitDecrypt' and set:------ * 'decryptOptionsKeyResolution' to 'DecryptWithKeyring' or 'DecryptWithKeyringAndPassphrase'--- * 'decryptOptionsPolicy' to strict ('defaultDecryptPolicy') or lenient--- * 'decryptOptionsPassphraseCallback' for SKESK passphrase lookup-data DecryptOptions =-  DecryptOptions-    { decryptOptionsKeyResolution :: DecryptKeyResolution-    , decryptOptionsPolicy :: DecryptPolicy-    , decryptOptionsPassphraseCallback :: InputCallback IO-    }---- | Outcome of a checked decrypt conduit run.------ Use 'conduitDecrypt' to obtain this value. Because--- 'Data.Conduit..|' preserves the--- /rightmost/ conduit's return value, callers who also need the decrypted--- packet stream should use 'Data.Conduit.fuseBoth':------ @--- (outcome, pkts) \<- runConduit $ source .| fuseBoth (conduitDecrypt opts) CL.consume--- @-data DecryptOutcome-  = DecryptClean-    -- ^ The integrity-terminating marker (MDC or SEIPD v2 final AEAD tag)-    -- was seen and no further packets arrived.  The message was-    -- well-formed end-to-end.-  | DecryptTruncated-    -- ^ The input stream ended before any integrity-terminating marker was-    -- seen.  The ciphertext was incomplete.-  | DecryptTrailingData-    -- ^ An integrity-terminating marker was seen, but additional packets-    -- followed it.  Only possible with 'lenientDecryptPolicy' (strict-    -- policy reports 'DecryptMalformedStructure' instead).  The trailing-    -- packets were forwarded downstream unchanged.-  | DecryptMalformedStructure String-    -- ^ A structural packet-sequencing violation was detected.  The-    -- 'String' describes the specific violation:-    ---    -- * PKESK version does not match the SEIPD version (e.g. a v6 PKESK-    --   preceding a SEIPDv1 payload, or a v4 SKESK preceding a SEIPDv2-    --   payload).-    ---    -- * ESK packets arrived in the wrong order relative to the encrypted-    --   data packet (e.g. a literal-data packet appeared between a PKESK-    --   and the SEIPD it was intended to protect).-    ---    -- * A packet arrived after the message integrity boundary (trailing-    --   data).  Under 'defaultDecryptPolicy' this is reported here; under-    --   'lenientDecryptPolicy' it is reported as 'DecryptTrailingData'-    --   instead.-  deriving (Eq, Show)--data DecryptSessionKeyResolutionPath-  = DecryptResolvedViaSKESK-  | DecryptResolvedViaPKESK-  | DecryptResolvedViaManualPKESKInput-  deriving (Eq, Show)--data PKESKResolverAttemptAction-  = ResolverAttemptResolveWith (Maybe (KeyVersion, PubKeyAlgorithm))-  | ResolverAttemptSkip-  | ResolverAttemptExhausted-  | ResolverAttemptFail PKESKResolverError-  deriving (Eq, Show)--data PKESKResolverAttempt =-  PKESKResolverAttempt-    { pkeskResolverAttemptPreviousFailures :: [PKESKAttemptFailure]-    -- ^ Failures from earlier attempts on the same PKESK packet.-    , pkeskResolverAttemptAction :: PKESKResolverAttemptAction-    }-  deriving (Eq, Show)--data DecryptSessionKeyResolutionReport =-  DecryptSessionKeyResolutionReport-    { decryptSessionResolutionPath :: DecryptSessionKeyResolutionPath-    , decryptSessionResolutionSKESKErrors :: [String]-    , decryptSessionResolutionPKESKErrors :: [String]-    , decryptSessionResolutionResolverAttempts :: [PKESKResolverAttempt]-    }-  deriving (Eq, Show)--data DecryptReport =-  DecryptReport-    { decryptReportOutcome :: DecryptOutcome-    , decryptReportSessionKeyResolutions :: [DecryptSessionKeyResolutionReport]-    }-  deriving (Eq, Show)---- | AEAD decryption context (Reader monad eliminates parameter threading)-data AEADDecryptContext cipher =-  AEADDecryptContext-    { aeadMode :: CCT.AEADMode-    , aeadInfo :: B.ByteString-    , aeadChunkSize :: Word8-    , aeadNoncePrefix :: B.ByteString-    , aeadCipher :: cipher-    }---- | ReaderT wrapper for AEAD decryption computations-type AEADDecrypt cipher = ReaderT (AEADDecryptContext cipher) (Either String)--conduitDecrypt ::-     (MonadFail m, MonadUnliftIO m, MonadResource m, MonadThrow m)-  => DecryptOptions-  -> ConduitT Pkt Pkt m DecryptOutcome-conduitDecrypt opts =-  decryptReportOutcome <$> conduitDecryptWithReport opts--conduitDecryptWithReport ::-     (MonadFail m, MonadUnliftIO m, MonadResource m, MonadThrow m)-  => DecryptOptions-  -> ConduitT Pkt Pkt m DecryptReport-conduitDecryptWithReport opts = do-  reportRef <- liftIO (newIORef [])-  resolver <- liftIO (buildDecryptResolver (decryptOptionsKeyResolution opts))-  let allowManualPKESKPrompt =-        case decryptOptionsKeyResolution opts of-          DecryptWithoutPKESK -> True-          _ -> False-  outcome <--    conduitDecryptChecked'-      (def {_decryptPolicy = decryptOptionsPolicy opts})-      allowManualPKESKPrompt-      resolver-      (decryptOptionsPassphraseCallback opts)-      (Just reportRef)-  resolutions <- reverse <$> liftIO (readIORef reportRef)-  pure-    DecryptReport-      { decryptReportOutcome = outcome-      , decryptReportSessionKeyResolutions = resolutions-      }---- | Build an internal 'PKESKResolver' from the public 'DecryptKeyResolution'.-buildDecryptResolver :: DecryptKeyResolution -> IO (PKESKResolver IO)-buildDecryptResolver DecryptWithoutPKESK =-  pure (\_ -> pure ResolveExhausted)-buildDecryptResolver (DecryptWithKeyring kr) =-  buildKeyringResolver kr Nothing-buildDecryptResolver (DecryptWithKeyringAndPassphrase kr cb) =-  buildKeyringResolver kr (Just cb)-buildDecryptResolver (DecryptWithUnwrapCandidatesCallback cb) =-  buildUnwrapCandidatesResolver cb---- | Build a stateful resolver that looks up keys from a 'SecretKeyring'.-buildKeyringResolver ::-     SecretKeyring-  -> Maybe (SomePKPayload -> IO (Maybe BL.ByteString))-  -> IO (PKESKResolver IO)-buildKeyringResolver kr maybePassphraseCb = do-  -- Tracks (last PKESK, remaining wildcard candidates once initialized).-  stateRef <- newIORef (Nothing :: Maybe PKESKPayload, Nothing :: Maybe [PKESKRecipientKey])-  pure $ \req -> do-    let pkesk = reqPKESK req-        probe = reqProbePacket req-    (lastPKESK, wildcardState) <- readIORef stateRef-    let freshPKESK = Just pkesk /= lastPKESK-    when freshPKESK $ writeIORef stateRef (Just pkesk, Nothing)-    let wc = if freshPKESK then Nothing else wildcardState-    case extractProbeKeyIdentifier probe of-      KeyIdentifierWildcard -> do-        -- Wildcard probe: iterate all keys-        candidates <- case wc of-          Nothing -> keyringCandidates (IxSet.toList kr)-          Just cs -> pure cs-        case candidates of-          [] -> do-            writeIORef stateRef (Just pkesk, Just [])-            pure ResolveExhausted-          (rk:rest) -> do-            writeIORef stateRef (Just pkesk, Just rest)-            pure (ResolveWith rk)-      keyIdentifier -> do-        -- Exact probe: direct lookup by key ID or fingerprint-        let matchingTKs = matchingTKsForRecipient keyIdentifier-            priorFailures = length (reqPreviousFailures req)-        candidates <- keyringCandidates matchingTKs-        case drop priorFailures candidates of-          [] -> pure ResolveSkip-          (rk:_) -> pure (ResolveWith rk)-  where-    matchingTKsForRecipient :: KeyIdentifier -> [TK 'SecretTK]-    matchingTKsForRecipient keyIdentifier =-      case keyIdentifier of-        KeyIdentifierWildcard -> IxSet.toList kr-        KeyIdentifierEightOctet rid -> IxSet.toList (kr IxSet.@= rid)-        KeyIdentifierFingerprint rid ->-          let indexedMatches = IxSet.toList (kr IxSet.@= rid)-           in if null indexedMatches-                then filter (tkMatchesRecipientFingerprint rid) (IxSet.toList kr)-                else indexedMatches--    tkMatchesRecipientFingerprint :: Fingerprint -> TK 'SecretTK -> Bool-    tkMatchesRecipientFingerprint rid tk =-      any-        (keyPktMatchesRecipientFingerprint rid)-        (_tkPrimaryKey tk : map fst (_tkSubs tk))--    keyPktMatchesRecipientFingerprint ::-         Fingerprint -> KeyPkt 'SecretPkt -> Bool-    keyPktMatchesRecipientFingerprint rid (KeyPktSecretPrimary pkp _) =-      pkPayloadMatchesRecipientFingerprint rid pkp-    keyPktMatchesRecipientFingerprint rid (KeyPktSecretSubkey pkp _) =-      pkPayloadMatchesRecipientFingerprint rid pkp--    pkPayloadMatchesRecipientFingerprint :: Fingerprint -> SomePKPayload -> Bool-    pkPayloadMatchesRecipientFingerprint rid pkp =-      fingerprint pkp `elem` recipientFingerprintMatchVariants rid--    recipientFingerprintMatchVariants :: Fingerprint -> [Fingerprint]-    recipientFingerprintMatchVariants (Fingerprint rid)-      | BL.length rid == 20 = [Fingerprint rid, Fingerprint (BL.cons 0x04 rid)]-      | BL.length rid == 21 && BL.head rid == 0x04 = [Fingerprint rid, Fingerprint (BL.tail rid)]-      | BL.length rid == 32 = [Fingerprint rid, Fingerprint (BL.cons 0x06 rid)]-      | BL.length rid == 33 && BL.head rid == 0x06 = [Fingerprint rid, Fingerprint (BL.tail rid)]-      | otherwise = [Fingerprint rid]--    keyringCandidates :: [TK 'SecretTK] -> IO [PKESKRecipientKey]-    keyringCandidates tks = concat <$> mapM tkCandidates tks--    tkCandidates :: TK 'SecretTK -> IO [PKESKRecipientKey]-    tkCandidates tk =-      fmap catMaybes . mapM resolveKeyPair $-        _tkPrimaryKey tk : map fst (_tkSubs tk)--    resolveKeyPair :: KeyPkt 'SecretPkt -> IO (Maybe PKESKRecipientKey)-    resolveKeyPair (KeyPktSecretPrimary pkp (SUUnencrypted sk _)) =-      pure $ Just PKESKRecipientKey {pkeskRecipientPKPayload = Just pkp, pkeskRecipientSKey = sk}-    resolveKeyPair (KeyPktSecretSubkey pkp (SUUnencrypted sk _)) =-      pure $ Just PKESKRecipientKey {pkeskRecipientPKPayload = Just pkp, pkeskRecipientSKey = sk}-    resolveKeyPair (KeyPktSecretPrimary pkp ska) = unlockProtected pkp ska-    resolveKeyPair (KeyPktSecretSubkey pkp ska) = unlockProtected pkp ska--    unlockProtected :: SomePKPayload -> SKAddendum -> IO (Maybe PKESKRecipientKey)-    unlockProtected pkp ska =-      case maybePassphraseCb of-        Nothing -> pure Nothing-        Just passphraseCb -> do-          mPassphrase <- passphraseCb pkp-          case mPassphrase of-            Nothing -> pure Nothing-            Just passphrase ->-              case decryptPrivateKey (pkp, ska) passphrase of-                Left _ -> pure Nothing-                Right (SUUnencrypted sk _) ->-                  pure $ Just PKESKRecipientKey {pkeskRecipientPKPayload = Just pkp, pkeskRecipientSKey = sk}-                Right _ -> pure Nothing--buildUnwrapCandidatesResolver ::-     (KeyIdentifier -> PubKeyAlgorithm -> IO [PKESKRecipientKey])-  -> IO (PKESKResolver IO)-buildUnwrapCandidatesResolver cb = do-  stateRef <- newIORef (Nothing :: Maybe PKESKPayload, [] :: [(Pkt, [PKESKRecipientKey])], [] :: [SKey])-  pure $ \req -> do-    let pkesk = reqPKESK req-        probePkt = reqProbePacket req-    (lastPKESK, probeState, seenSKeys) <- readIORef stateRef-    let freshPKESK = Just pkesk /= lastPKESK-    when freshPKESK $ writeIORef stateRef (Just pkesk, [], [])-    let state0 = if freshPKESK then [] else probeState-        seen0 = if freshPKESK then [] else seenSKeys-    case lookup probePkt state0 of-      Just (next:rest) -> do-        writeIORef-          stateRef-          ( Just pkesk-          , updateProbeState probePkt rest state0-          , pkeskRecipientSKey next : seen0-          )-        pure (ResolveWith next)-      Just [] ->-        pure ResolveSkip-      Nothing -> do-        candidates <- filterFreshCandidates seen0 <$> callbackCandidates probePkt-        case candidates of-          [] -> do-            writeIORef stateRef (Just pkesk, updateProbeState probePkt [] state0, seen0)-            pure ResolveSkip-          (next:rest) -> do-            writeIORef-              stateRef-              ( Just pkesk-              , updateProbeState probePkt rest state0-              , pkeskRecipientSKey next : seen0-              )-            pure (ResolveWith next)-  where-    callbackCandidates probePkt =-      cb (extractProbeKeyIdentifier probePkt) (extractProbePKA probePkt)--    updateProbeState probePkt remaining state0 =-      (probePkt, remaining) : filter ((/= probePkt) . fst) state0--    filterFreshCandidates seenSKeys =-      filter (\candidate -> pkeskRecipientSKey candidate `notElem` seenSKeys)---- | Extract the recipient identifier from a PKESK probe packet.-extractProbeKeyIdentifier :: Pkt -> KeyIdentifier-extractProbeKeyIdentifier (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ rid _ _)))-  | isWildcardV3RecipientKeyId rid = KeyIdentifierWildcard-  | otherwise = KeyIdentifierEightOctet rid-extractProbeKeyIdentifier (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid _ _)))-  | BL.null rid = KeyIdentifierWildcard-  | otherwise = KeyIdentifierFingerprint (Fingerprint rid)-extractProbeKeyIdentifier _ = KeyIdentifierWildcard--isWildcardV3RecipientKeyId :: EightOctetKeyId -> Bool-isWildcardV3RecipientKeyId (EightOctetKeyId rid) =-  BL.length rid == 8 && BL.all (== 0) rid---- | Extract the public-key algorithm from a PKESK probe packet.-extractProbePKA :: Pkt -> PubKeyAlgorithm-extractProbePKA (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ _ pka _))) = pka-extractProbePKA (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 _ pka _))) = pka-extractProbePKA _ = RSA  -- fallback; should not be reached---- | Core implementation: manual await loop so we can return a 'DecryptOutcome'.-conduitDecryptChecked' ::-     (MonadFail m, MonadUnliftIO m, MonadResource m, MonadThrow m)-  => RecursorState-  -> Bool-  -> PKESKResolver IO-  -> InputCallback IO-  -> Maybe (IORef [DecryptSessionKeyResolutionReport])-  -> ConduitT Pkt Pkt m DecryptOutcome-conduitDecryptChecked' rs0 allowManualPKESKPrompt pkcb cb reportRef =-  loop (SomeDecryptStreamState (ActiveDecryptState rs0))-  where-    loop ::-         (MonadFail m, MonadUnliftIO m, MonadResource m, MonadThrow m)-      => SomeDecryptStreamState -> ConduitT Pkt Pkt m DecryptOutcome-    loop streamState = do-      case streamState of-        SomeDecryptStreamState (MalformedDecryptState _ reason) ->-          return (DecryptMalformedStructure reason)-        SomeDecryptStreamState state -> do-          mpkt <- await-          case mpkt of-            Nothing -> return (finalOutcome state)-            Just pkt -> do-              (state', pkts) <- lift (push pkt state)-              mapM_ yield pkts-              loop state'--    push ::-         (MonadFail m, MonadUnliftIO m, MonadResource m, MonadThrow m)-      => Pkt-      -> DecryptStreamState phase-      -> m (SomeDecryptStreamState, [Pkt])-    push i (ActiveDecryptState s)-      | _depth s > 42 = fail "I think we've been quine-attacked"-      | hasPendingESKPrelude s && not (packetCanFollowESKPrelude i) =-          return-            ( SomeDecryptStreamState-                (MalformedDecryptState-                   s-                   "Malformed encrypted packet sequence: ESK packets must immediately precede encrypted data")-            , [] )-      | otherwise =-        let dp = _decryptPolicy s-        in case i of-          SKESKPkt payload ->-            do-              when (decryptRejectDeprecatedSKESK dp) $-                case skeskPayloadS2K payload of-                  Simple _ ->-                    fail "SKESK uses Simple S2K specifier, which is deprecated by RFC9580 policy"-                  Salted _ _ ->-                    fail "SKESK uses Salted S2K specifier, which is deprecated by RFC9580 policy"-                  _ -> pure ()-              return-                ( SomeDecryptStreamState-                    (ActiveDecryptState-                       (s {_pendingESKs = _pendingESKs s ++ [PendingSKESK payload]}))-                , [] )-          PKESKPkt p ->-            return-              ( SomeDecryptStreamState-                  (ActiveDecryptState-                     (s {_pendingESKs = _pendingESKs s ++ [PendingPKESK p]}))-              , [] )-          (SymEncDataPkt bs) ->-            if hasESKPayloadVersionMismatch dp LegacyEncryptedPayload s-              then-                return-                  ( SomeDecryptStreamState-                      (MalformedDecryptState-                         s-                         ("ESK/payload version mismatch: ESK packets present but none are version-aligned with " ++-                          "legacy SED payload"))-                  , [] )-              else do-                when (not (decryptAllowSEDNoIntegrity dp)) $-                  fail-                    "Received unauthenticated SED (Symmetrically Encrypted Data) packet; \-                    \RFC9580 policy requires integrity-protected SEIPD. \-                    \Use lenientDecryptPolicy to permit legacy messages."-                (symalgo, sessionKey) <--                  resolveSessionKey-                    s-                    allowManualPKESKPrompt-                    pkcb-                    cb-                    LegacyEncryptedPayload-                    reportRef-                checkDecryptSymmetricAlgo dp symalgo-                d <--                  decryptSEDP-                    s {_pendingESKs = []}-                    allowManualPKESKPrompt-                    pkcb-                    cb-                    reportRef-                    symalgo-                    sessionKey-                    bs-                -- SED is the terminal outer-stream packet.-                return (finalizeOuterEncryptedPayload s d)-          (SymEncIntegrityProtectedDataPkt (SEIPD1 _ bs)) ->-            if hasESKPayloadVersionMismatch dp LegacyEncryptedPayload s-              then-                return-                  ( SomeDecryptStreamState-                      (MalformedDecryptState-                         s-                         ("ESK/payload version mismatch: ESK packets present but none are version-aligned with " ++-                          "SEIPDv1 payload"))-                  , [] )-              else do-                when (not (decryptAllowSEIPDv1 dp)) $-                  fail-                    "Received SEIPDv1 packet; decrypt policy requires SEIPDv2 only."-                (symalgo, sessionKey) <--                  resolveSessionKey-                    s-                    allowManualPKESKPrompt-                    pkcb-                    cb-                    LegacyEncryptedPayload-                    reportRef-                checkDecryptSymmetricAlgo dp symalgo-                d <--                  decryptSEIPDP-                    s {_pendingESKs = []}-                    allowManualPKESKPrompt-                    pkcb-                    cb-                    reportRef-                    symalgo-                    sessionKey-                    bs-                -- The outer SEIPD1 packet is terminal; inner MDC is handled by-                -- the recursive conduit's own _seenMessageEnd tracking.-                return (finalizeOuterEncryptedPayload s d)-          (SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize salt bs)) ->-            if hasESKPayloadVersionMismatch dp (SEIPDv2EncryptedPayload sa aa) s-              then-                return-                  ( SomeDecryptStreamState-                      (MalformedDecryptState-                         s-                         ("ESK/payload version mismatch: ESK packets present but none are version-aligned with " ++-                          "SEIPDv2 payload"))-                  , [] )-              else do-                checkDecryptSymmetricAlgo dp sa-                checkDecryptAEADAlgo dp aa-                (_, sessionKey) <--                  resolveSessionKey-                    s-                    allowManualPKESKPrompt-                    pkcb-                    cb-                    (SEIPDv2EncryptedPayload sa aa)-                    reportRef-                d <--                  decryptSEIPDv2P-                    s {_pendingESKs = []}-                    allowManualPKESKPrompt-                    pkcb-                    cb-                    reportRef-                    sa-                    aa-                    chunkSize-                    salt-                    sessionKey-                    bs-                -- SEIPD2 final AEAD tag was verified inside decryptSEIPDv2P.-                return (finalizeOuterEncryptedPayload s d)-          m@(ModificationDetectionCodePkt mdc) -> do-            when (isNothing (_lastClearText s)) $ fail "MDC with no referent"-            let mcalculated = calculateMDC <$> _lastNonce s <*> _lastClearText s-            expectedMdc <--              case mcalculated of-                Nothing -> fail "MDC with no nonce or cleartext"-                Just Nothing -> fail "MDC referent is too short"-                Just (Just x) -> return x-            when (expectedMdc /= mdc) $-              fail $-              "MDC indicates tampering: " ++-              show mdc ++-              " versus " ++-              maybe "<empty>" show mcalculated ++-              "  ... " ++-              show (_lastNonce s) ++ " / " ++ show (_lastClearText s)-            -- MDC is the integrity boundary inside a SEIPD1 inner stream.-            return-              ( SomeDecryptStreamState (FinishedDecryptState s False)-              , [m] )-          -- RFC9580 Padding Packet (tag 21) can be ignored after decryption.-          (OtherPacketPkt 21 _) ->-            return (SomeDecryptStreamState (ActiveDecryptState s), [])-          (OtherPacketPkt t _) | t < 40 ->-            fail ("Unknown critical packet type in packet sequence: " ++ show t)-          (OtherPacketPkt _ _) ->-            return (SomeDecryptStreamState (ActiveDecryptState s), [])-          p ->-            return (SomeDecryptStreamState (ActiveDecryptState s), [p])-    push i (FinishedDecryptState s hadTrailing) =-      if decryptRejectTrailingData (_decryptPolicy s)-        then-          return-            ( SomeDecryptStreamState-                (MalformedDecryptState-                   s-                   "packet received after message integrity boundary")-            , [] )-        else-          return-            (SomeDecryptStreamState (FinishedDecryptState s True), [i])-    push _ malformedState@(MalformedDecryptState _ _) =-      return (SomeDecryptStreamState malformedState, [])--    hasPendingESKPrelude s = not (null (_pendingESKs s))--    hasESKPayloadVersionMismatch dp payloadFlavor state =-      decryptRejectESKVersionMismatch dp-        && hasPendingESKPrelude state-        && null (alignedPrecedingESKs payloadFlavor (_pendingESKs state))--    finalizeOuterEncryptedPayload state decryptedPkts =-      ( SomeDecryptStreamState-          (FinishedDecryptState (state { _pendingESKs = [] }) False)-      , decryptedPkts )--    finalOutcome :: DecryptStreamState phase -> DecryptOutcome-    finalOutcome (ActiveDecryptState _) = DecryptTruncated-    finalOutcome (FinishedDecryptState _ hadTrailing) =-      if hadTrailing-        then DecryptTrailingData-        else DecryptClean-    finalOutcome (MalformedDecryptState _ reason) =-      DecryptMalformedStructure reason--    packetCanFollowESKPrelude pkt =-      case pkt of-        SKESKPkt _ -> True-        PKESKPkt _ -> True-        SymEncDataPkt _ -> True-        SymEncIntegrityProtectedDataPkt _ -> True-        MarkerPkt _ -> True-        OtherPacketPkt 21 _ -> True-        _ -> False---- | Describes what integrity-terminating marker (if any) an inner packet--- stream is expected to contain.  Passed to 'checkInnerOutcome' to--- distinguish a legitimate end-of-stream from a missing marker.-data InnerIntegrityExpectation-  = NoIntegrityMarker-    -- ^ The inner stream has no integrity-terminating packet.  SED has none-    -- by design; SEIPD2 authenticates via AEAD before the conduit runs.-    -- 'DecryptTruncated' is the normal end-of-stream outcome.---- | Propagate non-clean inner-stream outcomes as a 'fail'.  Called after each--- recursive decrypt helper so that structural violations and (for SEIPD1) a--- missing MDC are not silently swallowed.-checkInnerOutcome :: MonadFail m => InnerIntegrityExpectation -> DecryptOutcome -> m ()-checkInnerOutcome _ DecryptClean = pure ()-checkInnerOutcome _ DecryptTrailingData = pure ()-checkInnerOutcome NoIntegrityMarker DecryptTruncated = pure ()-checkInnerOutcome _ (DecryptMalformedStructure reason) =-  fail ("Inner encrypted payload had malformed structure: " ++ reason)--decryptSEDP ::-    (MonadFail m, MonadUnliftIO m, MonadIO m, MonadThrow m)-  => RecursorState-  -> Bool-  -> PKESKResolver IO-  -> InputCallback IO-  -> Maybe (IORef [DecryptSessionKeyResolutionReport])-  -> SymmetricAlgorithm-  -> SessionKey-  -> BL.ByteString-  -> m [Pkt]-decryptSEDP rs allowManualPKESKPrompt pkcb cb reportRef symalgo (SessionKey sessionKey) bs = do-  decrypted <--   case decryptOpenPGPCfb symalgo (BL.toStrict bs) sessionKey of-     Left e -> fail (renderCipherError e)-     Right x -> pure x-  (innerOutcome, pkts) <- decryptInnerPackets rs allowManualPKESKPrompt pkcb cb reportRef decrypted-  checkInnerOutcome NoIntegrityMarker innerOutcome-  pure pkts--decryptSEIPDP ::-    (MonadFail m, MonadUnliftIO m, MonadIO m, MonadThrow m)-  => RecursorState-  -> Bool-  -> PKESKResolver IO-  -> InputCallback IO-  -> Maybe (IORef [DecryptSessionKeyResolutionReport])-  -> SymmetricAlgorithm-  -> SessionKey-  -> BL.ByteString-  -> m [Pkt]-decryptSEIPDP rs allowManualPKESKPrompt pkcb cb reportRef symalgo (SessionKey sessionKey) bs = do-  (nonce, decrypted) <--   case decryptPreservingNonce symalgo (BL.toStrict bs) sessionKey of-     Left e -> fail (renderCipherError e)-     Right x -> pure x-  decryptedWithoutMDC <--    case validateSEIPD1MDC nonce decrypted of-      Left err -> fail err-      Right x -> pure x-  (innerOutcome, pkts) <- decryptInnerPackets rs allowManualPKESKPrompt pkcb cb reportRef decryptedWithoutMDC-  checkInnerOutcome NoIntegrityMarker innerOutcome-  pure pkts--decryptSEIPDv2P ::-     (MonadFail m, MonadUnliftIO m, MonadIO m, MonadThrow m)-  => RecursorState-  -> Bool-  -> PKESKResolver IO-  -> InputCallback IO-  -> Maybe (IORef [DecryptSessionKeyResolutionReport])-  -> SymmetricAlgorithm-  -> AEADAlgorithm-  -> Word8-  -> Salt-  -> SessionKey-  -> BL.ByteString-  -> m [Pkt]-decryptSEIPDv2P rs allowManualPKESKPrompt pkcb cb reportRef symalgo aeadalgo chunkSize salt sessionKey bs = do-  let decrypted =-       decryptSEIPDv2Payload-         symalgo-         aeadalgo-         chunkSize-         salt-         (BL.toStrict bs)-         sessionKey-  case decrypted of-   Left e -> fail e-   Right cleartext -> do-     (innerOutcome, pkts) <--       decryptInnerPackets rs allowManualPKESKPrompt pkcb cb reportRef cleartext-     checkInnerOutcome NoIntegrityMarker innerOutcome-     pure pkts--decryptInnerPackets ::-    (MonadFail m, MonadUnliftIO m, MonadThrow m)-  => RecursorState-  -> Bool-  -> PKESKResolver IO-  -> InputCallback IO-  -> Maybe (IORef [DecryptSessionKeyResolutionReport])-  -> B.ByteString-  -> m (DecryptOutcome, [Pkt])-decryptInnerPackets rs allowManualPKESKPrompt pkcb cb reportRef cleartext =-  runConduitRes $-  CB.sourceLbs (BL.fromStrict cleartext) .| conduitGet get .| conduitDecompress .|-  fuseBoth-    (conduitDecryptChecked'-       rs {_depth = _depth rs + 1}-       allowManualPKESKPrompt-       pkcb-       cb-       reportRef)-    CL.consume--decryptSEIPDv2Payload ::-     SymmetricAlgorithm-  -> AEADAlgorithm-  -> Word8-  -> Salt-  -> B.ByteString-  -> SessionKey-  -> Either String B.ByteString-decryptSEIPDv2Payload symalgo aeadalgo chunkSize salt encrypted (SessionKey sessionKey) = do-  when (chunkSize > 16) $-    Left "SEIPD v2 chunk size octet must be between 0 and 16"-  (mode, nonceSize) <- aeadModeAndNonceSize aeadalgo-  keyLen <- symKeySize symalgo-  let outputLen = keyLen + nonceSize - 8-  when (B.length (unSalt salt) /= 32) $-    Left "SEIPD v2 salt must be exactly 32 octets"-  when (B.length encrypted < 32) $-    Left "SEIPD v2 ciphertext must include at least one chunk tag and a final tag"-  let info =-        B.pack-          [0xd2, 2, fromFVal symalgo, fromFVal aeadalgo, chunkSize]-      prk = extract @CHA.SHA256 (unSalt salt) sessionKey-      okm = expand @CHA.SHA256 prk info outputLen :: B.ByteString-      messageKey = B.take keyLen okm-      noncePrefix = B.take (nonceSize - 8) (B.drop keyLen okm)-  decryptSEIPDv2WithKey-    symalgo-    mode-    chunkSize-    info-    noncePrefix-    messageKey-    encrypted--decryptSEIPDv2WithKey ::-     SymmetricAlgorithm-  -> CCT.AEADMode-  -> Word8-  -> B.ByteString-  -> B.ByteString-  -> B.ByteString-  -> B.ByteString-  -> Either String B.ByteString-decryptSEIPDv2WithKey symalgo mode chunkSize info noncePrefix sessionKey encrypted =-  withAESCipher-    "SEIPD v2 decrypt currently supports AES-128/192/256 only"-    symalgo-    sessionKey-    (decryptChunks mode info chunkSize noncePrefix encrypted)--decryptChunks ::-     CCT.BlockCipher cipher-  => CCT.AEADMode-  -> B.ByteString-  -> Word8-  -> B.ByteString-  -> B.ByteString-  -> cipher-  -> Either String B.ByteString-decryptChunks mode info chunkSize noncePrefix encrypted cipher =-  let ctx = AEADDecryptContext mode info chunkSize noncePrefix cipher-   in runReaderT decryptChunksWithReader ctx-  where-    decryptChunksWithReader :: CCT.BlockCipher cipher => AEADDecrypt cipher B.ByteString-    decryptChunksWithReader = go 0 encrypted [] 0-      where-        chunkLen = 1 `shiftL` (fromIntegral chunkSize + 6)-        tagLen = 16-        -        go idx remaining acc totalPlain-          | B.length remaining < 2 * tagLen =-              lift $ Left "SEIPD v2 ciphertext is too short for chunk and final authentication tags"-          | otherwise = do-              let hasMoreChunks = B.length remaining > chunkLen + 2 * tagLen-                  currentChunkLen =-                    if hasMoreChunks-                      then chunkLen-                      else B.length remaining - 2 * tagLen-              when (currentChunkLen < 0) $-                lift $ Left "SEIPD v2 malformed chunk lengths"-              let (chunkCiphertext, r1) = B.splitAt currentChunkLen remaining-                  (chunkTag, r2) = B.splitAt tagLen r1-              plainChunk <- decryptChunkWithContext idx chunkCiphertext chunkTag-              if hasMoreChunks-                then go-                       (idx + 1)-                       r2-                       (plainChunk : acc)-                       (totalPlain + B.length plainChunk)-                else do-                  when (B.length r2 /= tagLen) $-                    lift $ Left "SEIPD v2 missing final authentication tag"-                  verifyFinalTagWithContext-                    (idx + 1)-                    (totalPlain + B.length plainChunk)-                    r2-                  return (B.concat (reverse (plainChunk : acc)))-        -        decryptChunkWithContext idx chunkCiphertext chunkTag = do-          AEADDecryptContext mode' _ _ noncePrefix' cipher' <- ask-          if mode' == CCT.AEAD_OCB-            then-              lift $-              decryptWithOCBRFC7253With-                (\_ _ _ _ _ _ -> "SEIPD v2 chunk authentication failed")-                cipher'-                (noncePrefix' <> encodeWord64be idx)-                info-                chunkCiphertext-                (mkAuthTag chunkTag)-            else do-              aead <- initAEADWithContext idx-              let mPlain =-                    CCT.aeadSimpleDecrypt-                      aead-                      info-                      chunkCiphertext-                      (mkAuthTag chunkTag)-              case mPlain of-                Nothing -> lift $ Left "SEIPD v2 chunk authentication failed"-                Just p -> return p-        -        verifyFinalTagWithContext idx totalPlain finalTag = do-          AEADDecryptContext mode' _ _ noncePrefix' cipher' <- ask-          if mode' == CCT.AEAD_OCB-            then do-              plain <--                lift $-                decryptWithOCBRFC7253With-                  (\_ _ _ _ _ _ -> "SEIPD v2 chunk authentication failed")-                  cipher'-                  (noncePrefix' <> encodeWord64be idx)-                  (info <> encodeWord64be (fromIntegral totalPlain))-                  B.empty-                  (mkAuthTag finalTag)-              if B.null plain-                then return ()-                else lift $ Left "SEIPD v2 final authentication tag verification failed"-            else do-              aead <- initAEADWithContext idx-              let mEmpty =-                    CCT.aeadSimpleDecrypt-                      aead-                      (info <> encodeWord64be (fromIntegral totalPlain))-                      B.empty-                      (mkAuthTag finalTag)-              case mEmpty of-                Just p | B.null p -> return ()-                _ -> lift $ Left "SEIPD v2 final authentication tag verification failed"-        -        initAEADWithContext idx = do-          AEADDecryptContext mode' _ _ noncePrefix' cipher' <- ask-          lift $ first show . CE.eitherCryptoError $-            CCT.aeadInit mode' cipher' (noncePrefix' <> encodeWord64be idx)--aeadModeAndNonceSize :: AEADAlgorithm -> Either String (CCT.AEADMode, Int)-aeadModeAndNonceSize =-  aeadModeAndNonceSizeForSEIPDv2-    "Unknown AEAD algorithm for SEIPD v2 decrypt"--symKeySize :: SymmetricAlgorithm -> Either String Int-symKeySize =-  seipdv2SymmetricKeySize-    "SEIPD v2 decrypt currently supports AES-128/192/256 only"--encodeWord64be :: Word64 -> B.ByteString-encodeWord64be = BL.toStrict . runPut . putWord64be--mkAuthTag :: B.ByteString -> CCT.AuthTag-mkAuthTag = CCT.AuthTag . BA.convert--checkDecryptSymmetricAlgo :: MonadFail m => DecryptPolicy -> SymmetricAlgorithm -> m ()-checkDecryptSymmetricAlgo dp sa =-  case decryptAllowedSymmetricAlgos dp of-    Nothing -> pure ()-    Just allowed-      | sa `elem` allowed -> pure ()-      | otherwise ->-          fail $-            "Decrypt policy rejects symmetric algorithm " ++-            show sa ++-            "; allowed: " ++-            show allowed--checkDecryptAEADAlgo :: MonadFail m => DecryptPolicy -> AEADAlgorithm -> m ()-checkDecryptAEADAlgo dp aa =-  case decryptAllowedAEADAlgos dp of-    Nothing -> pure ()-    Just allowed-      | aa `elem` allowed -> pure ()-      | otherwise ->-          fail $-            "Decrypt policy rejects AEAD algorithm " ++-            show aa ++-            "; allowed: " ++-            show allowed--skeskPayloadSymmetricAlgorithm :: SKESKPayload -> SymmetricAlgorithm-skeskPayloadSymmetricAlgorithm payload =-  case classifySKESKPayload payload of-    ClassifiedSKESKPayloadV4 (SKESKPayloadV4 sa _ _) -> sa-    ClassifiedSKESKPayloadV6 (SKESKPayloadV6 sa _ _ _ _ _) -> sa--skeskPayloadS2K :: SKESKPayload -> S2K-skeskPayloadS2K payload =-  case classifySKESKPayload payload of-    ClassifiedSKESKPayloadV4 (SKESKPayloadV4 _ s2k _) -> s2k-    ClassifiedSKESKPayloadV6 (SKESKPayloadV6 _ _ s2k _ _ _) -> s2k--skeskPayloadAEADAlgorithm :: SKESKPayload -> Maybe AEADAlgorithm-skeskPayloadAEADAlgorithm payload =-  case classifySKESKPayload payload of-    ClassifiedSKESKPayloadV4 _ -> Nothing-    ClassifiedSKESKPayloadV6 (SKESKPayloadV6 _ aa _ _ _ _) -> Just aa--resolveSKESKSessionKey :: BL.ByteString -> SKESKPayload -> Either String B.ByteString-resolveSKESKSessionKey passphrase payload =-  first renderSKESKSessionKeyResolutionError $-  resolveSKESKSessionKeyTyped passphrase (classifySKESKPayload payload)--data SKESKSessionKeyResolutionError-  = SKESKSessionKeyS2KError S2KError-  | SKESKSessionKeyOtherError String-  deriving (Eq, Show)--renderSKESKSessionKeyResolutionError :: SKESKSessionKeyResolutionError -> String-renderSKESKSessionKeyResolutionError (SKESKSessionKeyS2KError err) = renderS2KError err-renderSKESKSessionKeyResolutionError (SKESKSessionKeyOtherError err) = err--resolveSKESKSessionKeyTyped ::-     BL.ByteString-  -> ClassifiedSKESKPayload-  -> Either SKESKSessionKeyResolutionError B.ByteString-resolveSKESKSessionKeyTyped passphrase (ClassifiedSKESKPayloadV4 (SKESKPayloadV4 sa s2k Nothing)) =-  first-    SKESKSessionKeyS2KError-    (skesk2Key (SKESK4Packet sa s2k Nothing) passphrase)-resolveSKESKSessionKeyTyped passphrase (ClassifiedSKESKPayloadV4 (SKESKPayloadV4 sa s2k (Just esk))) =-  first-    SKESKSessionKeyS2KError-    (snd <$> skesk2SessionKey (SKESK4Packet sa s2k (Just esk)) passphrase)-resolveSKESKSessionKeyTyped passphrase (ClassifiedSKESKPayloadV6 (SKESKPayloadV6 sa aead s2k iv esk tag)) = do-  keyLen <- first (SKESKSessionKeyS2KError . S2KUnsupportedAlgorithm) (keySize sa)-  ikm <- first SKESKSessionKeyS2KError (string2Key s2k keyLen passphrase)-  kek <- first SKESKSessionKeyOtherError (deriveSKESK6KEK sa aead ikm)-  first-    SKESKSessionKeyOtherError-    (decryptSKESK6SessionKey sa aead kek (BL.toStrict iv) (BL.toStrict esk) (BL.toStrict tag))--data ClassifiedSKESKPayload where-  ClassifiedSKESKPayloadV4 :: SKESKPayloadV4 -> ClassifiedSKESKPayload-  ClassifiedSKESKPayloadV6 :: SKESKPayloadV6 -> ClassifiedSKESKPayload--classifySKESKPayload :: SKESKPayload -> ClassifiedSKESKPayload-classifySKESKPayload (SKESKPayloadV4Packet payloadV4) =-  ClassifiedSKESKPayloadV4 payloadV4-classifySKESKPayload (SKESKPayloadV6Packet payloadV6) =-  ClassifiedSKESKPayloadV6 payloadV6--resolveSessionKey ::-     (MonadFail m, MonadIO m)-  => RecursorState-  -> Bool-  -> PKESKResolver IO-  -> InputCallback IO-  -> EncryptedPayloadFlavor v-  -> Maybe (IORef [DecryptSessionKeyResolutionReport])-  -> m (SymmetricAlgorithm, SessionKey)-resolveSessionKey rs allowManualPKESKPrompt pkcb cb payloadFlavor reportRef =-  case precedingCandidates of-    [] ->-      if null (_pendingESKs rs)-        then fail "Encrypted data packet has no preceding SKESK or PKESK packet"-        else-          fail-            "Encrypted data packet has no preceding SKESK or PKESK packet aligned with payload version"-    candidates ->-      case skeskCandidates candidates of-        [] -> resolvePKESKCandidates (pkeskCandidates candidates) [] [] []-        skesks -> do-          passphrase <- liftIO $ cb "Input the passphrase I want"-          resolveSKESKCandidates passphrase skesks (pkeskCandidates candidates) []-  where-    precedingCandidates-      | strictAlignment = alignedByVersion-      | null alignedByVersion = _pendingESKs rs-      | otherwise = alignedByVersion--    strictAlignment = decryptRejectESKVersionMismatch (_decryptPolicy rs)-    alignedByVersion = pendingESKsFromAligned alignedStrict-    alignedStrict = alignedPrecedingESKs payloadFlavor (_pendingESKs rs)--    skeskCandidates esks = reverse [skesk | PendingSKESK skesk <- esks]--    pkeskCandidates esks = reverse [pkesk | PendingPKESK pkesk <- esks]--    resolveSKESKCandidates ::-         (MonadFail m, MonadIO m)-      => BL.ByteString-      -> [SKESKPayload]-      -> [PKESKPayload]-      -> [String]-      -> m (SymmetricAlgorithm, SessionKey)-    resolveSKESKCandidates _ [] pkesks skeskErrs =-      resolvePKESKCandidates pkesks skeskErrs [] []-    resolveSKESKCandidates passphrase (skesk:rest) pkesks skeskErrs =-      case resolveSKESKCandidate passphrase skesk of-        Left err ->-          resolveSKESKCandidates-            passphrase-            rest-            pkesks-            ((skeskErrPrefix skesk ++ err) : skeskErrs)-        Right resolved -> do-          emitResolutionReport-            (mkResolutionReport DecryptResolvedViaSKESK skeskErrs [] [])-          pure resolved--    resolveSKESKCandidate ::-         BL.ByteString-      -> SKESKPayload-      -> Either String (SymmetricAlgorithm, SessionKey)-    resolveSKESKCandidate passphrase skesk = do-      let skeskSymAlgo = skeskPayloadSymmetricAlgorithm skesk-          expectedSymAlgo = payloadExpectedSymmetricAlgorithm payloadFlavor-      sessionKeyBytes <- resolveSKESKSessionKey passphrase skesk-      case expectedSymAlgo of-        Just expected | expected /= skeskSymAlgo ->-          Left "SKESK/encrypted-payload symmetric algorithm mismatch"-        _ ->-          case (payloadExpectedAEADAlgorithm payloadFlavor, skeskPayloadAEADAlgorithm skesk) of-            (Just expectedAEAD, Just skeskAEAD)-              | expectedAEAD /= skeskAEAD ->-                  Left "SKESK/encrypted-payload AEAD algorithm mismatch"-            _ -> Right (skeskSymAlgo, SessionKey sessionKeyBytes)--    skeskErrPrefix skesk = "[" ++ describeSKESK skesk ++ "] "--    resolvePKESKCandidates ::-         (MonadFail m, MonadIO m)-      => [PKESKPayload]-      -> [String]-      -> [String]-      -> [PKESKResolverAttempt]-      -> m (SymmetricAlgorithm, SessionKey)-    resolvePKESKCandidates [] [] [] _ =-      fail "Encrypted data packet has no usable preceding SKESK or PKESK packet"-    resolvePKESKCandidates [] skeskErrs [] _ =-      fail-        ("Encrypted data packet has no usable preceding SKESK or PKESK packet; " ++-         "candidate errors: " ++ unwords (reverse skeskErrs))-    resolvePKESKCandidates [] skeskErrs pkeskErrs resolverAttempts =-      if allowManualPKESKPrompt-        then do-          let expectedSymAlgo = payloadExpectedSymmetricAlgorithm payloadFlavor-              errs = skeskErrs ++ pkeskErrs-          encodedSessionKey <--            BL.toStrict <$>-            liftIO-              (cb-                 "Input decrypted PKESK session key material (OpenPGP encoded or raw key bytes)")-          case decodePKESKSessionKey expectedSymAlgo encodedSessionKey of-            Left manualErr ->-              fail-                ("Encrypted data packet has no usable preceding SKESK or PKESK packet; " ++-                 "candidate errors: " ++-                 unwords (reverse errs) ++-                 "; manual input failed: " ++ manualErr)-            Right (sa, k) -> do-             emitResolutionReport-               (mkResolutionReport-                  DecryptResolvedViaManualPKESKInput-                  skeskErrs-                  pkeskErrs-                  resolverAttempts)-             pure (sa, SessionKey k)-        else-          fail-            ("Encrypted data packet has no usable preceding SKESK or PKESK packet; " ++-             "candidate errors: " ++-             unwords (reverse (skeskErrs ++ pkeskErrs)))-    resolvePKESKCandidates (pkesk:rest) skeskErrs pkeskErrs resolverAttempts = do-      let expectedSymAlgo = payloadExpectedSymmetricAlgorithm payloadFlavor-          errPrefix = "[" ++ describePKESK pkesk ++ "] "-      attemptPKESKCandidate [] [] 0 expectedSymAlgo errPrefix resolverAttempts-      where-        attemptPKESKCandidate attemptedSKeys previousFailures attemptIndex expectedSymAlgo errPrefix resolverAttemptsAcc = do-          let callbackProbeSummary = describeCallbackProbeSummary pkesk-          resolverResult <--            liftIO (resolvePKESKRecipientKey pkesk previousFailures attemptIndex)-          case resolverResult of-            Left resolverErr ->-             fail (errPrefix ++ resolverErr)-            Right (Nothing, _, newAttempts) ->-             let resolverAttempts' = resolverAttemptsAcc ++ newAttempts-                 terminalError =-                   case reverse previousFailures of-                     (latestFailure:_) -> errPrefix ++ pkeskAttemptFailureReason latestFailure-                     [] ->-                       errPrefix ++-                       "no matching key context (callback probes: " ++-                       callbackProbeSummary ++-                       ")"-             in-             resolvePKESKCandidates-               rest-               skeskErrs-               (terminalError : pkeskErrs)-               resolverAttempts'-            Right (Just keyInfo, nextAttemptIndex, newAttempts)-             | pkeskRecipientSKey keyInfo `elem` attemptedSKeys ->-                 let resolverAttempts' = resolverAttemptsAcc ++ newAttempts-                     terminalError =-                       case reverse previousFailures of-                         (latestFailure:_) -> errPrefix ++ pkeskAttemptFailureReason latestFailure-                         [] ->-                           errPrefix ++-                           "key context callback repeated without yielding a usable key"-                 in-                 resolvePKESKCandidates-                   rest-                   skeskErrs-                   (terminalError : pkeskErrs)-                   resolverAttempts'-             | otherwise -> do-                 let resolverAttempts' = resolverAttemptsAcc ++ newAttempts-                 unwrapped <- liftIO (tryUnwrapPKESKSessionMaterial pkesk keyInfo)-                 case unwrapped of-                   Left err ->-                     attemptPKESKCandidate-                       (pkeskRecipientSKey keyInfo : attemptedSKeys)-                       (previousFailures ++ [mkAttemptFailure keyInfo PKESKAttemptUnwrapFailed err])-                       nextAttemptIndex-                       expectedSymAlgo-                       errPrefix-                       resolverAttempts'-                   Right encodedSessionKey ->-                     case decodePKESKSessionKey expectedSymAlgo encodedSessionKey of-                       Left err ->-                         attemptPKESKCandidate-                            (pkeskRecipientSKey keyInfo : attemptedSKeys)-                            (previousFailures ++-                             [ mkAttemptFailure-                                 keyInfo-                                 PKESKAttemptSessionMaterialDecodeFailed-                                 err-                             ])-                            nextAttemptIndex-                            expectedSymAlgo-                            errPrefix-                            resolverAttempts'-                       Right (sa, k) -> do-                         emitResolutionReport-                           (mkResolutionReport-                               DecryptResolvedViaPKESK-                               skeskErrs-                               pkeskErrs-                               resolverAttempts')-                         pure (sa, SessionKey k)--    emitResolutionReport :: MonadIO m => DecryptSessionKeyResolutionReport -> m ()-    emitResolutionReport report =-      case reportRef of-        Nothing -> pure ()-        Just ref -> liftIO (modifyIORef' ref (report :))--    mkResolutionReport ::-         DecryptSessionKeyResolutionPath-      -> [String]-      -> [String]-      -> [PKESKResolverAttempt]-      -> DecryptSessionKeyResolutionReport-    mkResolutionReport path skeskErrs pkeskErrs resolverAttempts =-      DecryptSessionKeyResolutionReport-        { decryptSessionResolutionPath = path-        , decryptSessionResolutionSKESKErrors = reverse skeskErrs-        , decryptSessionResolutionPKESKErrors = reverse pkeskErrs-        , decryptSessionResolutionResolverAttempts = resolverAttempts-        }--    mkAttemptFailure keyInfo failureKind reason =-      PKESKAttemptFailure-        { pkeskAttemptFailureKeyContext =-            recipientKeyContext keyInfo-        , pkeskAttemptFailureKind = failureKind-        , pkeskAttemptFailureReason = reason-        }--    recipientKeyContext :: PKESKRecipientKey -> Maybe (KeyVersion, PubKeyAlgorithm)-    recipientKeyContext keyInfo =-      fmap (\pk -> (_keyVersion pk, _pkalgo pk)) (pkeskRecipientPKPayload keyInfo)--    renderPKESKResolverError (ResolverPolicyDenied reason) =-      "resolver policy denied candidate selection: " ++ reason-    renderPKESKResolverError (ResolverBackendUnavailable reason) =-      "resolver backend unavailable: " ++ reason-    renderPKESKResolverError (ResolverInvalidResponse reason) =-      "resolver returned an invalid response: " ++ reason--    resolvePKESKRecipientKey payload previousFailures attemptIndex0 =-      probePacketVariants attemptIndex0 [] (pkeskCallbackPackets payload)-      where-        probePacketVariants attemptIndex attemptsAcc [] =-          pure (Right (Nothing, attemptIndex, reverse attemptsAcc))-        probePacketVariants attemptIndex attemptsAcc (probePkt:restProbePkts) = do-          let request =-                PKESKResolveRequest-                  { reqPKESK = payload-                  , reqProbePacket = probePkt-                  , reqIsWildcardRecipient = isWildcardPKESKPayload payload-                  , reqAttemptIndex = attemptIndex-                  , reqPreviousFailures = previousFailures-                  }-          resolveAction <--            pkcb request-          let attemptRecord =-                PKESKResolverAttempt-                  { pkeskResolverAttemptPreviousFailures = previousFailures-                  , pkeskResolverAttemptAction =-                      case resolveAction of-                        ResolveWith keyInfo ->-                          ResolverAttemptResolveWith (recipientKeyContext keyInfo)-                        ResolveSkip -> ResolverAttemptSkip-                        ResolveExhausted -> ResolverAttemptExhausted-                        ResolveFail resolverErr -> ResolverAttemptFail resolverErr-                  }-          case resolveAction of-            ResolveWith keyInfo ->-              pure-                (Right (Just keyInfo, attemptIndex + 1, reverse (attemptRecord : attemptsAcc)))-            ResolveSkip ->-              probePacketVariants-                (attemptIndex + 1)-                (attemptRecord : attemptsAcc)-                restProbePkts-            ResolveExhausted ->-              pure-                (Right (Nothing, attemptIndex + 1, reverse (attemptRecord : attemptsAcc)))-            ResolveFail resolverErr ->-              pure (Left (renderPKESKResolverError resolverErr))--    pkeskCallbackPackets payload =-      nub $-      case payload of-        PKESKPayloadV3Packet (PKESKPayloadV3 v rid pka mpis) ->-          map-            (\ridVariant ->-               PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 v ridVariant pka mpis)))-            (recipientIdCallbackVariantsV3 rid)-        PKESKPayloadV6Packet (PKESKPayloadV6 rid pka esk) ->-          map-            (\ridVariant ->-               PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 ridVariant pka esk)))-            (recipientIdCallbackVariants rid)--    describeCallbackProbeSummary payload =-      intercalate ", " (map describePKESKCallbackProbe (pkeskCallbackPackets payload))--    describePKESKCallbackProbe (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ rid pka _))) =-      "PKESK3 " ++-      show pka ++-      " rid=" ++-      show rid ++-      if isWildcardV3RecipientKeyId rid-        then " (wildcard)"-        else ""-    describePKESKCallbackProbe (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka _))) =-      "PKESK6 " ++ show pka ++ " rid=" ++ show rid-    describePKESKCallbackProbe pkt = show pkt--    recipientIdCallbackVariantsV3 rid-      | isWildcardV3RecipientKeyId rid = [rid]-      | otherwise = [rid, EightOctetKeyId (BL.replicate 8 0)]--    isWildcardV3RecipientKeyId (EightOctetKeyId rid) =-      BL.length rid == 8 && BL.all (== 0) rid--    recipientIdCallbackVariants rid-      | BL.length rid == 20 = [rid, BL.cons 0x04 rid]-      | BL.length rid == 21 && BL.head rid == 0x04 = [rid, BL.tail rid]-      | BL.length rid == 32 = [rid, BL.cons 0x06 rid]-      | BL.length rid == 33 && BL.head rid == 0x06 = [rid, BL.tail rid]-      | otherwise = [rid]--    isWildcardPKESKPayload (PKESKPayloadV3Packet (PKESKPayloadV3 _ (EightOctetKeyId rid) _ _)) =-      isWildcardV3RecipientKeyId (EightOctetKeyId rid)-    isWildcardPKESKPayload _ = False-    describePKESK payload =-      case classifyPKESKPayload payload of-        ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ rid pka _) ->-          "PKESK3 " ++ show pka ++ " rid=" ++ show rid-        ClassifiedPKESKPayloadV6 (PKESKPayloadV6 rid pka _) ->-          "PKESK6 " ++ show pka ++ " rid=" ++ show rid--    describeSKESK payload =-      case classifySKESKPayload payload of-        ClassifiedSKESKPayloadV4 (SKESKPayloadV4 sa s2k _) ->-          "SKESK4 " ++ show sa ++ " s2k=" ++ show s2k-        ClassifiedSKESKPayloadV6 (SKESKPayloadV6 sa aa s2k _ _ _) ->-          "SKESK6 " ++ show sa ++ "/" ++ show aa ++ " s2k=" ++ show s2k--data AlignedPendingESK (v :: EncryptedPayloadVersion) where-  LegacyAlignedSKESK :: SKESKPayloadV4 -> AlignedPendingESK 'LegacyEncryptedPayloadVersion-  LegacyAlignedPKESK :: PKESKPayloadV3 -> AlignedPendingESK 'LegacyEncryptedPayloadVersion-  SEIPDv2AlignedSKESK :: SKESKPayloadV6 -> AlignedPendingESK 'SEIPDv2EncryptedPayloadVersion-  SEIPDv2AlignedPKESK :: PKESKPayloadV6 -> AlignedPendingESK 'SEIPDv2EncryptedPayloadVersion-  -- | A version 3 PKESK that precedes a SEIPDv2 payload.-  ---  -- RFC 9580 §5.13 explicitly permits version 3 PKESKs before a version 2-  -- SEIPD packet, as a backward-compatibility allowance for implementations-  -- that cannot yet produce v6 key material.  The v3 PKESK carries the-  -- session key wrapped with legacy (v3) asymmetric key wrapping; the SEIPD-  -- v2 payload itself is still authenticated with modern AEAD.  This-  -- constructor therefore counts as "aligned" for SEIPDv2 — it does not-  -- indicate a mis-assembled message — even though the PKESK version does-  -- not match the SEIPD version.-  SEIPDv2AlignedLegacyPKESK :: PKESKPayloadV3 -> AlignedPendingESK 'SEIPDv2EncryptedPayloadVersion--alignedPrecedingESKs ::-     EncryptedPayloadFlavor v-  -> [PendingESK]-  -> [AlignedPendingESK v]-alignedPrecedingESKs LegacyEncryptedPayload =-  mapMaybe-    (\esk ->-       case esk of-         PendingSKESK (SKESKPayloadV4Packet skesk4) -> Just (LegacyAlignedSKESK skesk4)-         PendingPKESK (PKESKPayloadV3Packet pkesk3) -> Just (LegacyAlignedPKESK pkesk3)-         _ -> Nothing)-alignedPrecedingESKs (SEIPDv2EncryptedPayload _ _) =-  mapMaybe-    (\esk ->-       case esk of-         PendingSKESK (SKESKPayloadV6Packet skesk6) -> Just (SEIPDv2AlignedSKESK skesk6)-         PendingPKESK (PKESKPayloadV6Packet pkesk6) -> Just (SEIPDv2AlignedPKESK pkesk6)-         -- v3 PKESK before SEIPDv2 is explicitly allowed by RFC 9580 §5.13;-         -- see 'SEIPDv2AlignedLegacyPKESK' for details.-         PendingPKESK (PKESKPayloadV3Packet pkesk3) -> Just (SEIPDv2AlignedLegacyPKESK pkesk3)-         _ -> Nothing)--pendingESKsFromAligned :: [AlignedPendingESK v] -> [PendingESK]-pendingESKsFromAligned =-  map-    (\esk ->-       case esk of-         LegacyAlignedSKESK skesk4 -> PendingSKESK (SKESKPayloadV4Packet skesk4)-         LegacyAlignedPKESK pkesk3 -> PendingPKESK (PKESKPayloadV3Packet pkesk3)-         SEIPDv2AlignedSKESK skesk6 -> PendingSKESK (SKESKPayloadV6Packet skesk6)-         SEIPDv2AlignedPKESK pkesk6 -> PendingPKESK (PKESKPayloadV6Packet pkesk6)-         SEIPDv2AlignedLegacyPKESK pkesk3 -> PendingPKESK (PKESKPayloadV3Packet pkesk3))--payloadExpectedSymmetricAlgorithm :: EncryptedPayloadFlavor v -> Maybe SymmetricAlgorithm-payloadExpectedSymmetricAlgorithm LegacyEncryptedPayload = Nothing-payloadExpectedSymmetricAlgorithm (SEIPDv2EncryptedPayload sa _) = Just sa--payloadExpectedAEADAlgorithm :: EncryptedPayloadFlavor v -> Maybe AEADAlgorithm-payloadExpectedAEADAlgorithm LegacyEncryptedPayload = Nothing-payloadExpectedAEADAlgorithm (SEIPDv2EncryptedPayload _ aa) = Just aa--tryUnwrapPKESKSessionMaterial ::-     PKESKPayload -> PKESKRecipientKey -> IO (Either String B.ByteString)-tryUnwrapPKESKSessionMaterial pkesk keyInfo = do-  attempted <- try @SomeException (unwrapPKESKSessionMaterial pkesk keyInfo :: IO B.ByteString)-  pure (first displayException attempted)--data PKESKUnwrapCase where-  PKESKUnwrapV3RSA :: RSATypes.PrivateKey -> MPI -> PKESKUnwrapCase-  PKESKUnwrapV6RSA :: RSATypes.PrivateKey -> B.ByteString -> PKESKUnwrapCase-  PKESKUnwrapV6ECDH ::-       PKESKRecipientKey-    -> PubKeyAlgorithm-    -> B.ByteString-    -> ECDSA.PrivateKey-    -> PKESKUnwrapCase-  PKESKUnwrapV6XDHRaw ::-       PKESKRecipientKey-    -> PubKeyAlgorithm-    -> B.ByteString-    -> B.ByteString-    -> PKESKUnwrapCase-  PKESKUnwrapV3X25519FromECDH ::-       PKESKRecipientKey-    -> NonEmpty MPI-    -> ECDSA.PrivateKey-    -> PKESKUnwrapCase-  PKESKUnwrapV3X25519Raw ::-       PKESKRecipientKey-    -> NonEmpty MPI-    -> B.ByteString-    -> PKESKUnwrapCase-  PKESKUnwrapV3ECDH ::-       PKESKRecipientKey-    -> PubKeyAlgorithm-    -> NonEmpty MPI-    -> ECDSA.PrivateKey-    -> PKESKUnwrapCase--data ClassifiedPKESKPayload where-  ClassifiedPKESKPayloadV3 :: PKESKPayloadV3 -> ClassifiedPKESKPayload-  ClassifiedPKESKPayloadV6 :: PKESKPayloadV6 -> ClassifiedPKESKPayload--data ClassifiedPKESKRecipientKey where-  ClassifiedPKESKRecipientRSA ::-       PKESKRecipientKey -> RSATypes.PrivateKey -> ClassifiedPKESKRecipientKey-  ClassifiedPKESKRecipientECDH ::-       PKESKRecipientKey -> ECDSA.PrivateKey -> ClassifiedPKESKRecipientKey-  ClassifiedPKESKRecipientX25519 ::-       PKESKRecipientKey -> B.ByteString -> ClassifiedPKESKRecipientKey-  ClassifiedPKESKRecipientX448 ::-       PKESKRecipientKey -> B.ByteString -> ClassifiedPKESKRecipientKey-  ClassifiedPKESKRecipientUnsupported ::-       PKESKRecipientKey -> ClassifiedPKESKRecipientKey--classifyPKESKPayload :: PKESKPayload -> ClassifiedPKESKPayload-classifyPKESKPayload (PKESKPayloadV3Packet payloadV3) =-  ClassifiedPKESKPayloadV3 payloadV3-classifyPKESKPayload (PKESKPayloadV6Packet payloadV6) =-  ClassifiedPKESKPayloadV6 payloadV6--classifyPKESKRecipientKey :: PKESKRecipientKey -> ClassifiedPKESKRecipientKey-classifyPKESKRecipientKey keyInfo@(PKESKRecipientKey _ (RSAPrivateKey (RSA_PrivateKey privateKey))) =-  ClassifiedPKESKRecipientRSA keyInfo privateKey-classifyPKESKRecipientKey keyInfo@(PKESKRecipientKey _ (ECDHPrivateKey (ECDSA_PrivateKey privateKey))) =-  ClassifiedPKESKRecipientECDH keyInfo privateKey-classifyPKESKRecipientKey keyInfo@(PKESKRecipientKey _ (X25519PrivateKey privateKeyRaw)) =-  ClassifiedPKESKRecipientX25519 keyInfo privateKeyRaw-classifyPKESKRecipientKey keyInfo@(PKESKRecipientKey _ (X448PrivateKey privateKeyRaw)) =-  ClassifiedPKESKRecipientX448 keyInfo privateKeyRaw-classifyPKESKRecipientKey keyInfo =-  ClassifiedPKESKRecipientUnsupported keyInfo--pkeskPayloadAlgorithm :: PKESKPayload -> PubKeyAlgorithm-pkeskPayloadAlgorithm payload =-  case classifyPKESKPayload payload of-    ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka _) -> pka-    ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka _) -> pka--classifyPKESKUnwrapCase ::-     PKESKPayload-  -> PKESKRecipientKey-  -> Either String PKESKUnwrapCase-classifyPKESKUnwrapCase payload keyInfo =-  case (classifyPKESKPayload payload, classifyPKESKRecipientKey keyInfo) of-    ( ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka (mpi :| []))-      , ClassifiedPKESKRecipientRSA _ privateKey)-      | pka == RSA || pka == DeprecatedRSAEncryptOnly ->-          Right (PKESKUnwrapV3RSA privateKey mpi)-    ( ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka esk)-      , ClassifiedPKESKRecipientRSA _ privateKey)-      | pka == RSA ->-          Right (PKESKUnwrapV6RSA privateKey (BL.toStrict esk))-    ( ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka esk)-      , ClassifiedPKESKRecipientECDH recipientCtx privateKey)-      | pka == ECDH || pka == X25519 ->-          Right (PKESKUnwrapV6ECDH recipientCtx pka (BL.toStrict esk) privateKey)-    ( ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka esk)-      , ClassifiedPKESKRecipientX25519 recipientCtx privateKeyRaw)-      | pka == X25519 ->-          Right (PKESKUnwrapV6XDHRaw recipientCtx pka (BL.toStrict esk) privateKeyRaw)-    ( ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka esk)-      , ClassifiedPKESKRecipientX448 recipientCtx privateKeyRaw)-      | pka == X448 ->-          Right (PKESKUnwrapV6XDHRaw recipientCtx pka (BL.toStrict esk) privateKeyRaw)-    ( ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka mpis)-      , ClassifiedPKESKRecipientECDH recipientCtx privateKey)-      | pka == X25519 ->-          Right (PKESKUnwrapV3X25519FromECDH recipientCtx mpis privateKey)-    ( ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka mpis)-      , ClassifiedPKESKRecipientX25519 recipientCtx privateKeyRaw)-      | pka == X25519 ->-          Right (PKESKUnwrapV3X25519Raw recipientCtx mpis privateKeyRaw)-    ( ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka mpis)-      , ClassifiedPKESKRecipientECDH recipientCtx privateKey)-      | pka == ECDH || pka == X25519 ->-          Right (PKESKUnwrapV3ECDH recipientCtx pka mpis privateKey)-    (ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka _), _) ->-      Left ("PKESK key unwrap unsupported for packet algorithm " ++ show pka)-    (ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka _), _) ->-      Left-        ("PKESKv6 key unwrap unsupported for packet algorithm " ++-         show pka ++ " with secret key " ++ show (pkeskRecipientSKey keyInfo))--unwrapPKESKSessionMaterial ::-     (MonadFail m, MonadIO m) => PKESKPayload -> PKESKRecipientKey -> m B.ByteString-unwrapPKESKSessionMaterial pkesk keyInfo = do-  either fail pure (validateTable30Policy pkesk keyInfo)-  unwrapCase <- either fail pure (classifyPKESKUnwrapCase pkesk keyInfo)-  case unwrapCase of-    PKESKUnwrapV3RSA privateKey mpi ->-      rsaUnwrap-        privateKey-        (leftPadTo (rsaModulusBytes privateKey) (i2osp (unMPI mpi)))-    PKESKUnwrapV6RSA privateKey esk -> do-      normalized <- either fail pure (normalizePKESKv6RSAEsk privateKey esk)-      rsaUnwrap privateKey normalized-    PKESKUnwrapV6ECDH recipientCtx pka esk privateKey ->-      ecdhUnwrapV6 recipientCtx pka esk privateKey-    PKESKUnwrapV6XDHRaw recipientCtx pka esk privateKeyRaw ->-      ecdhUnwrapV6XDHRaw recipientCtx pka esk privateKeyRaw-    PKESKUnwrapV3X25519FromECDH recipientCtx mpis privateKey -> do-      recipientPKP <--        maybe-          (fail-             "X25519 PKESKv3 unwrap requires recipient PKPayload context; use conduitDecrypt with DecryptWithKeyring or DecryptWithUnwrapCandidatesCallback")-          pure-          (pkeskRecipientPKPayload recipientCtx)-      recipientSecretRaw <--        either fail pure (resolveX25519SecretRaw recipientPKP privateKey)-      x25519UnwrapV3 recipientCtx mpis recipientSecretRaw-    PKESKUnwrapV3X25519Raw recipientCtx mpis privateKeyRaw ->-      x25519UnwrapV3 recipientCtx mpis privateKeyRaw-    PKESKUnwrapV3ECDH recipientCtx pka mpis privateKey ->-      ecdhUnwrap recipientCtx pka mpis privateKey-  where-    validateTable30Policy :: PKESKPayload -> PKESKRecipientKey -> Either String ()-    validateTable30Policy payload recipientCtx =-      case pkeskRecipientPKPayload recipientCtx of-        Nothing -> Right ()-        Just recipientPKP ->-          case (pkeskPayloadAlgorithm payload, _pubkey recipientPKP) of-            (ECDH, ECDHPubKey _ kdfHA kdfSA) ->-              validateTable30PolicyForRecipient recipientPKP kdfHA kdfSA-            _ -> Right ()--    rsaUnwrap privateKey encryptedSessionMaterial = do-      decrypted <--        liftIO-          (P15.decryptSafer privateKey encryptedSessionMaterial ::-           IO (Either RSATypes.Error B.ByteString))-      case decrypted of-        Left err -> fail ("RSA PKESK decrypt failed: " ++ show err)-        Right decoded -> pure decoded--    normalizePKESKv6RSAEsk ::-         RSATypes.PrivateKey-      -> B.ByteString-      -> Either String B.ByteString-    normalizePKESKv6RSAEsk privateKey esk = do-      when (B.length esk < 2) $-        Left "PKESKv6 RSA ESK is too short to contain an MPI"-      let mpiBits =-            fromIntegral (B.index esk 0) `shiftL` 8 +-            fromIntegral (B.index esk 1)-          mpiLen = (mpiBits + 7) `div` 8-      when (B.length esk /= 2 + mpiLen) $-        Left-          ("PKESKv6 RSA ESK MPI length mismatch: expected " ++-           show (2 + mpiLen) ++ " octets, got " ++ show (B.length esk))-      let mpiPayload = B.drop 2 esk-      when (mpiBits > 0) $ do-        when (B.null mpiPayload) $-          Left "PKESKv6 RSA ESK MPI has non-zero bit length but empty payload"-        let firstOctet = B.head mpiPayload-            actualBits =-              (B.length mpiPayload - 1) * 8 + (8 - countLeadingZeros firstOctet)-        when (actualBits /= mpiBits) $-          Left-            ("PKESKv6 RSA ESK MPI bit-length mismatch: declared " ++-             show mpiBits ++ ", actual " ++ show actualBits)-      let modulusLen = rsaModulusBytes privateKey-      when (B.length mpiPayload > modulusLen) $-        Left-          ("PKESKv6 RSA ESK MPI payload exceeds recipient modulus size: " ++-           show (B.length mpiPayload) ++ " > " ++ show modulusLen)-      pure (leftPadTo modulusLen mpiPayload)--    ecdhUnwrap recipientCtx pka mpis privateKey = do-      recipientPKP <--        maybe-          (fail-             "ECDH PKESK unwrap requires recipient PKPayload context; use conduitDecrypt with DecryptWithKeyring or DecryptWithUnwrapCandidatesCallback")-          pure-          (pkeskRecipientPKPayload recipientCtx)-      case _pubkey recipientPKP of-        ECDHPubKey ecdhPub kdfHA kdfSA -> do-          (ephemeralBytes, wrappedSessionKeyBytes) <--            either fail pure (parseECDHPKESKMPIs mpis)-          sharedSecret <--            case ecdhPub of-              ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _)) -> do-                ephPoint <- parseUncompressedPointForCurve curve ephemeralBytes-                pure-                  (BA.convert-                     (ECCDH.getShared curve (ECDSA.private_d privateKey) ephPoint) ::-                   B.ByteString)-              EdDSAPubKey Ed25519 _ -> do-                recipientSecretRaw <--                  either fail pure (resolveX25519SecretRaw recipientPKP privateKey)-                recipientSecret <--                  either fail pure .-                  first show . CE.eitherCryptoError $-                  C25519.secretKey recipientSecretRaw-                ephBytes <- either fail pure (normalizeX25519EphemeralPublic ephemeralBytes)-                ephPub <--                  either fail pure .-                  first show . CE.eitherCryptoError $-                  C25519.publicKey ephBytes-                pure . BA.convert $ C25519.dh ephPub recipientSecret-              EdDSAPubKey Ed448 _ ->-                fail-                  "legacy ECDH PKESK unwrap does not support Curve448Legacy recipients"-              _ ->-                fail-                  "ECDH PKESK unwrap requires recipient ECDH public key to be ECDSA or X25519-compatible"-          param <- either fail pure (buildECDHKDFParam recipientPKP pka ecdhPub kdfHA kdfSA)-          kek <- either fail pure (deriveECDHKek kdfHA kdfSA sharedSecret param)-          let wrappedCandidates =-                candidateWrappedRFC3394CiphertextsForLegacyECDH-                  (LegacyECDHWrappedRFC3394Ciphertext wrappedSessionKeyBytes)-              validUnwraps =-                [ material-                | wrappedCandidate <- wrappedCandidates-                , Right decoded <- [aesKeyUnwrapRFC3394 kdfSA kek (unLegacyECDHWrappedRFC3394Ciphertext wrappedCandidate)]-                , Right material <- [parseLegacyECDHDecodedSessionMaterial decoded]-                ]-          case validUnwraps of-            (material:_) -> pure (encodeLegacyECDHSessionMaterial material)-            [] ->-              case aesKeyUnwrapRFC3394 kdfSA kek wrappedSessionKeyBytes of-                Left err -> fail err-                Right _ ->-                  fail-                    "legacy ECDH wrapped session key decrypted but decoded session material is malformed"-        _ ->-          fail-            "ECDH PKESK unwrap requires recipient PKPayload with ECDHPubKey parameters"--    ecdhUnwrapV6 recipientCtx pka esk privateKey = do-      recipientPKP <--        maybe-          (fail-             "ECDH PKESKv6 unwrap requires recipient PKPayload context; use conduitDecrypt with DecryptWithKeyring or DecryptWithUnwrapCandidatesCallback")-          pure-          (pkeskRecipientPKPayload recipientCtx)-      if pka == X25519-        then do-          recipientSecretRaw <--            either fail pure (resolveX25519SecretRaw recipientPKP privateKey)-          v6X25519Unwrap recipientPKP recipientSecretRaw esk-        else-          if pka == X448-            then-              fail-                "X448 PKESKv6 unwrap requires an X448PrivateKey recipient secret key and recipient PKPayload context"-            else-              case _pubkey recipientPKP of-                ECDHPubKey ecdhPub kdfHA kdfSA -> do-                  (ephemeralBytes, wrappedSessionKeyBytes) <--                    either fail pure (parsePKESKv6ECDHEsk pka esk)-                  case ecdhPub of-                    ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _)) -> do-                      ephPoint <- parseUncompressedPointForCurve curve ephemeralBytes-                      let sharedSecret =-                            BA.convert-                              (ECCDH.getShared curve (ECDSA.private_d privateKey) ephPoint) ::-                            B.ByteString-                      param <- either fail pure (buildECDHKDFParam recipientPKP pka ecdhPub kdfHA kdfSA)-                      kek <- either fail pure (deriveECDHKek kdfHA kdfSA sharedSecret param)-                      case aesKeyUnwrapRFC3394 kdfSA kek wrappedSessionKeyBytes of-                        Left err -> fail err-                        Right decoded -> pure decoded-                    EdDSAPubKey Ed25519 _ -> do-                      recipientSecretRaw <--                        either fail pure (resolveX25519SecretRaw recipientPKP privateKey)-                      recipientSecret <--                        either fail pure .-                        first show . CE.eitherCryptoError $-                        C25519.secretKey recipientSecretRaw-                      ephBytes <- either fail pure (normalizeX25519EphemeralPublic ephemeralBytes)-                      ephPub <--                        either fail pure .-                        first show . CE.eitherCryptoError $-                        C25519.publicKey ephBytes-                      let sharedSecret = BA.convert (C25519.dh ephPub recipientSecret) :: B.ByteString-                      param <- either fail pure (buildECDHKDFParam recipientPKP pka ecdhPub kdfHA kdfSA)-                      let rfc6637Result =-                            do kek <- deriveECDHKek kdfHA kdfSA sharedSecret param-                               aesKeyUnwrapRFC3394 kdfSA kek wrappedSessionKeyBytes-                      case rfc6637Result of-                        Right decoded -> pure decoded-                        Left rfc6637Err -> do-                          recipientPublicRaw <- either fail pure (extractX25519RecipientPublic recipientPKP)-                          let kekX25519 = deriveX25519Kek ephBytes recipientPublicRaw sharedSecret-                          case aesKeyUnwrapRFC3394 AES128 kekX25519 wrappedSessionKeyBytes of-                            Right decoded -> pure decoded-                            Left x25519Err ->-                              fail-                                ("ECDH PKESKv6 Curve25519 unwrap failed (RFC6637: " ++-                                 rfc6637Err ++ ", X25519: " ++ x25519Err ++ ")")-                    EdDSAPubKey Ed448 _ ->-                      fail-                        "ECDH PKESKv6 unwrap does not support Curve448Legacy recipients; use X448 PKESKv6 packets"-                    _ ->-                      fail-                        "ECDH PKESKv6 unwrap requires recipient ECDH public key to be ECDSA or X25519-compatible"-                _ ->-                  fail-                    "ECDH PKESKv6 unwrap requires recipient PKPayload with ECDHPubKey parameters"--    ecdhUnwrapV6XDHRaw recipientCtx pka esk privateKeyRaw = do-      recipientPKP <--        maybe-          (fail-             "X25519/X448 PKESKv6 unwrap requires recipient PKPayload context; use conduitDecrypt with DecryptWithKeyring or DecryptWithUnwrapCandidatesCallback")-          pure-          (pkeskRecipientPKPayload recipientCtx)-      case pka of-        X25519 -> v6X25519Unwrap recipientPKP (leftPadTo 32 privateKeyRaw) esk-        X448 -> v6X448Unwrap recipientPKP (leftPadTo 56 privateKeyRaw) esk-        _ ->-          fail-            ("X25519/X448 PKESKv6 unwrap only supports X25519/X448 packets; got " ++-             show pka)--    v6X25519Unwrap recipientPKP recipientSecretRaw esk = do-      recipientPublicRaw <- either fail pure (extractX25519RecipientPublic recipientPKP)-      (ephemeralBytes, wrappedSessionKeyBytes) <--        either fail pure (parsePKESKv6ECDHEsk X25519 esk)-      ephBytes <- either fail pure (normalizeX25519EphemeralPublic ephemeralBytes)-      recipientSecret <--        either fail pure .-        first show . CE.eitherCryptoError $-        C25519.secretKey (leftPadTo 32 recipientSecretRaw)-      ephPub <--        either fail pure .-        first show . CE.eitherCryptoError $-        C25519.publicKey ephBytes-      let sharedSecret = BA.convert (C25519.dh ephPub recipientSecret) :: B.ByteString-          kek = deriveX25519Kek ephBytes recipientPublicRaw sharedSecret-      case aesKeyUnwrapRFC3394 AES128 kek wrappedSessionKeyBytes of-        Left err -> fail err-        Right decoded -> pure decoded--    extractX25519RecipientPublic recipientPKP =-      case _pubkey recipientPKP of-        EdDSAPubKey Ed25519 point ->-          normalizeX25519EphemeralPublic (edPointBytes point)-        ECDHPubKey (EdDSAPubKey Ed25519 point) _ _ ->-          normalizeX25519EphemeralPublic (edPointBytes point)-        other ->-          Left-            ("X25519 PKESKv6 unwrap requires an X25519 recipient public key, got " ++-             show other)--    extractX448RecipientPublic recipientPKP =-      case _pubkey recipientPKP of-        EdDSAPubKey Ed448 point ->-          normalizeX448EphemeralPublic (edPointBytes point)-        ECDHPubKey (EdDSAPubKey Ed448 point) _ _ ->-          normalizeX448EphemeralPublic (edPointBytes point)-        other ->-          Left-            ("X448 PKESKv6 unwrap requires an X448 recipient public key, got " ++-             show other)--    resolveX25519SecretRaw recipientPKP privateKey = do-      recipientPublicRaw <- extractX25519RecipientPublic recipientPKP-      let secretBE = leftPadTo 32 (i2osp (ECDSA.private_d privateKey))-          candidates = [secretBE, B.reverse secretBE]-          matchesCandidate candidate =-            case CE.eitherCryptoError (C25519.secretKey candidate) of-              Right sk ->-                let derivedPub = BA.convert (C25519.toPublic sk) :: B.ByteString-                 in derivedPub == recipientPublicRaw-              Left _ -> False-      case filter matchesCandidate candidates of-        (candidate:_) -> Right candidate-        [] -> Right secretBE--    v6X448Unwrap recipientPKP recipientSecretRaw esk = do-      recipientPublicRaw <- either fail pure (extractX448RecipientPublic recipientPKP)-      (ephemeralBytes, wrappedSessionKeyBytes) <--        either fail pure (parsePKESKv6ECDHEsk X448 esk)-      ephBytes <- either fail pure (normalizeX448EphemeralPublic ephemeralBytes)-      recipientSecret <--        either fail pure .-        first show . CE.eitherCryptoError $-        C448.secretKey (leftPadTo 56 recipientSecretRaw)-      ephPub <--        either fail pure .-        first show . CE.eitherCryptoError $-        C448.publicKey ephBytes-      let sharedSecret = BA.convert (C448.dh ephPub recipientSecret) :: B.ByteString-          kek = deriveX448Kek ephBytes recipientPublicRaw sharedSecret-      case aesKeyUnwrapRFC3394 AES256 kek wrappedSessionKeyBytes of-        Left err -> fail err-        Right decoded -> pure decoded--    x25519UnwrapV3 recipientCtx mpis recipientSecretRaw = do-      recipientPKP <--        maybe-          (fail-             "X25519 PKESKv3 unwrap requires recipient PKPayload context; use conduitDecrypt with DecryptWithKeyring or DecryptWithUnwrapCandidatesCallback")-          pure-          (pkeskRecipientPKPayload recipientCtx)-      recipientPublicRaw <- either fail pure (extractX25519RecipientPublic recipientPKP)-      (ephemeralBytes, eskBytes) <--        either fail pure (parseECDHPKESKMPIs mpis)-      ephBytes <- either fail pure (normalizeX25519EphemeralPublic ephemeralBytes)-      recipientSecret <--        either fail pure .-        first show . CE.eitherCryptoError $-        C25519.secretKey (leftPadTo 32 recipientSecretRaw)-      ephPub <--        either fail pure .-        first show . CE.eitherCryptoError $-        C25519.publicKey ephBytes-      let sharedSecret = BA.convert (C25519.dh ephPub recipientSecret) :: B.ByteString-          kek9580 = deriveX25519Kek ephBytes recipientPublicRaw sharedSecret-          -- RFC9580 interpretation: eskBytes = algo_byte || AES-KW(raw_session_key)-          rfc9580Result = do-            (sessionAlgorithm, wrappedKey) <- parsePKESKv3X25519EskBytes eskBytes-            rawKey <- aesKeyUnwrapRFC3394 AES128 kek9580 wrappedKey-            expectedLen <- symmetricKeyLength sessionAlgorithm-            when (B.length rawKey /= expectedLen) $-              Left-                ("X25519 PKESKv3 unwrapped session key length mismatch for " ++-                 show sessionAlgorithm ++-                 ": expected " ++ show expectedLen ++ ", got " ++ show (B.length rawKey))-            Right-              (B.singleton (fromIntegral (fromFVal sessionAlgorithm)) <>-               rawKey <>-               checksum16Bytes rawKey)-      case rfc9580Result of-        Right result -> pure result-        Left rfc9580Err ->-          -- Fallback: legacy ECDH interpretation where the full eskBytes is-          -- AES-KW(algo || key || checksum || padding).  Try with the RFC9580-          -- X25519 KEK and, when available, the RFC6637 ECDH KEK derived from-          -- any ECDH parameters on the recipient public key.-          let kekPairs = (kek9580, AES128) : x25519LegacyECDHKekCandidates recipientPKP sharedSecret-              wrapped = LegacyECDHWrappedRFC3394Ciphertext eskBytes-              candidates = candidateWrappedRFC3394CiphertextsForLegacyECDH wrapped-              validResults =-                [ encodeLegacyECDHSessionMaterial material-                | (kek, kekSA) <- kekPairs-                , candidate <- candidates-                , Right decoded <--                    [aesKeyUnwrapRFC3394 kekSA kek (unLegacyECDHWrappedRFC3394Ciphertext candidate)]-                , Right material <- [parseLegacyECDHDecodedSessionMaterial decoded]-                ]-          in case validResults of-               (result:_) -> pure result-               [] ->-                 fail-                   ("X25519 PKESKv3 unwrap failed (RFC9580: " ++-                    rfc9580Err ++-                    "; legacy ECDH-style fallback also failed)")--    -- | Derive RFC6637 ECDH KEK candidates for legacy X25519 PKESKv3 fallback.-    -- Returns @(kek, kekAlgorithm)@ pairs for each plausible ECDH KDF-    -- parameterisation found on the recipient public key.-    x25519LegacyECDHKekCandidates ::-         SomePKPayload-      -> B.ByteString-      -> [(B.ByteString, SymmetricAlgorithm)]-    x25519LegacyECDHKekCandidates pkPayload sharedSecret =-      case _pubkey pkPayload of-        ECDHPubKey ecdhPub kdfHA kdfSA ->-          [ (kek, kdfSA)-          | Right param <- [buildECDHKDFParam pkPayload X25519 ecdhPub kdfHA kdfSA]-          , Right kek   <- [deriveECDHKek kdfHA kdfSA sharedSecret param]-          ]-        _ -> []--rsaModulusBytes :: RSATypes.PrivateKey -> Int-rsaModulusBytes (RSATypes.PrivateKey (RSATypes.PublicKey sizeField _ _) _ _ _ _ _ _) =-  if sizeField > 512-    then (sizeField + 7) `div` 8-    else sizeField--edPointBytes :: EdPoint -> B.ByteString-edPointBytes (PrefixedNativeEPoint (EPoint x)) = i2osp x-edPointBytes (NativeEPoint (EPoint x)) = i2osp x--parseECDHPKESKMPIs :: NonEmpty MPI -> Either String (B.ByteString, B.ByteString)-parseECDHPKESKMPIs (ephemeralMPI :| [wrappedMPI]) =-  Right (i2osp (unMPI ephemeralMPI), i2osp (unMPI wrappedMPI))-parseECDHPKESKMPIs _ =-  Left "ECDH PKESK must contain exactly two MPIs (ephemeral key, wrapped session key)"--newtype LegacyECDHWrappedRFC3394Ciphertext =-  LegacyECDHWrappedRFC3394Ciphertext-    { unLegacyECDHWrappedRFC3394Ciphertext :: B.ByteString-    }-  deriving (Eq)--newtype LegacyECDHSessionKey = LegacyECDHSessionKey { unLegacyECDHSessionKey :: B.ByteString }--newtype LegacyECDHSessionPadding = LegacyECDHSessionPadding { unLegacyECDHSessionPadding :: B.ByteString }--data LegacyECDHDecodedSessionMaterial =-  LegacyECDHDecodedSessionMaterial-    { legacyECDHSessionAlgorithm :: SymmetricAlgorithm-    , legacyECDHSessionKey :: LegacyECDHSessionKey-    , legacyECDHSessionPadding :: LegacyECDHSessionPadding-    }--candidateWrappedRFC3394CiphertextsForLegacyECDH ::-     LegacyECDHWrappedRFC3394Ciphertext -> [LegacyECDHWrappedRFC3394Ciphertext]-candidateWrappedRFC3394CiphertextsForLegacyECDH wrapped =-  let observedLen = B.length (unLegacyECDHWrappedRFC3394Ciphertext wrapped)-      plausibleWrappedLens = legacyECDHRFC3394WrappedLengths-      reconstructed =-        [ LegacyECDHWrappedRFC3394Ciphertext-            (if observedLen == targetLen-               then unLegacyECDHWrappedRFC3394Ciphertext wrapped-               else leftPadTo targetLen (unLegacyECDHWrappedRFC3394Ciphertext wrapped))-        | targetLen <- plausibleWrappedLens-        , targetLen >= observedLen-        ]-   in nub (wrapped : reconstructed)--legacyECDHRFC3394WrappedLengths :: [Int]-legacyECDHRFC3394WrappedLengths =-  map legacyRFC3394WrappedLenForKeyLen [16, 24, 32]-  where-    legacyRFC3394WrappedLenForKeyLen keyLen =-      let encodedLen = 1 + keyLen + 2-          paddedLen = ((encodedLen + 7) `div` 8) * 8-       in paddedLen + 8--parseLegacyECDHDecodedSessionMaterial ::-     B.ByteString -> Either String LegacyECDHDecodedSessionMaterial-parseLegacyECDHDecodedSessionMaterial decoded = do-  when (B.length decoded < 3) $-    Left "legacy ECDH decoded session material is too short"-  let sessionAlgorithm = toFVal (B.head decoded)-  sessionKeyLen <- symmetricKeyLength sessionAlgorithm-  let payload = B.tail decoded-  when (B.length payload < sessionKeyLen + 2) $-    Left "legacy ECDH decoded session material does not contain full key and checksum"-  let (sessionKey, checksumAndPad) = B.splitAt sessionKeyLen payload-      (checksumBytes, padBytes) = B.splitAt 2 checksumAndPad-      expectedChecksum =-        fromIntegral (B.index checksumBytes 0) `shiftL` 8 +-        fromIntegral (B.index checksumBytes 1)-      actualChecksum = checksum16 sessionKey-  when (actualChecksum /= expectedChecksum) $-    Left "legacy ECDH decoded session-key checksum mismatch"-  if B.null padBytes || B.all (== 0) padBytes-    then-      Right-        (LegacyECDHDecodedSessionMaterial-           sessionAlgorithm-           (LegacyECDHSessionKey sessionKey)-           (LegacyECDHSessionPadding padBytes))-    else do-      validatePKCS7Padding padBytes-      Right-        (LegacyECDHDecodedSessionMaterial-           sessionAlgorithm-           (LegacyECDHSessionKey sessionKey)-           (LegacyECDHSessionPadding padBytes))--encodeLegacyECDHSessionMaterial :: LegacyECDHDecodedSessionMaterial -> B.ByteString-encodeLegacyECDHSessionMaterial-  (LegacyECDHDecodedSessionMaterial sessionAlgorithm (LegacyECDHSessionKey sessionKey) _) =-  B.singleton (fromIntegral (fromFVal sessionAlgorithm)) <>-  sessionKey <>-  checksum16Bytes sessionKey--parsePKESKv6ECDHEsk :: PubKeyAlgorithm -> B.ByteString -> Either String (B.ByteString, B.ByteString)-parsePKESKv6ECDHEsk pka esk-  | pka == X25519 =-      case parseFixedEphemeralWithWrappedLen 32 esk of-        Right parsed -> Right parsed-        Left _ -> parseLenPrefixedEphemeral 32 esk-  | pka == X448 =-      case parseFixedEphemeralWithWrappedLen 56 esk of-        Right parsed -> Right parsed-        Left _ -> parseLenPrefixedEphemeral 56 esk-  | B.length esk < 33 =-      Left "PKESKv6 ECDH ESK is too short"-  | otherwise =-      let withLen =-            let ephLen = fromIntegral (B.head esk)-                rest = B.tail esk-             in if ephLen > 0 && B.length rest > ephLen-                  then-                    let (eph, wrapped) = B.splitAt ephLen rest-                     in if validWrappedPayload wrapped-                          then Just (eph, wrapped)-                          else Nothing-                  else Nothing-          fixed32WithWrappedLen = parseFixedEphemeralWithWrappedLenMaybe 32 esk-          fixed32 =-            let (eph, wrapped) = B.splitAt 32 esk-             in if validWrappedPayload wrapped-                  then Just (eph, wrapped)-                  else Nothing-          mpiWithWrappedLen =-            if B.length esk >= 4-              then-                let mpiBits = fromIntegral (B.index esk 0) `shiftL` 8 + fromIntegral (B.index esk 1)-                    mpiLen = (mpiBits + 7) `div` 8-                    rest = B.drop (2 + mpiLen) esk-                 in if mpiLen > 0 && B.length esk > 2 + mpiLen && not (B.null rest)-                      then-                        let eph = B.take mpiLen (B.drop 2 esk)-                            wrappedLen = fromIntegral (B.head rest)-                            wrapped = B.tail rest-                         in if wrappedLen == B.length wrapped && validWrappedPayload wrapped-                              then Just (eph, wrapped)-                              else Nothing-                      else Nothing-              else Nothing-       in case fixed32WithWrappedLen <|> withLen <|> fixed32 <|> mpiWithWrappedLen of-            Just x -> Right x-            Nothing ->-              Left-                "PKESKv6 ECDH ESK could not be parsed as {ephemeral32||len||wrapped}, {len||ephemeral||wrapped}, {ephemeral32||wrapped}, or {mpi(ephemeral)||len||wrapped}"-  where-    validWrappedPayload wrapped = B.length wrapped >= 24 && B.length wrapped `mod` 8 == 0--    parseFixedEphemeralWithWrappedLenMaybe ephLen payload =-      let (eph, rest) = B.splitAt ephLen payload-       in if B.length rest >= 2-            then-              let wrappedLen = fromIntegral (B.head rest)-                  wrapped = B.tail rest-               in if wrappedLen == B.length wrapped && validWrappedPayload wrapped-                    then Just (eph, wrapped)-                    else Nothing-            else Nothing--    parseFixedEphemeralWithWrappedLen ephLen payload =-      maybe-        (Left-           ("PKESKv6 XDH ESK expected {ephemeral" ++-            show ephLen ++ "||len||wrapped} framing"))-        Right-        (parseFixedEphemeralWithWrappedLenMaybe ephLen payload)--    parseLenPrefixedEphemeral expectedLen payload =-      if B.null payload-        then Left "PKESKv6 XDH ESK is empty"-        else-          let ephLen = fromIntegral (B.head payload)-              rest = B.tail payload-           in if ephLen == expectedLen && B.length rest > ephLen-                then-                  let (eph, wrapped) = B.splitAt ephLen rest-                   in if validWrappedPayload wrapped-                        then Right (eph, wrapped)-                        else Left "PKESKv6 XDH ESK wrapped payload has invalid length"-                else-                  Left-                    ("PKESKv6 XDH ESK expected " ++-                     show expectedLen ++ "-octet ephemeral value")--normalizeX25519EphemeralPublic :: B.ByteString -> Either String B.ByteString-normalizeX25519EphemeralPublic =-  normalizeMontgomeryPublic-    32-    "invalid X25519 ephemeral public key length/prefix: "--normalizeX448EphemeralPublic :: B.ByteString -> Either String B.ByteString-normalizeX448EphemeralPublic =-  normalizeMontgomeryPublic-    56-    "invalid X448 ephemeral public key length/prefix: "--parseUncompressedPointForCurve :: MonadFail m => ECCT.Curve -> B.ByteString -> m ECCT.Point-parseUncompressedPointForCurve curve bs-  | B.length bs < 1 = fail "ECDH ephemeral point is empty"-  | Just expectedLen <- expectedUncompressedPointLength curve-  , B.length bs /= expectedLen =-      fail-        ("ECDH ephemeral point has invalid length for recipient curve: expected " ++-         show expectedLen ++ ", got " ++ show (B.length bs))-  | B.head bs /= 0x04 = fail "ECDH ephemeral point must be uncompressed (0x04)"-  | otherwise =-      let xy = B.tail bs-       in if odd (B.length xy)-            then fail "ECDH ephemeral point has malformed coordinate length"-            else-              let (xb, yb) = B.splitAt (B.length xy `div` 2) xy-               in pure (ECCT.Point (os2ip xb) (os2ip yb))--expectedUncompressedPointLength :: ECCT.Curve -> Maybe Int-expectedUncompressedPointLength curve-  | curve == ECCT.getCurveByName ECCT.SEC_p256r1 = Just 65-  | curve == ECCT.getCurveByName ECCT.SEC_p384r1 = Just 97-  | curve == ECCT.getCurveByName ECCT.SEC_p521r1 = Just 133-  | otherwise = Nothing--deriveX25519Kek :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString-deriveX25519Kek ephemeralPublic recipientPublic sharedSecret =-  let ikm = ephemeralPublic <> recipientPublic <> sharedSecret-      prk = extract @CHA.SHA256 B.empty ikm-      info :: B.ByteString-      info = "OpenPGP X25519"-      okm :: B.ByteString-      okm = expand @CHA.SHA256 prk info 16-   in okm--deriveX448Kek :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString-deriveX448Kek ephemeralPublic recipientPublic sharedSecret =-  let ikm = ephemeralPublic <> recipientPublic <> sharedSecret-      prk = extract @CHA.SHA512 B.empty ikm-      info :: B.ByteString-      info = "OpenPGP X448"-      okm :: B.ByteString-      okm = expand @CHA.SHA512 prk info 32-   in okm--aesKeyUnwrapRFC3394 ::-     SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString-aesKeyUnwrapRFC3394 sa kek wrapped =-  withAESCipher "ECDH PKESK currently supports AES KEK algorithms only" sa kek unwrapWithCipher-  where-    unwrapWithCipher ::-         CCT.BlockCipher cipher-      => cipher-      -> Either String B.ByteString-    unwrapWithCipher cipher = do-      when (B.length wrapped < 24 || B.length wrapped `mod` 8 /= 0) $-        Left "ECDH wrapped session key must be at least 24 octets and a multiple of 8"-      let (a0, rBytes) = B.splitAt 8 wrapped-          rs = chunksOf8 rBytes-      when (length rs < 2) $-        Left "ECDH wrapped session key must contain at least two 64-bit blocks"-      (aFinal, rFinal) <- unwrapRounds cipher a0 rs-      when (aFinal /= B.replicate 8 0xA6) $-        Left "ECDH wrapped session key integrity check failed"-      Right (B.concat rFinal)--    unwrapRounds ::-         CCT.BlockCipher cipher-      => cipher-      -> B.ByteString-      -> [B.ByteString]-      -> Either String (B.ByteString, [B.ByteString])-    unwrapRounds cipher aInit rsInit = goJ 5 aInit rsInit-      where-        n = length rsInit-        goJ j aState rsState-          | j < 0 = Right (aState, rsState)-          | otherwise = do-              (a', rs') <- goI n aState rsState-              goJ (j - 1) a' rs'-          where-            goI i aCurrent rsCurrent-              | i <= 0 = Right (aCurrent, rsCurrent)-              | otherwise = do-                  let t = fromIntegral (n * j + i) :: Word64-                      aXorT = xorBS aCurrent (encodeWord64be t)-                      rI = rsCurrent !! (i - 1)-                      block = CCT.ecbDecrypt cipher (aXorT <> rI)-                      (aNext, rNext) = B.splitAt 8 block-                      rsNext = (ix (i - 1) .~ rNext) rsCurrent-                  goI (i - 1) aNext rsNext--chunksOf8 :: B.ByteString -> [B.ByteString]-chunksOf8 bs-  | B.null bs = []-  | otherwise =-      let (h, t) = B.splitAt 8 bs-       in h : chunksOf8 t--xorBS :: B.ByteString -> B.ByteString -> B.ByteString-xorBS a b = B.pack (B.zipWith xor a b)--decodePKESKSessionKey ::-     Maybe SymmetricAlgorithm-  -> B.ByteString-  -> Either String (SymmetricAlgorithm, B.ByteString)-decodePKESKSessionKey expectedSymAlgo encodedSessionKey =-  case decodeOpenPGPEncodedSessionKey encodedSessionKey of-    Right (symalgo, sessionKey) ->-      case expectedSymAlgo of-        Just expected | expected /= symalgo ->-          Left "Decrypted PKESK symmetric algorithm does not match payload"-        _ -> Right (symalgo, sessionKey)-    Left decodeErr ->-      case expectedSymAlgo of-        Nothing ->-          Left-            ("PKESK session key material must be OpenPGP encoded when payload algorithm is unknown: " ++-             renderEncodedSessionKeyError decodeErr)-        Just expected -> do-          expectedLen <- symmetricKeyLength expected-          case decodeExpectedRawOrPaddedSessionKey expected expectedLen encodedSessionKey of-            Left err -> Left err-            Right sessionKey -> Right (expected, sessionKey)--parsePKESKv3X25519EskBytes ::-     B.ByteString -> Either String (SymmetricAlgorithm, B.ByteString)-parsePKESKv3X25519EskBytes eskBytes = do-  when (B.length eskBytes < 2) $-    Left "PKESKv3 X25519 ESK field is too short"-  let sessionAlgorithm = toFVal (B.head eskBytes)-      wrappedSessionKeyBytes = B.tail eskBytes-  when (sessionAlgorithm `notElem` [AES128, AES192, AES256]) $-    Left "PKESKv3 X25519 ESK field uses unsupported symmetric algorithm"-  when (B.length wrappedSessionKeyBytes < 24 || B.length wrappedSessionKeyBytes `mod` 8 /= 0) $-    Left "PKESKv3 X25519 wrapped session key must be at least 24 octets and a multiple of 8"-  pure (sessionAlgorithm, wrappedSessionKeyBytes)--decodeExpectedRawOrPaddedSessionKey ::-     SymmetricAlgorithm -> Int -> B.ByteString -> Either String B.ByteString-decodeExpectedRawOrPaddedSessionKey expected expectedLen encodedSessionKey-  | B.length encodedSessionKey == expectedLen = Right encodedSessionKey-  | otherwise =-      case decodeV6PaddedSessionKeyWithoutAlgo expectedLen encodedSessionKey of-        Right sessionKey -> Right sessionKey-        Left _ ->-          case decodeV6PaddedSessionKeyWithAlgo expected expectedLen encodedSessionKey of-            Right sessionKey -> Right sessionKey-            Left _ ->-              Left "PKESK raw session key length does not match payload algorithm"--decodeV6PaddedSessionKeyWithoutAlgo :: Int -> B.ByteString -> Either String B.ByteString-decodeV6PaddedSessionKeyWithoutAlgo expectedLen encodedSessionKey = do-  when (B.length encodedSessionKey < expectedLen + 2) $-    Left "v6 ECDH decoded session material is too short"-  let (sessionKey, rest) = B.splitAt expectedLen encodedSessionKey-      (checksumBytes, padBytes) = B.splitAt 2 rest-      expectedChecksum =-        fromIntegral (B.index checksumBytes 0) `shiftL` 8 +-        fromIntegral (B.index checksumBytes 1)-      actualChecksum = checksum16 sessionKey-  when (actualChecksum /= expectedChecksum) $-    Left "v6 ECDH decoded session-key checksum mismatch"-  validatePKCS7Padding padBytes-  Right sessionKey--decodeV6PaddedSessionKeyWithAlgo ::-     SymmetricAlgorithm -> Int -> B.ByteString -> Either String B.ByteString-decodeV6PaddedSessionKeyWithAlgo expected expectedLen encodedSessionKey = do-  when (B.length encodedSessionKey < expectedLen + 3) $-    Left "v6 ECDH decoded session material with algorithm octet is too short"-  let algOctet = B.head encodedSessionKey-  when (toFVal algOctet /= expected) $-    Left "v6 ECDH decoded session material algorithm mismatch"-  let rest = B.tail encodedSessionKey-      (sessionKey, checksumAndPad) = B.splitAt expectedLen rest-      (checksumBytes, padBytes) = B.splitAt 2 checksumAndPad-      expectedChecksum =-        fromIntegral (B.index checksumBytes 0) `shiftL` 8 +-        fromIntegral (B.index checksumBytes 1)-      actualChecksum = checksum16 sessionKey-  when (actualChecksum /= expectedChecksum) $-    Left "v6 ECDH decoded session-key checksum mismatch"-  validatePKCS7Padding padBytes-  Right sessionKey--validatePKCS7Padding :: B.ByteString -> Either String ()-validatePKCS7Padding padBytes-  | B.null padBytes = Right ()-  | otherwise = do-      let padLen = fromIntegral (B.last padBytes) :: Int-      when (padLen <= 0 || padLen > 8 || B.length padBytes /= padLen) $-        Left "v6 ECDH decoded session material has invalid PKCS#7-style padding length"-      when (B.any (/= fromIntegral padLen) padBytes) $-        Left "v6 ECDH decoded session material has invalid PKCS#7-style padding bytes"--symmetricKeyLength :: SymmetricAlgorithm -> Either String Int-symmetricKeyLength = first renderCipherError . keySize--checksum16 :: B.ByteString -> Word16-checksum16 =-  fromIntegral .-  B.foldl' (\acc octet -> (acc + fromIntegral octet) `mod` (65536 :: Integer)) 0--checksum16Bytes :: B.ByteString -> B.ByteString-checksum16Bytes sessionKey =-  B.pack [fromIntegral (chk `shiftR` 8), fromIntegral chk]+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE TypeApplications #-}++module Data.Conduit.OpenPGP.Decrypt+    ( conduitDecrypt+    , conduitDecryptWithReport+    , DecryptOptions (..)+    , DecryptKeyResolution (..)+    , PKESKRecipientKey (..)+    , PKESKAttemptFailureKind (..)+    , PKESKAttemptFailure (..)+    , DecryptOutcome (..)+    , DecryptReport (..)+    , DecryptSessionKeyResolutionReport (..)+    , DecryptSessionKeyResolutionPath (..)+    , PKESKResolverAttempt (..)+    , PKESKResolverAttemptAction (..)+    , decryptSEIPDv2Payload+    ) where++import Control.Applicative ((<|>))+import Control.Exception (SomeException, displayException, try)+import Control.Lens (ix, (.~))+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)+import Control.Monad.Trans.Resource (MonadResource, MonadThrow)+import qualified Crypto.Error as CE+import qualified Crypto.Hash as CH+import qualified Crypto.Hash.Algorithms as CHA+import Crypto.KDF.HKDF (expand, extract)+import Crypto.Number.Serialize (i2osp, os2ip)+import qualified Crypto.PubKey.Curve25519 as C25519+import qualified Crypto.PubKey.Curve448 as C448+import qualified Crypto.PubKey.ECC.DH as ECCDH+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.ECC.Types as ECCT+import qualified Crypto.PubKey.RSA.PKCS15 as P15+import qualified Crypto.PubKey.RSA.Types as RSATypes+import Data.Bifunctor (first)+import Data.Binary (get)+import Data.Binary.Put (putWord64be, runPut)+import Data.Bits (countLeadingZeros, shiftL, shiftR, xor)+import qualified Data.ByteArray as BA+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Conduit+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.List as CL+import Data.Conduit.Serialization.Binary (conduitGet)+import Data.IORef+    ( IORef+    , modifyIORef'+    , newIORef+    , readIORef+    , writeIORef+    )+import qualified Data.IxSet.Typed as IxSet+import Data.List (intercalate, nub)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (catMaybes, isNothing, mapMaybe)+import Data.Word (Word16, Word64, Word8)+import qualified "crypton" Crypto.Cipher.Types as CCT++import Codec.Encryption.OpenPGP.BlockCipher+    ( keySize+    , renderCipherError+    )+import Codec.Encryption.OpenPGP.CFB+    ( calculateMDC+    , decryptOpenPGPCfb+    , decryptPreservingNonce+    , validateSEIPD1MDC+    )+import Codec.Encryption.OpenPGP.Fingerprint (fingerprint)+import Codec.Encryption.OpenPGP.Internal (leftPadTo)+import Codec.Encryption.OpenPGP.Internal.CryptoAES+    ( withAESCipher+    )+import Codec.Encryption.OpenPGP.Internal.CryptoECDH+    ( buildECDHKDFParam+    , deriveECDHKek+    , normalizeMontgomeryPublic+    )+import Codec.Encryption.OpenPGP.Internal.CryptoSEIPDv2+    ( aeadModeAndNonceSizeForSEIPDv2+    , decryptSKESK6SessionKey+    , deriveSKESK6KEK+    , seipdv2SymmetricKeySize+    )+import Codec.Encryption.OpenPGP.Internal.RFC7253OCB+    ( decryptWithOCBRFC7253With+    )+import Codec.Encryption.OpenPGP.Policy+    ( DecryptPolicy (..)+    , defaultDecryptPolicy+    , validateTable30PolicyForRecipient+    )+import Codec.Encryption.OpenPGP.S2K+    ( S2KError (..)+    , decodeOpenPGPEncodedSessionKey+    , renderEncodedSessionKeyError+    , renderS2KError+    , skesk2Key+    , skesk2SessionKey+    , string2Key+    )+import Codec.Encryption.OpenPGP.SecretKey (decryptPrivateKey)+import Codec.Encryption.OpenPGP.Types+import Data.Conduit.OpenPGP.Compression (conduitDecompress)+import Data.Conduit.OpenPGP.Keyring.Instances ()++data RecursorState+    = RecursorState+    { _depth :: Int+    , _pendingESKs :: [PendingESK]+    , _lastNonce :: Maybe B.ByteString+    , _lastClearText :: Maybe B.ByteString+    , _decryptPolicy :: DecryptPolicy+    }+    deriving (Eq, Show)++def :: RecursorState+def = RecursorState 0 [] Nothing Nothing defaultDecryptPolicy++data DecryptStreamPhase+    = ActiveDecryptPhase+    | FinishedDecryptPhase+    | MalformedDecryptPhase++data DecryptStreamState (phase :: DecryptStreamPhase) where+    ActiveDecryptState+        :: RecursorState+        -> DecryptStreamState 'ActiveDecryptPhase+    FinishedDecryptState+        :: RecursorState+        -> Bool+        -> DecryptStreamState 'FinishedDecryptPhase+    MalformedDecryptState+        :: RecursorState+        -> String+        -> DecryptStreamState 'MalformedDecryptPhase++data SomeDecryptStreamState where+    SomeDecryptStreamState+        :: DecryptStreamState phase+        -> SomeDecryptStreamState++data PendingESK+    = PendingPKESK PKESKPayload+    | PendingSKESK SKESKPayload+    deriving (Eq, Show)++data EncryptedPayloadVersion+    = LegacyEncryptedPayloadVersion+    | SEIPDv2EncryptedPayloadVersion++data EncryptedPayloadFlavor (v :: EncryptedPayloadVersion) where+    LegacyEncryptedPayload+        :: EncryptedPayloadFlavor 'LegacyEncryptedPayloadVersion+    SEIPDv2EncryptedPayload+        :: SymmetricAlgorithm+        -> AEADAlgorithm+        -> EncryptedPayloadFlavor 'SEIPDv2EncryptedPayloadVersion++type InputCallback m = String -> m BL.ByteString++data PKESKRecipientKey+    = PKESKRecipientKey+    { pkeskRecipientPKPayload :: Maybe SomePKPayload+    {- ^ Public key payload for the recipient.  Required for X25519, X448,+    and ECDH unwrap paths; may be 'Nothing' for RSA.+    -}+    , pkeskRecipientSKey :: SKey+    -- ^ Corresponding secret key.+    }++data PKESKAttemptFailure+    = PKESKAttemptFailure+    { pkeskAttemptFailureKeyContext+        :: Maybe (KeyVersion, PubKeyAlgorithm)+    , pkeskAttemptFailureKind :: PKESKAttemptFailureKind+    , pkeskAttemptFailureReason :: String+    }+    deriving (Eq, Show)++data PKESKAttemptFailureKind+    = PKESKAttemptUnwrapFailed+    | PKESKAttemptSessionMaterialDecodeFailed+    deriving (Eq, Show)++data PKESKResolverError+    = ResolverPolicyDenied String+    | ResolverBackendUnavailable String+    | ResolverInvalidResponse String+    deriving (Eq, Show)++data PKESKResolveRequest+    = PKESKResolveRequest+    { reqPKESK :: PKESKPayload+    , reqProbePacket :: Pkt+    , reqIsWildcardRecipient :: Bool+    , reqAttemptIndex :: Int+    , reqPreviousFailures :: [PKESKAttemptFailure]+    }+    deriving (Eq, Show)++data PKESKResolveAction+    = ResolveWith PKESKRecipientKey+    | ResolveSkip+    | ResolveExhausted+    | ResolveFail PKESKResolverError++type PKESKResolver m =+    PKESKResolveRequest -> m PKESKResolveAction++{- | Build a stateful 'PKESKResolver' that iterates over a pre-populated+candidate list. The returned resolver yields candidates in order and+returns 'ResolveExhausted' once the list is depleted.+| How to resolve secret keys for PKESK-encrypted messages.+-}+data DecryptKeyResolution+    = {- | Do not attempt PKESK decryption; fall through to manual session-key+      input via the passphrase callback instead.+      -}+      DecryptWithoutPKESK+    | {- | Resolve secret keys from a 'SecretKeyring'. Only unencrypted secret+      keys (not passphrase-protected) are used. For passphrase-protected keys,+      use 'DecryptWithKeyringAndPassphrase'.+      -}+      DecryptWithKeyring SecretKeyring+    | {- | Resolve secret keys from a 'SecretKeyring', unlocking passphrase-+      protected keys using the provided callback. The callback receives the+      public key payload and returns the passphrase, or 'Nothing' to skip.+      -}+      DecryptWithKeyringAndPassphrase+        SecretKeyring+        (SomePKPayload -> IO (Maybe BL.ByteString))+    | {- | Preferred callback form for non-keyring key material. The callback+      receives a typed key identifier (8-octet key ID, fingerprint, or+      wildcard) plus the packet public-key algorithm, then returns all+      matching candidates in priority order. hOpenPGP iterates candidates+      deterministically without re-calling the callback for each retry.+      -}+      DecryptWithUnwrapCandidatesCallback+        (KeyIdentifier -> PubKeyAlgorithm -> IO [PKESKRecipientKey])++{- | Canonical decrypt configuration.++Most callers should prefer 'conduitDecrypt' and set:++* 'decryptOptionsKeyResolution' to 'DecryptWithKeyring' or 'DecryptWithKeyringAndPassphrase'+* 'decryptOptionsPolicy' to strict ('defaultDecryptPolicy') or lenient+* 'decryptOptionsPassphraseCallback' for SKESK passphrase lookup+-}+data DecryptOptions+    = DecryptOptions+    { decryptOptionsKeyResolution :: DecryptKeyResolution+    , decryptOptionsPolicy :: DecryptPolicy+    , decryptOptionsPassphraseCallback :: InputCallback IO+    }++{- | Outcome of a checked decrypt conduit run.++Use 'conduitDecrypt' to obtain this value. Because+'Data.Conduit..|' preserves the+/rightmost/ conduit's return value, callers who also need the decrypted+packet stream should use 'Data.Conduit.fuseBoth':++@+(outcome, pkts) \<- runConduit $ source .| fuseBoth (conduitDecrypt opts) CL.consume+@+-}+data DecryptOutcome+    = {- | The integrity-terminating marker (MDC or SEIPD v2 final AEAD tag)+      was seen and no further packets arrived.  The message was+      well-formed end-to-end.+      -}+      DecryptClean+    | {- | The input stream ended before any integrity-terminating marker was+      seen.  The ciphertext was incomplete.+      -}+      DecryptTruncated+    | {- | An integrity-terminating marker was seen, but additional packets+      followed it.  Only possible with 'lenientDecryptPolicy' (strict+      policy reports 'DecryptMalformedStructure' instead).  The trailing+      packets were forwarded downstream unchanged.+      -}+      DecryptTrailingData+    | {- | A structural packet-sequencing violation was detected.  The+      'String' describes the specific violation:++      * PKESK version does not match the SEIPD version (e.g. a v6 PKESK+      preceding a SEIPDv1 payload, or a v4 SKESK preceding a SEIPDv2+      payload).++      * ESK packets arrived in the wrong order relative to the encrypted+      data packet (e.g. a literal-data packet appeared between a PKESK+      and the SEIPD it was intended to protect).++      * A packet arrived after the message integrity boundary (trailing+      data).  Under 'defaultDecryptPolicy' this is reported here; under+      'lenientDecryptPolicy' it is reported as 'DecryptTrailingData'+      instead.+      -}+      DecryptMalformedStructure String+    deriving (Eq, Show)++data DecryptSessionKeyResolutionPath+    = DecryptResolvedViaSKESK+    | DecryptResolvedViaPKESK+    | DecryptResolvedViaManualPKESKInput+    deriving (Eq, Show)++data PKESKResolverAttemptAction+    = ResolverAttemptResolveWith (Maybe (KeyVersion, PubKeyAlgorithm))+    | ResolverAttemptSkip+    | ResolverAttemptExhausted+    | ResolverAttemptFail PKESKResolverError+    deriving (Eq, Show)++data PKESKResolverAttempt+    = PKESKResolverAttempt+    { pkeskResolverAttemptPreviousFailures :: [PKESKAttemptFailure]+    -- ^ Failures from earlier attempts on the same PKESK packet.+    , pkeskResolverAttemptAction :: PKESKResolverAttemptAction+    }+    deriving (Eq, Show)++data DecryptSessionKeyResolutionReport+    = DecryptSessionKeyResolutionReport+    { decryptSessionResolutionPath :: DecryptSessionKeyResolutionPath+    , decryptSessionResolutionSKESKErrors :: [String]+    , decryptSessionResolutionPKESKErrors :: [String]+    , decryptSessionResolutionResolverAttempts+        :: [PKESKResolverAttempt]+    }+    deriving (Eq, Show)++data DecryptReport+    = DecryptReport+    { decryptReportOutcome :: DecryptOutcome+    , decryptReportSessionKeyResolutions+        :: [DecryptSessionKeyResolutionReport]+    }+    deriving (Eq, Show)++-- | AEAD decryption context (Reader monad eliminates parameter threading)+data AEADDecryptContext cipher+    = AEADDecryptContext+    { aeadMode :: CCT.AEADMode+    , aeadInfo :: B.ByteString+    , aeadChunkSize :: Word8+    , aeadNoncePrefix :: B.ByteString+    , aeadCipher :: cipher+    }++-- | ReaderT wrapper for AEAD decryption computations+type AEADDecrypt cipher =+    ReaderT (AEADDecryptContext cipher) (Either String)++conduitDecrypt+    :: (MonadFail m, MonadResource m, MonadThrow m, MonadUnliftIO m)+    => DecryptOptions+    -> ConduitT Pkt Pkt m DecryptOutcome+conduitDecrypt opts =+    decryptReportOutcome <$> conduitDecryptWithReport opts++conduitDecryptWithReport+    :: (MonadFail m, MonadResource m, MonadThrow m, MonadUnliftIO m)+    => DecryptOptions+    -> ConduitT Pkt Pkt m DecryptReport+conduitDecryptWithReport opts = do+    reportRef <- liftIO (newIORef [])+    resolver <-+        liftIO (buildDecryptResolver (decryptOptionsKeyResolution opts))+    let allowManualPKESKPrompt =+            case decryptOptionsKeyResolution opts of+                DecryptWithoutPKESK -> True+                _ -> False+    outcome <-+        conduitDecryptChecked'+            (def {_decryptPolicy = decryptOptionsPolicy opts})+            allowManualPKESKPrompt+            resolver+            (decryptOptionsPassphraseCallback opts)+            (Just reportRef)+    resolutions <- reverse <$> liftIO (readIORef reportRef)+    pure+        DecryptReport+            { decryptReportOutcome = outcome+            , decryptReportSessionKeyResolutions = resolutions+            }++-- | Build an internal 'PKESKResolver' from the public 'DecryptKeyResolution'.+buildDecryptResolver+    :: DecryptKeyResolution -> IO (PKESKResolver IO)+buildDecryptResolver DecryptWithoutPKESK =+    pure (\_ -> pure ResolveExhausted)+buildDecryptResolver (DecryptWithKeyring kr) =+    buildKeyringResolver kr Nothing+buildDecryptResolver (DecryptWithKeyringAndPassphrase kr cb) =+    buildKeyringResolver kr (Just cb)+buildDecryptResolver (DecryptWithUnwrapCandidatesCallback cb) =+    buildUnwrapCandidatesResolver cb++-- | Build a stateful resolver that looks up keys from a 'SecretKeyring'.+buildKeyringResolver+    :: SecretKeyring+    -> Maybe (SomePKPayload -> IO (Maybe BL.ByteString))+    -> IO (PKESKResolver IO)+buildKeyringResolver kr maybePassphraseCb = do+    -- Tracks (last PKESK, remaining wildcard candidates once initialized).+    stateRef <-+        newIORef+            ( Nothing :: Maybe PKESKPayload+            , Nothing :: Maybe [PKESKRecipientKey]+            , [] :: [(Pkt, [PKESKRecipientKey])]+            )+    pure $ \req -> do+        let pkesk = reqPKESK req+            probe = reqProbePacket req+        (lastPKESK, wildcardState, exactCache) <- readIORef stateRef+        let freshPKESK = Just pkesk /= lastPKESK+        when freshPKESK $ writeIORef stateRef (Just pkesk, Nothing, [])+        let wc = if freshPKESK then Nothing else wildcardState+            ec = if freshPKESK then [] else exactCache+        case extractProbeKeyIdentifier probe of+            KeyIdentifierWildcard -> do+                -- Wildcard probe: iterate all keys+                candidates <- case wc of+                    Nothing -> keyringCandidates (IxSet.toList kr)+                    Just cs -> pure cs+                case candidates of+                    [] -> do+                        writeIORef stateRef (Just pkesk, Just [], ec)+                        pure ResolveExhausted+                    (rk : rest) -> do+                        writeIORef stateRef (Just pkesk, Just rest, ec)+                        pure (ResolveWith rk)+            keyIdentifier -> do+                -- Exact probe: direct lookup by key ID or fingerprint.+                candidates <- case lookup probe ec of+                    Just cs -> pure cs+                    Nothing -> do+                        let matchingTKs = matchingTKsForRecipient keyIdentifier+                        cs <- keyringCandidates matchingTKs+                        writeIORef+                            stateRef+                            ( Just pkesk+                            , wc+                            , (probe, cs) : filter ((/= probe) . fst) ec+                            )+                        pure cs+                let priorFailures = length (reqPreviousFailures req)+                case drop priorFailures candidates of+                    [] -> pure ResolveSkip+                    (rk : _) -> pure (ResolveWith rk)+  where+    matchingTKsForRecipient :: KeyIdentifier -> [TK 'SecretTK]+    matchingTKsForRecipient keyIdentifier =+        case keyIdentifier of+            KeyIdentifierWildcard -> IxSet.toList kr+            KeyIdentifierEightOctet rid -> IxSet.toList (kr IxSet.@= rid)+            KeyIdentifierFingerprint rid ->+                let indexedMatches = IxSet.toList (kr IxSet.@= rid)+                 in if null indexedMatches+                        then filter (tkMatchesRecipientFingerprint rid) (IxSet.toList kr)+                        else indexedMatches++    tkMatchesRecipientFingerprint+        :: Fingerprint -> TK 'SecretTK -> Bool+    tkMatchesRecipientFingerprint rid tk =+        any+            (keyPktMatchesRecipientFingerprint rid)+            (_tkPrimaryKey tk : map fst (_tkSubs tk))++    keyPktMatchesRecipientFingerprint+        :: Fingerprint -> KeyPkt 'SecretPkt -> Bool+    keyPktMatchesRecipientFingerprint rid (KeyPktSecretPrimary pkp _) =+        pkPayloadMatchesRecipientFingerprint rid pkp+    keyPktMatchesRecipientFingerprint rid (KeyPktSecretSubkey pkp _) =+        pkPayloadMatchesRecipientFingerprint rid pkp++    pkPayloadMatchesRecipientFingerprint+        :: Fingerprint -> SomePKPayload -> Bool+    pkPayloadMatchesRecipientFingerprint rid pkp =+        fingerprint pkp `elem` recipientFingerprintMatchVariants rid++    recipientFingerprintMatchVariants :: Fingerprint -> [Fingerprint]+    recipientFingerprintMatchVariants (Fingerprint rid)+        | BL.length rid == 20 =+            [Fingerprint rid, Fingerprint (BL.cons 0x04 rid)]+        | BL.length rid == 21 && BL.head rid == 0x04 =+            [Fingerprint rid, Fingerprint (BL.tail rid)]+        | BL.length rid == 32 =+            [Fingerprint rid, Fingerprint (BL.cons 0x06 rid)]+        | BL.length rid == 33 && BL.head rid == 0x06 =+            [Fingerprint rid, Fingerprint (BL.tail rid)]+        | otherwise = [Fingerprint rid]++    keyringCandidates :: [TK 'SecretTK] -> IO [PKESKRecipientKey]+    keyringCandidates tks = concat <$> mapM tkCandidates tks++    tkCandidates :: TK 'SecretTK -> IO [PKESKRecipientKey]+    tkCandidates tk =+        fmap catMaybes . mapM resolveKeyPair $+            _tkPrimaryKey tk : map fst (_tkSubs tk)++    resolveKeyPair+        :: KeyPkt 'SecretPkt -> IO (Maybe PKESKRecipientKey)+    resolveKeyPair (KeyPktSecretPrimary pkp (SUUnencrypted sk _)) =+        pure $+            Just+                PKESKRecipientKey+                    { pkeskRecipientPKPayload = Just pkp+                    , pkeskRecipientSKey = sk+                    }+    resolveKeyPair (KeyPktSecretSubkey pkp (SUUnencrypted sk _)) =+        pure $+            Just+                PKESKRecipientKey+                    { pkeskRecipientPKPayload = Just pkp+                    , pkeskRecipientSKey = sk+                    }+    resolveKeyPair (KeyPktSecretPrimary pkp ska) = unlockProtected pkp ska+    resolveKeyPair (KeyPktSecretSubkey pkp ska) = unlockProtected pkp ska++    unlockProtected+        :: SomePKPayload -> SKAddendum -> IO (Maybe PKESKRecipientKey)+    unlockProtected pkp ska =+        case maybePassphraseCb of+            Nothing -> pure Nothing+            Just passphraseCb -> do+                mPassphrase <- passphraseCb pkp+                case mPassphrase of+                    Nothing -> pure Nothing+                    Just passphrase ->+                        case decryptPrivateKey (pkp, ska) passphrase of+                            Left _ -> pure Nothing+                            Right (SUUnencrypted sk _) ->+                                pure $+                                    Just+                                        PKESKRecipientKey+                                            { pkeskRecipientPKPayload = Just pkp+                                            , pkeskRecipientSKey = sk+                                            }+                            Right _ -> pure Nothing++buildUnwrapCandidatesResolver+    :: (KeyIdentifier -> PubKeyAlgorithm -> IO [PKESKRecipientKey])+    -> IO (PKESKResolver IO)+buildUnwrapCandidatesResolver cb = do+    stateRef <-+        newIORef+            ( Nothing :: Maybe PKESKPayload+            , [] :: [(Pkt, [PKESKRecipientKey])]+            , [] :: [SKey]+            )+    pure $ \req -> do+        let pkesk = reqPKESK req+            probePkt = reqProbePacket req+        (lastPKESK, probeState, seenSKeys) <- readIORef stateRef+        let freshPKESK = Just pkesk /= lastPKESK+        when freshPKESK $ writeIORef stateRef (Just pkesk, [], [])+        let state0 = if freshPKESK then [] else probeState+            seen0 = if freshPKESK then [] else seenSKeys+        case lookup probePkt state0 of+            Just (next : rest) -> do+                writeIORef+                    stateRef+                    ( Just pkesk+                    , updateProbeState probePkt rest state0+                    , pkeskRecipientSKey next : seen0+                    )+                pure (ResolveWith next)+            Just [] ->+                pure ResolveSkip+            Nothing -> do+                candidates <-+                    filterFreshCandidates seen0 <$> callbackCandidates probePkt+                case candidates of+                    [] -> do+                        writeIORef+                            stateRef+                            (Just pkesk, updateProbeState probePkt [] state0, seen0)+                        pure ResolveSkip+                    (next : rest) -> do+                        writeIORef+                            stateRef+                            ( Just pkesk+                            , updateProbeState probePkt rest state0+                            , pkeskRecipientSKey next : seen0+                            )+                        pure (ResolveWith next)+  where+    callbackCandidates probePkt =+        cb+            (extractProbeKeyIdentifier probePkt)+            (extractProbePKA probePkt)++    updateProbeState probePkt remaining state0 =+        (probePkt, remaining) : filter ((/= probePkt) . fst) state0++    filterFreshCandidates seenSKeys =+        filter+            (\candidate -> pkeskRecipientSKey candidate `notElem` seenSKeys)++-- | Extract the recipient identifier from a PKESK probe packet.+extractProbeKeyIdentifier :: Pkt -> KeyIdentifier+extractProbeKeyIdentifier (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ rid _ _)))+    | isWildcardV3RecipientKeyId rid = KeyIdentifierWildcard+    | otherwise = KeyIdentifierEightOctet rid+extractProbeKeyIdentifier (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid _ _)))+    | BL.null rid = KeyIdentifierWildcard+    | otherwise = KeyIdentifierFingerprint (Fingerprint rid)+extractProbeKeyIdentifier _ = KeyIdentifierWildcard++isWildcardV3RecipientKeyId :: EightOctetKeyId -> Bool+isWildcardV3RecipientKeyId (EightOctetKeyId rid) =+    BL.length rid == 8 && BL.all (== 0) rid++-- | Extract the public-key algorithm from a PKESK probe packet.+extractProbePKA :: Pkt -> PubKeyAlgorithm+extractProbePKA (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ _ pka _))) = pka+extractProbePKA (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 _ pka _))) = pka+extractProbePKA _ = RSA -- fallback; should not be reached++-- | Core implementation: manual await loop so we can return a 'DecryptOutcome'.+conduitDecryptChecked'+    :: (MonadFail m, MonadResource m, MonadThrow m, MonadUnliftIO m)+    => RecursorState+    -> Bool+    -> PKESKResolver IO+    -> InputCallback IO+    -> Maybe (IORef [DecryptSessionKeyResolutionReport])+    -> ConduitT Pkt Pkt m DecryptOutcome+conduitDecryptChecked' rs0 allowManualPKESKPrompt pkcb cb reportRef =+    loop (SomeDecryptStreamState (ActiveDecryptState rs0))+  where+    loop+        :: (MonadFail m, MonadResource m, MonadThrow m, MonadUnliftIO m)+        => SomeDecryptStreamState -> ConduitT Pkt Pkt m DecryptOutcome+    loop streamState = do+        case streamState of+            SomeDecryptStreamState (MalformedDecryptState _ reason) ->+                return (DecryptMalformedStructure reason)+            SomeDecryptStreamState state -> do+                mpkt <- await+                case mpkt of+                    Nothing -> return (finalOutcome state)+                    Just pkt -> do+                        (state', pkts) <- lift (push pkt state)+                        mapM_ yield pkts+                        loop state'++    push+        :: (MonadFail m, MonadResource m, MonadThrow m, MonadUnliftIO m)+        => Pkt+        -> DecryptStreamState phase+        -> m (SomeDecryptStreamState, [Pkt])+    push i (ActiveDecryptState s)+        | _depth s > 42 = fail "I think we've been quine-attacked"+        | hasPendingESKPrelude s && not (packetCanFollowESKPrelude i) =+            return+                ( SomeDecryptStreamState+                    ( MalformedDecryptState+                        s+                        "Malformed encrypted packet sequence: ESK packets must immediately precede encrypted data"+                    )+                , []+                )+        | otherwise =+            let dp = _decryptPolicy s+             in case i of+                    SKESKPkt payload ->+                        do+                            when (decryptRejectDeprecatedSKESK dp) $+                                case skeskPayloadS2K payload of+                                    Simple _ ->+                                        fail+                                            "SKESK uses Simple S2K specifier, which is deprecated by RFC9580 policy"+                                    Salted _ _ ->+                                        fail+                                            "SKESK uses Salted S2K specifier, which is deprecated by RFC9580 policy"+                                    _ -> pure ()+                            return+                                ( SomeDecryptStreamState+                                    ( ActiveDecryptState+                                        (s {_pendingESKs = PendingSKESK payload : _pendingESKs s})+                                    )+                                , []+                                )+                    PKESKPkt p ->+                        return+                            ( SomeDecryptStreamState+                                ( ActiveDecryptState+                                    (s {_pendingESKs = PendingPKESK p : _pendingESKs s})+                                )+                            , []+                            )+                    (SymEncDataPkt bs) ->+                        if hasESKPayloadVersionMismatch dp LegacyEncryptedPayload s+                            then+                                return+                                    ( SomeDecryptStreamState+                                        ( MalformedDecryptState+                                            s+                                            ( "ESK/payload version mismatch: ESK packets present but none are version-aligned with "+                                                ++ "legacy SED payload"+                                            )+                                        )+                                    , []+                                    )+                            else do+                                when (not (decryptAllowSEDNoIntegrity dp)) $+                                    fail+                                        "Received unauthenticated SED (Symmetrically Encrypted Data) packet; \+                                        \RFC9580 policy requires integrity-protected SEIPD. \+                                        \Use lenientDecryptPolicy to permit legacy messages."+                                (symalgo, sessionKey) <-+                                    resolveSessionKey+                                        s+                                        allowManualPKESKPrompt+                                        pkcb+                                        cb+                                        LegacyEncryptedPayload+                                        reportRef+                                checkDecryptSymmetricAlgo dp symalgo+                                d <-+                                    decryptSEDP+                                        s {_pendingESKs = []}+                                        allowManualPKESKPrompt+                                        pkcb+                                        cb+                                        reportRef+                                        symalgo+                                        sessionKey+                                        bs+                                -- SED is the terminal outer-stream packet.+                                return (finalizeOuterEncryptedPayload s d)+                    (SymEncIntegrityProtectedDataPkt (SEIPD1 _ bs)) ->+                        if hasESKPayloadVersionMismatch dp LegacyEncryptedPayload s+                            then+                                return+                                    ( SomeDecryptStreamState+                                        ( MalformedDecryptState+                                            s+                                            ( "ESK/payload version mismatch: ESK packets present but none are version-aligned with "+                                                ++ "SEIPDv1 payload"+                                            )+                                        )+                                    , []+                                    )+                            else do+                                when (not (decryptAllowSEIPDv1 dp)) $+                                    fail+                                        "Received SEIPDv1 packet; decrypt policy requires SEIPDv2 only."+                                (symalgo, sessionKey) <-+                                    resolveSessionKey+                                        s+                                        allowManualPKESKPrompt+                                        pkcb+                                        cb+                                        LegacyEncryptedPayload+                                        reportRef+                                checkDecryptSymmetricAlgo dp symalgo+                                d <-+                                    decryptSEIPDP+                                        s {_pendingESKs = []}+                                        allowManualPKESKPrompt+                                        pkcb+                                        cb+                                        reportRef+                                        symalgo+                                        sessionKey+                                        bs+                                -- The outer SEIPD1 packet is terminal; inner MDC is handled by+                                -- the recursive conduit's own _seenMessageEnd tracking.+                                return (finalizeOuterEncryptedPayload s d)+                    (SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize salt bs)) ->+                        if hasESKPayloadVersionMismatch dp (SEIPDv2EncryptedPayload sa aa) s+                            then+                                return+                                    ( SomeDecryptStreamState+                                        ( MalformedDecryptState+                                            s+                                            ( "ESK/payload version mismatch: ESK packets present but none are version-aligned with "+                                                ++ "SEIPDv2 payload"+                                            )+                                        )+                                    , []+                                    )+                            else do+                                checkDecryptSymmetricAlgo dp sa+                                checkDecryptAEADAlgo dp aa+                                (_, sessionKey) <-+                                    resolveSessionKey+                                        s+                                        allowManualPKESKPrompt+                                        pkcb+                                        cb+                                        (SEIPDv2EncryptedPayload sa aa)+                                        reportRef+                                d <-+                                    decryptSEIPDv2P+                                        s {_pendingESKs = []}+                                        allowManualPKESKPrompt+                                        pkcb+                                        cb+                                        reportRef+                                        sa+                                        aa+                                        chunkSize+                                        salt+                                        sessionKey+                                        bs+                                -- SEIPD2 final AEAD tag was verified inside decryptSEIPDv2P.+                                return (finalizeOuterEncryptedPayload s d)+                    m@(ModificationDetectionCodePkt mdc) -> do+                        when (isNothing (_lastClearText s)) $ fail "MDC with no referent"+                        let mcalculated = calculateMDC <$> _lastNonce s <*> _lastClearText s+                        expectedMdc <-+                            case mcalculated of+                                Nothing -> fail "MDC with no nonce or cleartext"+                                Just Nothing -> fail "MDC referent is too short"+                                Just (Just x) -> return x+                        when (expectedMdc /= mdc) $+                            fail $+                                "MDC indicates tampering: "+                                    ++ show mdc+                                    ++ " versus "+                                    ++ maybe "<empty>" show mcalculated+                                    ++ "  ... "+                                    ++ show (_lastNonce s)+                                    ++ " / "+                                    ++ show (_lastClearText s)+                        -- MDC is the integrity boundary inside a SEIPD1 inner stream.+                        return+                            ( SomeDecryptStreamState (FinishedDecryptState s False)+                            , [m]+                            )+                    -- RFC9580 Padding Packet (tag 21) can be ignored after decryption.+                    (PaddingPkt _) ->+                        return (SomeDecryptStreamState (ActiveDecryptState s), [])+                    (OtherPacketPkt t _)+                        | t < 40 ->+                            fail+                                ("Unknown critical packet type in packet sequence: " ++ show t)+                    (OtherPacketPkt _ _) ->+                        return (SomeDecryptStreamState (ActiveDecryptState s), [])+                    p ->+                        return (SomeDecryptStreamState (ActiveDecryptState s), [p])+    push i (FinishedDecryptState s hadTrailing) =+        if decryptRejectTrailingData (_decryptPolicy s)+            then+                return+                    ( SomeDecryptStreamState+                        ( MalformedDecryptState+                            s+                            "packet received after message integrity boundary"+                        )+                    , []+                    )+            else+                return+                    (SomeDecryptStreamState (FinishedDecryptState s True), [i])+    push _ malformedState@(MalformedDecryptState _ _) =+        return (SomeDecryptStreamState malformedState, [])++    hasPendingESKPrelude s = not (null (_pendingESKs s))++    hasESKPayloadVersionMismatch dp payloadFlavor state =+        decryptRejectESKVersionMismatch dp+            && hasPendingESKPrelude state+            && null (alignedPrecedingESKs payloadFlavor (_pendingESKs state))++    finalizeOuterEncryptedPayload state decryptedPkts =+        ( SomeDecryptStreamState+            (FinishedDecryptState (state {_pendingESKs = []}) False)+        , decryptedPkts+        )++    finalOutcome :: DecryptStreamState phase -> DecryptOutcome+    finalOutcome (ActiveDecryptState _) = DecryptTruncated+    finalOutcome (FinishedDecryptState _ hadTrailing) =+        if hadTrailing+            then DecryptTrailingData+            else DecryptClean+    finalOutcome (MalformedDecryptState _ reason) =+        DecryptMalformedStructure reason++    packetCanFollowESKPrelude pkt =+        case pkt of+            SKESKPkt _ -> True+            PKESKPkt _ -> True+            SymEncDataPkt _ -> True+            SymEncIntegrityProtectedDataPkt _ -> True+            MarkerPkt _ -> True+            OtherPacketPkt 21 _ -> True+            _ -> False++{- | Describes what integrity-terminating marker (if any) an inner packet+stream is expected to contain.  Passed to 'checkInnerOutcome' to+distinguish a legitimate end-of-stream from a missing marker.+-}+data InnerIntegrityExpectation+    = {- | The inner stream has no integrity-terminating packet.  SED has none+      by design; SEIPD2 authenticates via AEAD before the conduit runs.+      'DecryptTruncated' is the normal end-of-stream outcome.+      -}+      NoIntegrityMarker++{- | Propagate non-clean inner-stream outcomes as a 'fail'.  Called after each+recursive decrypt helper so that structural violations and (for SEIPD1) a+missing MDC are not silently swallowed.+-}+checkInnerOutcome+    :: MonadFail m+    => InnerIntegrityExpectation -> DecryptOutcome -> m ()+checkInnerOutcome _ DecryptClean = pure ()+checkInnerOutcome _ DecryptTrailingData = pure ()+checkInnerOutcome NoIntegrityMarker DecryptTruncated = pure ()+checkInnerOutcome _ (DecryptMalformedStructure reason) =+    fail+        ("Inner encrypted payload had malformed structure: " ++ reason)++decryptSEDP+    :: (MonadFail m, MonadIO m, MonadThrow m, MonadUnliftIO m)+    => RecursorState+    -> Bool+    -> PKESKResolver IO+    -> InputCallback IO+    -> Maybe (IORef [DecryptSessionKeyResolutionReport])+    -> SymmetricAlgorithm+    -> SessionKey+    -> BL.ByteString+    -> m [Pkt]+decryptSEDP rs allowManualPKESKPrompt pkcb cb reportRef symalgo (SessionKey sessionKey) bs = do+    decrypted <-+        case decryptOpenPGPCfb symalgo (BL.toStrict bs) sessionKey of+            Left e -> fail (renderCipherError e)+            Right x -> pure x+    (innerOutcome, pkts) <-+        decryptInnerPackets+            rs+            allowManualPKESKPrompt+            pkcb+            cb+            reportRef+            decrypted+    checkInnerOutcome NoIntegrityMarker innerOutcome+    pure pkts++decryptSEIPDP+    :: (MonadFail m, MonadIO m, MonadThrow m, MonadUnliftIO m)+    => RecursorState+    -> Bool+    -> PKESKResolver IO+    -> InputCallback IO+    -> Maybe (IORef [DecryptSessionKeyResolutionReport])+    -> SymmetricAlgorithm+    -> SessionKey+    -> BL.ByteString+    -> m [Pkt]+decryptSEIPDP rs allowManualPKESKPrompt pkcb cb reportRef symalgo (SessionKey sessionKey) bs = do+    (nonce, decrypted) <-+        case decryptPreservingNonce symalgo (BL.toStrict bs) sessionKey of+            Left e -> fail (renderCipherError e)+            Right x -> pure x+    decryptedWithoutMDC <-+        case validateSEIPD1MDC nonce decrypted of+            Left err -> fail err+            Right x -> pure x+    (innerOutcome, pkts) <-+        decryptInnerPackets+            rs+            allowManualPKESKPrompt+            pkcb+            cb+            reportRef+            decryptedWithoutMDC+    checkInnerOutcome NoIntegrityMarker innerOutcome+    pure pkts++decryptSEIPDv2P+    :: (MonadFail m, MonadIO m, MonadThrow m, MonadUnliftIO m)+    => RecursorState+    -> Bool+    -> PKESKResolver IO+    -> InputCallback IO+    -> Maybe (IORef [DecryptSessionKeyResolutionReport])+    -> SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> Salt+    -> SessionKey+    -> BL.ByteString+    -> m [Pkt]+decryptSEIPDv2P rs allowManualPKESKPrompt pkcb cb reportRef symalgo aeadalgo chunkSize salt sessionKey bs = do+    let decrypted =+            decryptSEIPDv2Payload+                symalgo+                aeadalgo+                chunkSize+                salt+                (BL.toStrict bs)+                sessionKey+    case decrypted of+        Left e -> fail e+        Right cleartext -> do+            (innerOutcome, pkts) <-+                decryptInnerPackets+                    rs+                    allowManualPKESKPrompt+                    pkcb+                    cb+                    reportRef+                    cleartext+            checkInnerOutcome NoIntegrityMarker innerOutcome+            pure pkts++decryptInnerPackets+    :: (MonadFail m, MonadThrow m, MonadUnliftIO m)+    => RecursorState+    -> Bool+    -> PKESKResolver IO+    -> InputCallback IO+    -> Maybe (IORef [DecryptSessionKeyResolutionReport])+    -> B.ByteString+    -> m (DecryptOutcome, [Pkt])+decryptInnerPackets rs allowManualPKESKPrompt pkcb cb reportRef cleartext =+    runConduitRes $+        CB.sourceLbs (BL.fromStrict cleartext)+            .| conduitGet get+            .| conduitDecompress+            .| fuseBoth+                ( conduitDecryptChecked'+                    rs {_depth = _depth rs + 1}+                    allowManualPKESKPrompt+                    pkcb+                    cb+                    reportRef+                )+                CL.consume++decryptSEIPDv2Payload+    :: SymmetricAlgorithm+    -> AEADAlgorithm+    -> Word8+    -> Salt+    -> B.ByteString+    -> SessionKey+    -> Either String B.ByteString+decryptSEIPDv2Payload symalgo aeadalgo chunkSize salt encrypted (SessionKey sessionKey) = do+    when (chunkSize > 16) $+        Left "SEIPD v2 chunk size octet must be between 0 and 16"+    (mode, nonceSize) <- aeadModeAndNonceSize aeadalgo+    keyLen <- symKeySize symalgo+    let outputLen = keyLen + nonceSize - 8+    when (B.length (unSalt salt) /= 32) $+        Left "SEIPD v2 salt must be exactly 32 octets"+    when (B.length encrypted < 32) $+        Left+            "SEIPD v2 ciphertext must include at least one chunk tag and a final tag"+    let info =+            B.pack+                [0xd2, 2, fromFVal symalgo, fromFVal aeadalgo, chunkSize]+        prk = extract @CHA.SHA256 (unSalt salt) sessionKey+        okm = expand @CHA.SHA256 prk info outputLen :: B.ByteString+        messageKey = B.take keyLen okm+        noncePrefix = B.take (nonceSize - 8) (B.drop keyLen okm)+    decryptSEIPDv2WithKey+        symalgo+        mode+        chunkSize+        info+        noncePrefix+        messageKey+        encrypted++decryptSEIPDv2WithKey+    :: SymmetricAlgorithm+    -> CCT.AEADMode+    -> Word8+    -> B.ByteString+    -> B.ByteString+    -> B.ByteString+    -> B.ByteString+    -> Either String B.ByteString+decryptSEIPDv2WithKey symalgo mode chunkSize info noncePrefix sessionKey encrypted =+    withAESCipher+        "SEIPD v2 decrypt currently supports AES-128/192/256 only"+        symalgo+        sessionKey+        (decryptChunks mode info chunkSize noncePrefix encrypted)++decryptChunks+    :: CCT.BlockCipher cipher+    => CCT.AEADMode+    -> B.ByteString+    -> Word8+    -> B.ByteString+    -> B.ByteString+    -> cipher+    -> Either String B.ByteString+decryptChunks mode info chunkSize noncePrefix encrypted cipher =+    let ctx = AEADDecryptContext mode info chunkSize noncePrefix cipher+     in runReaderT decryptChunksWithReader ctx+  where+    decryptChunksWithReader+        :: CCT.BlockCipher cipher => AEADDecrypt cipher B.ByteString+    decryptChunksWithReader = go 0 encrypted [] 0+      where+        chunkLen = 1 `shiftL` (fromIntegral chunkSize + 6)+        tagLen = 16++        go idx remaining acc totalPlain+            | B.length remaining < 2 * tagLen =+                lift $+                    Left+                        "SEIPD v2 ciphertext is too short for chunk and final authentication tags"+            | otherwise = do+                let hasMoreChunks = B.length remaining > chunkLen + 2 * tagLen+                    currentChunkLen =+                        if hasMoreChunks+                            then chunkLen+                            else B.length remaining - 2 * tagLen+                when (currentChunkLen < 0) $+                    lift $+                        Left "SEIPD v2 malformed chunk lengths"+                let (chunkCiphertext, r1) = B.splitAt currentChunkLen remaining+                    (chunkTag, r2) = B.splitAt tagLen r1+                plainChunk <-+                    decryptChunkWithContext idx chunkCiphertext chunkTag+                if hasMoreChunks+                    then+                        go+                            (idx + 1)+                            r2+                            (plainChunk : acc)+                            (totalPlain + B.length plainChunk)+                    else do+                        when (B.length r2 /= tagLen) $+                            lift $+                                Left "SEIPD v2 missing final authentication tag"+                        verifyFinalTagWithContext+                            (idx + 1)+                            (totalPlain + B.length plainChunk)+                            r2+                        return (B.concat (reverse (plainChunk : acc)))++        decryptChunkWithContext idx chunkCiphertext chunkTag = do+            AEADDecryptContext mode' _ _ noncePrefix' cipher' <- ask+            if mode' == CCT.AEAD_OCB+                then+                    lift $+                        decryptWithOCBRFC7253With+                            (\_ _ _ _ _ _ -> "SEIPD v2 chunk authentication failed")+                            cipher'+                            (noncePrefix' <> encodeWord64be idx)+                            info+                            chunkCiphertext+                            (mkAuthTag chunkTag)+                else do+                    aead <- initAEADWithContext idx+                    let mPlain =+                            CCT.aeadSimpleDecrypt+                                aead+                                info+                                chunkCiphertext+                                (mkAuthTag chunkTag)+                    case mPlain of+                        Nothing -> lift $ Left "SEIPD v2 chunk authentication failed"+                        Just p -> return p++        verifyFinalTagWithContext idx totalPlain finalTag = do+            AEADDecryptContext mode' _ _ noncePrefix' cipher' <- ask+            if mode' == CCT.AEAD_OCB+                then do+                    plain <-+                        lift $+                            decryptWithOCBRFC7253With+                                (\_ _ _ _ _ _ -> "SEIPD v2 chunk authentication failed")+                                cipher'+                                (noncePrefix' <> encodeWord64be idx)+                                (info <> encodeWord64be (fromIntegral totalPlain))+                                B.empty+                                (mkAuthTag finalTag)+                    if B.null plain+                        then return ()+                        else+                            lift $+                                Left "SEIPD v2 final authentication tag verification failed"+                else do+                    aead <- initAEADWithContext idx+                    let mEmpty =+                            CCT.aeadSimpleDecrypt+                                aead+                                (info <> encodeWord64be (fromIntegral totalPlain))+                                B.empty+                                (mkAuthTag finalTag)+                    case mEmpty of+                        Just p | B.null p -> return ()+                        _ ->+                            lift $+                                Left "SEIPD v2 final authentication tag verification failed"++        initAEADWithContext idx = do+            AEADDecryptContext mode' _ _ noncePrefix' cipher' <- ask+            lift $+                first show . CE.eitherCryptoError $+                    CCT.aeadInit mode' cipher' (noncePrefix' <> encodeWord64be idx)++aeadModeAndNonceSize+    :: AEADAlgorithm -> Either String (CCT.AEADMode, Int)+aeadModeAndNonceSize =+    aeadModeAndNonceSizeForSEIPDv2+        "Unknown AEAD algorithm for SEIPD v2 decrypt"++symKeySize :: SymmetricAlgorithm -> Either String Int+symKeySize =+    seipdv2SymmetricKeySize+        "SEIPD v2 decrypt currently supports AES-128/192/256 only"++encodeWord64be :: Word64 -> B.ByteString+encodeWord64be = BL.toStrict . runPut . putWord64be++mkAuthTag :: B.ByteString -> CCT.AuthTag+mkAuthTag = CCT.AuthTag . BA.convert++checkDecryptSymmetricAlgo+    :: MonadFail m => DecryptPolicy -> SymmetricAlgorithm -> m ()+checkDecryptSymmetricAlgo dp sa =+    case decryptAllowedSymmetricAlgos dp of+        Nothing -> pure ()+        Just allowed+            | sa `elem` allowed -> pure ()+            | otherwise ->+                fail $+                    "Decrypt policy rejects symmetric algorithm "+                        ++ show sa+                        ++ "; allowed: "+                        ++ show allowed++checkDecryptAEADAlgo+    :: MonadFail m => DecryptPolicy -> AEADAlgorithm -> m ()+checkDecryptAEADAlgo dp aa =+    case decryptAllowedAEADAlgos dp of+        Nothing -> pure ()+        Just allowed+            | aa `elem` allowed -> pure ()+            | otherwise ->+                fail $+                    "Decrypt policy rejects AEAD algorithm "+                        ++ show aa+                        ++ "; allowed: "+                        ++ show allowed++skeskPayloadSymmetricAlgorithm+    :: SKESKPayload -> SymmetricAlgorithm+skeskPayloadSymmetricAlgorithm payload =+    case classifySKESKPayload payload of+        ClassifiedSKESKPayloadV4 (SKESKPayloadV4 sa _ _) -> sa+        ClassifiedSKESKPayloadV6 (SKESKPayloadV6 sa _ _ _ _ _) -> sa++skeskPayloadS2K :: SKESKPayload -> S2K+skeskPayloadS2K payload =+    case classifySKESKPayload payload of+        ClassifiedSKESKPayloadV4 (SKESKPayloadV4 _ s2k _) -> s2k+        ClassifiedSKESKPayloadV6 (SKESKPayloadV6 _ _ s2k _ _ _) -> s2k++skeskPayloadAEADAlgorithm :: SKESKPayload -> Maybe AEADAlgorithm+skeskPayloadAEADAlgorithm payload =+    case classifySKESKPayload payload of+        ClassifiedSKESKPayloadV4 _ -> Nothing+        ClassifiedSKESKPayloadV6 (SKESKPayloadV6 _ aa _ _ _ _) -> Just aa++resolveSKESKSessionKey+    :: BL.ByteString -> SKESKPayload -> Either String B.ByteString+resolveSKESKSessionKey passphrase payload =+    first renderSKESKSessionKeyResolutionError $+        resolveSKESKSessionKeyTyped+            passphrase+            (classifySKESKPayload payload)++data SKESKSessionKeyResolutionError+    = SKESKSessionKeyS2KError S2KError+    | SKESKSessionKeyOtherError String+    deriving (Eq, Show)++renderSKESKSessionKeyResolutionError+    :: SKESKSessionKeyResolutionError -> String+renderSKESKSessionKeyResolutionError (SKESKSessionKeyS2KError err) = renderS2KError err+renderSKESKSessionKeyResolutionError (SKESKSessionKeyOtherError err) = err++resolveSKESKSessionKeyTyped+    :: BL.ByteString+    -> ClassifiedSKESKPayload+    -> Either SKESKSessionKeyResolutionError B.ByteString+resolveSKESKSessionKeyTyped passphrase (ClassifiedSKESKPayloadV4 (SKESKPayloadV4 sa s2k Nothing)) =+    first+        SKESKSessionKeyS2KError+        (skesk2Key (SKESK4Packet sa s2k Nothing) passphrase)+resolveSKESKSessionKeyTyped passphrase (ClassifiedSKESKPayloadV4 (SKESKPayloadV4 sa s2k (Just esk))) =+    first+        SKESKSessionKeyS2KError+        ( snd+            <$> skesk2SessionKey (SKESK4Packet sa s2k (Just esk)) passphrase+        )+resolveSKESKSessionKeyTyped passphrase (ClassifiedSKESKPayloadV6 (SKESKPayloadV6 sa aead s2k iv esk tag)) = do+    keyLen <-+        first+            (SKESKSessionKeyS2KError . S2KUnsupportedAlgorithm)+            (keySize sa)+    ikm <-+        first SKESKSessionKeyS2KError (string2Key s2k keyLen passphrase)+    kek <-+        first SKESKSessionKeyOtherError (deriveSKESK6KEK sa aead ikm)+    first+        SKESKSessionKeyOtherError+        ( decryptSKESK6SessionKey+            sa+            aead+            kek+            (BL.toStrict iv)+            (BL.toStrict esk)+            (BL.toStrict tag)+        )++data ClassifiedSKESKPayload where+    ClassifiedSKESKPayloadV4+        :: SKESKPayloadV4 -> ClassifiedSKESKPayload+    ClassifiedSKESKPayloadV6+        :: SKESKPayloadV6 -> ClassifiedSKESKPayload++classifySKESKPayload :: SKESKPayload -> ClassifiedSKESKPayload+classifySKESKPayload (SKESKPayloadV4Packet payloadV4) =+    ClassifiedSKESKPayloadV4 payloadV4+classifySKESKPayload (SKESKPayloadV6Packet payloadV6) =+    ClassifiedSKESKPayloadV6 payloadV6++resolveSessionKey+    :: (MonadFail m, MonadIO m)+    => RecursorState+    -> Bool+    -> PKESKResolver IO+    -> InputCallback IO+    -> EncryptedPayloadFlavor v+    -> Maybe (IORef [DecryptSessionKeyResolutionReport])+    -> m (SymmetricAlgorithm, SessionKey)+resolveSessionKey rs allowManualPKESKPrompt pkcb cb payloadFlavor reportRef =+    case precedingCandidates of+        [] ->+            if null (_pendingESKs rs)+                then+                    fail+                        "Encrypted data packet has no preceding SKESK or PKESK packet"+                else+                    fail+                        "Encrypted data packet has no preceding SKESK or PKESK packet aligned with payload version"+        candidates ->+            case skeskCandidates candidates of+                [] -> resolvePKESKCandidates (pkeskCandidates candidates) [] [] []+                skesks -> do+                    passphrase <- liftIO $ cb "Input the passphrase I want"+                    resolveSKESKCandidates+                        passphrase+                        skesks+                        (pkeskCandidates candidates)+                        []+  where+    precedingCandidates+        | strictAlignment = alignedByVersion+        | null alignedByVersion = _pendingESKs rs+        | otherwise = alignedByVersion++    strictAlignment = decryptRejectESKVersionMismatch (_decryptPolicy rs)+    alignedByVersion = pendingESKsFromAligned alignedStrict+    alignedStrict = alignedPrecedingESKs payloadFlavor (_pendingESKs rs)++    skeskCandidates esks = [skesk | PendingSKESK skesk <- esks]++    pkeskCandidates esks = [pkesk | PendingPKESK pkesk <- esks]++    resolveSKESKCandidates+        :: (MonadFail m, MonadIO m)+        => BL.ByteString+        -> [SKESKPayload]+        -> [PKESKPayload]+        -> [String]+        -> m (SymmetricAlgorithm, SessionKey)+    resolveSKESKCandidates _ [] pkesks skeskErrs =+        resolvePKESKCandidates pkesks skeskErrs [] []+    resolveSKESKCandidates passphrase (skesk : rest) pkesks skeskErrs =+        case resolveSKESKCandidate passphrase skesk of+            Left err ->+                resolveSKESKCandidates+                    passphrase+                    rest+                    pkesks+                    ((skeskErrPrefix skesk ++ err) : skeskErrs)+            Right resolved -> do+                emitResolutionReport+                    (mkResolutionReport DecryptResolvedViaSKESK skeskErrs [] [])+                pure resolved++    resolveSKESKCandidate+        :: BL.ByteString+        -> SKESKPayload+        -> Either String (SymmetricAlgorithm, SessionKey)+    resolveSKESKCandidate passphrase skesk = do+        let skeskSymAlgo = skeskPayloadSymmetricAlgorithm skesk+            expectedSymAlgo = payloadExpectedSymmetricAlgorithm payloadFlavor+        sessionKeyBytes <- resolveSKESKSessionKey passphrase skesk+        case expectedSymAlgo of+            Just expected+                | expected /= skeskSymAlgo ->+                    Left "SKESK/encrypted-payload symmetric algorithm mismatch"+            _ ->+                case ( payloadExpectedAEADAlgorithm payloadFlavor+                     , skeskPayloadAEADAlgorithm skesk+                     ) of+                    (Just expectedAEAD, Just skeskAEAD)+                        | expectedAEAD /= skeskAEAD ->+                            Left "SKESK/encrypted-payload AEAD algorithm mismatch"+                    _ -> Right (skeskSymAlgo, SessionKey sessionKeyBytes)++    skeskErrPrefix skesk = "[" ++ describeSKESK skesk ++ "] "++    resolvePKESKCandidates+        :: (MonadFail m, MonadIO m)+        => [PKESKPayload]+        -> [String]+        -> [String]+        -> [PKESKResolverAttempt]+        -> m (SymmetricAlgorithm, SessionKey)+    resolvePKESKCandidates [] [] [] _ =+        fail+            "Encrypted data packet has no usable preceding SKESK or PKESK packet"+    resolvePKESKCandidates [] skeskErrs [] _ =+        fail+            ( "Encrypted data packet has no usable preceding SKESK or PKESK packet; "+                ++ "candidate errors: "+                ++ unwords (reverse skeskErrs)+            )+    resolvePKESKCandidates [] skeskErrs pkeskErrs resolverAttempts =+        if allowManualPKESKPrompt+            then do+                let expectedSymAlgo = payloadExpectedSymmetricAlgorithm payloadFlavor+                    errs = skeskErrs ++ pkeskErrs+                encodedSessionKey <-+                    BL.toStrict+                        <$> liftIO+                            ( cb+                                "Input decrypted PKESK session key material (OpenPGP encoded or raw key bytes)"+                            )+                case decodePKESKSessionKey expectedSymAlgo encodedSessionKey of+                    Left manualErr ->+                        fail+                            ( "Encrypted data packet has no usable preceding SKESK or PKESK packet; "+                                ++ "candidate errors: "+                                ++ unwords (reverse errs)+                                ++ "; manual input failed: "+                                ++ manualErr+                            )+                    Right (sa, k) -> do+                        emitResolutionReport+                            ( mkResolutionReport+                                DecryptResolvedViaManualPKESKInput+                                skeskErrs+                                pkeskErrs+                                resolverAttempts+                            )+                        pure (sa, SessionKey k)+            else+                fail+                    ( "Encrypted data packet has no usable preceding SKESK or PKESK packet; "+                        ++ "candidate errors: "+                        ++ unwords (reverse (skeskErrs ++ pkeskErrs))+                    )+    resolvePKESKCandidates (pkesk : rest) skeskErrs pkeskErrs resolverAttempts = do+        let expectedSymAlgo = payloadExpectedSymmetricAlgorithm payloadFlavor+            errPrefix = "[" ++ describePKESK pkesk ++ "] "+        attemptPKESKCandidate+            []+            []+            0+            expectedSymAlgo+            errPrefix+            resolverAttempts+      where+        attemptPKESKCandidate attemptedSKeys previousFailures attemptIndex expectedSymAlgo errPrefix resolverAttemptsAcc = do+            let callbackProbeSummary = describeCallbackProbeSummary pkesk+            resolverResult <-+                liftIO+                    (resolvePKESKRecipientKey pkesk previousFailures attemptIndex)+            case resolverResult of+                Left resolverErr ->+                    fail (errPrefix ++ resolverErr)+                Right (Nothing, _, newAttempts) ->+                    let resolverAttempts' = resolverAttemptsAcc ++ newAttempts+                        terminalError =+                            case reverse previousFailures of+                                (latestFailure : _) -> errPrefix ++ pkeskAttemptFailureReason latestFailure+                                [] ->+                                    errPrefix+                                        ++ "no matching key context (callback probes: "+                                        ++ callbackProbeSummary+                                        ++ ")"+                     in resolvePKESKCandidates+                            rest+                            skeskErrs+                            (terminalError : pkeskErrs)+                            resolverAttempts'+                Right (Just keyInfo, nextAttemptIndex, newAttempts)+                    | pkeskRecipientSKey keyInfo `elem` attemptedSKeys ->+                        let resolverAttempts' = resolverAttemptsAcc ++ newAttempts+                            terminalError =+                                case reverse previousFailures of+                                    (latestFailure : _) -> errPrefix ++ pkeskAttemptFailureReason latestFailure+                                    [] ->+                                        errPrefix+                                            ++ "key context callback repeated without yielding a usable key"+                         in resolvePKESKCandidates+                                rest+                                skeskErrs+                                (terminalError : pkeskErrs)+                                resolverAttempts'+                    | otherwise -> do+                        let resolverAttempts' = resolverAttemptsAcc ++ newAttempts+                        unwrapped <- liftIO (tryUnwrapPKESKSessionMaterial pkesk keyInfo)+                        case unwrapped of+                            Left err ->+                                attemptPKESKCandidate+                                    (pkeskRecipientSKey keyInfo : attemptedSKeys)+                                    ( previousFailures+                                        ++ [mkAttemptFailure keyInfo PKESKAttemptUnwrapFailed err]+                                    )+                                    nextAttemptIndex+                                    expectedSymAlgo+                                    errPrefix+                                    resolverAttempts'+                            Right encodedSessionKey ->+                                case decodePKESKSessionKey expectedSymAlgo encodedSessionKey of+                                    Left err ->+                                        attemptPKESKCandidate+                                            (pkeskRecipientSKey keyInfo : attemptedSKeys)+                                            ( previousFailures+                                                ++ [ mkAttemptFailure+                                                        keyInfo+                                                        PKESKAttemptSessionMaterialDecodeFailed+                                                        err+                                                   ]+                                            )+                                            nextAttemptIndex+                                            expectedSymAlgo+                                            errPrefix+                                            resolverAttempts'+                                    Right (sa, k) -> do+                                        emitResolutionReport+                                            ( mkResolutionReport+                                                DecryptResolvedViaPKESK+                                                skeskErrs+                                                pkeskErrs+                                                resolverAttempts'+                                            )+                                        pure (sa, SessionKey k)++    emitResolutionReport+        :: MonadIO m => DecryptSessionKeyResolutionReport -> m ()+    emitResolutionReport report =+        case reportRef of+            Nothing -> pure ()+            Just ref -> liftIO (modifyIORef' ref (report :))++    mkResolutionReport+        :: DecryptSessionKeyResolutionPath+        -> [String]+        -> [String]+        -> [PKESKResolverAttempt]+        -> DecryptSessionKeyResolutionReport+    mkResolutionReport path skeskErrs pkeskErrs resolverAttempts =+        DecryptSessionKeyResolutionReport+            { decryptSessionResolutionPath = path+            , decryptSessionResolutionSKESKErrors = reverse skeskErrs+            , decryptSessionResolutionPKESKErrors = reverse pkeskErrs+            , decryptSessionResolutionResolverAttempts = resolverAttempts+            }++    mkAttemptFailure keyInfo failureKind reason =+        PKESKAttemptFailure+            { pkeskAttemptFailureKeyContext =+                recipientKeyContext keyInfo+            , pkeskAttemptFailureKind = failureKind+            , pkeskAttemptFailureReason = reason+            }++    recipientKeyContext+        :: PKESKRecipientKey -> Maybe (KeyVersion, PubKeyAlgorithm)+    recipientKeyContext keyInfo =+        fmap+            (\pk -> (_keyVersion pk, _pkalgo pk))+            (pkeskRecipientPKPayload keyInfo)++    renderPKESKResolverError (ResolverPolicyDenied reason) =+        "resolver policy denied candidate selection: " ++ reason+    renderPKESKResolverError (ResolverBackendUnavailable reason) =+        "resolver backend unavailable: " ++ reason+    renderPKESKResolverError (ResolverInvalidResponse reason) =+        "resolver returned an invalid response: " ++ reason++    resolvePKESKRecipientKey payload previousFailures attemptIndex0 =+        probePacketVariants+            attemptIndex0+            []+            (pkeskCallbackPackets payload)+      where+        probePacketVariants attemptIndex attemptsAcc [] =+            pure (Right (Nothing, attemptIndex, reverse attemptsAcc))+        probePacketVariants attemptIndex attemptsAcc (probePkt : restProbePkts) = do+            let request =+                    PKESKResolveRequest+                        { reqPKESK = payload+                        , reqProbePacket = probePkt+                        , reqIsWildcardRecipient = isWildcardPKESKPayload payload+                        , reqAttemptIndex = attemptIndex+                        , reqPreviousFailures = previousFailures+                        }+            resolveAction <-+                pkcb request+            let attemptRecord =+                    PKESKResolverAttempt+                        { pkeskResolverAttemptPreviousFailures = previousFailures+                        , pkeskResolverAttemptAction =+                            case resolveAction of+                                ResolveWith keyInfo ->+                                    ResolverAttemptResolveWith (recipientKeyContext keyInfo)+                                ResolveSkip -> ResolverAttemptSkip+                                ResolveExhausted -> ResolverAttemptExhausted+                                ResolveFail resolverErr -> ResolverAttemptFail resolverErr+                        }+            case resolveAction of+                ResolveWith keyInfo ->+                    pure+                        ( Right+                            ( Just keyInfo+                            , attemptIndex + 1+                            , reverse (attemptRecord : attemptsAcc)+                            )+                        )+                ResolveSkip ->+                    probePacketVariants+                        (attemptIndex + 1)+                        (attemptRecord : attemptsAcc)+                        restProbePkts+                ResolveExhausted ->+                    pure+                        ( Right+                            ( Nothing+                            , attemptIndex + 1+                            , reverse (attemptRecord : attemptsAcc)+                            )+                        )+                ResolveFail resolverErr ->+                    pure (Left (renderPKESKResolverError resolverErr))++    pkeskCallbackPackets payload =+        nub $+            case payload of+                PKESKPayloadV3Packet (PKESKPayloadV3 v rid pka mpis) ->+                    map+                        ( \ridVariant ->+                            PKESKPkt+                                (PKESKPayloadV3Packet (PKESKPayloadV3 v ridVariant pka mpis))+                        )+                        (recipientIdCallbackVariantsV3 rid)+                PKESKPayloadV6Packet (PKESKPayloadV6 rid pka esk) ->+                    map+                        ( \ridVariant ->+                            PKESKPkt+                                (PKESKPayloadV6Packet (PKESKPayloadV6 ridVariant pka esk))+                        )+                        (recipientIdCallbackVariants rid)++    describeCallbackProbeSummary payload =+        intercalate+            ", "+            (map describePKESKCallbackProbe (pkeskCallbackPackets payload))++    describePKESKCallbackProbe (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ rid pka _))) =+        "PKESK3 "+            ++ show pka+            ++ " rid="+            ++ show rid+            ++ if isWildcardV3RecipientKeyId rid+                then " (wildcard)"+                else ""+    describePKESKCallbackProbe (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka _))) =+        "PKESK6 " ++ show pka ++ " rid=" ++ show rid+    describePKESKCallbackProbe pkt = show pkt++    recipientIdCallbackVariantsV3 rid+        | isWildcardV3RecipientKeyId rid = [rid]+        | otherwise = [rid, EightOctetKeyId (BL.replicate 8 0)]++    recipientIdCallbackVariants rid+        | BL.length rid == 20 = [rid, BL.cons 0x04 rid]+        | BL.length rid == 21 && BL.head rid == 0x04 = [rid, BL.tail rid]+        | BL.length rid == 32 = [rid, BL.cons 0x06 rid]+        | BL.length rid == 33 && BL.head rid == 0x06 = [rid, BL.tail rid]+        | otherwise = [rid]++    isWildcardPKESKPayload (PKESKPayloadV3Packet (PKESKPayloadV3 _ (EightOctetKeyId rid) _ _)) =+        isWildcardV3RecipientKeyId (EightOctetKeyId rid)+    isWildcardPKESKPayload _ = False+    describePKESK payload =+        case classifyPKESKPayload payload of+            ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ rid pka _) ->+                "PKESK3 " ++ show pka ++ " rid=" ++ show rid+            ClassifiedPKESKPayloadV6 (PKESKPayloadV6 rid pka _) ->+                "PKESK6 " ++ show pka ++ " rid=" ++ show rid++    describeSKESK payload =+        case classifySKESKPayload payload of+            ClassifiedSKESKPayloadV4 (SKESKPayloadV4 sa s2k _) ->+                "SKESK4 " ++ show sa ++ " s2k=" ++ show s2k+            ClassifiedSKESKPayloadV6 (SKESKPayloadV6 sa aa s2k _ _ _) ->+                "SKESK6 " ++ show sa ++ "/" ++ show aa ++ " s2k=" ++ show s2k++data AlignedPendingESK (v :: EncryptedPayloadVersion) where+    LegacyAlignedSKESK+        :: SKESKPayloadV4+        -> AlignedPendingESK 'LegacyEncryptedPayloadVersion+    LegacyAlignedPKESK+        :: PKESKPayloadV3+        -> AlignedPendingESK 'LegacyEncryptedPayloadVersion+    SEIPDv2AlignedSKESK+        :: SKESKPayloadV6+        -> AlignedPendingESK 'SEIPDv2EncryptedPayloadVersion+    SEIPDv2AlignedPKESK+        :: PKESKPayloadV6+        -> AlignedPendingESK 'SEIPDv2EncryptedPayloadVersion+    {- | A version 3 PKESK that precedes a SEIPDv2 payload.++    RFC 9580 §5.13 explicitly permits version 3 PKESKs before a version 2+    SEIPD packet, as a backward-compatibility allowance for implementations+    that cannot yet produce v6 key material.  The v3 PKESK carries the+    session key wrapped with legacy (v3) asymmetric key wrapping; the SEIPD+    v2 payload itself is still authenticated with modern AEAD.  This+    constructor therefore counts as "aligned" for SEIPDv2 — it does not+    indicate a mis-assembled message — even though the PKESK version does+    not match the SEIPD version.+    -}+    SEIPDv2AlignedLegacyPKESK+        :: PKESKPayloadV3+        -> AlignedPendingESK 'SEIPDv2EncryptedPayloadVersion++alignedPrecedingESKs+    :: EncryptedPayloadFlavor v+    -> [PendingESK]+    -> [AlignedPendingESK v]+alignedPrecedingESKs LegacyEncryptedPayload =+    mapMaybe+        ( \esk ->+            case esk of+                PendingSKESK (SKESKPayloadV4Packet skesk4) -> Just (LegacyAlignedSKESK skesk4)+                PendingPKESK (PKESKPayloadV3Packet pkesk3) -> Just (LegacyAlignedPKESK pkesk3)+                _ -> Nothing+        )+alignedPrecedingESKs (SEIPDv2EncryptedPayload _ _) =+    mapMaybe+        ( \esk ->+            case esk of+                PendingSKESK (SKESKPayloadV6Packet skesk6) -> Just (SEIPDv2AlignedSKESK skesk6)+                PendingPKESK (PKESKPayloadV6Packet pkesk6) -> Just (SEIPDv2AlignedPKESK pkesk6)+                -- v3 PKESK before SEIPDv2 is explicitly allowed by RFC 9580 §5.13;+                -- see 'SEIPDv2AlignedLegacyPKESK' for details.+                PendingPKESK (PKESKPayloadV3Packet pkesk3) -> Just (SEIPDv2AlignedLegacyPKESK pkesk3)+                _ -> Nothing+        )++pendingESKsFromAligned :: [AlignedPendingESK v] -> [PendingESK]+pendingESKsFromAligned =+    map+        ( \esk ->+            case esk of+                LegacyAlignedSKESK skesk4 -> PendingSKESK (SKESKPayloadV4Packet skesk4)+                LegacyAlignedPKESK pkesk3 -> PendingPKESK (PKESKPayloadV3Packet pkesk3)+                SEIPDv2AlignedSKESK skesk6 -> PendingSKESK (SKESKPayloadV6Packet skesk6)+                SEIPDv2AlignedPKESK pkesk6 -> PendingPKESK (PKESKPayloadV6Packet pkesk6)+                SEIPDv2AlignedLegacyPKESK pkesk3 -> PendingPKESK (PKESKPayloadV3Packet pkesk3)+        )++payloadExpectedSymmetricAlgorithm+    :: EncryptedPayloadFlavor v -> Maybe SymmetricAlgorithm+payloadExpectedSymmetricAlgorithm LegacyEncryptedPayload = Nothing+payloadExpectedSymmetricAlgorithm (SEIPDv2EncryptedPayload sa _) = Just sa++payloadExpectedAEADAlgorithm+    :: EncryptedPayloadFlavor v -> Maybe AEADAlgorithm+payloadExpectedAEADAlgorithm LegacyEncryptedPayload = Nothing+payloadExpectedAEADAlgorithm (SEIPDv2EncryptedPayload _ aa) = Just aa++tryUnwrapPKESKSessionMaterial+    :: PKESKPayload+    -> PKESKRecipientKey+    -> IO (Either String B.ByteString)+tryUnwrapPKESKSessionMaterial pkesk keyInfo = do+    attempted <-+        try @SomeException+            (unwrapPKESKSessionMaterial pkesk keyInfo :: IO B.ByteString)+    pure (first displayException attempted)++data PKESKUnwrapCase where+    PKESKUnwrapV3RSA :: RSATypes.PrivateKey -> MPI -> PKESKUnwrapCase+    PKESKUnwrapV6RSA+        :: RSATypes.PrivateKey -> B.ByteString -> PKESKUnwrapCase+    PKESKUnwrapV6ECDH+        :: PKESKRecipientKey+        -> PubKeyAlgorithm+        -> B.ByteString+        -> ECDSA.PrivateKey+        -> PKESKUnwrapCase+    PKESKUnwrapV6XDHRaw+        :: PKESKRecipientKey+        -> PubKeyAlgorithm+        -> B.ByteString+        -> B.ByteString+        -> PKESKUnwrapCase+    PKESKUnwrapV3X25519FromECDH+        :: PKESKRecipientKey+        -> NonEmpty MPI+        -> ECDSA.PrivateKey+        -> PKESKUnwrapCase+    PKESKUnwrapV3X25519Raw+        :: PKESKRecipientKey+        -> NonEmpty MPI+        -> B.ByteString+        -> PKESKUnwrapCase+    PKESKUnwrapV3ECDH+        :: PKESKRecipientKey+        -> PubKeyAlgorithm+        -> NonEmpty MPI+        -> ECDSA.PrivateKey+        -> PKESKUnwrapCase++data ClassifiedPKESKPayload where+    ClassifiedPKESKPayloadV3+        :: PKESKPayloadV3 -> ClassifiedPKESKPayload+    ClassifiedPKESKPayloadV6+        :: PKESKPayloadV6 -> ClassifiedPKESKPayload++data ClassifiedPKESKRecipientKey where+    ClassifiedPKESKRecipientRSA+        :: PKESKRecipientKey+        -> RSATypes.PrivateKey+        -> ClassifiedPKESKRecipientKey+    ClassifiedPKESKRecipientECDH+        :: PKESKRecipientKey+        -> ECDSA.PrivateKey+        -> ClassifiedPKESKRecipientKey+    ClassifiedPKESKRecipientX25519+        :: PKESKRecipientKey -> B.ByteString -> ClassifiedPKESKRecipientKey+    ClassifiedPKESKRecipientX448+        :: PKESKRecipientKey -> B.ByteString -> ClassifiedPKESKRecipientKey+    ClassifiedPKESKRecipientUnsupported+        :: PKESKRecipientKey -> ClassifiedPKESKRecipientKey++classifyPKESKPayload :: PKESKPayload -> ClassifiedPKESKPayload+classifyPKESKPayload (PKESKPayloadV3Packet payloadV3) =+    ClassifiedPKESKPayloadV3 payloadV3+classifyPKESKPayload (PKESKPayloadV6Packet payloadV6) =+    ClassifiedPKESKPayloadV6 payloadV6++classifyPKESKRecipientKey+    :: PKESKRecipientKey -> ClassifiedPKESKRecipientKey+classifyPKESKRecipientKey keyInfo@(PKESKRecipientKey _ (RSAPrivateKey (RSA_PrivateKey privateKey))) =+    ClassifiedPKESKRecipientRSA keyInfo privateKey+classifyPKESKRecipientKey+    keyInfo@( PKESKRecipientKey+                    _+                    (ECDHPrivateKey (ECDSA_PrivateKey privateKey))+                ) =+        ClassifiedPKESKRecipientECDH keyInfo privateKey+classifyPKESKRecipientKey keyInfo@(PKESKRecipientKey _ (X25519PrivateKey privateKeyRaw)) =+    ClassifiedPKESKRecipientX25519 keyInfo privateKeyRaw+classifyPKESKRecipientKey keyInfo@(PKESKRecipientKey _ (X448PrivateKey privateKeyRaw)) =+    ClassifiedPKESKRecipientX448 keyInfo privateKeyRaw+classifyPKESKRecipientKey keyInfo =+    ClassifiedPKESKRecipientUnsupported keyInfo++pkeskPayloadAlgorithm :: PKESKPayload -> PubKeyAlgorithm+pkeskPayloadAlgorithm payload =+    case classifyPKESKPayload payload of+        ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka _) -> pka+        ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka _) -> pka++classifyPKESKUnwrapCase+    :: PKESKPayload+    -> PKESKRecipientKey+    -> Either String PKESKUnwrapCase+classifyPKESKUnwrapCase payload keyInfo =+    case (classifyPKESKPayload payload, classifyPKESKRecipientKey keyInfo) of+        ( ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka (mpi :| []))+            , ClassifiedPKESKRecipientRSA _ privateKey+            )+                | pka == RSA || pka == DeprecatedRSAEncryptOnly ->+                    Right (PKESKUnwrapV3RSA privateKey mpi)+        ( ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka esk)+            , ClassifiedPKESKRecipientRSA _ privateKey+            )+                | pka == RSA ->+                    Right (PKESKUnwrapV6RSA privateKey (BL.toStrict esk))+        ( ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka esk)+            , ClassifiedPKESKRecipientECDH recipientCtx privateKey+            )+                | pka == ECDH || pka == X25519 ->+                    Right+                        (PKESKUnwrapV6ECDH recipientCtx pka (BL.toStrict esk) privateKey)+        ( ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka esk)+            , ClassifiedPKESKRecipientX25519 recipientCtx privateKeyRaw+            )+                | pka == X25519 ->+                    Right+                        ( PKESKUnwrapV6XDHRaw+                            recipientCtx+                            pka+                            (BL.toStrict esk)+                            privateKeyRaw+                        )+        ( ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka esk)+            , ClassifiedPKESKRecipientX448 recipientCtx privateKeyRaw+            )+                | pka == X448 ->+                    Right+                        ( PKESKUnwrapV6XDHRaw+                            recipientCtx+                            pka+                            (BL.toStrict esk)+                            privateKeyRaw+                        )+        ( ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka mpis)+            , ClassifiedPKESKRecipientECDH recipientCtx privateKey+            )+                | pka == X25519 ->+                    Right (PKESKUnwrapV3X25519FromECDH recipientCtx mpis privateKey)+        ( ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka mpis)+            , ClassifiedPKESKRecipientX25519 recipientCtx privateKeyRaw+            )+                | pka == X25519 ->+                    Right (PKESKUnwrapV3X25519Raw recipientCtx mpis privateKeyRaw)+        ( ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka mpis)+            , ClassifiedPKESKRecipientECDH recipientCtx privateKey+            )+                | pka == ECDH || pka == X25519 ->+                    Right (PKESKUnwrapV3ECDH recipientCtx pka mpis privateKey)+        (ClassifiedPKESKPayloadV3 (PKESKPayloadV3 _ _ pka _), _) ->+            Left+                ("PKESK key unwrap unsupported for packet algorithm " ++ show pka)+        (ClassifiedPKESKPayloadV6 (PKESKPayloadV6 _ pka _), _) ->+            Left+                ( "PKESKv6 key unwrap unsupported for packet algorithm "+                    ++ show pka+                    ++ " with secret key "+                    ++ show (pkeskRecipientSKey keyInfo)+                )++unwrapPKESKSessionMaterial+    :: (MonadFail m, MonadIO m)+    => PKESKPayload -> PKESKRecipientKey -> m B.ByteString+unwrapPKESKSessionMaterial pkesk keyInfo = do+    either fail pure (validateTable30Policy pkesk keyInfo)+    unwrapCase <-+        either fail pure (classifyPKESKUnwrapCase pkesk keyInfo)+    case unwrapCase of+        PKESKUnwrapV3RSA privateKey mpi ->+            rsaUnwrap+                privateKey+                (leftPadTo (rsaModulusBytes privateKey) (i2osp (unMPI mpi)))+        PKESKUnwrapV6RSA privateKey esk -> do+            normalized <-+                either fail pure (normalizePKESKv6RSAEsk privateKey esk)+            rsaUnwrap privateKey normalized+        PKESKUnwrapV6ECDH recipientCtx pka esk privateKey ->+            ecdhUnwrapV6 recipientCtx pka esk privateKey+        PKESKUnwrapV6XDHRaw recipientCtx pka esk privateKeyRaw ->+            ecdhUnwrapV6XDHRaw recipientCtx pka esk privateKeyRaw+        PKESKUnwrapV3X25519FromECDH recipientCtx mpis privateKey -> do+            recipientPKP <-+                maybe+                    ( fail+                        "X25519 PKESKv3 unwrap requires recipient PKPayload context; use conduitDecrypt with DecryptWithKeyring or DecryptWithUnwrapCandidatesCallback"+                    )+                    pure+                    (pkeskRecipientPKPayload recipientCtx)+            recipientSecretRaw <-+                either fail pure (resolveX25519SecretRaw recipientPKP privateKey)+            x25519UnwrapV3 recipientCtx mpis recipientSecretRaw+        PKESKUnwrapV3X25519Raw recipientCtx mpis privateKeyRaw ->+            x25519UnwrapV3 recipientCtx mpis privateKeyRaw+        PKESKUnwrapV3ECDH recipientCtx pka mpis privateKey ->+            ecdhUnwrap recipientCtx pka mpis privateKey+  where+    validateTable30Policy+        :: PKESKPayload -> PKESKRecipientKey -> Either String ()+    validateTable30Policy payload recipientCtx =+        case pkeskRecipientPKPayload recipientCtx of+            Nothing -> Right ()+            Just recipientPKP ->+                case (pkeskPayloadAlgorithm payload, _pubkey recipientPKP) of+                    (ECDH, ECDHPubKey _ kdfHA kdfSA) ->+                        validateTable30PolicyForRecipient recipientPKP kdfHA kdfSA+                    _ -> Right ()++    rsaUnwrap privateKey encryptedSessionMaterial = do+        decrypted <-+            liftIO+                ( P15.decryptSafer privateKey encryptedSessionMaterial+                    :: IO (Either RSATypes.Error B.ByteString)+                )+        case decrypted of+            Left err -> fail ("RSA PKESK decrypt failed: " ++ show err)+            Right decoded -> pure decoded++    normalizePKESKv6RSAEsk+        :: RSATypes.PrivateKey+        -> B.ByteString+        -> Either String B.ByteString+    normalizePKESKv6RSAEsk privateKey esk = do+        when (B.length esk < 2) $+            Left "PKESKv6 RSA ESK is too short to contain an MPI"+        let mpiBits =+                fromIntegral (B.index esk 0) `shiftL` 8+                    + fromIntegral (B.index esk 1)+            mpiLen = (mpiBits + 7) `div` 8+        when (B.length esk /= 2 + mpiLen) $+            Left+                ( "PKESKv6 RSA ESK MPI length mismatch: expected "+                    ++ show (2 + mpiLen)+                    ++ " octets, got "+                    ++ show (B.length esk)+                )+        let mpiPayload = B.drop 2 esk+        when (mpiBits > 0) $ do+            when (B.null mpiPayload) $+                Left+                    "PKESKv6 RSA ESK MPI has non-zero bit length but empty payload"+            let firstOctet = B.head mpiPayload+                actualBits =+                    (B.length mpiPayload - 1) * 8+                        + (8 - countLeadingZeros firstOctet)+            when (actualBits /= mpiBits) $+                Left+                    ( "PKESKv6 RSA ESK MPI bit-length mismatch: declared "+                        ++ show mpiBits+                        ++ ", actual "+                        ++ show actualBits+                    )+        let modulusLen = rsaModulusBytes privateKey+        when (B.length mpiPayload > modulusLen) $+            Left+                ( "PKESKv6 RSA ESK MPI payload exceeds recipient modulus size: "+                    ++ show (B.length mpiPayload)+                    ++ " > "+                    ++ show modulusLen+                )+        pure (leftPadTo modulusLen mpiPayload)++    ecdhUnwrap recipientCtx pka mpis privateKey = do+        recipientPKP <-+            maybe+                ( fail+                    "ECDH PKESK unwrap requires recipient PKPayload context; use conduitDecrypt with DecryptWithKeyring or DecryptWithUnwrapCandidatesCallback"+                )+                pure+                (pkeskRecipientPKPayload recipientCtx)+        case _pubkey recipientPKP of+            ECDHPubKey ecdhPub kdfHA kdfSA -> do+                (ephemeralBytes, wrappedSessionKeyBytes) <-+                    either fail pure (parseECDHPKESKMPIs mpis)+                sharedSecret <-+                    case ecdhPub of+                        ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _)) -> do+                            ephPoint <- parseUncompressedPointForCurve curve ephemeralBytes+                            pure+                                ( BA.convert+                                    (ECCDH.getShared curve (ECDSA.private_d privateKey) ephPoint)+                                    :: B.ByteString+                                )+                        EdDSAPubKey EdSigningCurve25519 _ -> do+                            recipientSecretRaw <-+                                either fail pure (resolveX25519SecretRaw recipientPKP privateKey)+                            recipientSecret <-+                                either fail pure+                                    . first show+                                    . CE.eitherCryptoError+                                    $ C25519.secretKey recipientSecretRaw+                            ephBytes <-+                                either fail pure (normalizeX25519EphemeralPublic ephemeralBytes)+                            ephPub <-+                                either fail pure+                                    . first show+                                    . CE.eitherCryptoError+                                    $ C25519.publicKey ephBytes+                            pure . BA.convert $ C25519.dh ephPub recipientSecret+                        EdDSAPubKey EdSigningCurve448 _ ->+                            fail+                                "legacy ECDH PKESK unwrap does not support Curve448Legacy recipients"+                        _ ->+                            fail+                                "ECDH PKESK unwrap requires recipient ECDH public key to be ECDSA or X25519-compatible"+                param <-+                    either+                        fail+                        pure+                        (buildECDHKDFParam recipientPKP pka ecdhPub kdfHA kdfSA)+                kek <-+                    either fail pure (deriveECDHKek kdfHA kdfSA sharedSecret param)+                let wrappedCandidates =+                        candidateWrappedRFC3394CiphertextsForLegacyECDH+                            (LegacyECDHWrappedRFC3394Ciphertext wrappedSessionKeyBytes)+                    validUnwraps =+                        [ material+                        | wrappedCandidate <- wrappedCandidates+                        , Right decoded <-+                            [ aesKeyUnwrapRFC3394+                                kdfSA+                                kek+                                (unLegacyECDHWrappedRFC3394Ciphertext wrappedCandidate)+                            ]+                        , Right material <- [parseLegacyECDHDecodedSessionMaterial decoded]+                        ]+                case validUnwraps of+                    (material : _) -> pure (encodeLegacyECDHSessionMaterial material)+                    [] ->+                        case aesKeyUnwrapRFC3394 kdfSA kek wrappedSessionKeyBytes of+                            Left err -> fail err+                            Right _ ->+                                fail+                                    "legacy ECDH wrapped session key decrypted but decoded session material is malformed"+            _ ->+                fail+                    "ECDH PKESK unwrap requires recipient PKPayload with ECDHPubKey parameters"++    ecdhUnwrapV6 recipientCtx pka esk privateKey = do+        recipientPKP <-+            maybe+                ( fail+                    "ECDH PKESKv6 unwrap requires recipient PKPayload context; use conduitDecrypt with DecryptWithKeyring or DecryptWithUnwrapCandidatesCallback"+                )+                pure+                (pkeskRecipientPKPayload recipientCtx)+        if pka == X25519+            then do+                recipientSecretRaw <-+                    either fail pure (resolveX25519SecretRaw recipientPKP privateKey)+                v6X25519Unwrap recipientPKP recipientSecretRaw esk+            else+                if pka == X448+                    then+                        fail+                            "X448 PKESKv6 unwrap requires an X448PrivateKey recipient secret key and recipient PKPayload context"+                    else case _pubkey recipientPKP of+                        ECDHPubKey ecdhPub kdfHA kdfSA -> do+                            (ephemeralBytes, wrappedSessionKeyBytes) <-+                                either fail pure (parsePKESKv6ECDHEsk pka esk)+                            case ecdhPub of+                                ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _)) -> do+                                    ephPoint <- parseUncompressedPointForCurve curve ephemeralBytes+                                    let sharedSecret =+                                            BA.convert+                                                (ECCDH.getShared curve (ECDSA.private_d privateKey) ephPoint)+                                                :: B.ByteString+                                    param <-+                                        either+                                            fail+                                            pure+                                            (buildECDHKDFParam recipientPKP pka ecdhPub kdfHA kdfSA)+                                    kek <-+                                        either fail pure (deriveECDHKek kdfHA kdfSA sharedSecret param)+                                    case aesKeyUnwrapRFC3394 kdfSA kek wrappedSessionKeyBytes of+                                        Left err -> fail err+                                        Right decoded -> pure decoded+                                EdDSAPubKey EdSigningCurve25519 _ -> do+                                    recipientSecretRaw <-+                                        either fail pure (resolveX25519SecretRaw recipientPKP privateKey)+                                    recipientSecret <-+                                        either fail pure+                                            . first show+                                            . CE.eitherCryptoError+                                            $ C25519.secretKey recipientSecretRaw+                                    ephBytes <-+                                        either fail pure (normalizeX25519EphemeralPublic ephemeralBytes)+                                    ephPub <-+                                        either fail pure+                                            . first show+                                            . CE.eitherCryptoError+                                            $ C25519.publicKey ephBytes+                                    let sharedSecret = BA.convert (C25519.dh ephPub recipientSecret) :: B.ByteString+                                    param <-+                                        either+                                            fail+                                            pure+                                            (buildECDHKDFParam recipientPKP pka ecdhPub kdfHA kdfSA)+                                    let rfc6637Result =+                                            do+                                                kek <- deriveECDHKek kdfHA kdfSA sharedSecret param+                                                aesKeyUnwrapRFC3394 kdfSA kek wrappedSessionKeyBytes+                                    case rfc6637Result of+                                        Right decoded -> pure decoded+                                        Left rfc6637Err -> do+                                            recipientPublicRaw <-+                                                either fail pure (extractX25519RecipientPublic recipientPKP)+                                            let kekX25519 = deriveX25519Kek ephBytes recipientPublicRaw sharedSecret+                                            case aesKeyUnwrapRFC3394 AES128 kekX25519 wrappedSessionKeyBytes of+                                                Right decoded -> pure decoded+                                                Left x25519Err ->+                                                    fail+                                                        ( "ECDH PKESKv6 Curve25519 unwrap failed (RFC6637: "+                                                            ++ rfc6637Err+                                                            ++ ", X25519: "+                                                            ++ x25519Err+                                                            ++ ")"+                                                        )+                                EdDSAPubKey EdSigningCurve448 _ ->+                                    fail+                                        "ECDH PKESKv6 unwrap does not support Curve448Legacy recipients; use X448 PKESKv6 packets"+                                _ ->+                                    fail+                                        "ECDH PKESKv6 unwrap requires recipient ECDH public key to be ECDSA or X25519-compatible"+                        _ ->+                            fail+                                "ECDH PKESKv6 unwrap requires recipient PKPayload with ECDHPubKey parameters"++    ecdhUnwrapV6XDHRaw recipientCtx pka esk privateKeyRaw = do+        recipientPKP <-+            maybe+                ( fail+                    "X25519/X448 PKESKv6 unwrap requires recipient PKPayload context; use conduitDecrypt with DecryptWithKeyring or DecryptWithUnwrapCandidatesCallback"+                )+                pure+                (pkeskRecipientPKPayload recipientCtx)+        case pka of+            X25519 -> v6X25519Unwrap recipientPKP (leftPadTo 32 privateKeyRaw) esk+            X448 -> v6X448Unwrap recipientPKP (leftPadTo 56 privateKeyRaw) esk+            _ ->+                fail+                    ( "X25519/X448 PKESKv6 unwrap only supports X25519/X448 packets; got "+                        ++ show pka+                    )++    v6X25519Unwrap recipientPKP recipientSecretRaw esk = do+        recipientPublicRaw <-+            either fail pure (extractX25519RecipientPublic recipientPKP)+        (ephemeralBytes, wrappedSessionKeyBytes) <-+            either fail pure (parsePKESKv6ECDHEsk X25519 esk)+        ephBytes <-+            either fail pure (normalizeX25519EphemeralPublic ephemeralBytes)+        recipientSecret <-+            either fail pure+                . first show+                . CE.eitherCryptoError+                $ C25519.secretKey (leftPadTo 32 recipientSecretRaw)+        ephPub <-+            either fail pure+                . first show+                . CE.eitherCryptoError+                $ C25519.publicKey ephBytes+        let sharedSecret = BA.convert (C25519.dh ephPub recipientSecret) :: B.ByteString+            kek = deriveX25519Kek ephBytes recipientPublicRaw sharedSecret+        case aesKeyUnwrapRFC3394 AES128 kek wrappedSessionKeyBytes of+            Left err -> fail err+            Right decoded -> pure decoded++    extractX25519RecipientPublic recipientPKP =+        case _pubkey recipientPKP of+            EdDSAPubKey EdSigningCurve25519 point ->+                normalizeX25519EphemeralPublic (edPointBytes point)+            ECDHPubKey (EdDSAPubKey EdSigningCurve25519 point) _ _ ->+                normalizeX25519EphemeralPublic (edPointBytes point)+            other ->+                Left+                    ( "X25519 PKESKv6 unwrap requires an X25519 recipient public key, got "+                        ++ show other+                    )++    extractX448RecipientPublic recipientPKP =+        case _pubkey recipientPKP of+            EdDSAPubKey EdSigningCurve448 point ->+                normalizeX448EphemeralPublic (edPointBytes point)+            ECDHPubKey (EdDSAPubKey EdSigningCurve448 point) _ _ ->+                normalizeX448EphemeralPublic (edPointBytes point)+            other ->+                Left+                    ( "X448 PKESKv6 unwrap requires an X448 recipient public key, got "+                        ++ show other+                    )++    resolveX25519SecretRaw recipientPKP privateKey = do+        recipientPublicRaw <- extractX25519RecipientPublic recipientPKP+        let secretBE = leftPadTo 32 (i2osp (ECDSA.private_d privateKey))+            candidates = [secretBE, B.reverse secretBE]+            matchesCandidate candidate =+                case CE.eitherCryptoError (C25519.secretKey candidate) of+                    Right sk ->+                        let derivedPub = BA.convert (C25519.toPublic sk) :: B.ByteString+                         in derivedPub == recipientPublicRaw+                    Left _ -> False+        case filter matchesCandidate candidates of+            (candidate : _) -> Right candidate+            [] -> Right secretBE++    v6X448Unwrap recipientPKP recipientSecretRaw esk = do+        recipientPublicRaw <-+            either fail pure (extractX448RecipientPublic recipientPKP)+        (ephemeralBytes, wrappedSessionKeyBytes) <-+            either fail pure (parsePKESKv6ECDHEsk X448 esk)+        ephBytes <-+            either fail pure (normalizeX448EphemeralPublic ephemeralBytes)+        recipientSecret <-+            either fail pure+                . first show+                . CE.eitherCryptoError+                $ C448.secretKey (leftPadTo 56 recipientSecretRaw)+        ephPub <-+            either fail pure+                . first show+                . CE.eitherCryptoError+                $ C448.publicKey ephBytes+        let sharedSecret = BA.convert (C448.dh ephPub recipientSecret) :: B.ByteString+            kek = deriveX448Kek ephBytes recipientPublicRaw sharedSecret+        case aesKeyUnwrapRFC3394 AES256 kek wrappedSessionKeyBytes of+            Left err -> fail err+            Right decoded -> pure decoded++    x25519UnwrapV3 recipientCtx mpis recipientSecretRaw = do+        recipientPKP <-+            maybe+                ( fail+                    "X25519 PKESKv3 unwrap requires recipient PKPayload context; use conduitDecrypt with DecryptWithKeyring or DecryptWithUnwrapCandidatesCallback"+                )+                pure+                (pkeskRecipientPKPayload recipientCtx)+        recipientPublicRaw <-+            either fail pure (extractX25519RecipientPublic recipientPKP)+        (ephemeralBytes, eskBytes) <-+            either fail pure (parseECDHPKESKMPIs mpis)+        ephBytes <-+            either fail pure (normalizeX25519EphemeralPublic ephemeralBytes)+        recipientSecret <-+            either fail pure+                . first show+                . CE.eitherCryptoError+                $ C25519.secretKey (leftPadTo 32 recipientSecretRaw)+        ephPub <-+            either fail pure+                . first show+                . CE.eitherCryptoError+                $ C25519.publicKey ephBytes+        let sharedSecret = BA.convert (C25519.dh ephPub recipientSecret) :: B.ByteString+            kek9580 = deriveX25519Kek ephBytes recipientPublicRaw sharedSecret+            -- RFC9580 interpretation: eskBytes = algo_byte || AES-KW(raw_session_key)+            rfc9580Result = do+                (sessionAlgorithm, wrappedKey) <-+                    parsePKESKv3X25519EskBytes eskBytes+                rawKey <- aesKeyUnwrapRFC3394 AES128 kek9580 wrappedKey+                expectedLen <- symmetricKeyLength sessionAlgorithm+                when (B.length rawKey /= expectedLen) $+                    Left+                        ( "X25519 PKESKv3 unwrapped session key length mismatch for "+                            ++ show sessionAlgorithm+                            ++ ": expected "+                            ++ show expectedLen+                            ++ ", got "+                            ++ show (B.length rawKey)+                        )+                Right+                    ( B.singleton (fromIntegral (fromFVal sessionAlgorithm))+                        <> rawKey+                        <> checksum16Bytes rawKey+                    )+        case rfc9580Result of+            Right result -> pure result+            Left rfc9580Err ->+                -- Fallback: legacy ECDH interpretation where the full eskBytes is+                -- AES-KW(algo || key || checksum || padding).  Try with the RFC9580+                -- X25519 KEK and, when available, the RFC6637 ECDH KEK derived from+                -- any ECDH parameters on the recipient public key.+                let kekPairs =+                        (kek9580, AES128)+                            : x25519LegacyECDHKekCandidates recipientPKP sharedSecret+                    wrapped = LegacyECDHWrappedRFC3394Ciphertext eskBytes+                    candidates = candidateWrappedRFC3394CiphertextsForLegacyECDH wrapped+                    validResults =+                        [ encodeLegacyECDHSessionMaterial material+                        | (kek, kekSA) <- kekPairs+                        , candidate <- candidates+                        , Right decoded <-+                            [ aesKeyUnwrapRFC3394+                                kekSA+                                kek+                                (unLegacyECDHWrappedRFC3394Ciphertext candidate)+                            ]+                        , Right material <- [parseLegacyECDHDecodedSessionMaterial decoded]+                        ]+                 in case validResults of+                        (result : _) -> pure result+                        [] ->+                            fail+                                ( "X25519 PKESKv3 unwrap failed (RFC9580: "+                                    ++ rfc9580Err+                                    ++ "; legacy ECDH-style fallback also failed)"+                                )++    -- \| Derive RFC6637 ECDH KEK candidates for legacy X25519 PKESKv3 fallback.+    -- Returns @(kek, kekAlgorithm)@ pairs for each plausible ECDH KDF+    -- parameterisation found on the recipient public key.+    x25519LegacyECDHKekCandidates+        :: SomePKPayload+        -> B.ByteString+        -> [(B.ByteString, SymmetricAlgorithm)]+    x25519LegacyECDHKekCandidates pkPayload sharedSecret =+        case _pubkey pkPayload of+            ECDHPubKey ecdhPub kdfHA kdfSA ->+                [ (kek, kdfSA)+                | Right param <-+                    [buildECDHKDFParam pkPayload X25519 ecdhPub kdfHA kdfSA]+                , Right kek <- [deriveECDHKek kdfHA kdfSA sharedSecret param]+                ]+            _ -> []++rsaModulusBytes :: RSATypes.PrivateKey -> Int+rsaModulusBytes+    ( RSATypes.PrivateKey+            (RSATypes.PublicKey sizeField _ _)+            _+            _+            _+            _+            _+            _+        ) =+        sizeField++edPointBytes :: EdPoint -> B.ByteString+edPointBytes (PrefixedNativeEPoint (EPoint x)) = i2osp x+edPointBytes (NativeEPoint (EPoint x)) = i2osp x++parseECDHPKESKMPIs+    :: NonEmpty MPI -> Either String (B.ByteString, B.ByteString)+parseECDHPKESKMPIs (ephemeralMPI :| [wrappedMPI]) =+    Right (i2osp (unMPI ephemeralMPI), i2osp (unMPI wrappedMPI))+parseECDHPKESKMPIs _ =+    Left+        "ECDH PKESK must contain exactly two MPIs (ephemeral key, wrapped session key)"++newtype LegacyECDHWrappedRFC3394Ciphertext+    = LegacyECDHWrappedRFC3394Ciphertext+    { unLegacyECDHWrappedRFC3394Ciphertext :: B.ByteString+    }+    deriving (Eq)++newtype LegacyECDHSessionKey = LegacyECDHSessionKey {unLegacyECDHSessionKey :: B.ByteString}++newtype LegacyECDHSessionPadding = LegacyECDHSessionPadding+    {unLegacyECDHSessionPadding :: B.ByteString}++data LegacyECDHDecodedSessionMaterial+    = LegacyECDHDecodedSessionMaterial+    { legacyECDHSessionAlgorithm :: SymmetricAlgorithm+    , legacyECDHSessionKey :: LegacyECDHSessionKey+    , legacyECDHSessionPadding :: LegacyECDHSessionPadding+    }++candidateWrappedRFC3394CiphertextsForLegacyECDH+    :: LegacyECDHWrappedRFC3394Ciphertext+    -> [LegacyECDHWrappedRFC3394Ciphertext]+candidateWrappedRFC3394CiphertextsForLegacyECDH wrapped =+    let observedLen = B.length (unLegacyECDHWrappedRFC3394Ciphertext wrapped)+        plausibleWrappedLens = legacyECDHRFC3394WrappedLengths+        reconstructed =+            [ LegacyECDHWrappedRFC3394Ciphertext+                ( if observedLen == targetLen+                    then unLegacyECDHWrappedRFC3394Ciphertext wrapped+                    else+                        leftPadTo+                            targetLen+                            (unLegacyECDHWrappedRFC3394Ciphertext wrapped)+                )+            | targetLen <- plausibleWrappedLens+            , targetLen >= observedLen+            ]+     in nub (wrapped : reconstructed)++legacyECDHRFC3394WrappedLengths :: [Int]+legacyECDHRFC3394WrappedLengths =+    map legacyRFC3394WrappedLenForKeyLen [16, 24, 32]+  where+    legacyRFC3394WrappedLenForKeyLen keyLen =+        let encodedLen = 1 + keyLen + 2+            paddedLen = ((encodedLen + 7) `div` 8) * 8+         in paddedLen + 8++parseLegacyECDHDecodedSessionMaterial+    :: B.ByteString -> Either String LegacyECDHDecodedSessionMaterial+parseLegacyECDHDecodedSessionMaterial decoded = do+    when (B.length decoded < 3) $+        Left "legacy ECDH decoded session material is too short"+    let sessionAlgorithm = toFVal (B.head decoded)+    sessionKeyLen <- symmetricKeyLength sessionAlgorithm+    let payload = B.tail decoded+    when (B.length payload < sessionKeyLen + 2) $+        Left+            "legacy ECDH decoded session material does not contain full key and checksum"+    let (sessionKey, checksumAndPad) = B.splitAt sessionKeyLen payload+        (checksumBytes, padBytes) = B.splitAt 2 checksumAndPad+        expectedChecksum =+            fromIntegral (B.index checksumBytes 0) `shiftL` 8+                + fromIntegral (B.index checksumBytes 1)+        actualChecksum = checksum16 sessionKey+    when (actualChecksum /= expectedChecksum) $+        Left "legacy ECDH decoded session-key checksum mismatch"+    if B.null padBytes || B.all (== 0) padBytes+        then+            Right+                ( LegacyECDHDecodedSessionMaterial+                    sessionAlgorithm+                    (LegacyECDHSessionKey sessionKey)+                    (LegacyECDHSessionPadding padBytes)+                )+        else do+            validatePKCS7Padding padBytes+            Right+                ( LegacyECDHDecodedSessionMaterial+                    sessionAlgorithm+                    (LegacyECDHSessionKey sessionKey)+                    (LegacyECDHSessionPadding padBytes)+                )++encodeLegacyECDHSessionMaterial+    :: LegacyECDHDecodedSessionMaterial -> B.ByteString+encodeLegacyECDHSessionMaterial+    ( LegacyECDHDecodedSessionMaterial+            sessionAlgorithm+            (LegacyECDHSessionKey sessionKey)+            _+        ) =+        B.singleton (fromIntegral (fromFVal sessionAlgorithm))+            <> sessionKey+            <> checksum16Bytes sessionKey++parsePKESKv6ECDHEsk+    :: PubKeyAlgorithm+    -> B.ByteString+    -> Either String (B.ByteString, B.ByteString)+parsePKESKv6ECDHEsk pka esk+    | pka == X25519 =+        case parseFixedEphemeralWithWrappedLen 32 esk of+            Right parsed -> Right parsed+            Left _ -> parseLenPrefixedEphemeral 32 esk+    | pka == X448 =+        case parseFixedEphemeralWithWrappedLen 56 esk of+            Right parsed -> Right parsed+            Left _ -> parseLenPrefixedEphemeral 56 esk+    | B.length esk < 33 =+        Left "PKESKv6 ECDH ESK is too short"+    | otherwise =+        let withLen =+                let ephLen = fromIntegral (B.head esk)+                    rest = B.tail esk+                 in if ephLen > 0 && B.length rest > ephLen+                        then+                            let (eph, wrapped) = B.splitAt ephLen rest+                             in if validWrappedPayload wrapped+                                    then Just (eph, wrapped)+                                    else Nothing+                        else Nothing+            fixed32WithWrappedLen = parseFixedEphemeralWithWrappedLenMaybe 32 esk+            fixed32 =+                let (eph, wrapped) = B.splitAt 32 esk+                 in if validWrappedPayload wrapped+                        then Just (eph, wrapped)+                        else Nothing+            mpiWithWrappedLen =+                if B.length esk >= 4+                    then+                        let mpiBits =+                                fromIntegral (B.index esk 0) `shiftL` 8+                                    + fromIntegral (B.index esk 1)+                            mpiLen = (mpiBits + 7) `div` 8+                            rest = B.drop (2 + mpiLen) esk+                         in if mpiLen > 0 && B.length esk > 2 + mpiLen && not (B.null rest)+                                then+                                    let eph = B.take mpiLen (B.drop 2 esk)+                                        wrappedLen = fromIntegral (B.head rest)+                                        wrapped = B.tail rest+                                     in if wrappedLen == B.length wrapped && validWrappedPayload wrapped+                                            then Just (eph, wrapped)+                                            else Nothing+                                else Nothing+                    else Nothing+         in case fixed32WithWrappedLen+                <|> withLen+                <|> fixed32+                <|> mpiWithWrappedLen of+                Just x -> Right x+                Nothing ->+                    Left+                        "PKESKv6 ECDH ESK could not be parsed as {ephemeral32||len||wrapped}, {len||ephemeral||wrapped}, {ephemeral32||wrapped}, or {mpi(ephemeral)||len||wrapped}"+  where+    validWrappedPayload wrapped = B.length wrapped >= 24 && B.length wrapped `mod` 8 == 0++    parseFixedEphemeralWithWrappedLenMaybe ephLen payload =+        let (eph, rest) = B.splitAt ephLen payload+         in if B.length rest >= 2+                then+                    let wrappedLen = fromIntegral (B.head rest)+                        wrapped = B.tail rest+                     in if wrappedLen == B.length wrapped && validWrappedPayload wrapped+                            then Just (eph, wrapped)+                            else Nothing+                else Nothing++    parseFixedEphemeralWithWrappedLen ephLen payload =+        maybe+            ( Left+                ( "PKESKv6 XDH ESK expected {ephemeral"+                    ++ show ephLen+                    ++ "||len||wrapped} framing"+                )+            )+            Right+            (parseFixedEphemeralWithWrappedLenMaybe ephLen payload)++    parseLenPrefixedEphemeral expectedLen payload =+        if B.null payload+            then Left "PKESKv6 XDH ESK is empty"+            else+                let ephLen = fromIntegral (B.head payload)+                    rest = B.tail payload+                 in if ephLen == expectedLen && B.length rest > ephLen+                        then+                            let (eph, wrapped) = B.splitAt ephLen rest+                             in if validWrappedPayload wrapped+                                    then Right (eph, wrapped)+                                    else Left "PKESKv6 XDH ESK wrapped payload has invalid length"+                        else+                            Left+                                ( "PKESKv6 XDH ESK expected "+                                    ++ show expectedLen+                                    ++ "-octet ephemeral value"+                                )++normalizeX25519EphemeralPublic+    :: B.ByteString -> Either String B.ByteString+normalizeX25519EphemeralPublic =+    normalizeMontgomeryPublic+        32+        "invalid X25519 ephemeral public key length/prefix: "++normalizeX448EphemeralPublic+    :: B.ByteString -> Either String B.ByteString+normalizeX448EphemeralPublic =+    normalizeMontgomeryPublic+        56+        "invalid X448 ephemeral public key length/prefix: "++parseUncompressedPointForCurve+    :: MonadFail m => ECCT.Curve -> B.ByteString -> m ECCT.Point+parseUncompressedPointForCurve curve bs+    | B.length bs < 1 = fail "ECDH ephemeral point is empty"+    | Just expectedLen <- expectedUncompressedPointLength curve+    , B.length bs /= expectedLen =+        fail+            ( "ECDH ephemeral point has invalid length for recipient curve: expected "+                ++ show expectedLen+                ++ ", got "+                ++ show (B.length bs)+            )+    | B.head bs /= 0x04 =+        fail "ECDH ephemeral point must be uncompressed (0x04)"+    | otherwise =+        let xy = B.tail bs+         in if odd (B.length xy)+                then fail "ECDH ephemeral point has malformed coordinate length"+                else+                    let (xb, yb) = B.splitAt (B.length xy `div` 2) xy+                     in pure (ECCT.Point (os2ip xb) (os2ip yb))++expectedUncompressedPointLength :: ECCT.Curve -> Maybe Int+expectedUncompressedPointLength curve+    | curve == ECCT.getCurveByName ECCT.SEC_p256r1 = Just 65+    | curve == ECCT.getCurveByName ECCT.SEC_p384r1 = Just 97+    | curve == ECCT.getCurveByName ECCT.SEC_p521r1 = Just 133+    | otherwise = Nothing++deriveX25519Kek+    :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString+deriveX25519Kek ephemeralPublic recipientPublic sharedSecret =+    let ikm = ephemeralPublic <> recipientPublic <> sharedSecret+        prk = extract @CHA.SHA256 B.empty ikm+        info :: B.ByteString+        info = "OpenPGP X25519"+        okm :: B.ByteString+        okm = expand @CHA.SHA256 prk info 16+     in okm++deriveX448Kek+    :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString+deriveX448Kek ephemeralPublic recipientPublic sharedSecret =+    let ikm = ephemeralPublic <> recipientPublic <> sharedSecret+        prk = extract @CHA.SHA512 B.empty ikm+        info :: B.ByteString+        info = "OpenPGP X448"+        okm :: B.ByteString+        okm = expand @CHA.SHA512 prk info 32+     in okm++aesKeyUnwrapRFC3394+    :: SymmetricAlgorithm+    -> B.ByteString+    -> B.ByteString+    -> Either String B.ByteString+aesKeyUnwrapRFC3394 sa kek wrapped =+    withAESCipher+        "ECDH PKESK currently supports AES KEK algorithms only"+        sa+        kek+        unwrapWithCipher+  where+    unwrapWithCipher+        :: CCT.BlockCipher cipher+        => cipher+        -> Either String B.ByteString+    unwrapWithCipher cipher = do+        when (B.length wrapped < 24 || B.length wrapped `mod` 8 /= 0) $+            Left+                "ECDH wrapped session key must be at least 24 octets and a multiple of 8"+        let (a0, rBytes) = B.splitAt 8 wrapped+            rs = chunksOf8 rBytes+        when (length rs < 2) $+            Left+                "ECDH wrapped session key must contain at least two 64-bit blocks"+        (aFinal, rFinal) <- unwrapRounds cipher a0 rs+        when (aFinal /= B.replicate 8 0xA6) $+            Left "ECDH wrapped session key integrity check failed"+        Right (B.concat rFinal)++    unwrapRounds+        :: CCT.BlockCipher cipher+        => cipher+        -> B.ByteString+        -> [B.ByteString]+        -> Either String (B.ByteString, [B.ByteString])+    unwrapRounds cipher aInit rsInit = goJ 5 aInit rsInit+      where+        n = length rsInit+        goJ j aState rsState+            | j < 0 = Right (aState, rsState)+            | otherwise = do+                (a', rs') <- goI n aState rsState+                goJ (j - 1) a' rs'+          where+            goI i aCurrent rsCurrent+                | i <= 0 = Right (aCurrent, rsCurrent)+                | otherwise = do+                    let t = fromIntegral (n * j + i) :: Word64+                        aXorT = xorBS aCurrent (encodeWord64be t)+                        rI = rsCurrent !! (i - 1)+                        block = CCT.ecbDecrypt cipher (aXorT <> rI)+                        (aNext, rNext) = B.splitAt 8 block+                        rsNext = (ix (i - 1) .~ rNext) rsCurrent+                    goI (i - 1) aNext rsNext++chunksOf8 :: B.ByteString -> [B.ByteString]+chunksOf8 bs+    | B.null bs = []+    | otherwise =+        let (h, t) = B.splitAt 8 bs+         in h : chunksOf8 t++xorBS :: B.ByteString -> B.ByteString -> B.ByteString+xorBS a b = B.pack (B.zipWith xor a b)++decodePKESKSessionKey+    :: Maybe SymmetricAlgorithm+    -> B.ByteString+    -> Either String (SymmetricAlgorithm, B.ByteString)+decodePKESKSessionKey expectedSymAlgo encodedSessionKey =+    case decodeOpenPGPEncodedSessionKey encodedSessionKey of+        Right (symalgo, sessionKey) ->+            case expectedSymAlgo of+                Just expected+                    | expected /= symalgo ->+                        Left "Decrypted PKESK symmetric algorithm does not match payload"+                _ -> Right (symalgo, sessionKey)+        Left decodeErr ->+            case expectedSymAlgo of+                Nothing ->+                    Left+                        ( "PKESK session key material must be OpenPGP encoded when payload algorithm is unknown: "+                            ++ renderEncodedSessionKeyError decodeErr+                        )+                Just expected -> do+                    expectedLen <- symmetricKeyLength expected+                    case decodeExpectedRawOrPaddedSessionKey+                        expected+                        expectedLen+                        encodedSessionKey of+                        Left err -> Left err+                        Right sessionKey -> Right (expected, sessionKey)++parsePKESKv3X25519EskBytes+    :: B.ByteString -> Either String (SymmetricAlgorithm, B.ByteString)+parsePKESKv3X25519EskBytes eskBytes = do+    when (B.length eskBytes < 2) $+        Left "PKESKv3 X25519 ESK field is too short"+    let sessionAlgorithm = toFVal (B.head eskBytes)+        wrappedSessionKeyBytes = B.tail eskBytes+    when (sessionAlgorithm `notElem` [AES128, AES192, AES256]) $+        Left+            "PKESKv3 X25519 ESK field uses unsupported symmetric algorithm"+    when+        ( B.length wrappedSessionKeyBytes < 24+            || B.length wrappedSessionKeyBytes `mod` 8 /= 0+        )+        $ Left+            "PKESKv3 X25519 wrapped session key must be at least 24 octets and a multiple of 8"+    pure (sessionAlgorithm, wrappedSessionKeyBytes)++decodeExpectedRawOrPaddedSessionKey+    :: SymmetricAlgorithm+    -> Int+    -> B.ByteString+    -> Either String B.ByteString+decodeExpectedRawOrPaddedSessionKey expected expectedLen encodedSessionKey+    | B.length encodedSessionKey == expectedLen =+        Right encodedSessionKey+    | otherwise =+        case decodeV6PaddedSessionKeyWithoutAlgo expectedLen encodedSessionKey of+            Right sessionKey -> Right sessionKey+            Left _ ->+                case decodeV6PaddedSessionKeyWithAlgo+                    expected+                    expectedLen+                    encodedSessionKey of+                    Right sessionKey -> Right sessionKey+                    Left _ ->+                        Left+                            "PKESK raw session key length does not match payload algorithm"++decodeV6PaddedSessionKeyWithoutAlgo+    :: Int -> B.ByteString -> Either String B.ByteString+decodeV6PaddedSessionKeyWithoutAlgo expectedLen encodedSessionKey = do+    when (B.length encodedSessionKey < expectedLen + 2) $+        Left "v6 ECDH decoded session material is too short"+    let (sessionKey, rest) = B.splitAt expectedLen encodedSessionKey+        (checksumBytes, padBytes) = B.splitAt 2 rest+        expectedChecksum =+            fromIntegral (B.index checksumBytes 0) `shiftL` 8+                + fromIntegral (B.index checksumBytes 1)+        actualChecksum = checksum16 sessionKey+    when (actualChecksum /= expectedChecksum) $+        Left "v6 ECDH decoded session-key checksum mismatch"+    validatePKCS7Padding padBytes+    Right sessionKey++decodeV6PaddedSessionKeyWithAlgo+    :: SymmetricAlgorithm+    -> Int+    -> B.ByteString+    -> Either String B.ByteString+decodeV6PaddedSessionKeyWithAlgo expected expectedLen encodedSessionKey = do+    when (B.length encodedSessionKey < expectedLen + 3) $+        Left+            "v6 ECDH decoded session material with algorithm octet is too short"+    let algOctet = B.head encodedSessionKey+    when (toFVal algOctet /= expected) $+        Left "v6 ECDH decoded session material algorithm mismatch"+    let rest = B.tail encodedSessionKey+        (sessionKey, checksumAndPad) = B.splitAt expectedLen rest+        (checksumBytes, padBytes) = B.splitAt 2 checksumAndPad+        expectedChecksum =+            fromIntegral (B.index checksumBytes 0) `shiftL` 8+                + fromIntegral (B.index checksumBytes 1)+        actualChecksum = checksum16 sessionKey+    when (actualChecksum /= expectedChecksum) $+        Left "v6 ECDH decoded session-key checksum mismatch"+    validatePKCS7Padding padBytes+    Right sessionKey++validatePKCS7Padding :: B.ByteString -> Either String ()+validatePKCS7Padding padBytes+    | B.null padBytes = Right ()+    | otherwise = do+        let padLen = fromIntegral (B.last padBytes) :: Int+        when (padLen <= 0 || padLen > 8 || B.length padBytes /= padLen) $+            Left+                "v6 ECDH decoded session material has invalid PKCS#7-style padding length"+        when (B.any (/= fromIntegral padLen) padBytes) $+            Left+                "v6 ECDH decoded session material has invalid PKCS#7-style padding bytes"++symmetricKeyLength :: SymmetricAlgorithm -> Either String Int+symmetricKeyLength = first renderCipherError . keySize++checksum16 :: B.ByteString -> Word16+checksum16 =+    fromIntegral+        . B.foldl'+            (\acc octet -> (acc + fromIntegral octet) `mod` (65536 :: Integer))+            0++checksum16Bytes :: B.ByteString -> B.ByteString+checksum16Bytes sessionKey =+    B.pack [fromIntegral (chk `shiftR` 8), fromIntegral chk]   where     chk = checksum16 sessionKey
Data/Conduit/OpenPGP/Keyring.hs view
@@ -2,496 +2,502 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).- {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}  module Data.Conduit.OpenPGP.Keyring-  ( conduitToUnknownTKs-  , TypedTKConduitError(..)-  , conduitToSomeTKsEither-  , conduitToSomeTKsDropping-  , conduitToSomeTKsDroppingEither-  , conduitToTKs-  , conduitToPublicTKs-  , conduitToPublicViewTKs-  , conduitToSecretTKs-  , AuthSecretSubkeyUID(..)-  , AuthSecretSubkeyAtTime(..)-  , AuthSecretSubkeyRejectionReason(..)-  , AuthSecretSubkeyRejectedAtTime(..)-  , AuthSecretSubkeysAtReport(..)-  , authSecretSubkeysAt-  , authSecretSubkeysAtReport-  , conduitToAuthSecretSubkeysAt-  , conduitToAuthSecretSubkeysAtReport-  , conduitToTKsDropping-  , conduitToTKsEither-  , conduitToTKsDroppingEither-  , conduitToTKsWithWireRep-  , conduitToTKsDroppingWithWireRep-  , conduitToTKsWithWireRepEither-  , conduitToTKsDroppingWithWireRepEither-  , KeyringChunkParseError(..)-  , sinkPublicKeyringMap-  , sinkSecretKeyringMap-  , publicTKToKeyring-  , secretTKToKeyring-  , partitionSomeTKs-  ) where+    ( TypedTKConduitError (..)+    , conduitToSomeTKsEither+    , conduitToSomeTKsDroppingEither+    , AuthSecretSubkeyUID (..)+    , AuthSecretSubkeyAtTime (..)+    , AuthSecretSubkeyRejectionReason (..)+    , AuthSecretSubkeyRejectedAtTime (..)+    , AuthSecretSubkeysAtReport (..)+    , authSecretSubkeysAt+    , authSecretSubkeysAtReport+    , conduitToAuthSecretSubkeysAt+    , conduitToAuthSecretSubkeysAtReport+    , conduitToTKsEither+    , conduitToTKsDroppingEither+    , conduitToTKsWithWireRepEither+    , conduitToTKsDroppingWithWireRepEither+    , conduitDropErrorsAndNothings+    , KeyringChunkParseError (..)+    , sinkPublicKeyringMap+    , sinkSecretKeyringMap+    , publicTKToKeyring+    , secretTKToKeyring+    , partitionSomeTKs+    ) where +import Data.Bifunctor (first) import Data.Conduit import qualified Data.Conduit.List as CL-import Data.Bifunctor (first)+import Data.IxSet.Typed (empty, insert) import Data.List (find) import Data.Maybe (maybeToList) import qualified Data.Set as Set import Data.Text (Text) import Data.Time.Clock (UTCTime)-import Data.IxSet.Typed (empty, insert)  import Codec.Encryption.OpenPGP.Expirations-  ( isCertificationSig-  , isPKTimeValidWithSelfSignatures-  , isTKTimeValid-  , newestByCreationTime-  , signatureCreationTime-  , signatureEffectiveAt-  )+    ( isCertificationSig+    , isPKTimeValidWithSelfSignatures+    , isTKTimeValid+    , newestByCreationTime+    , signatureCreationTime+    , signatureEffectiveAt+    ) import Codec.Encryption.OpenPGP.KeyringParser-  ( KeyringChunkParseError(..)-  , anyTK-  , anyTKWithWireRep-  , finalizeParsingEither-  , parseAChunkEither-  )-import Codec.Encryption.OpenPGP.Ontology (isSubkeyBindingSig, isTrustPkt)+    ( KeyringChunkParseError (..)+    , anyTK+    , anyTKWithWireRep+    , finalizeParsingEither+    , parseAChunkEither+    )+import Codec.Encryption.OpenPGP.Ontology+    ( isSubkeyBindingSig+    , isTrustPkt+    )+import Codec.Encryption.OpenPGP.Policy+    ( defaultVerificationPolicy+    ) import Codec.Encryption.OpenPGP.SignatureQualities- ( signatureHashedSubpacketsKnown- )+    ( signatureHashedSubpacketsKnown+    ) import Codec.Encryption.OpenPGP.Signatures- ( verifyAgainstKeys- , verifySigWith- , verifyTKWith- )+    ( verifyAgainstKeys+    , verifySigWith+    , verifyTKWith+    ) import Codec.Encryption.OpenPGP.Types import Data.Conduit.OpenPGP.Keyring.Instances ()  data Phase-  = MainKey-  | Revs-  | Uids-  | UAts-  | Subs-  | SkippingBroken-  deriving (Eq, Ord, Show)+    = MainKey+    | Revs+    | Uids+    | UAts+    | Subs+    | SkippingBroken+    deriving (Eq, Ord, Show)  data TypedTKConduitError-  = TypedTKParseError KeyringChunkParseError-  | TypedTKConversionError TKConversionError-  deriving (Eq, Show)---- | Deprecated: this conduit silently drops parse failures and parse-time--- omissions. Prefer 'conduitToTKsEither' and handle errors explicitly.-conduitToUnknownTKs :: Monad m => ConduitT Pkt TKUnknown m ()-conduitToUnknownTKs =-  conduitToTKsEither .|-  conduitDropErrorsAndNothings-{-# DEPRECATED conduitToUnknownTKs "Use conduitToTKsEither and handle Left/Maybe explicitly." #-}+    = TypedTKParseError KeyringChunkParseError+    | TypedTKConversionError TKConversionError+    deriving (Eq, Show)  -- | Canonical strict typed conduit with explicit parse+conversion error channel.-conduitToSomeTKsEither ::-     Monad m => ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m ()+conduitToSomeTKsEither+    :: (Monad m)+    => ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m () conduitToSomeTKsEither =-  conduitToTKsEither .|-  CL.map toTypedSomeTKEither---- | Deprecated: this conduit silently drops parse+conversion failures.--- Prefer 'conduitToSomeTKsEither' and handle errors explicitly.-conduitToSomeTKsDropping :: Monad m => ConduitT Pkt SomeTK m ()-conduitToSomeTKsDropping =-  conduitToSomeTKsDroppingEither .|-  conduitDropErrorsAndNothings-{-# DEPRECATED conduitToSomeTKsDropping "Use conduitToSomeTKsEither and handle Left/Maybe explicitly." #-}+    conduitToTKsEither+        .| CL.map toTypedSomeTKEither --- | Tolerant typed conduit (broken transferable-key chunks may be omitted),--- while still surfacing parse+conversion failures.-conduitToSomeTKsDroppingEither ::-     Monad m => ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m ()+{- | Tolerant typed conduit (broken transferable-key chunks may be omitted),+while still surfacing parse+conversion failures.+-}+conduitToSomeTKsDroppingEither+    :: (Monad m)+    => ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m () conduitToSomeTKsDroppingEither =-  conduitToTKsDroppingEither .|-  CL.map toTypedSomeTKEither---- | Deprecated: this conduit silently drops parse+conversion failures.--- Prefer 'conduitToSomeTKsEither' and handle errors explicitly.-conduitToTKs :: Monad m => ConduitT Pkt SomeTK m ()-conduitToTKs =-  conduitToUnknownTKs .|-  CL.mapMaybe (either (const Nothing) Just . fromUnknownToTKEither)-{-# DEPRECATED conduitToTKs "Use conduitToSomeTKsEither and handle Left/Maybe explicitly." #-}+    conduitToTKsDroppingEither+        .| CL.map toTypedSomeTKEither -toTypedSomeTKEither ::-     Either KeyringChunkParseError (Maybe TKUnknown)-  -> Either TypedTKConduitError (Maybe SomeTK)+toTypedSomeTKEither+    :: Either KeyringChunkParseError (Maybe TKUnknown)+    -> Either TypedTKConduitError (Maybe SomeTK) toTypedSomeTKEither =-  either-    (Left . TypedTKParseError)-    (\maybeUnknown ->-       case maybeUnknown of-         Nothing -> Right Nothing-         Just unknown -> first TypedTKConversionError (Just <$> fromUnknownToTKEither unknown))--conduitToPublicTKs :: Monad m => ConduitT Pkt (TK 'PublicTK) m ()-conduitToPublicTKs =-  conduitToTKs .|-  CL.mapMaybe someTKToPublicTK-{-# DEPRECATED conduitToPublicTKs "Use conduitToSomeTKsEither and perform explicit projection/filtering." #-}---- | Yield public TKs from any input: native public TKs pass through,--- secret TKs are stripped to their public view-conduitToPublicViewTKs :: Monad m => ConduitT Pkt (TK 'PublicTK) m ()-conduitToPublicViewTKs =-  conduitToTKs .|-  CL.map someTKToPublicViewTK-{-# DEPRECATED conduitToPublicViewTKs "Use conduitToSomeTKsEither and perform explicit projection." #-}--conduitToSecretTKs :: Monad m => ConduitT Pkt (TK 'SecretTK) m ()-conduitToSecretTKs =-  conduitToTKs .|-  CL.mapMaybe someTKToSecretTK-{-# DEPRECATED conduitToSecretTKs "Use conduitToSomeTKsEither and perform explicit projection/filtering." #-}+    either+        (Left . TypedTKParseError)+        ( \maybeUnknown ->+            case maybeUnknown of+                Nothing -> Right Nothing+                Just unknown ->+                    first+                        TypedTKConversionError+                        (Just <$> fromUnknownToTKEither unknown)+        ) -data AuthSecretSubkeyUID =-  AuthSecretSubkeyUID+data AuthSecretSubkeyUID+    = AuthSecretSubkeyUID     { authSecretSubkeyUIDValue :: Text     , authSecretSubkeyUIDIsPrimary :: Bool     }-  deriving (Eq, Show)+    deriving (Eq, Show) -data AuthSecretSubkeyAtTime =-  AuthSecretSubkeyAtTime+data AuthSecretSubkeyAtTime+    = AuthSecretSubkeyAtTime     { authSecretSubkeyPrimaryKey :: KeyPkt 'SecretPkt     , authSecretSubkeyValue :: KeyPkt 'SecretPkt     , authSecretSubkeyUIDs :: [AuthSecretSubkeyUID]     , authSecretSubkeyPrimaryUID :: Maybe Text     }-  deriving (Eq, Show)+    deriving (Eq, Show)  data AuthSecretSubkeyRejectionReason-  = AuthSecretSubkeyTKVerificationFailed-  | AuthSecretSubkeyPrimaryKeyInvalidAtTime-  | AuthSecretSubkeyNotSecretSubkeyPacket-  | AuthSecretSubkeyNotSubkeyPacket-  | AuthSecretSubkeySubkeyInvalidAtTime-  | AuthSecretSubkeyMissingAuthCapability-  deriving (Eq, Show)+    = AuthSecretSubkeyTKVerificationFailed+    | AuthSecretSubkeyPrimaryKeyInvalidAtTime+    | AuthSecretSubkeyNotSecretSubkeyPacket+    | AuthSecretSubkeyNotSubkeyPacket+    | AuthSecretSubkeySubkeyInvalidAtTime+    | AuthSecretSubkeyMissingAuthCapability+    deriving (Eq, Show) -data AuthSecretSubkeyRejectedAtTime =-  AuthSecretSubkeyRejectedAtTime+data AuthSecretSubkeyRejectedAtTime+    = AuthSecretSubkeyRejectedAtTime     { authSecretSubkeyRejectedPrimaryKey :: KeyPkt 'SecretPkt     , authSecretSubkeyRejectedValue :: Maybe (KeyPkt 'SecretPkt)     , authSecretSubkeyRejectedUIDs :: [AuthSecretSubkeyUID]     , authSecretSubkeyRejectedPrimaryUID :: Maybe Text     , authSecretSubkeyRejectedReason :: AuthSecretSubkeyRejectionReason     }-  deriving (Eq, Show)+    deriving (Eq, Show) -data AuthSecretSubkeysAtReport =-  AuthSecretSubkeysAtReport+data AuthSecretSubkeysAtReport+    = AuthSecretSubkeysAtReport     { authSecretSubkeysAccepted :: [AuthSecretSubkeyAtTime]     , authSecretSubkeysRejected :: [AuthSecretSubkeyRejectedAtTime]     }-  deriving (Eq, Show)+    deriving (Eq, Show) -conduitToAuthSecretSubkeysAtReport ::-     Monad m-  => UTCTime-  -> ConduitT (TK 'SecretTK) AuthSecretSubkeysAtReport m ()+conduitToAuthSecretSubkeysAtReport+    :: Monad m+    => UTCTime+    -> ConduitT (TK 'SecretTK) AuthSecretSubkeysAtReport m () conduitToAuthSecretSubkeysAtReport validationTime =-  CL.map (authSecretSubkeysAtReport validationTime)+    CL.map (authSecretSubkeysAtReport validationTime) -conduitToAuthSecretSubkeysAt ::-     Monad m-  => UTCTime-  -> ConduitT (TK 'SecretTK) AuthSecretSubkeyAtTime m ()+conduitToAuthSecretSubkeysAt+    :: Monad m+    => UTCTime+    -> ConduitT (TK 'SecretTK) AuthSecretSubkeyAtTime m () conduitToAuthSecretSubkeysAt validationTime =-  CL.concatMap (authSecretSubkeysAccepted . authSecretSubkeysAtReport validationTime)+    CL.concatMap+        ( authSecretSubkeysAccepted+            . authSecretSubkeysAtReport validationTime+        ) -authSecretSubkeysAt :: UTCTime -> TK 'SecretTK -> [AuthSecretSubkeyAtTime]+authSecretSubkeysAt+    :: UTCTime -> TK 'SecretTK -> [AuthSecretSubkeyAtTime] authSecretSubkeysAt validationTime =-  authSecretSubkeysAccepted . authSecretSubkeysAtReport validationTime+    authSecretSubkeysAccepted+        . authSecretSubkeysAtReport validationTime -authSecretSubkeysAtReport :: UTCTime -> TK 'SecretTK -> AuthSecretSubkeysAtReport+authSecretSubkeysAtReport+    :: UTCTime -> TK 'SecretTK -> AuthSecretSubkeysAtReport authSecretSubkeysAtReport validationTime typedTk =-  case verifyTKWith (verifySigWith (verifyAgainstKeys [untyped])) (Just validationTime) typedTk of-    Left _ ->-      AuthSecretSubkeysAtReport-        []-        [ AuthSecretSubkeyRejectedAtTime-            { authSecretSubkeyRejectedPrimaryKey = primaryKey-            , authSecretSubkeyRejectedValue = Nothing-            , authSecretSubkeyRejectedUIDs = []-            , authSecretSubkeyRejectedPrimaryUID = Nothing-            , authSecretSubkeyRejectedReason = AuthSecretSubkeyTKVerificationFailed-            }-        ]-    Right verifiedTk-      | not (isTKTimeValid validationTime (tkToUnknown verifiedTk)) ->-          let uids = uidContextsAt validationTime (tkToUnknown verifiedTk)-              primaryUid = authSecretSubkeyUIDValue <$> find authSecretSubkeyUIDIsPrimary uids-           in AuthSecretSubkeysAtReport+    case verifyTKWith+        ( verifySigWith+            defaultVerificationPolicy+            (verifyAgainstKeys [untyped])+        )+        (Just validationTime)+        typedTk of+        Left _ ->+            AuthSecretSubkeysAtReport                 []                 [ AuthSecretSubkeyRejectedAtTime                     { authSecretSubkeyRejectedPrimaryKey = primaryKey                     , authSecretSubkeyRejectedValue = Nothing-                    , authSecretSubkeyRejectedUIDs = uids-                    , authSecretSubkeyRejectedPrimaryUID = primaryUid-                    , authSecretSubkeyRejectedReason = AuthSecretSubkeyPrimaryKeyInvalidAtTime+                    , authSecretSubkeyRejectedUIDs = []+                    , authSecretSubkeyRejectedPrimaryUID = Nothing+                    , authSecretSubkeyRejectedReason =+                        AuthSecretSubkeyTKVerificationFailed                     }                 ]-      | otherwise ->-          let uids = uidContextsAt validationTime (tkToUnknown verifiedTk)-              primaryUid = authSecretSubkeyUIDValue <$> find authSecretSubkeyUIDIsPrimary uids-           in foldr-                (\subCandidate acc ->-                   case classifySecretSubkeyAtTime validationTime primaryKey uids primaryUid subCandidate of-                     Left rejected ->-                       acc {authSecretSubkeysRejected = rejected : authSecretSubkeysRejected acc}-                     Right accepted ->-                       acc {authSecretSubkeysAccepted = accepted : authSecretSubkeysAccepted acc})-                (AuthSecretSubkeysAtReport [] [])-                (_tkSubs verifiedTk)+        Right verifiedTk+            | not (isTKTimeValid validationTime (tkToUnknown verifiedTk)) ->+                let uids = uidContextsAt validationTime (tkToUnknown verifiedTk)+                    primaryUid =+                        authSecretSubkeyUIDValue+                            <$> find authSecretSubkeyUIDIsPrimary uids+                 in AuthSecretSubkeysAtReport+                        []+                        [ AuthSecretSubkeyRejectedAtTime+                            { authSecretSubkeyRejectedPrimaryKey = primaryKey+                            , authSecretSubkeyRejectedValue = Nothing+                            , authSecretSubkeyRejectedUIDs = uids+                            , authSecretSubkeyRejectedPrimaryUID = primaryUid+                            , authSecretSubkeyRejectedReason =+                                AuthSecretSubkeyPrimaryKeyInvalidAtTime+                            }+                        ]+            | otherwise ->+                let uids = uidContextsAt validationTime (tkToUnknown verifiedTk)+                    primaryUid =+                        authSecretSubkeyUIDValue+                            <$> find authSecretSubkeyUIDIsPrimary uids+                 in foldr+                        ( \subCandidate acc ->+                            case classifySecretSubkeyAtTime+                                validationTime+                                primaryKey+                                uids+                                primaryUid+                                subCandidate of+                                Left rejected ->+                                    acc+                                        { authSecretSubkeysRejected =+                                            rejected : authSecretSubkeysRejected acc+                                        }+                                Right accepted ->+                                    acc+                                        { authSecretSubkeysAccepted =+                                            accepted : authSecretSubkeysAccepted acc+                                        }+                        )+                        (AuthSecretSubkeysAtReport [] [])+                        (_tkSubs verifiedTk)   where     untyped = tkToUnknown typedTk     primaryKey = _tkPrimaryKey typedTk -classifySecretSubkeyAtTime ::-     UTCTime-  -> KeyPkt 'SecretPkt-  -> [AuthSecretSubkeyUID]-  -> Maybe Text-  -> (KeyPkt 'SecretPkt, [SignaturePayload])-  -> Either AuthSecretSubkeyRejectedAtTime AuthSecretSubkeyAtTime+classifySecretSubkeyAtTime+    :: UTCTime+    -> KeyPkt 'SecretPkt+    -> [AuthSecretSubkeyUID]+    -> Maybe Text+    -> (KeyPkt 'SecretPkt, [SignaturePayload])+    -> Either AuthSecretSubkeyRejectedAtTime AuthSecretSubkeyAtTime classifySecretSubkeyAtTime validationTime primaryKey uids primaryUid (subkey, sigs)-  | keyPktRole subkey /= KeyPktSubkey =-      Left-        AuthSecretSubkeyRejectedAtTime-          { authSecretSubkeyRejectedPrimaryKey = primaryKey-          , authSecretSubkeyRejectedValue = Just subkey-          , authSecretSubkeyRejectedUIDs = uids-          , authSecretSubkeyRejectedPrimaryUID = primaryUid-          , authSecretSubkeyRejectedReason = AuthSecretSubkeyNotSubkeyPacket-          }-  | not (isPKTimeValidWithSelfSignatures validationTime (keyPktPKPayload subkey) sigs) =-      Left-        AuthSecretSubkeyRejectedAtTime-          { authSecretSubkeyRejectedPrimaryKey = primaryKey-          , authSecretSubkeyRejectedValue = Just subkey-          , authSecretSubkeyRejectedUIDs = uids-          , authSecretSubkeyRejectedPrimaryUID = primaryUid-          , authSecretSubkeyRejectedReason = AuthSecretSubkeySubkeyInvalidAtTime-          }-  | not (subkeyAuthCapableAt validationTime sigs) =-      Left-        AuthSecretSubkeyRejectedAtTime-          { authSecretSubkeyRejectedPrimaryKey = primaryKey-          , authSecretSubkeyRejectedValue = Just subkey-          , authSecretSubkeyRejectedUIDs = uids-          , authSecretSubkeyRejectedPrimaryUID = primaryUid-          , authSecretSubkeyRejectedReason = AuthSecretSubkeyMissingAuthCapability-          }-  | otherwise =-      Right-        AuthSecretSubkeyAtTime-          { authSecretSubkeyPrimaryKey = primaryKey-          , authSecretSubkeyValue = subkey-          , authSecretSubkeyUIDs = uids-          , authSecretSubkeyPrimaryUID = primaryUid-          }+    | keyPktRole subkey /= KeyPktSubkey =+        Left+            AuthSecretSubkeyRejectedAtTime+                { authSecretSubkeyRejectedPrimaryKey = primaryKey+                , authSecretSubkeyRejectedValue = Just subkey+                , authSecretSubkeyRejectedUIDs = uids+                , authSecretSubkeyRejectedPrimaryUID = primaryUid+                , authSecretSubkeyRejectedReason = AuthSecretSubkeyNotSubkeyPacket+                }+    | not+        ( isPKTimeValidWithSelfSignatures+            validationTime+            (keyPktPKPayload subkey)+            sigs+        ) =+        Left+            AuthSecretSubkeyRejectedAtTime+                { authSecretSubkeyRejectedPrimaryKey = primaryKey+                , authSecretSubkeyRejectedValue = Just subkey+                , authSecretSubkeyRejectedUIDs = uids+                , authSecretSubkeyRejectedPrimaryUID = primaryUid+                , authSecretSubkeyRejectedReason =+                    AuthSecretSubkeySubkeyInvalidAtTime+                }+    | not (subkeyAuthCapableAt validationTime sigs) =+        Left+            AuthSecretSubkeyRejectedAtTime+                { authSecretSubkeyRejectedPrimaryKey = primaryKey+                , authSecretSubkeyRejectedValue = Just subkey+                , authSecretSubkeyRejectedUIDs = uids+                , authSecretSubkeyRejectedPrimaryUID = primaryUid+                , authSecretSubkeyRejectedReason =+                    AuthSecretSubkeyMissingAuthCapability+                }+    | otherwise =+        Right+            AuthSecretSubkeyAtTime+                { authSecretSubkeyPrimaryKey = primaryKey+                , authSecretSubkeyValue = subkey+                , authSecretSubkeyUIDs = uids+                , authSecretSubkeyPrimaryUID = primaryUid+                }  uidContextsAt :: UTCTime -> TKUnknown -> [AuthSecretSubkeyUID] uidContextsAt validationTime tk =-  map-    (\(uid, _) ->-       AuthSecretSubkeyUID-         { authSecretSubkeyUIDValue = uid-         , authSecretSubkeyUIDIsPrimary = Just uid == primaryUid-         })-    (_tkuUIDs tk)+    map+        ( \(uid, _) ->+            AuthSecretSubkeyUID+                { authSecretSubkeyUIDValue = uid+                , authSecretSubkeyUIDIsPrimary = Just uid == primaryUid+                }+        )+        (_tkuUIDs tk)   where     primaryUid = primaryUIDAt validationTime (_tkuUIDs tk) -primaryUIDAt :: UTCTime -> [(Text, [SignaturePayload])] -> Maybe Text+primaryUIDAt+    :: UTCTime -> [(Text, [SignaturePayload])] -> Maybe Text primaryUIDAt validationTime uids =-  snd <$> newestByCreationTime candidates+    snd <$> newestByCreationTime candidates   where     candidates =-      [ (createdAt, uid)-      | (uid, sigs) <- uids-      , cert <- maybeToList (latestEffectiveCertificationAt validationTime sigs)-      , signatureMarksPrimaryUID cert-      , createdAt <- maybeToList (signatureCreationTime cert)-      ]+        [ (createdAt, uid)+        | (uid, sigs) <- uids+        , cert <-+            maybeToList (latestEffectiveCertificationAt validationTime sigs)+        , signatureMarksPrimaryUID cert+        , createdAt <- maybeToList (signatureCreationTime cert)+        ]  subkeyAuthCapableAt :: UTCTime -> [SignaturePayload] -> Bool subkeyAuthCapableAt validationTime sigs =-  maybe False signatureHasAuthKeyFlag (latestEffectiveBindingSignatureAt validationTime sigs)+    maybe+        False+        signatureHasAuthKeyFlag+        (latestEffectiveBindingSignatureAt validationTime sigs) -latestEffectiveBindingSignatureAt :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload+latestEffectiveBindingSignatureAt+    :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload latestEffectiveBindingSignatureAt validationTime sigs =-  snd <$>-  newestByCreationTime-    [ (createdAt, sig)-    | sig <- sigs-    , isSubkeyBindingSig sig-    , signatureEffectiveAt validationTime sig-    , createdAt <- maybeToList (signatureCreationTime sig)-    ]+    snd+        <$> newestByCreationTime+            [ (createdAt, sig)+            | sig <- sigs+            , isSubkeyBindingSig sig+            , signatureEffectiveAt validationTime sig+            , createdAt <- maybeToList (signatureCreationTime sig)+            ] -latestEffectiveCertificationAt :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload+latestEffectiveCertificationAt+    :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload latestEffectiveCertificationAt validationTime sigs =-  snd <$>-  newestByCreationTime-    [ (createdAt, sig)-    | sig <- sigs-    , isCertificationSig sig-    , signatureEffectiveAt validationTime sig-    , createdAt <- maybeToList (signatureCreationTime sig)-    ]+    snd+        <$> newestByCreationTime+            [ (createdAt, sig)+            | sig <- sigs+            , isCertificationSig sig+            , signatureEffectiveAt validationTime sig+            , createdAt <- maybeToList (signatureCreationTime sig)+            ]  signatureHasAuthKeyFlag :: SignaturePayload -> Bool signatureHasAuthKeyFlag sig =-  Set.member AuthKey (signatureKeyFlags sig)+    Set.member AuthKey (signatureKeyFlags sig)  signatureKeyFlags :: SignaturePayload -> Set.Set KeyFlag signatureKeyFlags sig =-  foldr-    (\sp acc ->-       case sp of-         SigSubPacket _ (KeyFlags flags) -> Set.union flags acc-         _ -> acc)-    Set.empty-    (maybe [] id (signatureHashedSubpacketsKnown sig))+    foldr+        ( \sp acc ->+            case sp of+                SigSubPacket _ (KeyFlags flags) -> Set.union flags acc+                _ -> acc+        )+        Set.empty+        (maybe [] id (signatureHashedSubpacketsKnown sig))  signatureMarksPrimaryUID :: SignaturePayload -> Bool signatureMarksPrimaryUID sig =-  any-    (\sp ->-       case sp of-         SigSubPacket _ (PrimaryUserId True) -> True-         _ -> False)-    (maybe [] id (signatureHashedSubpacketsKnown sig))+    any+        ( \sp ->+            case sp of+                SigSubPacket _ (PrimaryUserId True) -> True+                _ -> False+        )+        (maybe [] id (signatureHashedSubpacketsKnown sig)) -conduitToTKsEither ::-     Monad m => ConduitT Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()+conduitToTKsEither+    :: Monad m+    => ConduitT+        Pkt+        (Either KeyringChunkParseError (Maybe TKUnknown))+        m+        () conduitToTKsEither = conduitToTKsEither' True --- | Deprecated: this conduit silently drops parse failures and parse-time--- omissions. Prefer 'conduitToTKsDroppingEither' when tolerant parsing is--- needed, or 'conduitToTKsEither' for strict parsing.-conduitToTKsDropping :: Monad m => ConduitT Pkt TKUnknown m ()-conduitToTKsDropping =-  conduitToTKsDroppingEither .|-  conduitDropErrorsAndNothings-{-# DEPRECATED conduitToTKsDropping "Use conduitToTKsDroppingEither or conduitToTKsEither and handle Left/Maybe explicitly." #-}--conduitToTKsDroppingEither ::-     Monad m => ConduitT Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()+conduitToTKsDroppingEither+    :: Monad m+    => ConduitT+        Pkt+        (Either KeyringChunkParseError (Maybe TKUnknown))+        m+        () conduitToTKsDroppingEither = conduitToTKsEither' False -conduitToTKsWithWireRep :: Monad m => ConduitT PktWithWireRep TKWithWireRep m ()-conduitToTKsWithWireRep =-  conduitToTKsWithWireRepEither .|-  conduitDropErrorsAndNothings-{-# DEPRECATED conduitToTKsWithWireRep "Use conduitToTKsWithWireRepEither and handle Left/Maybe explicitly." #-}--conduitToTKsWithWireRepEither ::-     Monad m-  => ConduitT-      PktWithWireRep-      (Either KeyringChunkParseError (Maybe TKWithWireRep))-      m-      ()+conduitToTKsWithWireRepEither+    :: Monad m+    => ConduitT+        PktWithWireRep+        (Either KeyringChunkParseError (Maybe TKWithWireRep))+        m+        () conduitToTKsWithWireRepEither = conduitToTKsWithWireRepEither' True -conduitToTKsDroppingWithWireRep ::-     Monad m => ConduitT PktWithWireRep TKWithWireRep m ()-conduitToTKsDroppingWithWireRep =-  conduitToTKsDroppingWithWireRepEither .|-  conduitDropErrorsAndNothings-{-# DEPRECATED conduitToTKsDroppingWithWireRep "Use conduitToTKsDroppingWithWireRepEither or conduitToTKsWithWireRepEither and handle Left/Maybe explicitly." #-}--conduitToTKsDroppingWithWireRepEither ::-     Monad m-  => ConduitT-      PktWithWireRep-      (Either KeyringChunkParseError (Maybe TKWithWireRep))-      m-      ()+conduitToTKsDroppingWithWireRepEither+    :: Monad m+    => ConduitT+        PktWithWireRep+        (Either KeyringChunkParseError (Maybe TKWithWireRep))+        m+        () conduitToTKsDroppingWithWireRepEither = conduitToTKsWithWireRepEither' False -fakecmAccumEither ::-     Monad m-  => (accum -> Either e (accum, [b]))-  -> (a -> accum -> Either e (accum, [b]))-  -> accum-  -> ConduitT a (Either e b) m ()+fakecmAccumEither+    :: Monad m+    => (accum -> Either e (accum, [b]))+    -> (a -> accum -> Either e (accum, [b]))+    -> accum+    -> ConduitT a (Either e b) m () fakecmAccumEither finalizer f initialAccum = loop initialAccum   where     loop accum =-     await >>=-     maybe-       (case finalizer accum of-          Left err -> yield (Left err)-          Right (_, bs) -> mapM_ (yield . Right) bs)-       go-     where-       go a = do-         case f a accum of-           Left err -> do-             yield (Left err)-             loop initialAccum-           Right (accum', bs) -> do-             mapM_ (yield . Right) bs-             loop accum'+        await+            >>= maybe+                ( case finalizer accum of+                    Left err -> yield (Left err)+                    Right (_, bs) -> mapM_ (yield . Right) bs+                )+                go+      where+        go a = do+            case f a accum of+                Left err -> do+                    yield (Left err)+                    loop initialAccum+                Right (accum', bs) -> do+                    mapM_ (yield . Right) bs+                    loop accum' -conduitDropErrorsAndNothings ::-     Monad m => ConduitT (Either e (Maybe a)) a m ()+conduitDropErrorsAndNothings+    :: Monad m => ConduitT (Either e (Maybe a)) a m () conduitDropErrorsAndNothings =-  CL.mapMaybe (either (const Nothing) id)+    CL.mapMaybe (either (const Nothing) id) -conduitToTKsEither' ::-     Monad m => Bool -> ConduitT Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()+conduitToTKsEither'+    :: Monad m+    => Bool+    -> ConduitT+        Pkt+        (Either KeyringChunkParseError (Maybe TKUnknown))+        m+        () conduitToTKsEither' intolerant =-  CL.filter notTrustPacket .| CL.map (: []) .|-  fakecmAccumEither-    finalizeParsingEither-    (parseAChunkEither (anyTK intolerant))-    ([], Just (Nothing, anyTK intolerant))+    CL.filter notTrustPacket+        .| CL.map (: [])+        .| fakecmAccumEither+            finalizeParsingEither+            (parseAChunkEither (anyTK intolerant))+            ([], Just (Nothing, anyTK intolerant))   where     notTrustPacket = not . isTrustPkt -conduitToTKsWithWireRepEither' ::-     Monad m-  => Bool-  -> ConduitT-      PktWithWireRep-      (Either KeyringChunkParseError (Maybe TKWithWireRep))-      m-      ()+conduitToTKsWithWireRepEither'+    :: Monad m+    => Bool+    -> ConduitT+        PktWithWireRep+        (Either KeyringChunkParseError (Maybe TKWithWireRep))+        m+        () conduitToTKsWithWireRepEither' intolerant =-  CL.filter notTrustPacket .| CL.map (: []) .|-  fakecmAccumEither-    finalizeParsingEither-    (parseAChunkEither (anyTKWithWireRep intolerant))-    ([], Just (Nothing, anyTKWithWireRep intolerant))+    CL.filter notTrustPacket+        .| CL.map (: [])+        .| fakecmAccumEither+            finalizeParsingEither+            (parseAChunkEither (anyTKWithWireRep intolerant))+            ([], Just (Nothing, anyTKWithWireRep intolerant))   where     notTrustPacket = not . isTrustPkt . _pktValue -sinkPublicKeyringMap :: Monad m => ConduitT (TK 'PublicTK) Void m PublicKeyring+sinkPublicKeyringMap+    :: Monad m => ConduitT (TK 'PublicTK) Void m PublicKeyring sinkPublicKeyringMap = CL.fold (flip insert) empty -sinkSecretKeyringMap :: Monad m => ConduitT (TK 'SecretTK) Void m SecretKeyring+sinkSecretKeyringMap+    :: Monad m => ConduitT (TK 'SecretTK) Void m SecretKeyring sinkSecretKeyringMap = CL.fold (flip insert) empty  -- | Lift a single typed TK into its kinded keyring
Data/Conduit/OpenPGP/Verify.hs view
@@ -2,98 +2,105 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).- {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-}  module Data.Conduit.OpenPGP.Verify-  ( VerificationMode(..)-  , VerificationModeW(..)-  , conduitVerify-  , verifyPacketsBatch-  , verifyPacketsWithModeTyped-  , verifyPacketsWithMode-  ) where+    ( VerificationMode (..)+    , VerificationModeW (..)+    , conduitVerify+    , verifyPacketsBatch+    , verifyPacketsWithModeTyped+    , verifyPacketsWithMode+    ) where  import Data.Conduit+import qualified Data.Conduit.List as CL import Data.Time.Clock (UTCTime)-import Data.List (foldl') -import Codec.Encryption.OpenPGP.Internal (PktStreamContext(..), emptyPSC)+import Codec.Encryption.OpenPGP.Internal+    ( PktStreamContext (..)+    , emptyPSC+    )+import Codec.Encryption.OpenPGP.Policy+    ( defaultVerificationPolicy+    ) import Codec.Encryption.OpenPGP.Signatures-  ( VerificationError(..)-  , verifyAgainstKeyring-  , verifySigWith-  )+    ( VerificationError (..)+    , verifyAgainstKeyring+    , verifySigWith+    ) import Codec.Encryption.OpenPGP.Types-import qualified Data.Conduit.List as CL  data VerificationMode-  = VerificationStreaming-  | VerificationBatch-  deriving (Eq, Show)+    = VerificationStreaming+    | VerificationBatch+    deriving (Eq, Show)  data VerificationModeW (mode :: VerificationMode) where-  VerificationStreamingW :: VerificationModeW 'VerificationStreaming-  VerificationBatchW :: VerificationModeW 'VerificationBatch+    VerificationStreamingW+        :: VerificationModeW 'VerificationStreaming+    VerificationBatchW :: VerificationModeW 'VerificationBatch -conduitVerify ::-     Monad m-  => PublicKeyring-  -> Maybe UTCTime-  -> ConduitT Pkt (Either VerificationError Verification) m ()+conduitVerify+    :: Monad m+    => PublicKeyring+    -> Maybe UTCTime+    -> ConduitT Pkt (Either VerificationError Verification) m () conduitVerify kr mt =-  CL.concatMapAccum (\pkt state -> pushPacketTyped kr mt pkt state) emptyPSC+    CL.concatMapAccum+        (\pkt state -> pushPacketTyped kr mt pkt state)+        emptyPSC -verifyPacketsBatch ::-     PublicKeyring-  -> Maybe UTCTime-  -> [Pkt]-  -> [Either VerificationError Verification]+verifyPacketsBatch+    :: PublicKeyring+    -> Maybe UTCTime+    -> [Pkt]+    -> [Either VerificationError Verification] verifyPacketsBatch kr mt =-  verifyPacketsBatchTyped kr mt+    verifyPacketsBatchTyped kr mt -verifyPacketsBatchTyped ::-     PublicKeyring-  -> Maybe UTCTime-  -> [Pkt]-  -> [Either VerificationError Verification]+verifyPacketsBatchTyped+    :: PublicKeyring+    -> Maybe UTCTime+    -> [Pkt]+    -> [Either VerificationError Verification] verifyPacketsBatchTyped kr mt =-  reverse . snd . foldl' step (emptyPSC, [])+    reverse . snd . foldl' step (emptyPSC, [])   where     step (state, outputs) pkt =-      let (nextState, newOutputs) = pushPacketTyped kr mt pkt state-       in (nextState, reverse newOutputs ++ outputs)+        let (nextState, newOutputs) = pushPacketTyped kr mt pkt state+         in (nextState, reverse newOutputs ++ outputs) -verifyPacketsWithMode ::-     Monad m-  => VerificationMode-  -> PublicKeyring-  -> Maybe UTCTime-  -> ConduitT Pkt (Either VerificationError Verification) m ()+verifyPacketsWithMode+    :: Monad m+    => VerificationMode+    -> PublicKeyring+    -> Maybe UTCTime+    -> ConduitT Pkt (Either VerificationError Verification) m () verifyPacketsWithMode VerificationStreaming kr mt =-  verifyPacketsWithModeTyped VerificationStreamingW kr mt+    verifyPacketsWithModeTyped VerificationStreamingW kr mt verifyPacketsWithMode VerificationBatch kr mt =-  verifyPacketsWithModeTyped VerificationBatchW kr mt+    verifyPacketsWithModeTyped VerificationBatchW kr mt -verifyPacketsWithModeTyped ::-     Monad m-  => VerificationModeW mode-  -> PublicKeyring-  -> Maybe UTCTime-  -> ConduitT Pkt (Either VerificationError Verification) m ()+verifyPacketsWithModeTyped+    :: Monad m+    => VerificationModeW mode+    -> PublicKeyring+    -> Maybe UTCTime+    -> ConduitT Pkt (Either VerificationError Verification) m () verifyPacketsWithModeTyped modeW kr mt =-  case modeW of-    VerificationStreamingW -> conduitVerify kr mt-    VerificationBatchW -> CL.consume >>= mapM_ yield . verifyPacketsBatch kr mt+    case modeW of+        VerificationStreamingW -> conduitVerify kr mt+        VerificationBatchW -> CL.consume >>= mapM_ yield . verifyPacketsBatch kr mt -pushPacketTyped ::-     PublicKeyring-  -> Maybe UTCTime-  -> Pkt-  -> PktStreamContext-  -> (PktStreamContext, [Either VerificationError Verification])+pushPacketTyped+    :: PublicKeyring+    -> Maybe UTCTime+    -> Pkt+    -> PktStreamContext+    -> (PktStreamContext, [Either VerificationError Verification]) pushPacketTyped _ _ ld@LiteralDataPkt {} state = (state {lastLD = ld}, []) pushPacketTyped _ _ uid@(UserIdPkt _) state = (state {lastUIDorUAt = uid}, []) pushPacketTyped _ _ uat@(UserAttributePkt _) state = (state {lastUIDorUAt = uat}, [])@@ -102,37 +109,54 @@ pushPacketTyped _ _ sk@(SecretKeyPkt _ _) state = (state {lastPrimaryKey = sk}, []) pushPacketTyped _ _ sk@(SecretSubkeyPkt _ _) state = (state {lastSubkey = sk}, []) pushPacketTyped kr mt sig@(SignaturePkt signature) state =-  case fromSignaturePayloadVerifiableSignatureV signature of-    Just _ ->-      ( state {lastSig = sig}-      , [verifySigWith (verifyAgainstKeyring kr) sig state mt]-      )-    Nothing -> (state, [])-pushPacketTyped _ _ (OtherPacketPkt t _) state | t < 40 =-  (state, [Left (UnknownCriticalPacketInStream t)])-pushPacketTyped _ _ (BrokenPacketPkt err t _) state | t < 40 =-  (state, [Left (BrokenCriticalPacketInStream t err)])+    case fromSignaturePayloadVerifiableSignatureV signature of+        Just _ ->+            ( state {lastSig = sig}+            ,+                [ verifySigWith+                    defaultVerificationPolicy+                    (verifyAgainstKeyring kr)+                    sig+                    state+                    mt+                ]+            )+        Nothing -> (state, [])+pushPacketTyped _ _ (OtherPacketPkt t _) state+    | t < 40 =+        (state, [Left (UnknownCriticalPacketInStream t)])+pushPacketTyped _ _ (BrokenPacketPkt err t _) state+    | t < 40 =+        (state, [Left (BrokenCriticalPacketInStream t err)]) pushPacketTyped _ _ pkt@(OnePassSignaturePkt _) state-  | isOpeningOnePassSignature pkt = (state, [])+    | isOpeningOnePassSignature pkt = (state, []) pushPacketTyped _ _ _ state = (state, [])  data VerifiableSignatureV where-  VerifiableSignatureV4 :: SignaturePayloadV 'SigPayloadV4 -> VerifiableSignatureV-  VerifiableSignatureV6 :: SignaturePayloadV 'SigPayloadV6 -> VerifiableSignatureV+    VerifiableSignatureV4+        :: SignaturePayloadV 'SigPayloadV4 -> VerifiableSignatureV+    VerifiableSignatureV6+        :: SignaturePayloadV 'SigPayloadV6 -> VerifiableSignatureV -fromSignaturePayloadVerifiableSignatureV ::-     SignaturePayload -> Maybe VerifiableSignatureV+fromSignaturePayloadVerifiableSignatureV+    :: SignaturePayload -> Maybe VerifiableSignatureV fromSignaturePayloadVerifiableSignatureV sigPayload =-  case toSomeSignaturePayload sigPayload of-    SomeSignaturePayload (payload@SigPayloadV4Data {}) ->-      Just (VerifiableSignatureV4 payload)-    SomeSignaturePayload (payload@SigPayloadV6Data {}) ->-      Just (VerifiableSignatureV6 payload)-    _ -> Nothing+    case toSomeSignaturePayload sigPayload of+        SomeSignaturePayload (payload@SigPayloadV4Data {}) ->+            Just (VerifiableSignatureV4 payload)+        SomeSignaturePayload (payload@SigPayloadV6Data {}) ->+            Just (VerifiableSignatureV6 payload)+        _ -> Nothing  isOpeningOnePassSignature :: Pkt -> Bool-isOpeningOnePassSignature (OnePassSignaturePkt (OPSPayloadV3Packet (OPSPayloadV3 _ _ _ _ _ False))) =-  True-isOpeningOnePassSignature (OnePassSignaturePkt (OPSPayloadV6Packet (OPSPayloadV6 _ _ _ _ _ False))) =-  True+isOpeningOnePassSignature+    ( OnePassSignaturePkt+            (OPSPayloadV3Packet (OPSPayloadV3 _ _ _ _ _ False))+        ) =+        True+isOpeningOnePassSignature+    ( OnePassSignaturePkt+            (OPSPayloadV6Packet (OPSPayloadV6 _ _ _ _ _ False))+        ) =+        True isOpeningOnePassSignature _ = False
bench/mark.hs view
@@ -2,105 +2,124 @@ -- Copyright © 2014-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).- {-# LANGUAGE FlexibleContexts #-}  import Criterion.Main--import Codec.Encryption.OpenPGP.Serialize-  ( conduitParsePktsWithWireRep-  , parsePkts-  , parsePktsEither-  , parsePktsWithWireRep-  )-import Codec.Encryption.OpenPGP.Signatures-  ( verifyAgainstKeyring-  , verifyAgainstKeys-  , verifySigWith-  , verifyTKWith-  , verifyUnknownTKWith-  )-import Codec.Encryption.OpenPGP.Types-  ( someTKToPublicViewTK-  , wireRepRef-  )- import Data.Binary (get)-import Data.Conduit.OpenPGP.Keyring- ( conduitToSomeTKsEither- , conduitToTKsEither- )-import Data.Conduit.Serialization.Binary (conduitGet)-import qualified Data.IxSet.Typed as IxSet import qualified Data.ByteString.Lazy as BL-import Data.Either (rights)-import Data.Maybe (catMaybes)- 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.Either (rights)+import qualified Data.IxSet.Typed as IxSet+import Data.Maybe (catMaybes) +import Codec.Encryption.OpenPGP.Policy+    ( defaultVerificationPolicy+    )+import Codec.Encryption.OpenPGP.Serialize+    ( conduitParsePktsWithWireRep+    , parsePkts+    , parsePktsEither+    , parsePktsWithWireRep+    )+import Codec.Encryption.OpenPGP.Signatures+    ( verifyAgainstKeyring+    , verifyAgainstKeys+    , verifySigWith+    , verifyTKWith+    , verifyUnknownTKWith+    )+import Codec.Encryption.OpenPGP.Types+    ( someTKToPublicViewTK+    , wireRepRef+    )+import Data.Conduit.OpenPGP.Keyring+    ( conduitToSomeTKsEither+    , conduitToTKsEither+    )+ main :: IO () main =-  defaultMain-    [ bgroup-        "keyring"-        [ bench "load keys" $ whnfIO (loadKeys "tests/data/pubring.gpg")-        , bench "load keyring" $ whnfIO (loadKeyring "tests/data/pubring.gpg")-        , bench "self-verify keys" $-          whnfIO (selfVerifyKeys "tests/data/pubring.gpg")-        , bench "self-verify keyring" $-          whnfIO (selfVerifyKeyring "tests/data/pubring.gpg")+    defaultMain+        [ bgroup+            "keyring"+            [ bench "load keys" $ whnfIO (loadKeys "tests/data/pubring.gpg")+            , bench "load keyring" $+                whnfIO (loadKeyring "tests/data/pubring.gpg")+            , bench "self-verify keys" $+                whnfIO (selfVerifyKeys "tests/data/pubring.gpg")+            , bench "self-verify keyring" $+                whnfIO (selfVerifyKeyring "tests/data/pubring.gpg")+            ]+        , env (BL.readFile "tests/data/pubring.gpg") $ \pubringPayload ->+            let pubringRef = wireRepRef pubringPayload+             in bgroup+                    "packet-parse"+                    [ bench "parsePkts/count" $ nf (length . parsePkts) pubringPayload+                    , bench "parsePktsEither/count" $+                        nf+                            (either (const 0) length . parsePktsEither)+                            pubringPayload+                    , bench "parsePktsWithWireRep/count" $+                        nf+                            (length . parsePktsWithWireRep pubringRef)+                            pubringPayload+                    , bench "conduitParsePktsWithWireRep/count" $+                        whnfIO+                            ( fmap+                                length+                                ( DC.runConduitRes $+                                    CB.sourceLbs pubringPayload+                                        DC..| conduitParsePktsWithWireRep Nothing+                                        DC..| CL.consume+                                )+                            )+                    ]         ]-    , env (BL.readFile "tests/data/pubring.gpg") $ \pubringPayload ->-        let pubringRef = wireRepRef pubringPayload-         in-        bgroup-          "packet-parse"-          [ bench "parsePkts/count" $ nf (length . parsePkts) pubringPayload-          , bench "parsePktsEither/count" $-            nf-              (either (const 0) length . parsePktsEither)-              pubringPayload-          , bench "parsePktsWithWireRep/count" $-            nf-              (length . parsePktsWithWireRep pubringRef)-              pubringPayload-          , bench "conduitParsePktsWithWireRep/count" $-            whnfIO-              (fmap-                 length-                 (DC.runConduitRes $-                  CB.sourceLbs pubringPayload DC..| conduitParsePktsWithWireRep Nothing DC..|-                  CL.consume))-          ]-    ]   where     loadKeys fp =-      fmap-        (catMaybes . rights)-        (DC.runConduitRes $-         CB.sourceFile fp DC..| conduitGet get DC..| conduitToTKsEither DC..|-         CL.consume)+        fmap+            (catMaybes . rights)+            ( DC.runConduitRes $+                CB.sourceFile fp+                    DC..| conduitGet get+                    DC..| conduitToTKsEither+                    DC..| CL.consume+            )     loadKeyring fp =-      fmap-        (sinkFromSomeTKs . rights)-        (DC.runConduitRes $-         CB.sourceFile fp DC..| conduitGet get DC..| conduitToSomeTKsEither DC..|-         CL.consume)+        fmap+            (sinkFromSomeTKs . rights)+            ( DC.runConduitRes $+                CB.sourceFile fp+                    DC..| conduitGet get+                    DC..| conduitToSomeTKsEither+                    DC..| CL.consume+            )     selfVerifyKeys fp =-      fmap-        (\ks ->-           mapM (verifyUnknownTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks)-        (loadKeys fp)+        fmap+            ( \ks ->+                mapM+                    ( verifyUnknownTKWith+                        (verifySigWith defaultVerificationPolicy (verifyAgainstKeys ks))+                        Nothing+                    )+                    ks+            )+            (loadKeys fp)     selfVerifyKeyring fp =-      fmap-        (\kr ->-           mapM-             (verifyTKWith (verifySigWith (verifyAgainstKeyring kr)) Nothing)-             (IxSet.toList kr))-        (loadKeyring fp)+        fmap+            ( \kr ->+                mapM+                    ( verifyTKWith+                        (verifySigWith defaultVerificationPolicy (verifyAgainstKeyring kr))+                        Nothing+                    )+                    (IxSet.toList kr)+            )+            (loadKeyring fp)     sinkFromSomeTKs =-      IxSet.fromList .-      map someTKToPublicViewTK .-      catMaybes+        IxSet.fromList+            . map someTKToPublicViewTK+            . catMaybes
hOpenPGP.cabal view
@@ -1,6 +1,6 @@ Cabal-version:       3.4 Name:                hOpenPGP-Version:             3.0.2.2+Version:             3.1 Synopsis:            native Haskell implementation of OpenPGP (RFC9580) Description:         native Haskell implementation of OpenPGP (RFC9580), with some backwards compatibility Homepage:            https://salsa.debian.org/clint/hOpenPGP@@ -332,4 +332,4 @@ source-repository this   type:     git   location: https://salsa.debian.org/clint/hOpenPGP.git-  tag:      v3.0.2.2+  tag:      v3.1
tests/Tests/Common.hs view
@@ -2,1537 +2,1927 @@ -- 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 PackageImports #-}-{-# LANGUAGE TypeApplications #-}--module Tests.Common-  ( addTimestampSeconds-  , armorPayload-  , assertFalse-  , assertTrue-  , collectSecretKeyInfos-  , conduitDecryptWithPKESKContext-  , loadArmor-  , loadAndDecompressPkts-  , loadSEIPDv2FixtureWithV4Secret-  , loadUnencryptedRsaSigner-  , loadV4EncryptedSecretKeyFixtureForProperty-  , loadV6UnencryptedSecretKeyFixtureForProperty-  , prependUnusableLatestPKESK-  , readFixtureLazy-  , readFixturePackets-  , readFixturePayload-  , reorderPrecedingPKESKs-  , reverseIf-  , runGet -- FIXME: this is confusing-  , selectRecipientKeyInfo-  , setKeyTimestamp-  , signCertificationAt-  , signSubkeyBindingWithRSAExtrasAt-  , signSubkeyRevocationWithRSAAt-  , timestampToUTCTime-  , assertSingleFailureContainsTimeline-  , assertSingleSignerFingerprint-  , encryptMessageDefault-  , expectV4PKPayload-  , expectV6PKPayload-  , extractV4SignatureAlgorithmFields-  , fp-  , loadKeyring-  , loadDeterministicEd25519Signer-  , loadDeterministicEd25519SignerV6-  , loadDeterministicEd448Signer-  , loadDeterministicEd448SignerV6-  , loadUnencryptedRsaSignerV6-  , messageIssuerSubpacketsAt-  , mkTestKeyring-  , setPKAlgorithm-  , signBinaryMessageWithRSAAt-  , signBinaryMessageWithEd25519At-  , signKeyRevocationWithReasonAt-  , signKeyRevocationWithReasonAndExtrasAt-  , signSubkeyBindingWithRSAAt-  , verifyTimelinePackets-  , signCertificationRevocationWithEd25519At-  , signCertificationWithEd25519At-  , verificationFixtureGroup-  , verifyMessageFromBytestring-  , verifyMessageFromBytestringBatch-  , verifyMessageFromPackets-  , verifyMessageFromPacketsBatch-  , certificateVerificationFixtures-  , fixturePath-  , messageVerificationFixtures-  , readPKIPassphrase-  , setKeyVersion-  , signCertificationRevocationAt-  , aesKeyWrapRFC3394ForTest-  , assertX25519EskShape-  , assertX448EskShape-  , buildCurve25519LegacyKdfParamForTest-  , buildECDHKDFParamForTest-  , cgp-  , conduitDecrypt -- FIXME: this is confusing-  , conduitDecryptChecked-  , conduitDecryptCheckedWithDecryptPolicy-  , conduitDecryptWithCandidatesCallbackAndPolicy-  , conduitDecryptWithDecryptPolicy-  , deriveECDHKekForTest-  , deriveX25519KekForTest-  , deriveX448KekForTest-  , doPkeyAndSkeyMatch-  , encodeChecksum16-  , forceVersionedRecipientIdentifier-  , isPrecedingESK-  , mkPKESKSessionMaterialOrFail-  , readFixtureStrict-  , selectRecipientKeyInfoByRawRecipientId-  , signDirectKeyWithRSAExtrasAt-  , testEncodeOpenPGPSessionMaterial-  , testParsedRSASecretKeyPKCS15DecryptNotMessageNotRecognized-  , testSEIPDv2ForV4KeyArmor-  , testSEIPDv2TwoRecipientsArmor-  , testSEIPDv2ThreeRecipientsArmor-  )-where--import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, assertFailure, testCase)--import Codec.Encryption.OpenPGP.Arbitrary ()-import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA-import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor(..), ArmorType(..))-import Codec.Encryption.OpenPGP.Compression (decompressPkt)-import Codec.Encryption.OpenPGP.Encrypt-  ( PKESKSessionMaterial-  , mkPKESKSessionMaterial-  , encodeOpenPGPSessionMaterial-  )--import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)-import Codec.Encryption.OpenPGP.Internal-  ( curveFromCurve-  , curveToCurveoidBS-  , emptyPSC-  , lastPrimaryKey-  , lastUIDorUAt-  , lastSubkey-  )-import Codec.Encryption.OpenPGP.KeySelection (parseFingerprint)-import Codec.Encryption.OpenPGP.Message-  ( asV4PKPayload-  , asV6PKPayload-  , ClearPayload-  , EncryptedPayload-  , encryptMessage-  , EncryptMessageOptions(..)-  , Passphrase-  , MessageError(..)-  , RecoveredSessionMaterial(..)-  , SessionMaterialExposure(..)-  , VersionedPKPayload-  )-import Codec.Encryption.OpenPGP.SecretKey-  ( decryptPrivateKey-  )-import Codec.Encryption.OpenPGP.Serialize-  ( dearmorIfAsciiArmored-  , parsePkts-  )-import Codec.Encryption.OpenPGP.SerializeForSigs (payloadForSig)-import Codec.Encryption.OpenPGP.Signatures-  ( VerificationError(..)-  , renderVerificationError-  , renderSignError-  , signCertificationWithRSA-  , signCertRevocationWithRSA-  , signSubkeyRevocationWithRSA-  , signDataWithRSA-  , signDataWithEd25519-  , signDirectKeyWithRSA-  , signKeyRevocationWithRSA-  )-import Codec.Encryption.OpenPGP.Types-import Control.Monad (unless, void)-import qualified "crypton" Crypto.Cipher.AES as AES-import qualified "crypton" Crypto.Cipher.Types as CCT-import qualified Crypto.Error as CE-import qualified Crypto.Hash as CH-import qualified Crypto.Hash.Algorithms as CHA-import Crypto.KDF.HKDF (expand, extract)-import qualified Crypto.PubKey.Ed25519 as Ed25519-import qualified Crypto.PubKey.Ed448 as Ed448-import qualified Crypto.PubKey.RSA.PKCS15 as P15-import Control.Monad.Trans.Resource (ResourceT)-import Crypto.Number.Serialize (os2ip)-import qualified Crypto.PubKey.ECC.ECDSA as ECDSA-import qualified Crypto.PubKey.RSA as RSA-import qualified Data.ByteArray as BA-import Data.Bifunctor (bimap, first)-import Data.Binary (get)-import Data.Binary.Get-  ( Get-  , getLazyByteString-  , getRemainingLazyByteString-  , getWord16be-  , getWord8-  , runGetOrFail-  )-import Data.Binary.Put (putWord64be, runPut)-import Data.Bits (xor)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Char8 as BLC8-import qualified Data.ByteString.Base16.Lazy as B16L-import Data.Char (toUpper)-import Data.Conduit.OpenPGP.Compression (conduitDecompress)-import Data.Conduit.OpenPGP.Decrypt-  ( DecryptKeyResolution(..)-  , DecryptOptions(..)-  , PKESKRecipientKey(..)-  , DecryptOutcome(..)-  )-import qualified Data.Conduit.OpenPGP.Decrypt as DCD-import Codec.Encryption.OpenPGP.Policy-  ( DecryptPolicy-  , defaultDecryptPolicy-  )-import Data.Conduit.OpenPGP.Keyring-  ( conduitToPublicViewTKs-  , sinkPublicKeyringMap-  , partitionSomeTKs-  )-import Data.Conduit.OpenPGP.Message-  ( VerificationOptions(..)-  , VerificationPolicy(..)-  , defaultVerificationOptions-  , VerificationMode(..)-  , verifyMessage-  , verifyMessagePackets-  )-import Data.Conduit.Serialization.Binary (conduitGet)-import Data.List (isInfixOf)-import Data.List.NonEmpty (NonEmpty(..))-import Data.Maybe (catMaybes, listToMaybe)-import Data.Text (Text)-import Data.Time.Clock (UTCTime)-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import Data.Word (Word32, Word64)--import qualified Data.Conduit as DC-import qualified Data.Conduit.Binary as CB-import qualified Data.Conduit.List as CL--import qualified Crypto.PubKey.ECC.Types as ECCT---- Test assertion helpers-assertTrue :: String -> Bool -> Assertion-assertTrue msg b = assertBool msg b--assertFalse :: String -> Bool -> Assertion-assertFalse msg b = assertBool msg (not b)--fixturePath :: FilePath -> FilePath-fixturePath file = "tests/data/" ++ file--readFixtureLazy :: FilePath -> IO BL.ByteString-readFixtureLazy = BL.readFile . fixturePath--readFixtureStrict :: FilePath -> IO B.ByteString-readFixtureStrict = B.readFile . fixturePath--readFixturePackets :: FilePath -> IO [Pkt]-readFixturePackets file =-  DC.runConduitRes $ CB.sourceFile (fixturePath file) DC..| conduitGet get DC..| CL.consume--readFixtureDecompressedPackets :: FilePath -> IO [Pkt]-readFixtureDecompressedPackets file =-  DC.runConduitRes $-  CB.sourceFile (fixturePath file) DC..| conduitGet get DC..| conduitDecompress DC..| CL.consume--loadFirstArmor :: FilePath -> IO Armor-loadFirstArmor file = do-  armors <- loadArmor file-  case armors of-    (a:_) -> pure a-    [] -> assertFailure (file ++ " armor file contained no armor blocks") >> fail "expected armor block"--readPKIPassphrase :: IO BL.ByteString-readPKIPassphrase = readFixtureLazy "pki-password.txt"---- this needs a better name-runGet :: Get a -> BL.ByteString -> Either String a-runGet g bs = bimap (\(_, _, x) -> x) (\(_, _, x) -> x) (runGetOrFail g bs)--extractV4SignatureAlgorithmFields ::-     BL.ByteString -> Either String (PubKeyAlgorithm, B.ByteString)-extractV4SignatureAlgorithmFields =-  runGet $ do-    version <- getWord8-    if version /= 4-      then fail ("expected v4 signature payload, got version " ++ show version)-      else do-        _ <- getWord8 -- sig type-        pka <- getWord8-        _ <- getWord8 -- hash algo-        hlen <- getWord16be-        _ <- getLazyByteString (fromIntegral hlen)-        ulen <- getWord16be-        _ <- getLazyByteString (fromIntegral ulen)-        _ <- getWord16be -- left16-        algorithmFields <- getRemainingLazyByteString-        pure (toFVal pka, BL.toStrict algorithmFields)--conduitDecrypt ::-     (String -> IO BL.ByteString)-  -> DC.ConduitT Pkt Pkt (ResourceT IO) ()-conduitDecrypt cb =-  void $-  DCD.conduitDecrypt-    DecryptOptions-      { decryptOptionsKeyResolution = DecryptWithoutPKESK-      , decryptOptionsPolicy = defaultDecryptPolicy-      , decryptOptionsPassphraseCallback = cb-      }--conduitDecryptWithPKESKContext ::-     (Pkt -> IO (Maybe PKESKRecipientKey))-  -> (String -> IO BL.ByteString)-  -> DC.ConduitT Pkt Pkt (ResourceT IO) ()-conduitDecryptWithPKESKContext pkcb cb =-  void $-  DCD.conduitDecrypt-    DecryptOptions-      { decryptOptionsKeyResolution = DecryptWithUnwrapCandidatesCallback (asPKESKUnwrapCandidatesCallback pkcb)-      , decryptOptionsPolicy = defaultDecryptPolicy-      , decryptOptionsPassphraseCallback = cb-      }--conduitDecryptWithDecryptPolicy ::-     DecryptPolicy-  -> (Pkt -> IO (Maybe PKESKRecipientKey))-  -> (String -> IO BL.ByteString)-  -> DC.ConduitT Pkt Pkt (ResourceT IO) ()-conduitDecryptWithDecryptPolicy dp pkcb cb =-  void $-  DCD.conduitDecrypt-    DecryptOptions-      { decryptOptionsKeyResolution = DecryptWithUnwrapCandidatesCallback (asPKESKUnwrapCandidatesCallback pkcb)-      , decryptOptionsPolicy = dp-      , decryptOptionsPassphraseCallback = cb-      }--conduitDecryptChecked ::-     (String -> IO BL.ByteString)-  -> DC.ConduitT Pkt Pkt (ResourceT IO) DecryptOutcome-conduitDecryptChecked cb =-  DCD.conduitDecrypt-    DecryptOptions-      { decryptOptionsKeyResolution = DecryptWithoutPKESK-      , decryptOptionsPolicy = defaultDecryptPolicy-      , decryptOptionsPassphraseCallback = cb-      }--conduitDecryptCheckedWithDecryptPolicy ::-     DecryptPolicy-  -> (Pkt -> IO (Maybe PKESKRecipientKey))-  -> (String -> IO BL.ByteString)-  -> DC.ConduitT Pkt Pkt (ResourceT IO) DecryptOutcome-conduitDecryptCheckedWithDecryptPolicy dp pkcb cb =-  DCD.conduitDecrypt-    DecryptOptions-      { decryptOptionsKeyResolution = DecryptWithUnwrapCandidatesCallback (asPKESKUnwrapCandidatesCallback pkcb)-      , decryptOptionsPolicy = dp-      , decryptOptionsPassphraseCallback = cb-      }--conduitDecryptWithCandidatesCallbackAndPolicy ::-     DecryptPolicy-  -> (KeyIdentifier -> PubKeyAlgorithm -> IO [PKESKRecipientKey])-  -> (String -> IO BL.ByteString)-  -> DC.ConduitT Pkt Pkt (ResourceT IO) ()-conduitDecryptWithCandidatesCallbackAndPolicy dp candCb cb =-  void $-  DCD.conduitDecrypt-    DecryptOptions-      { decryptOptionsKeyResolution = DecryptWithUnwrapCandidatesCallback candCb-      , decryptOptionsPolicy = dp-      , decryptOptionsPassphraseCallback = cb-      }--asPKESKUnwrapCandidatesCallback ::-     (Pkt -> IO (Maybe PKESKRecipientKey))-  -> KeyIdentifier-  -> PubKeyAlgorithm-  -> IO [PKESKRecipientKey]-asPKESKUnwrapCandidatesCallback pkcb keyIdentifier pka = do-  mk <- pkcb (pkeskProbePacket keyIdentifier pka)-  pure (maybe [] (: []) mk)--pkeskProbePacket :: KeyIdentifier -> PubKeyAlgorithm -> Pkt-pkeskProbePacket keyIdentifier pka =-  case keyIdentifier of-    KeyIdentifierWildcard ->-      PKESKPkt-        (PKESKPayloadV3Packet-           (PKESKPayloadV3 3 (EightOctetKeyId (BL.replicate 8 0)) pka (MPI 0 :| [])))-    KeyIdentifierEightOctet rid ->-      PKESKPkt-        (PKESKPayloadV3Packet-           (PKESKPayloadV3 3 rid pka (MPI 0 :| [])))-    KeyIdentifierFingerprint rid ->-      PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 (unFingerprint rid) pka mempty))--readFixturePayload :: FilePath -> IO BL.ByteString-readFixturePayload fpr = do-  bs <- BL.readFile ("tests/data/" ++ fpr)-  case dearmorIfAsciiArmored bs of-    Left err -> assertFailure ("ASCII armor decode failed for " ++ fpr ++ ": " ++ err) >> pure mempty-    Right (_, payload) -> pure payload--testParsedRSASecretKeyPKCS15DecryptNotMessageNotRecognized :: Assertion-testParsedRSASecretKeyPKCS15DecryptNotMessageNotRecognized = do-  secretPackets <--    DC.runConduitRes $-    CB.sourceFile "tests/data/unencrypted.seckey" DC..| conduitGet get DC..| CL.consume-  (publicKey, privateKey) <--    case secretPackets of-      (SecretKeyPkt pkp ska:_) ->-        case (_pubkey pkp, ska) of-          (RSAPubKey (RSA_PublicKey pub), SUUnencrypted (RSAPrivateKey (RSA_PrivateKey prv)) _) ->-            pure (pub, prv)-          _ ->-            assertFailure "unencrypted.seckey did not contain a parseable unencrypted RSA key pair" >>-            fail "expected RSA key pair from parsed secret key packet"-      _ ->-        assertFailure "unencrypted.seckey did not begin with a secret key packet" >>-        fail "expected secret key packet"-  let plaintext = "pkcs1-v1.5 regression payload" :: B.ByteString-  encrypted <- (P15.encrypt publicKey plaintext :: IO (Either RSA.Error B.ByteString))-  ciphertext <--    case encrypted of-      Left err ->-        assertFailure ("RSA PKCS#1 v1.5 encryption failed: " ++ show err) >> pure mempty-      Right ct -> pure ct-  decrypted <- (P15.decryptSafer privateKey ciphertext :: IO (Either RSA.Error B.ByteString))-  case decrypted of-    Left RSA.MessageNotRecognized ->-      assertFailure "parsed RSA private key decryption failed with MessageNotRecognized"-    Left err ->-      assertFailure ("parsed RSA private key decryption failed: " ++ show err)-    Right got ->-      assertEqual-        "parsed RSA private key decrypts PKCS#1 v1.5 payload"-        plaintext-        got--testEncodeOpenPGPSessionMaterial :: Assertion-testEncodeOpenPGPSessionMaterial = do-  let keyBytes = B.pack [1 .. 32]-      expected =-        B.singleton (fromFVal AES256) <> keyBytes <> encodeChecksum16 keyBytes-  case encodeOpenPGPSessionMaterial AES256 (SessionKey keyBytes) of-    Left err ->-      assertFailure ("encodeOpenPGPSessionMaterial failed: " ++ show err)-    Right encoded ->-      assertEqual "OpenPGP session material encoding" expected encoded--mkPKESKSessionMaterialOrFail ::-     SymmetricAlgorithm -> SessionKey -> IO PKESKSessionMaterial-mkPKESKSessionMaterialOrFail symalgo sessionKey =-  case mkPKESKSessionMaterial symalgo sessionKey of-    Left err ->-      assertFailure ("mkPKESKSessionMaterial failed: " ++ show err) >>-      fail "mkPKESKSessionMaterial failed"-    Right material -> pure material--armorPayload :: Armor -> BL.ByteString-armorPayload (Armor _ _ bs) = BL.fromStrict (BLC8.toStrict bs)-armorPayload (ClearSigned _ _ inner) = armorPayload inner--selectRecipientKeyInfo :: Pkt -> [PKESKRecipientKey] -> Maybe PKESKRecipientKey-selectRecipientKeyInfo (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka _))) keyInfos =-  listToMaybe-    [ keyInfo-    | keyInfo <- keyInfos-    , supportsPKESKAlgorithm pka keyInfo-    , matchesRecipientIdentifier rid keyInfo-    ]-selectRecipientKeyInfo _ keyInfos = listToMaybe keyInfos--supportsPKESKAlgorithm :: PubKeyAlgorithm -> PKESKRecipientKey -> Bool-supportsPKESKAlgorithm pka keyInfo =-  case pkeskRecipientSKey keyInfo of-    RSAPrivateKey {} -> pka == RSA-    ECDHPrivateKey {} -> pka == ECDH || pka == X25519-    X25519PrivateKey {} -> pka == X25519-    X448PrivateKey {} -> pka == X448-    _ -> False--matchesRecipientIdentifier :: BL.ByteString -> PKESKRecipientKey -> Bool-matchesRecipientIdentifier rid keyInfo =-  case pkeskRecipientPKPayload keyInfo of-    Nothing -> False-    Just pkp ->-      let fingerprintBytes = BL.toStrict (unFingerprint (fingerprint pkp))-          identifier = BL.toStrict rid-       in identifier == fingerprintBytes ||-          identifier == B.cons 0x04 fingerprintBytes ||-          identifier == B.cons 0x06 fingerprintBytes--buildECDHKDFParamForTest ::-     SomePKPayload-  -> PubKeyAlgorithm-  -> ECCT.Curve-  -> HashAlgorithm-  -> SymmetricAlgorithm-  -> B.ByteString-buildECDHKDFParamForTest recipientPKP pka curve kdfHA kdfSA =-  B.singleton (fromIntegral (B.length curveOid)) <> curveOid <>-  B.pack [fromFVal pka, 0x03, 0x01, fromFVal kdfHA, fromFVal kdfSA] <>-  "Anonymous Sender    " <>-  BL.toStrict (unFingerprint (fingerprint recipientPKP))-  where-    curveOid = either (const B.empty) id (curveToCurveoidBS (curveFromCurve curve))--buildCurve25519LegacyKdfParamForTest ::-     SomePKPayload-  -> PubKeyAlgorithm-  -> HashAlgorithm-  -> SymmetricAlgorithm-  -> B.ByteString-buildCurve25519LegacyKdfParamForTest recipientPKP pka kdfHA kdfSA =-  B.singleton (fromIntegral (B.length curveOid)) <> curveOid <>-  B.pack [fromFVal pka, 0x03, 0x01, fromFVal kdfHA, fromFVal kdfSA] <>-  "Anonymous Sender    " <>-  BL.toStrict (unFingerprint (fingerprint recipientPKP))-  where-    curveOid = "\x2b\x06\x01\x04\x01\x97\x55\x01\x05\x01"--deriveECDHKekForTest ::-     HashAlgorithm-  -> SymmetricAlgorithm-  -> B.ByteString-  -> B.ByteString-  -> B.ByteString-deriveECDHKekForTest kdfHA kdfSA sharedSecret kdfParam =-  B.take (keyLengthForTest kdfSA) digest-  where-    digest =-      case kdfHA of-        SHA256 -> BA.convert (CH.hash (B.pack [0, 0, 0, 1] <> sharedSecret <> kdfParam) :: CH.Digest CHA.SHA256)-        SHA384 -> BA.convert (CH.hash (B.pack [0, 0, 0, 1] <> sharedSecret <> kdfParam) :: CH.Digest CHA.SHA384)-        SHA512 -> BA.convert (CH.hash (B.pack [0, 0, 0, 1] <> sharedSecret <> kdfParam) :: CH.Digest CHA.SHA512)-        _ -> BA.convert (CH.hash (B.pack [0, 0, 0, 1] <> sharedSecret <> kdfParam) :: CH.Digest CHA.SHA256)--deriveX448KekForTest ::-     B.ByteString-  -> B.ByteString-  -> B.ByteString-  -> B.ByteString-deriveX448KekForTest ephemeralPublic recipientPublic sharedSecret =-  let ikm = ephemeralPublic <> recipientPublic <> sharedSecret-      prk = extract @CHA.SHA512 B.empty ikm-      info = "OpenPGP X448" :: B.ByteString-   in expand @CHA.SHA512 prk info 32--deriveX25519KekForTest ::-     B.ByteString-  -> B.ByteString-  -> B.ByteString-  -> B.ByteString-deriveX25519KekForTest ephemeralPublic recipientPublic sharedSecret =-  let ikm = ephemeralPublic <> recipientPublic <> sharedSecret-      prk = extract @CHA.SHA256 B.empty ikm-      info = "OpenPGP X25519" :: B.ByteString-   in expand @CHA.SHA256 prk info 16--keyLengthForTest :: SymmetricAlgorithm -> Int-keyLengthForTest AES128 = 16-keyLengthForTest AES192 = 24-keyLengthForTest AES256 = 32-keyLengthForTest _ = 16--aesKeyWrapRFC3394ForTest ::-     SymmetricAlgorithm -> B.ByteString -> B.ByteString -> B.ByteString-aesKeyWrapRFC3394ForTest sa kek plain =-  case sa of-    AES128 -> wrapWithCipher (initCipher kek :: AES.AES128) plain-    AES192 -> wrapWithCipher (initCipher kek :: AES.AES192) plain-    AES256 -> wrapWithCipher (initCipher kek :: AES.AES256) plain-    _ -> error "unsupported KEK algorithm in test"-  where-    initCipher keyBytes =-      case CE.eitherCryptoError (CCT.cipherInit keyBytes) of-        Left err -> error ("cipher init failed: " ++ show err)-        Right c -> c-    wrapWithCipher cipher plainBytes =-      let rs = chunksOf8ForTest plainBytes-          n = length rs-          a0 = B.replicate 8 0xA6-          (aFinal, rFinal) = foldl (\(a, r) j -> wrapRound cipher n j a r) (a0, rs) [0 .. 5]-       in aFinal <> B.concat rFinal-    wrapRound cipher n j a rs = foldl step (a, rs) [1 .. n]-      where-        step (aCurr, rCurr) i =-          let b = CCT.ecbEncrypt cipher (aCurr <> (rCurr !! (i - 1)))-              (aMsb, rLsb) = B.splitAt 8 b-              t = fromIntegral (n * j + i) :: Word64-              aNext = xorBSForTest aMsb (encodeWord64beForTest t)-           in (aNext, replaceAtForTest (i - 1) rLsb rCurr)--encodeWord64beForTest :: Word64 -> B.ByteString-encodeWord64beForTest = BL.toStrict . runPut . putWord64be--chunksOf8ForTest :: B.ByteString -> [B.ByteString]-chunksOf8ForTest bs-  | B.null bs = []-  | otherwise =-      let (h, t) = B.splitAt 8 bs-       in h : chunksOf8ForTest t--replaceAtForTest :: Int -> a -> [a] -> [a]-replaceAtForTest idx x xs =-  let (prefix, suffix) = splitAt idx xs-   in case suffix of-        [] -> xs-        (_:rest) -> prefix <> (x : rest)--xorBSForTest :: B.ByteString -> B.ByteString -> B.ByteString-xorBSForTest a b = B.pack (B.zipWith xor a b)--encodeChecksum16 :: B.ByteString -> B.ByteString-encodeChecksum16 bs =-  B.pack-    [fromIntegral (s `div` 256), fromIntegral (s `mod` 256)]-  where-    s = B.foldl' (\acc octet -> (acc + fromIntegral octet) `mod` (65536 :: Int)) 0 bs--verifyMessageFromPackets :: PublicKeyring -> BL.ByteString -> [Either String Verification]-verifyMessageFromPackets keyring signedMessage =-  map (either (Left . renderVerificationError) Right) $-  verifyMessagePackets-    defaultVerificationOptions-      { verificationPolicy = VerifyInformational-      , verificationMode = VerificationStreaming-      }-    keyring-    (concatMap (either (const []) id . decompressPkt) (parsePkts signedMessage))--verifyMessageFromPacketsBatch :: PublicKeyring -> BL.ByteString -> [Either String Verification]-verifyMessageFromPacketsBatch keyring signedMessage =-  map (either (Left . renderVerificationError) Right) $-  verifyMessagePackets-    defaultVerificationOptions-      { verificationPolicy = VerifyInformational-      , verificationMode = VerificationBatch-      }-    keyring-    (concatMap (either (const []) id . decompressPkt) (parsePkts signedMessage))--verifyMessageFromBytestring :: PublicKeyring -> BL.ByteString -> [Either String Verification]-verifyMessageFromBytestring keyring signedMessage =-  map (either (Left . renderVerificationError) Right) $-  verifyMessage-    defaultVerificationOptions-      { verificationPolicy = VerifyInformational-      , verificationMode = VerificationStreaming-      }-    keyring-    signedMessage--verifyMessageFromBytestringBatch :: PublicKeyring -> BL.ByteString -> [Either String Verification]-verifyMessageFromBytestringBatch keyring signedMessage =-  map (either (Left . renderVerificationError) Right) $-  verifyMessage-    defaultVerificationOptions-      { verificationPolicy = VerifyInformational-      , verificationMode = VerificationBatch-      }-    keyring-    signedMessage--assertMessageVerification ::-     (PublicKeyring -> BL.ByteString -> [Either String Verification])-  -> FilePath-  -> FilePath-  -> [Fingerprint]-  -> Assertion-assertMessageVerification verifier keyringFile messageFile issuers = do-  kr <- loadKeyring keyringFile-  signedMessage <- readFixtureLazy messageFile-  let verification = verifier kr signedMessage-      actual = map (fmap (fingerprint . _verificationSigner)) verification-  assertEqual-    (keyringFile ++ " for " ++ messageFile)-    (map Right issuers)-    actual--loadKeyring :: FilePath -> IO PublicKeyring-loadKeyring keyring =-  DC.runConduitRes $-  CB.sourceFile (fixturePath keyring) DC..| conduitGet get DC..| conduitToPublicViewTKs DC..|-  sinkPublicKeyringMap--loadAndDecompressPkts :: FilePath -> IO [Pkt]-loadAndDecompressPkts = readFixtureDecompressedPackets--loadArmor :: FilePath -> IO [Armor]-loadArmor file = do-  armored <- readFixtureLazy file-  case AA.decodeLazy armored :: Either String [Armor] of-    Left err ->-      assertFailure ("Failed to decode armored fixture " ++ file ++ ": " ++ err) >> pure []-    Right armors -> pure armors--encryptMessageDefault ::-     SessionMaterialExposure-  -> Passphrase-  -> ClearPayload-  -> Either-       MessageError-       (EncryptedPayload, Maybe RecoveredSessionMaterial)-encryptMessageDefault exposure passphrase payload =-  encryptMessage-    (RFC9580EncryptMessageOptions-       { rfc9580EncryptMessageExposure = exposure-       , rfc9580EncryptMessageSymmetricAlgorithm = AES256-       , rfc9580EncryptMessageS2K = Argon2 (Salt16 (B.pack [0x80 .. 0x8f])) 1 4 15-       , rfc9580EncryptMessageIV = IV "0123456789ABCDEF"-       })-    passphrase-    payload--mkTestKeyring :: [TKUnknown] -> PublicKeyring-mkTestKeyring tks =-  let someTKs = [stk | Right stk <- map fromUnknownToTKEither tks]-  in fst (partitionSomeTKs someTKs)--addTimestampSeconds :: ThirtyTwoBitTimeStamp -> Word32 -> ThirtyTwoBitTimeStamp-addTimestampSeconds (ThirtyTwoBitTimeStamp ts) seconds = ThirtyTwoBitTimeStamp (ts + seconds)--timestampToUTCTime :: ThirtyTwoBitTimeStamp -> UTCTime-timestampToUTCTime = posixSecondsToUTCTime . realToFrac . unThirtyTwoBitTimeStamp--signCertificationAt ::-     SomePKPayload-  -> RSA.PrivateKey-  -> UserId-  -> ThirtyTwoBitTimeStamp-  -> [SigSubPacket]-  -> IO SignaturePayload-signCertificationAt signer signingKey uid creationTime hashedExtras = do-  (hashed, unhashed) <- messageIssuerSubpacketsAt signer creationTime-  case signCertificationWithRSA-         GenericCert-         signer-         uid-         (hashedExtras ++ hashed)-         unhashed-         signingKey of-    Left err ->-      assertFailure ("failed to sign certification: " ++ renderSignError err) >>-      fail "expected certification signature"-    Right sigPayload -> pure sigPayload--signCertificationRevocationAt ::-     SomePKPayload-  -> RSA.PrivateKey-  -> UserId-  -> ThirtyTwoBitTimeStamp-  -> [SigSubPacket]-  -> IO SignaturePayload-signCertificationRevocationAt signer signingKey uid creationTime hashedExtras = do-  (hashed, unhashed) <- messageIssuerSubpacketsAt signer creationTime-  case signCertRevocationWithRSA-         signer-         uid-         (hashedExtras ++ hashed)-         unhashed-         signingKey of-    Left err ->-      assertFailure ("failed to sign certification revocation: " ++ renderSignError err) >>-      fail "expected certification revocation signature"-    Right sigPayload -> pure sigPayload--messageIssuerSubpacketsAt ::-     SomePKPayload-  -> ThirtyTwoBitTimeStamp-  -> IO ([SigSubPacket], [SigSubPacket])-messageIssuerSubpacketsAt signer creationTime =-  case eightOctetKeyID signer of-    Left err ->-      assertFailure ("failed to derive issuer key id for timeline test: " ++ err) >>-      fail "expected issuer key id"-    Right issuerKeyId ->-      pure-        ( [ SigSubPacket False (SigCreationTime creationTime)-          , SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint signer))-          ]-        , [SigSubPacket False (Issuer issuerKeyId)]-        )--loadUnencryptedRsaSigner :: IO (SomePKPayload, RSA.PrivateKey)-loadUnencryptedRsaSigner = do-  secretPackets <--    DC.runConduitRes $-    CB.sourceFile "tests/data/unencrypted.seckey" DC..| conduitGet get DC..| CL.consume-  case secretPackets of-    (SecretKeyPkt pkp ska:_) ->-      case ska of-        SUUnencrypted (RSAPrivateKey (RSA_PrivateKey privateKey)) _ ->-          pure (pkp, privateKey)-        _ ->-          assertFailure "unencrypted.seckey did not contain an unencrypted RSA key" >>-          fail "expected decrypted RSA private key"-    _ ->-      assertFailure "unencrypted.seckey did not begin with a secret key packet" >>-      fail "expected secret key packet"--loadUnencryptedRsaSignerV6 :: IO (SomePKPayload, RSA.PrivateKey)-loadUnencryptedRsaSignerV6 = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  pure (setKeyVersion V6 signer, signingKey)--setKeyVersion :: KeyVersion -> SomePKPayload -> SomePKPayload-setKeyVersion keyVersion (PKPayload _ ts v3e pka pubkey) =-  PKPayload keyVersion ts v3e pka pubkey--setKeyTimestamp :: ThirtyTwoBitTimeStamp -> SomePKPayload -> SomePKPayload-setKeyTimestamp ts (PKPayload keyVersion _ v3e pka pubkey) =-  PKPayload keyVersion ts v3e pka pubkey--setPKAlgorithm :: PubKeyAlgorithm -> SomePKPayload -> SomePKPayload-setPKAlgorithm algorithm (PKPayload keyVersion ts v3e _ pubkey) =-  PKPayload keyVersion ts v3e algorithm pubkey--expectV4PKPayload :: String -> SomePKPayload -> IO (VersionedPKPayload V4)-expectV4PKPayload label pk =-  case asV4PKPayload pk of-    Left err ->-      assertFailure (label ++ " should have a v4 PKPayload: " ++ err) >>-      fail "expected v4 PKPayload"-    Right v4pk -> pure v4pk--expectV6PKPayload :: String -> SomePKPayload -> IO (VersionedPKPayload V6)-expectV6PKPayload label pk =-  case asV6PKPayload pk of-    Left err ->-      assertFailure (label ++ " should have a v6 PKPayload: " ++ err) >>-      fail "expected v6 PKPayload"-    Right v6pk -> pure v6pk--loadDeterministicEd25519Signer :: IO (SomePKPayload, Ed25519.SecretKey)-loadDeterministicEd25519Signer = do-  let seed = B.pack [1 .. 32]-  secretKey <--    case CE.eitherCryptoError (Ed25519.secretKey seed) of-      Left err ->-        assertFailure ("failed to initialize deterministic Ed25519 secret key: " ++ show err) >>-        fail "expected deterministic Ed25519 secret key"-      Right sk -> pure sk-  let publicKeyBytes = BA.convert (Ed25519.toPublic secretKey) :: B.ByteString-      signer =-        PKPayload-          V4-          0-          0-          EdDSA-          (EdDSAPubKey Ed25519 (PrefixedNativeEPoint (EPoint (os2ip (B.cons 0x40 publicKeyBytes)))))-  pure (signer, secretKey)--loadDeterministicEd25519SignerV6 :: IO (SomePKPayload, Ed25519.SecretKey)-loadDeterministicEd25519SignerV6 = do-  let seed = B.pack [1 .. 32]-  secretKey <--    case CE.eitherCryptoError (Ed25519.secretKey seed) of-      Left err ->-        assertFailure ("failed to initialize deterministic Ed25519 secret key: " ++ show err) >>-        fail "expected deterministic Ed25519 secret key"-      Right sk -> pure sk-  let publicKeyBytes = BA.convert (Ed25519.toPublic secretKey) :: B.ByteString-      signer =-        PKPayload-          V6-          0-          0-          EdDSA-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip publicKeyBytes))))-  pure (signer, secretKey)--loadDeterministicEd448Signer :: IO (SomePKPayload, Ed448.SecretKey)-loadDeterministicEd448Signer = do-  let seed = B.pack [1 .. 57]-  secretKey <--    case CE.eitherCryptoError (Ed448.secretKey seed) of-      Left err ->-        assertFailure ("failed to initialize deterministic Ed448 secret key: " ++ show err) >>-        fail "expected deterministic Ed448 secret key"-      Right sk -> pure sk-  let publicKeyBytes = BA.convert (Ed448.toPublic secretKey) :: B.ByteString-      signer =-        PKPayload-          V4-          0-          0-          EdDSA-          (EdDSAPubKey Ed448 (PrefixedNativeEPoint (EPoint (os2ip (B.cons 0x40 publicKeyBytes)))))-  pure (signer, secretKey)--loadDeterministicEd448SignerV6 :: IO (SomePKPayload, Ed448.SecretKey)-loadDeterministicEd448SignerV6 = do-  let seed = B.pack [1 .. 57]-  secretKey <--    case CE.eitherCryptoError (Ed448.secretKey seed) of-      Left err ->-        assertFailure ("failed to initialize deterministic Ed448 secret key: " ++ show err) >>-        fail "expected deterministic Ed448 secret key"-      Right sk -> pure sk-  let publicKeyBytes = BA.convert (Ed448.toPublic secretKey) :: B.ByteString-      signer =-        PKPayload-          V6-          0-          0-          EdDSA-          (EdDSAPubKey Ed448 (NativeEPoint (EPoint (os2ip publicKeyBytes))))-  pure (signer, secretKey)--testSEIPDv2ForV4KeyArmor :: Assertion-testSEIPDv2ForV4KeyArmor = do-  armors <- loadArmor "seipdv2-for-v4-key.pgp.aa"-  armor <--    case armors of-      [a] -> pure a-      _ ->-        assertFailure "seipdv2-for-v4-key fixture should contain one armored payload" >>-        fail "expected one armored payload"-  payload <--    case armor of-      Armor ArmorMessage _ p -> pure p-      Armor atype _ _ ->-        assertFailure-          ("seipdv2-for-v4-key fixture should decode as a message block, got " ++-           show atype) >>-        fail "expected message block"-      _ ->-        assertFailure "seipdv2-for-v4-key fixture should decode as an armored payload" >>-        fail "expected armored payload"-  let packets = parsePkts (BL.fromStrict (BLC8.toStrict payload))-  case packets of-    [PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka _)), SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize _ _)] -> do-      let ridHex = map toUpper (BLC8.unpack (B16L.encode rid))-      if ridHex `elem` ["C8263FC6D676044B6E973959C2F2C2CAE30DE908", "04C8263FC6D676044B6E973959C2F2C2CAE30DE908"]-        then pure ()-        else-          assertFailure-            ("seipdv2-for-v4-key fixture should target the expected recipient fingerprint, got " ++-             ridHex)-      assertEqual-        "seipdv2-for-v4-key fixture should use ECDH PKESKv6"-        ECDH-        pka-      assertEqual-        "seipdv2-for-v4-key fixture should use AES-256"-        AES256-        sa-      assertEqual-        "seipdv2-for-v4-key fixture should use OCB"-        OCB-        aa-      assertEqual-        "seipdv2-for-v4-key fixture should use 4KiB chunks"-        6-        chunkSize-    _ ->-      assertFailure-        ("seipdv2-for-v4-key fixture should contain [PKESKPkt (PKESK6 ...), SymEncIntegrityProtectedDataPkt (SEIPD2 ...)], got: " ++-         show packets)--loadSEIPDv2FixtureWithV4Secret :: FilePath -> IO ([Pkt], [Pkt], BL.ByteString)-loadSEIPDv2FixtureWithV4Secret fixture = do-  messageArmor <- loadFirstArmor fixture-  encryptedSecretArmor <- loadFirstArmor "v4-encrypted-secret.pgp.aa"-  passphrase <- readPKIPassphrase-  pure-    ( parsePkts (armorPayload messageArmor)-    , parsePkts (armorPayload encryptedSecretArmor)-    , passphrase-    )--forceVersionedRecipientIdentifier :: Pkt -> Pkt-forceVersionedRecipientIdentifier pkt =-  case pkt of-    PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka esk))-      | BL.length rid == 20 ->-          PKESKPkt-            (PKESKPayloadV6Packet (PKESKPayloadV6 (BL.cons 0x04 rid) pka esk))-      | BL.length rid == 32 ->-          PKESKPkt-            (PKESKPayloadV6Packet (PKESKPayloadV6 (BL.cons 0x06 rid) pka esk))-      | otherwise -> pkt-    _ -> pkt--selectRecipientKeyInfoByRawRecipientId :: Pkt -> [PKESKRecipientKey] -> Maybe PKESKRecipientKey-selectRecipientKeyInfoByRawRecipientId (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka _))) keyInfos =-  listToMaybe-    [ keyInfo-    | keyInfo <- keyInfos-    , supportsPKESKAlgorithm pka keyInfo-    , matchesRawRecipientFingerprint rid keyInfo-    ]-selectRecipientKeyInfoByRawRecipientId _ keyInfos = listToMaybe keyInfos--matchesRawRecipientFingerprint :: BL.ByteString -> PKESKRecipientKey -> Bool-matchesRawRecipientFingerprint rid keyInfo =-  case pkeskRecipientPKPayload keyInfo of-    Nothing -> False-    Just pkp ->-      BL.toStrict rid == BL.toStrict (unFingerprint (fingerprint pkp))--testSEIPDv2TwoRecipientsArmor :: Assertion-testSEIPDv2TwoRecipientsArmor =-  testSEIPDv2RecipientFixtureArmor "seipdv2-two-recipients.pgp.aa" 2--testSEIPDv2ThreeRecipientsArmor :: Assertion-testSEIPDv2ThreeRecipientsArmor =-  testSEIPDv2RecipientFixtureArmor "seipdv2-three-recipients.pgp.aa" 3--testSEIPDv2RecipientFixtureArmor :: FilePath -> Int -> Assertion-testSEIPDv2RecipientFixtureArmor file expectedRecipients = do-  armors <- loadArmor file-  armor <--    case armors of-      [a] -> pure a-      _ ->-        assertFailure (file ++ " fixture should contain one armored payload") >>-        fail "expected one armored payload"-  payload <--    case armor of-      Armor ArmorMessage _ p -> pure p-      Armor atype _ _ ->-        assertFailure-          (file ++ " fixture should decode as a message block, got " ++ show atype) >>-        fail "expected message block"-      _ ->-        assertFailure (file ++ " fixture should decode as an armored payload") >>-        fail "expected armored payload"-  let packets = parsePkts (BL.fromStrict (BLC8.toStrict payload))-      pkesks = [(rid, pka) | PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka _)) <- packets]-      x25519Esks = [BL.toStrict esk | PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 _ X25519 esk)) <- packets]-      x448Esks = [BL.toStrict esk | PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 _ X448 esk)) <- packets]-      seipdv2Packets =-        [(sa, aa, chunkSize) | SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize _ _) <- packets]-  assertEqual-    (file ++ " fixture should contain expected number of PKESKv6 packets")-    expectedRecipients-    (length pkesks)-  if all (\(_, pka) -> pka == ECDH || pka == X25519) pkesks-    then pure ()-    else-      assertFailure-        (file ++ " fixture should use only ECDH/X25519 PKESKv6 packets, got " ++-         show (map snd pkesks))-  if any ((== ECDH) . snd) pkesks-    then pure ()-    else-      assertFailure (file ++ " fixture should include an ECDH recipient for the v4 key")-  mapM_ (assertX25519EskShape file) x25519Esks-  mapM_ (assertX448EskShape file) x448Esks-  if all-       (\(rid, _) ->-          let l = BL.length rid-           in l == 20 || l == 21 || l == 32 || l == 33)-       pkesks-    then pure ()-    else-      assertFailure-        (file ++ " fixture should use 20/21-byte or 32/33-byte recipient identifiers")-  case seipdv2Packets of-    [(sa, aa, chunkSize)] -> do-      assertEqual (file ++ " fixture should use AES-256") AES256 sa-      assertEqual (file ++ " fixture should use OCB") OCB aa-      assertEqual (file ++ " fixture should use 4KiB chunks") 6 chunkSize-    _ ->-      assertFailure-        (file ++ " fixture should contain one SymEncIntegrityProtectedDataV2 packet")--assertX25519EskShape :: FilePath -> B.ByteString -> Assertion-assertX25519EskShape file x25519Esk-  | B.length x25519Esk < 33 =-      assertFailure-        (file ++ " X25519 PKESKv6 ESK should contain 32-octet ephemeral and wrapped-len")-  | otherwise = do-      let wrappedLen = fromIntegral (B.index x25519Esk 32) :: Int-          wrapped = B.drop 33 x25519Esk-      assertEqual-        (file ++ " X25519 PKESKv6 wrapped length octet")-        wrappedLen-        (B.length wrapped)--assertX448EskShape :: FilePath -> B.ByteString -> Assertion-assertX448EskShape file x448Esk-  | B.length x448Esk < 57 =-      assertFailure-        (file ++ " X448 PKESKv6 ESK should contain 56-octet ephemeral and wrapped-len")-  | otherwise = do-      let wrappedLen = fromIntegral (B.index x448Esk 56) :: Int-          wrapped = B.drop 57 x448Esk-      assertEqual-        (file ++ " X448 PKESKv6 wrapped length octet")-        wrappedLen-        (B.length wrapped)--prependUnusableLatestPKESK :: [Pkt] -> [Pkt]-prependUnusableLatestPKESK packets =-  let bogusRid = BL.pack (0x06 : replicate 32 0x99)-      bogusPKESK = PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 bogusRid RSA "bogus-esk"))-      (eskPrefix, encryptedSuffix) = span isPrecedingESK packets-   in eskPrefix ++ [bogusPKESK] ++ encryptedSuffix--reorderPrecedingPKESKs :: [Pkt] -> [Pkt]-reorderPrecedingPKESKs packets =-  let (eskPrefix, encryptedSuffix) = span isPrecedingESK packets-      reorderedPKESKs = reverse [pkt | pkt@(PKESKPkt _) <- eskPrefix]-   in refillPKESKSlots eskPrefix reorderedPKESKs ++ encryptedSuffix-  where-    refillPKESKSlots [] _ = []-    refillPKESKSlots (pkt:rest) pkesks =-      case pkt of-        PKESKPkt {} ->-          case pkesks of-            [] -> pkt : refillPKESKSlots rest []-            (replacement:remaining) ->-              replacement : refillPKESKSlots rest remaining-        _ -> pkt : refillPKESKSlots rest pkesks--isPrecedingESK :: Pkt -> Bool-isPrecedingESK (PKESKPkt _) = True-isPrecedingESK (SKESKPkt _) = True-isPrecedingESK _ = False--messageVerificationFixtures :: [(String, FilePath, FilePath, [Fingerprint])]-messageVerificationFixtures =-  [ ( "uncompressed-ops-dsa"-    , "pubring.gpg"-    , "uncompressed-ops-dsa.gpg"-    , [fp "1EB2 0B2F 5A5C C3BE AFD6  E5CB 7732 CF98 8A63 EA86"])-  , ( "uncompressed-ops-dsa-sha384"-    , "pubring.gpg"-    , "uncompressed-ops-dsa-sha384.txt.gpg"-    , [fp "1EB2 0B2F 5A5C C3BE AFD6  E5CB 7732 CF98 8A63 EA86"])-  , ( "uncompressed-ops-rsa"-    , "pubring.gpg"-    , "uncompressed-ops-rsa.gpg"-    , [fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D"])-  , ( "compressedsig"-    , "pubring.gpg"-    , "compressedsig.gpg"-    , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])-  , ( "compressedsig-zlib"-    , "pubring.gpg"-    , "compressedsig-zlib.gpg"-    , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])-  , ( "compressedsig-bzip2"-    , "pubring.gpg"-    , "compressedsig-bzip2.gpg"-    , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])-  ]--certificateVerificationFixtures :: [(String, FilePath, FilePath, [Fingerprint])]-certificateVerificationFixtures =-  [ ( "userid"-    , "pubring.gpg"-    , "minimized.gpg"-    , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])-  , ( "subkey"-    , "pubring.gpg"-    , "subkey.gpg"-    , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])-  , ( "primary key binding"-    , "signing-subkey.gpg"-    , "primary-binding.gpg"-    , [fp "ED1B D216 F70E 5D5F 4444  48F9 B830 F2C4 83A9 9AE5"])-  , ( "attribute"-    , "pubring.gpg"-    , "uat.gpg"-    , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])-  , ( "primary key revocation"-    , "pubring.gpg"-    , "prikey-rev.gpg"-    , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])-  , ( "subkey revocation"-    , "pubring.gpg"-    , "subkey-rev.gpg"-    , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])-  , ( "6F87040E"-    , "pubring.gpg"-    , "6F87040E.pubkey"-    , [ fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"-      , fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D"-      , fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"-      ])-  , ( "6F87040E-cr"-    , "pubring.gpg"-    , "6F87040E-cr.pubkey"-    , [ fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"-      , fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"-      , fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"-      , fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D"-      , fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"-      ])-  , ( "simple RSA secret key"-    , "pubring.gpg"-    , "simple.seckey"-    , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])-  , ( "simple ECDSA public key"-    , "ecdsa-key-without-ecdh.pubkey"-    , "ecdsa-key-without-ecdh.pubkey"-    , [fp "174C CF12 C571 6D0E 527F  B50E F770 8BAD D606 3224"])-  ]--verificationFixtureGroup ::-     String-  -> (PublicKeyring -> BL.ByteString -> [Either String Verification])-  -> [(String, FilePath, FilePath, [Fingerprint])]-  -> TestTree-verificationFixtureGroup groupName verifier fixtures =-  testGroup-    groupName-    [ testCase name (assertMessageVerification verifier keyringFile messageFile issuers)-    | (name, keyringFile, messageFile, issuers) <- fixtures-    ]--loadV6UnencryptedSecretKeyFixtureForProperty :: IO (Either String (SomePKPayload, SKAddendum, SKey))-loadV6UnencryptedSecretKeyFixtureForProperty = do-  armored <- readFixtureLazy "v6-secret.pgp.aa"-  pure $ do-    armors <- first ("failed to decode v6 secret fixture: " ++) (AA.decodeLazy armored)-    armor <--      case armors of-        (a:_) -> Right a-        [] -> Left "v6-secret.pgp.aa should contain one armored payload"-    let packets = parsePkts (armorPayload armor)-    (pkp, ska) <--      case packets of-        (SecretKeyPkt pkpayload skaddendum:_) -> Right (pkpayload, skaddendum)-        _ -> Left "v6-secret.pgp.aa should begin with a secret key packet"-    skey <--      case ska of-        SUUnencrypted x _ -> Right x-        _ -> Left "v6-secret.pgp.aa should contain unencrypted secret key material"-    Right (pkp, ska, skey)--loadV4EncryptedSecretKeyFixtureForProperty ::-     IO (Either String (SomePKPayload, SKAddendum, SKey, BL.ByteString))-loadV4EncryptedSecretKeyFixtureForProperty = do-  passphrase <- readPKIPassphrase-  packets <--    DC.runConduitRes $-    CB.sourceFile "tests/data/aes256-sha512.seckey" DC..| conduitGet get DC..|-    CL.consume-  pure $ do-    (pkp, ska) <--      case packets of-        (SecretKeyPkt pkpayload skaddendum:_) -> Right (pkpayload, skaddendum)-        _ -> Left "aes256-sha512.seckey should begin with a secret key packet"-    skey <--      case decryptPrivateKey (pkp, ska) passphrase of-        Right (SUUnencrypted x _) -> Right x-        Right other ->-          Left ("unexpected decrypted key shape for v4 fixture: " ++ show other)-        Left err ->-          Left ("failed to decrypt v4 fixture secret key: " ++ err)-    Right (pkp, ska, skey, passphrase)--reverseIf :: Bool -> [a] -> [a]-reverseIf shouldReverse xs-  | shouldReverse = reverse xs-  | otherwise = xs--cgp :: DC.ConduitT B.ByteString Pkt (ResourceT IO) ()-cgp = conduitGet (get :: Get Pkt)--fp :: Text -> Fingerprint-fp = either error id . parseFingerprint--doPkeyAndSkeyMatch :: PKey -> SKey -> Assertion-doPkeyAndSkeyMatch (RSAPubKey (RSA_PublicKey rpub)) (RSAPrivateKey (RSA_PrivateKey rpriv)) =-  assertEqual-    "RSA private key matches RSA public key"-    rpub-    (RSA.private_pub rpriv)-doPkeyAndSkeyMatch (ECDSAPubKey (ECDSA_PublicKey ecpub)) (ECDSAPrivateKey (ECDSA_PrivateKey ecpriv)) =-  assertEqual-    "ECDSA private key curve matches ECDSA public key curve"-    (ECDSA.public_curve ecpub)-    (ECDSA.private_curve ecpriv)-doPkeyAndSkeyMatch _ _ = assertFailure "matching unimplemented"--collectSecretKeyInfos :: [Pkt] -> BL.ByteString -> IO [PKESKRecipientKey]-collectSecretKeyInfos pkts passphrase = do-  let keyInfoResults = map toKeyInfo pkts-      keyInfos = catMaybes [mKeyInfo | Right mKeyInfo <- keyInfoResults]-      unlockErrors = [err | Left err <- keyInfoResults]-  unless (null unlockErrors) $-    assertFailure-      ("one or more secret key packets failed to unlock (partial failures are surfaced to\-       \ prevent silent key-context gaps):\n" ++-       unlines unlockErrors)-  pure keyInfos-  where-    toKeyInfo (SecretKeyPkt pkp ska) = decryptToRecipientKey "SecretKeyPkt" pkp ska-    toKeyInfo (SecretSubkeyPkt pkp ska) = decryptToRecipientKey "SecretSubkeyPkt" pkp ska-    toKeyInfo _ = Right Nothing--    decryptToRecipientKey contextLabel pkp ska =-      case ska of-        SUUnencrypted skey _ ->-          Right-            (Just-               (PKESKRecipientKey-                  { pkeskRecipientPKPayload = Just pkp-                  , pkeskRecipientSKey = skey-                  }))-        _ ->-          case decryptPrivateKey (pkp, ska) passphrase of-            Right (SUUnencrypted skey _) ->-              Right-                (Just-                  (PKESKRecipientKey-                      { pkeskRecipientPKPayload = Just pkp-                      , pkeskRecipientSKey = skey-                      }))-            Right decryptedSKA ->-              Left-                (contextLabel ++-                 " " ++-                 show (fingerprint pkp) ++-                 ": decryptPrivateKey returned unexpected protection: " ++-                 show decryptedSKA)-            Left err ->-              Left-                (contextLabel ++-                 " " ++-                 show (fingerprint pkp) ++-                 ": decryptPrivateKey failed: " ++ err)--signSubkeyRevocationWithRSAAt ::-     SomePKPayload-  -> SomePKPayload-  -> RSA.PrivateKey-  -> ThirtyTwoBitTimeStamp-  -> IO SignaturePayload-signSubkeyRevocationWithRSAAt signer subkey signingKey creationTime = do-  (hashed, unhashed) <- messageIssuerSubpacketsAt signer creationTime-  case signSubkeyRevocationWithRSA signer subkey hashed unhashed signingKey of-    Left err ->-      assertFailure ("failed to sign subkey revocation: " ++ renderSignError err) >>-      fail "expected subkey revocation signature"-    Right sigPayload -> pure sigPayload--signSubkeyBindingWithRSAAt ::-     SomePKPayload-  -> SomePKPayload-  -> RSA.PrivateKey-  -> ThirtyTwoBitTimeStamp-  -> IO SignaturePayload-signSubkeyBindingWithRSAAt signer subkey signingKey creationTime = do-  signSubkeyBindingWithRSAExtrasAt signer subkey signingKey creationTime []--signDirectKeyWithRSAExtrasAt ::-     SomePKPayload-  -> RSA.PrivateKey-  -> ThirtyTwoBitTimeStamp-  -> [SigSubPacket]-  -> IO SignaturePayload-signDirectKeyWithRSAExtrasAt signer signingKey creationTime hashedExtras = do-  (hashed, unhashed) <- messageIssuerSubpacketsAt signer creationTime-  case signDirectKeyWithRSA SignatureDirectlyOnAKey signer (hashedExtras ++ hashed) unhashed signingKey of-    Left err ->-      assertFailure ("failed to sign direct key self-signature: " ++ renderSignError err) >>-      fail "expected direct key self-signature"-    Right sigPayload -> pure sigPayload--signSubkeyBindingWithRSAExtrasAt ::-     SomePKPayload-  -> SomePKPayload-  -> RSA.PrivateKey-  -> ThirtyTwoBitTimeStamp-  -> [SigSubPacket]-  -> IO SignaturePayload-signSubkeyBindingWithRSAExtrasAt signer subkey signingKey creationTime hashedExtras = do-  (hashed, unhashed) <- messageIssuerSubpacketsAt signer creationTime-  let bindingPayload =-        payloadForSig-          SubkeyBindingSig-          emptyPSC-            { lastPrimaryKey = PublicKeyPkt signer-            , lastSubkey = PublicSubkeyPkt subkey-            }-  case signDataWithRSA SubkeyBindingSig signingKey (hashedExtras ++ hashed) unhashed bindingPayload of-    Left err ->-      assertFailure ("failed to sign subkey binding: " ++ renderSignError err) >>-      fail "expected subkey binding signature"-    Right sigPayload -> pure sigPayload--verifyTimelinePackets :: PublicKeyring -> BL.ByteString -> SignaturePayload -> [Either VerificationError Verification]-verifyTimelinePackets keyring payload sigPayload =-  verifyMessagePackets-    defaultVerificationOptions-      { verificationPolicy = VerifyStrict-      , verificationMode = VerificationBatch-      }-    keyring-    [LiteralDataPkt BinaryData BL.empty 0 payload, SignaturePkt sigPayload]--assertSingleSignerFingerprint ::-     String-  -> Fingerprint-  -> [Either VerificationError Verification]-  -> Assertion-assertSingleSignerFingerprint label expected results =-  case results of-    [Right verification] ->-      assertEqual label expected (fingerprint (_verificationSigner verification))-    other ->-      assertFailure-        (label ++-         ", expected one successful verification result, got " ++-         show (length other) ++-         " result(s)")--assertSingleFailureContainsTimeline ::-     String-  -> String-  -> [Either VerificationError Verification]-  -> Assertion-assertSingleFailureContainsTimeline label needle results =-  case results of-    [Left err] ->-      assertBool-        label-        (needle `isInfixOf` renderVerificationError err)-    other ->-      assertFailure-        (label ++-         ", expected one verification failure result, got " ++-         show (length other) ++-         " result(s)")--signCertificationWithEd25519At ::-     SomePKPayload-  -> SomePKPayload-  -> Ed25519.SecretKey-  -> UserId-  -> ThirtyTwoBitTimeStamp-  -> [SigSubPacket]-  -> IO SignaturePayload-signCertificationWithEd25519At certifiedSigner certifierSigner signingKey uid creationTime hashedExtras = do-  (hashed, unhashed) <- messageIssuerSubpacketsAt certifierSigner creationTime-  let state =-        emptyPSC-          { lastPrimaryKey = PublicKeyPkt certifiedSigner-          , lastUIDorUAt = UserIdPkt (let UserId uidText = uid in uidText)-          }-  case signDataWithEd25519-         GenericCert-         signingKey-         (hashedExtras ++ hashed)-         unhashed-         (payloadForSig GenericCert state) of-    Left err ->-      assertFailure ("failed to sign Ed25519 certification: " ++ renderSignError err) >>-      fail "expected Ed25519 certification signature"-    Right sigPayload -> pure sigPayload--signCertificationRevocationWithEd25519At ::-     SomePKPayload-  -> SomePKPayload-  -> Ed25519.SecretKey-  -> UserId-  -> ThirtyTwoBitTimeStamp-  -> [SigSubPacket]-  -> IO SignaturePayload-signCertificationRevocationWithEd25519At certifiedSigner certifierSigner signingKey uid creationTime hashedExtras = do-  (hashed, unhashed) <- messageIssuerSubpacketsAt certifierSigner creationTime-  let state =-        emptyPSC-          { lastPrimaryKey = PublicKeyPkt certifiedSigner-          , lastUIDorUAt = UserIdPkt (let UserId uidText = uid in uidText)-          }-  case signDataWithEd25519-         CertRevocationSig-         signingKey-         (hashedExtras ++ hashed)-         unhashed-         (payloadForSig CertRevocationSig state) of-    Left err ->-      assertFailure ("failed to sign Ed25519 certification revocation: " ++ renderSignError err) >>-      fail "expected Ed25519 certification revocation signature"-    Right sigPayload -> pure sigPayload--signKeyRevocationWithReasonAt ::-     SomePKPayload-  -> RSA.PrivateKey-  -> ThirtyTwoBitTimeStamp-  -> RevocationCode-  -> IO SignaturePayload-signKeyRevocationWithReasonAt signer signingKey creationTime reasonCode =-  signKeyRevocationWithReasonAndExtrasAt-    signer-    signingKey-    creationTime-    reasonCode-    []--signKeyRevocationWithReasonAndExtrasAt ::-     SomePKPayload-  -> RSA.PrivateKey-  -> ThirtyTwoBitTimeStamp-  -> RevocationCode-  -> [SigSubPacket]-  -> IO SignaturePayload-signKeyRevocationWithReasonAndExtrasAt signer signingKey creationTime reasonCode hashedExtras = do-  (hashed, unhashed) <- messageIssuerSubpacketsAt signer creationTime-  case signKeyRevocationWithRSA-         signer-         (SigSubPacket False (ReasonForRevocation reasonCode "") : hashedExtras ++ hashed)-         unhashed-         signingKey of-    Left err ->-      assertFailure ("failed to sign key revocation: " ++ renderSignError err) >>-      fail "expected key revocation signature"-    Right sigPayload -> pure sigPayload--signBinaryMessageWithRSAAt ::-     SomePKPayload-  -> RSA.PrivateKey-  -> ThirtyTwoBitTimeStamp-  -> BL.ByteString-  -> IO SignaturePayload-signBinaryMessageWithRSAAt signer signingKey creationTime payload = do-  (hashed, unhashed) <- messageIssuerSubpacketsAt signer creationTime-  case signDataWithRSA BinarySig signingKey hashed unhashed payload of-    Left err ->-      assertFailure ("failed to sign RSA message payload: " ++ renderSignError err) >>-      fail "expected RSA message signature"-    Right sigPayload -> pure sigPayload--signBinaryMessageWithEd25519At ::-     SomePKPayload-  -> Ed25519.SecretKey-  -> ThirtyTwoBitTimeStamp-  -> BL.ByteString-  -> IO SignaturePayload-signBinaryMessageWithEd25519At signer signingKey creationTime payload = do-  (hashed, unhashed) <- messageIssuerSubpacketsAt signer creationTime-  case signDataWithEd25519 BinarySig signingKey hashed unhashed payload of-    Left err ->-      assertFailure ("failed to sign Ed25519 message payload: " ++ renderSignError err) >>-      fail "expected Ed25519 message signature"-    Right sigPayload -> pure sigPayload-+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE TypeApplications #-}++module Tests.Common+    ( addTimestampSeconds+    , armorPayload+    , assertFalse+    , assertTrue+    , collectSecretKeyInfos+    , conduitDecryptWithPKESKContext+    , loadArmor+    , loadAndDecompressPkts+    , loadSEIPDv2FixtureWithV4Secret+    , loadUnencryptedRsaSigner+    , loadV4EncryptedSecretKeyFixtureForProperty+    , loadV6UnencryptedSecretKeyFixtureForProperty+    , prependUnusableLatestPKESK+    , readFixtureLazy+    , readFixturePackets+    , readFixturePayload+    , reorderPrecedingPKESKs+    , reverseIf+    , runGet -- FIXME: this is confusing+    , selectRecipientKeyInfo+    , setKeyTimestamp+    , signCertificationAt+    , signSubkeyBindingWithRSAExtrasAt+    , signSubkeyRevocationWithRSAAt+    , timestampToUTCTime+    , assertSingleFailureContainsTimeline+    , assertSingleSignerFingerprint+    , encryptMessageDefault+    , expectV4PKPayload+    , expectV6PKPayload+    , extractV4SignatureAlgorithmFields+    , fp+    , loadKeyring+    , loadDeterministicEd25519Signer+    , loadDeterministicEd25519SignerV6+    , loadDeterministicEd448Signer+    , loadDeterministicEd448SignerV6+    , loadUnencryptedRsaSignerV6+    , messageIssuerSubpacketsAt+    , mkTestKeyring+    , setPKAlgorithm+    , signBinaryMessageWithRSAAt+    , signBinaryMessageWithEd25519At+    , signKeyRevocationWithReasonAt+    , signKeyRevocationWithReasonAndExtrasAt+    , signSubkeyBindingWithRSAAt+    , verifyTimelinePackets+    , signCertificationRevocationWithEd25519At+    , signCertificationWithEd25519At+    , verificationFixtureGroup+    , verifyMessageFromBytestring+    , verifyMessageFromBytestringBatch+    , verifyMessageFromPackets+    , verifyMessageFromPacketsBatch+    , certificateVerificationFixtures+    , fixturePath+    , messageVerificationFixtures+    , readPKIPassphrase+    , setKeyVersion+    , signCertificationRevocationAt+    , aesKeyWrapRFC3394ForTest+    , assertX25519EskShape+    , assertX448EskShape+    , buildCurve25519LegacyKdfParamForTest+    , buildECDHKDFParamForTest+    , cgp+    , conduitDecrypt -- FIXME: this is confusing+    , conduitDecryptChecked+    , conduitDecryptCheckedWithDecryptPolicy+    , conduitDecryptWithCandidatesCallbackAndPolicy+    , conduitDecryptWithDecryptPolicy+    , deriveECDHKekForTest+    , deriveX25519KekForTest+    , deriveX448KekForTest+    , doPkeyAndSkeyMatch+    , encodeChecksum16+    , forceVersionedRecipientIdentifier+    , isPrecedingESK+    , mkPKESKSessionMaterialOrFail+    , readFixtureStrict+    , selectRecipientKeyInfoByRawRecipientId+    , signDirectKeyWithRSAExtrasAt+    , testEncodeOpenPGPSessionMaterial+    , testParsedRSASecretKeyPKCS15DecryptNotMessageNotRecognized+    , testSEIPDv2ForV4KeyArmor+    , testSEIPDv2TwoRecipientsArmor+    , testSEIPDv2ThreeRecipientsArmor+    )+where++import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA+import Codec.Encryption.OpenPGP.ASCIIArmor.Types+    ( Armor (..)+    , ArmorType (..)+    )+import Control.Error.Util (hush)+import Control.Monad (join, unless, void)+import Control.Monad.Trans.Resource (ResourceT)+import qualified Crypto.Error as CE+import qualified Crypto.Hash as CH+import qualified Crypto.Hash.Algorithms as CHA+import Crypto.KDF.HKDF (expand, extract)+import Crypto.Number.Serialize (os2ip)+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.ECC.Types as ECCT+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.RSA.PKCS15 as P15+import Data.Bifunctor (bimap, first)+import Data.Binary (get)+import Data.Binary.Get+    ( Get+    , getLazyByteString+    , getRemainingLazyByteString+    , getWord16be+    , getWord8+    , runGetOrFail+    )+import Data.Binary.Put (putWord64be, runPut)+import Data.Bits (xor)+import qualified Data.ByteArray as BA+import qualified Data.ByteString as B+import qualified Data.ByteString.Base16.Lazy as B16L+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC8+import Data.Char (toUpper)+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.IORef (IORef, modifyIORef', newIORef, readIORef)+import Data.List (isInfixOf)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (catMaybes, listToMaybe)+import Data.Text (Text)+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Word (Word32, Word64)+import System.IO.Unsafe (unsafePerformIO)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit+    ( Assertion+    , assertBool+    , assertEqual+    , assertFailure+    , testCase+    )+import qualified "crypton" Crypto.Cipher.AES as AES+import qualified "crypton" Crypto.Cipher.Types as CCT++import Codec.Encryption.OpenPGP.Arbitrary ()+import Codec.Encryption.OpenPGP.Compression (decompressPkt)+import Codec.Encryption.OpenPGP.Encrypt+    ( PKESKSessionMaterial+    , encodeOpenPGPSessionMaterial+    , mkPKESKSessionMaterial+    )+import Codec.Encryption.OpenPGP.Fingerprint+    ( eightOctetKeyID+    , fingerprint+    )+import Codec.Encryption.OpenPGP.Internal+    ( curveFromCurve+    , curveToCurveoidBS+    , emptyPSC+    , lastPrimaryKey+    , lastSubkey+    , lastUIDorUAt+    )+import Codec.Encryption.OpenPGP.KeySelection (parseFingerprint)+import Codec.Encryption.OpenPGP.Message+    ( ClearPayload+    , EncryptMessageOptions (..)+    , EncryptedPayload+    , MessageError (..)+    , Passphrase+    , RecoveredSessionMaterial (..)+    , SessionMaterialExposure (..)+    , VersionedPKPayload+    , asV4PKPayload+    , asV6PKPayload+    , encryptMessage+    )+import Codec.Encryption.OpenPGP.Policy+    ( DecryptPolicy+    , defaultDecryptPolicy+    )+import Codec.Encryption.OpenPGP.SecretKey+    ( decryptPrivateKey+    )+import Codec.Encryption.OpenPGP.Serialize+    ( dearmorIfAsciiArmored+    , parsePkts+    )+import Codec.Encryption.OpenPGP.SerializeForSigs (payloadForSig)+import Codec.Encryption.OpenPGP.Signatures+    ( VerificationError (..)+    , renderSignError+    , renderVerificationError+    , signCertRevocationWithRSA+    , signCertificationWithRSA+    , signDataWithEd25519+    , signDataWithRSA+    , signDirectKeyWithRSA+    , signKeyRevocationWithRSA+    , signSubkeyRevocationWithRSA+    )+import Codec.Encryption.OpenPGP.Types+import Data.Conduit.OpenPGP.Compression (conduitDecompress)+import Data.Conduit.OpenPGP.Decrypt+    ( DecryptKeyResolution (..)+    , DecryptOptions (..)+    , DecryptOutcome (..)+    , PKESKRecipientKey (..)+    )+import qualified Data.Conduit.OpenPGP.Decrypt as DCD+import Data.Conduit.OpenPGP.Keyring+    ( conduitToSomeTKsEither+    , partitionSomeTKs+    , sinkPublicKeyringMap+    )+import Data.Conduit.OpenPGP.Message+    ( VerificationMode (..)+    , VerificationOptions (..)+    , VerificationPolicy (..)+    , defaultVerificationOptions+    , verifyMessage+    , verifyMessagePackets+    )++-- Test assertion helpers+assertTrue :: String -> Bool -> Assertion+assertTrue msg b = assertBool msg b++assertFalse :: String -> Bool -> Assertion+assertFalse msg b = assertBool msg (not b)++fixturePath :: FilePath -> FilePath+fixturePath file = "tests/data/" ++ file++readFixtureLazy :: FilePath -> IO BL.ByteString+readFixtureLazy = BL.readFile . fixturePath++readFixtureStrict :: FilePath -> IO B.ByteString+readFixtureStrict = B.readFile . fixturePath++readFixturePackets :: FilePath -> IO [Pkt]+readFixturePackets file =+    DC.runConduitRes $+        CB.sourceFile (fixturePath file)+            DC..| conduitGet get+            DC..| CL.consume++readFixtureDecompressedPackets :: FilePath -> IO [Pkt]+readFixtureDecompressedPackets file =+    DC.runConduitRes $+        CB.sourceFile (fixturePath file)+            DC..| conduitGet get+            DC..| conduitDecompress+            DC..| CL.consume++loadFirstArmor :: FilePath -> IO Armor+loadFirstArmor file = do+    armors <- loadArmor file+    case armors of+        (a : _) -> pure a+        [] ->+            assertFailure (file ++ " armor file contained no armor blocks")+                >> fail "expected armor block"++readPKIPassphrase :: IO BL.ByteString+readPKIPassphrase = readFixtureLazy "pki-password.txt"++-- this needs a better name+runGet :: Get a -> BL.ByteString -> Either String a+runGet g bs = bimap (\(_, _, x) -> x) (\(_, _, x) -> x) (runGetOrFail g bs)++extractV4SignatureAlgorithmFields+    :: BL.ByteString -> Either String (PubKeyAlgorithm, B.ByteString)+extractV4SignatureAlgorithmFields =+    runGet $ do+        version <- getWord8+        if version /= 4+            then+                fail+                    ("expected v4 signature payload, got version " ++ show version)+            else do+                _ <- getWord8 -- sig type+                pka <- getWord8+                _ <- getWord8 -- hash algo+                hlen <- getWord16be+                _ <- getLazyByteString (fromIntegral hlen)+                ulen <- getWord16be+                _ <- getLazyByteString (fromIntegral ulen)+                _ <- getWord16be -- left16+                algorithmFields <- getRemainingLazyByteString+                pure (toFVal pka, BL.toStrict algorithmFields)++conduitDecrypt+    :: (String -> IO BL.ByteString)+    -> DC.ConduitT Pkt Pkt (ResourceT IO) ()+conduitDecrypt cb =+    void $+        DCD.conduitDecrypt+            DecryptOptions+                { decryptOptionsKeyResolution = DecryptWithoutPKESK+                , decryptOptionsPolicy = defaultDecryptPolicy+                , decryptOptionsPassphraseCallback = cb+                }++conduitDecryptWithPKESKContext+    :: (Pkt -> IO (Maybe PKESKRecipientKey))+    -> (String -> IO BL.ByteString)+    -> DC.ConduitT Pkt Pkt (ResourceT IO) ()+conduitDecryptWithPKESKContext pkcb cb =+    void $+        DCD.conduitDecrypt+            DecryptOptions+                { decryptOptionsKeyResolution =+                    DecryptWithUnwrapCandidatesCallback+                        (asPKESKUnwrapCandidatesCallback pkcb)+                , decryptOptionsPolicy = defaultDecryptPolicy+                , decryptOptionsPassphraseCallback = cb+                }++conduitDecryptWithDecryptPolicy+    :: DecryptPolicy+    -> (Pkt -> IO (Maybe PKESKRecipientKey))+    -> (String -> IO BL.ByteString)+    -> DC.ConduitT Pkt Pkt (ResourceT IO) ()+conduitDecryptWithDecryptPolicy dp pkcb cb =+    void $+        DCD.conduitDecrypt+            DecryptOptions+                { decryptOptionsKeyResolution =+                    DecryptWithUnwrapCandidatesCallback+                        (asPKESKUnwrapCandidatesCallback pkcb)+                , decryptOptionsPolicy = dp+                , decryptOptionsPassphraseCallback = cb+                }++conduitDecryptChecked+    :: (String -> IO BL.ByteString)+    -> DC.ConduitT Pkt Pkt (ResourceT IO) DecryptOutcome+conduitDecryptChecked cb =+    DCD.conduitDecrypt+        DecryptOptions+            { decryptOptionsKeyResolution = DecryptWithoutPKESK+            , decryptOptionsPolicy = defaultDecryptPolicy+            , decryptOptionsPassphraseCallback = cb+            }++conduitDecryptCheckedWithDecryptPolicy+    :: DecryptPolicy+    -> (Pkt -> IO (Maybe PKESKRecipientKey))+    -> (String -> IO BL.ByteString)+    -> DC.ConduitT Pkt Pkt (ResourceT IO) DecryptOutcome+conduitDecryptCheckedWithDecryptPolicy dp pkcb cb =+    DCD.conduitDecrypt+        DecryptOptions+            { decryptOptionsKeyResolution =+                DecryptWithUnwrapCandidatesCallback+                    (asPKESKUnwrapCandidatesCallback pkcb)+            , decryptOptionsPolicy = dp+            , decryptOptionsPassphraseCallback = cb+            }++conduitDecryptWithCandidatesCallbackAndPolicy+    :: DecryptPolicy+    -> (KeyIdentifier -> PubKeyAlgorithm -> IO [PKESKRecipientKey])+    -> (String -> IO BL.ByteString)+    -> DC.ConduitT Pkt Pkt (ResourceT IO) ()+conduitDecryptWithCandidatesCallbackAndPolicy dp candCb cb =+    void $+        DCD.conduitDecrypt+            DecryptOptions+                { decryptOptionsKeyResolution =+                    DecryptWithUnwrapCandidatesCallback candCb+                , decryptOptionsPolicy = dp+                , decryptOptionsPassphraseCallback = cb+                }++asPKESKUnwrapCandidatesCallback+    :: (Pkt -> IO (Maybe PKESKRecipientKey))+    -> KeyIdentifier+    -> PubKeyAlgorithm+    -> IO [PKESKRecipientKey]+asPKESKUnwrapCandidatesCallback pkcb keyIdentifier pka = do+    mk <- pkcb (pkeskProbePacket keyIdentifier pka)+    pure (maybe [] (: []) mk)++pkeskProbePacket :: KeyIdentifier -> PubKeyAlgorithm -> Pkt+pkeskProbePacket keyIdentifier pka =+    case keyIdentifier of+        KeyIdentifierWildcard ->+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId (BL.replicate 8 0))+                        pka+                        (MPI 0 :| [])+                    )+                )+        KeyIdentifierEightOctet rid ->+            PKESKPkt+                ( PKESKPayloadV3Packet+                    (PKESKPayloadV3 3 rid pka (MPI 0 :| []))+                )+        KeyIdentifierFingerprint rid ->+            PKESKPkt+                ( PKESKPayloadV6Packet+                    (PKESKPayloadV6 (unFingerprint rid) pka mempty)+                )++readFixturePayload :: FilePath -> IO BL.ByteString+readFixturePayload fpr = do+    bs <- BL.readFile ("tests/data/" ++ fpr)+    case dearmorIfAsciiArmored bs of+        Left err ->+            assertFailure+                ("ASCII armor decode failed for " ++ fpr ++ ": " ++ err)+                >> pure mempty+        Right (_, payload) -> pure payload++testParsedRSASecretKeyPKCS15DecryptNotMessageNotRecognized+    :: Assertion+testParsedRSASecretKeyPKCS15DecryptNotMessageNotRecognized = do+    secretPackets <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/unencrypted.seckey"+                DC..| conduitGet get+                DC..| CL.consume+    (publicKey, privateKey) <-+        case secretPackets of+            (SecretKeyPkt pkp ska : _) ->+                case (_pubkey pkp, ska) of+                    ( RSAPubKey (RSA_PublicKey pub)+                        , SUUnencrypted (RSAPrivateKey (RSA_PrivateKey prv)) _+                        ) ->+                            pure (pub, prv)+                    _ ->+                        assertFailure+                            "unencrypted.seckey did not contain a parseable unencrypted RSA key pair"+                            >> fail "expected RSA key pair from parsed secret key packet"+            _ ->+                assertFailure+                    "unencrypted.seckey did not begin with a secret key packet"+                    >> fail "expected secret key packet"+    let plaintext = "pkcs1-v1.5 regression payload" :: B.ByteString+    encrypted <-+        ( P15.encrypt publicKey plaintext+            :: IO (Either RSA.Error B.ByteString)+        )+    ciphertext <-+        case encrypted of+            Left err ->+                assertFailure ("RSA PKCS#1 v1.5 encryption failed: " ++ show err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        ( P15.decryptSafer privateKey ciphertext+            :: IO (Either RSA.Error B.ByteString)+        )+    case decrypted of+        Left RSA.MessageNotRecognized ->+            assertFailure+                "parsed RSA private key decryption failed with MessageNotRecognized"+        Left err ->+            assertFailure+                ("parsed RSA private key decryption failed: " ++ show err)+        Right got ->+            assertEqual+                "parsed RSA private key decrypts PKCS#1 v1.5 payload"+                plaintext+                got++testEncodeOpenPGPSessionMaterial :: Assertion+testEncodeOpenPGPSessionMaterial = do+    let keyBytes = B.pack [1 .. 32]+        expected =+            B.singleton (fromFVal AES256)+                <> keyBytes+                <> encodeChecksum16 keyBytes+    case encodeOpenPGPSessionMaterial AES256 (SessionKey keyBytes) of+        Left err ->+            assertFailure+                ("encodeOpenPGPSessionMaterial failed: " ++ show err)+        Right encoded ->+            assertEqual "OpenPGP session material encoding" expected encoded++mkPKESKSessionMaterialOrFail+    :: SymmetricAlgorithm -> SessionKey -> IO PKESKSessionMaterial+mkPKESKSessionMaterialOrFail symalgo sessionKey =+    case mkPKESKSessionMaterial symalgo sessionKey of+        Left err ->+            assertFailure ("mkPKESKSessionMaterial failed: " ++ show err)+                >> fail "mkPKESKSessionMaterial failed"+        Right material -> pure material++armorPayload :: Armor -> BL.ByteString+armorPayload (Armor _ _ bs) = BL.fromStrict (BLC8.toStrict bs)+armorPayload (ClearSigned _ _ inner) = armorPayload inner++selectRecipientKeyInfo+    :: Pkt -> [PKESKRecipientKey] -> Maybe PKESKRecipientKey+selectRecipientKeyInfo (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka _))) keyInfos =+    listToMaybe+        [ keyInfo+        | keyInfo <- keyInfos+        , supportsPKESKAlgorithm pka keyInfo+        , matchesRecipientIdentifier rid keyInfo+        ]+selectRecipientKeyInfo (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ rid pka _))) keyInfos+    | isWildcardEightOctetKeyId rid =+        listToMaybe+            [ keyInfo | keyInfo <- keyInfos, supportsPKESKAlgorithm pka keyInfo+            ]+    | otherwise =+        listToMaybe+            [ keyInfo+            | keyInfo <- keyInfos+            , supportsPKESKAlgorithm pka keyInfo+            , matchesEightOctetRecipientKeyId rid keyInfo+            ]+selectRecipientKeyInfo _ keyInfos = listToMaybe keyInfos++isWildcardEightOctetKeyId :: EightOctetKeyId -> Bool+isWildcardEightOctetKeyId (EightOctetKeyId rid) =+    BL.length rid == 8 && BL.all (== 0) rid++matchesEightOctetRecipientKeyId+    :: EightOctetKeyId -> PKESKRecipientKey -> Bool+matchesEightOctetRecipientKeyId (EightOctetKeyId rid) keyInfo =+    case pkeskRecipientPKPayload keyInfo of+        Nothing -> False+        Just pkp ->+            let fingerprintBytes = unFingerprint (fingerprint pkp)+             in BL.length fingerprintBytes >= 8+                    && BL.drop (BL.length fingerprintBytes - 8) fingerprintBytes == rid++supportsPKESKAlgorithm+    :: PubKeyAlgorithm -> PKESKRecipientKey -> Bool+supportsPKESKAlgorithm pka keyInfo =+    case pkeskRecipientSKey keyInfo of+        RSAPrivateKey {} -> pka == RSA+        ECDHPrivateKey {} -> pka == ECDH || pka == X25519+        X25519PrivateKey {} -> pka == X25519+        X448PrivateKey {} -> pka == X448+        _ -> False++matchesRecipientIdentifier+    :: BL.ByteString -> PKESKRecipientKey -> Bool+matchesRecipientIdentifier rid keyInfo =+    case pkeskRecipientPKPayload keyInfo of+        Nothing -> False+        Just pkp ->+            let fingerprintBytes = BL.toStrict (unFingerprint (fingerprint pkp))+                identifier = BL.toStrict rid+             in identifier == fingerprintBytes+                    || identifier == B.cons 0x04 fingerprintBytes+                    || identifier == B.cons 0x06 fingerprintBytes++buildECDHKDFParamForTest+    :: SomePKPayload+    -> PubKeyAlgorithm+    -> ECCT.Curve+    -> HashAlgorithm+    -> SymmetricAlgorithm+    -> B.ByteString+buildECDHKDFParamForTest recipientPKP pka curve kdfHA kdfSA =+    B.singleton (fromIntegral (B.length curveOid))+        <> curveOid+        <> B.pack [fromFVal pka, 0x03, 0x01, fromFVal kdfHA, fromFVal kdfSA]+        <> "Anonymous Sender    "+        <> BL.toStrict (unFingerprint (fingerprint recipientPKP))+  where+    curveOid =+        either+            (const B.empty)+            id+            (curveToCurveoidBS (curveFromCurve curve))++buildCurve25519LegacyKdfParamForTest+    :: SomePKPayload+    -> PubKeyAlgorithm+    -> HashAlgorithm+    -> SymmetricAlgorithm+    -> B.ByteString+buildCurve25519LegacyKdfParamForTest recipientPKP pka kdfHA kdfSA =+    B.singleton (fromIntegral (B.length curveOid))+        <> curveOid+        <> B.pack [fromFVal pka, 0x03, 0x01, fromFVal kdfHA, fromFVal kdfSA]+        <> "Anonymous Sender    "+        <> BL.toStrict (unFingerprint (fingerprint recipientPKP))+  where+    curveOid = "\x2b\x06\x01\x04\x01\x97\x55\x01\x05\x01"++deriveECDHKekForTest+    :: HashAlgorithm+    -> SymmetricAlgorithm+    -> B.ByteString+    -> B.ByteString+    -> B.ByteString+deriveECDHKekForTest kdfHA kdfSA sharedSecret kdfParam =+    B.take (keyLengthForTest kdfSA) digest+  where+    digest =+        case kdfHA of+            SHA256 ->+                BA.convert+                    ( CH.hash (B.pack [0, 0, 0, 1] <> sharedSecret <> kdfParam)+                        :: CH.Digest CHA.SHA256+                    )+            SHA384 ->+                BA.convert+                    ( CH.hash (B.pack [0, 0, 0, 1] <> sharedSecret <> kdfParam)+                        :: CH.Digest CHA.SHA384+                    )+            SHA512 ->+                BA.convert+                    ( CH.hash (B.pack [0, 0, 0, 1] <> sharedSecret <> kdfParam)+                        :: CH.Digest CHA.SHA512+                    )+            _ ->+                BA.convert+                    ( CH.hash (B.pack [0, 0, 0, 1] <> sharedSecret <> kdfParam)+                        :: CH.Digest CHA.SHA256+                    )++deriveX448KekForTest+    :: B.ByteString+    -> B.ByteString+    -> B.ByteString+    -> B.ByteString+deriveX448KekForTest ephemeralPublic recipientPublic sharedSecret =+    let ikm = ephemeralPublic <> recipientPublic <> sharedSecret+        prk = extract @CHA.SHA512 B.empty ikm+        info = "OpenPGP X448" :: B.ByteString+     in expand @CHA.SHA512 prk info 32++deriveX25519KekForTest+    :: B.ByteString+    -> B.ByteString+    -> B.ByteString+    -> B.ByteString+deriveX25519KekForTest ephemeralPublic recipientPublic sharedSecret =+    let ikm = ephemeralPublic <> recipientPublic <> sharedSecret+        prk = extract @CHA.SHA256 B.empty ikm+        info = "OpenPGP X25519" :: B.ByteString+     in expand @CHA.SHA256 prk info 16++keyLengthForTest :: SymmetricAlgorithm -> Int+keyLengthForTest AES128 = 16+keyLengthForTest AES192 = 24+keyLengthForTest AES256 = 32+keyLengthForTest _ = 16++aesKeyWrapRFC3394ForTest+    :: SymmetricAlgorithm+    -> B.ByteString+    -> B.ByteString+    -> B.ByteString+aesKeyWrapRFC3394ForTest sa kek plain =+    case sa of+        AES128 -> wrapWithCipher (initCipher kek :: AES.AES128) plain+        AES192 -> wrapWithCipher (initCipher kek :: AES.AES192) plain+        AES256 -> wrapWithCipher (initCipher kek :: AES.AES256) plain+        _ -> error "unsupported KEK algorithm in test"+  where+    initCipher keyBytes =+        case CE.eitherCryptoError (CCT.cipherInit keyBytes) of+            Left err -> error ("cipher init failed: " ++ show err)+            Right c -> c+    wrapWithCipher cipher plainBytes =+        let rs = chunksOf8ForTest plainBytes+            n = length rs+            a0 = B.replicate 8 0xA6+            (aFinal, rFinal) =+                foldl (\(a, r) j -> wrapRound cipher n j a r) (a0, rs) [0 .. 5]+         in aFinal <> B.concat rFinal+    wrapRound cipher n j a rs = foldl step (a, rs) [1 .. n]+      where+        step (aCurr, rCurr) i =+            let b = CCT.ecbEncrypt cipher (aCurr <> (rCurr !! (i - 1)))+                (aMsb, rLsb) = B.splitAt 8 b+                t = fromIntegral (n * j + i) :: Word64+                aNext = xorBSForTest aMsb (encodeWord64beForTest t)+             in (aNext, replaceAtForTest (i - 1) rLsb rCurr)++encodeWord64beForTest :: Word64 -> B.ByteString+encodeWord64beForTest = BL.toStrict . runPut . putWord64be++chunksOf8ForTest :: B.ByteString -> [B.ByteString]+chunksOf8ForTest bs+    | B.null bs = []+    | otherwise =+        let (h, t) = B.splitAt 8 bs+         in h : chunksOf8ForTest t++replaceAtForTest :: Int -> a -> [a] -> [a]+replaceAtForTest idx x xs =+    let (prefix, suffix) = splitAt idx xs+     in case suffix of+            [] -> xs+            (_ : rest) -> prefix <> (x : rest)++xorBSForTest :: B.ByteString -> B.ByteString -> B.ByteString+xorBSForTest a b = B.pack (B.zipWith xor a b)++encodeChecksum16 :: B.ByteString -> B.ByteString+encodeChecksum16 bs =+    B.pack+        [fromIntegral (s `div` 256), fromIntegral (s `mod` 256)]+  where+    s =+        B.foldl'+            (\acc octet -> (acc + fromIntegral octet) `mod` (65536 :: Int))+            0+            bs++verifyMessageFromPackets+    :: PublicKeyring -> BL.ByteString -> [Either String Verification]+verifyMessageFromPackets keyring signedMessage =+    map (either (Left . renderVerificationError) Right) $+        verifyMessagePackets+            defaultVerificationOptions+                { verificationPolicy = VerifyInformational+                , verificationMode = VerificationStreaming+                }+            keyring+            ( concatMap+                (either (const []) id . decompressPkt)+                (parsePkts signedMessage)+            )++verifyMessageFromPacketsBatch+    :: PublicKeyring -> BL.ByteString -> [Either String Verification]+verifyMessageFromPacketsBatch keyring signedMessage =+    map (either (Left . renderVerificationError) Right) $+        verifyMessagePackets+            defaultVerificationOptions+                { verificationPolicy = VerifyInformational+                , verificationMode = VerificationBatch+                }+            keyring+            ( concatMap+                (either (const []) id . decompressPkt)+                (parsePkts signedMessage)+            )++verifyMessageFromBytestring+    :: PublicKeyring -> BL.ByteString -> [Either String Verification]+verifyMessageFromBytestring keyring signedMessage =+    map (either (Left . renderVerificationError) Right) $+        verifyMessage+            defaultVerificationOptions+                { verificationPolicy = VerifyInformational+                , verificationMode = VerificationStreaming+                }+            keyring+            signedMessage++verifyMessageFromBytestringBatch+    :: PublicKeyring -> BL.ByteString -> [Either String Verification]+verifyMessageFromBytestringBatch keyring signedMessage =+    map (either (Left . renderVerificationError) Right) $+        verifyMessage+            defaultVerificationOptions+                { verificationPolicy = VerifyInformational+                , verificationMode = VerificationBatch+                }+            keyring+            signedMessage++assertMessageVerification+    :: (PublicKeyring -> BL.ByteString -> [Either String Verification])+    -> FilePath+    -> FilePath+    -> [Fingerprint]+    -> Assertion+assertMessageVerification verifier keyringFile messageFile issuers = do+    kr <- loadKeyring keyringFile+    signedMessage <- readFixtureLazy messageFile+    let verification = verifier kr signedMessage+        actual = map (fmap (fingerprint . _verificationSigner)) verification+    assertEqual+        (keyringFile ++ " for " ++ messageFile)+        (map Right issuers)+        actual++loadKeyring :: FilePath -> IO PublicKeyring+loadKeyring keyring =+    DC.runConduitRes $+        CB.sourceFile (fixturePath keyring)+            DC..| conduitGet get+            DC..| conduitToSomeTKsEither+            DC..| CL.map (fmap someTKToPublicViewTK . join . hush)+            DC..| CL.catMaybes+            DC..| sinkPublicKeyringMap++loadAndDecompressPkts :: FilePath -> IO [Pkt]+loadAndDecompressPkts = readFixtureDecompressedPackets++loadArmor :: FilePath -> IO [Armor]+loadArmor file = do+    armored <- readFixtureLazy file+    case AA.decodeLazy armored :: Either String [Armor] of+        Left err ->+            assertFailure+                ("Failed to decode armored fixture " ++ file ++ ": " ++ err)+                >> pure []+        Right armors -> pure armors++encryptMessageDefault+    :: SessionMaterialExposure+    -> Passphrase+    -> ClearPayload+    -> Either+        MessageError+        (EncryptedPayload, Maybe RecoveredSessionMaterial)+encryptMessageDefault exposure passphrase payload =+    encryptMessage+        ( RFC9580EncryptMessageOptions+            { rfc9580EncryptMessageExposure = exposure+            , rfc9580EncryptMessageSymmetricAlgorithm = AES256+            , rfc9580EncryptMessageS2K =+                Argon2 (Salt16 (B.pack [0x80 .. 0x8f])) 1 4 15+            , rfc9580EncryptMessageIV = IV "0123456789ABCDEF"+            }+        )+        passphrase+        payload++mkTestKeyring :: [TKUnknown] -> PublicKeyring+mkTestKeyring tks =+    let someTKs = [stk | Right stk <- map fromUnknownToTKEither tks]+     in fst (partitionSomeTKs someTKs)++addTimestampSeconds+    :: ThirtyTwoBitTimeStamp -> Word32 -> ThirtyTwoBitTimeStamp+addTimestampSeconds (ThirtyTwoBitTimeStamp ts) seconds = ThirtyTwoBitTimeStamp (ts + seconds)++timestampToUTCTime :: ThirtyTwoBitTimeStamp -> UTCTime+timestampToUTCTime = posixSecondsToUTCTime . realToFrac . unThirtyTwoBitTimeStamp++signCertificationAt+    :: SomePKPayload+    -> RSA.PrivateKey+    -> UserId+    -> ThirtyTwoBitTimeStamp+    -> [SigSubPacket]+    -> IO SignaturePayload+signCertificationAt signer signingKey uid creationTime hashedExtras = do+    (hashed, unhashed) <-+        messageIssuerSubpacketsAt signer creationTime+    case signCertificationWithRSA+        GenericCert+        signer+        uid+        (hashedExtras ++ hashed)+        unhashed+        signingKey of+        Left err ->+            assertFailure+                ("failed to sign certification: " ++ renderSignError err)+                >> fail "expected certification signature"+        Right sigPayload -> pure sigPayload++signCertificationRevocationAt+    :: SomePKPayload+    -> RSA.PrivateKey+    -> UserId+    -> ThirtyTwoBitTimeStamp+    -> [SigSubPacket]+    -> IO SignaturePayload+signCertificationRevocationAt signer signingKey uid creationTime hashedExtras = do+    (hashed, unhashed) <-+        messageIssuerSubpacketsAt signer creationTime+    case signCertRevocationWithRSA+        signer+        uid+        (hashedExtras ++ hashed)+        unhashed+        signingKey of+        Left err ->+            assertFailure+                ( "failed to sign certification revocation: "+                    ++ renderSignError err+                )+                >> fail "expected certification revocation signature"+        Right sigPayload -> pure sigPayload++messageIssuerSubpacketsAt+    :: SomePKPayload+    -> ThirtyTwoBitTimeStamp+    -> IO ([SigSubPacket], [SigSubPacket])+messageIssuerSubpacketsAt signer creationTime =+    case eightOctetKeyID signer of+        Left err ->+            assertFailure+                ("failed to derive issuer key id for timeline test: " ++ err)+                >> fail "expected issuer key id"+        Right issuerKeyId ->+            pure+                (+                    [ SigSubPacket False (SigCreationTime creationTime)+                    , SigSubPacket+                        False+                        (IssuerFingerprint IssuerFingerprintV4 (fingerprint signer))+                    ]+                , [SigSubPacket False (Issuer issuerKeyId)]+                )++loadUnencryptedRsaSigner :: IO (SomePKPayload, RSA.PrivateKey)+loadUnencryptedRsaSigner = do+    secretPackets <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/unencrypted.seckey"+                DC..| conduitGet get+                DC..| CL.consume+    case secretPackets of+        (SecretKeyPkt pkp ska : _) ->+            case ska of+                SUUnencrypted (RSAPrivateKey (RSA_PrivateKey privateKey)) _ ->+                    pure (pkp, privateKey)+                _ ->+                    assertFailure+                        "unencrypted.seckey did not contain an unencrypted RSA key"+                        >> fail "expected decrypted RSA private key"+        _ ->+            assertFailure+                "unencrypted.seckey did not begin with a secret key packet"+                >> fail "expected secret key packet"++loadUnencryptedRsaSignerV6 :: IO (SomePKPayload, RSA.PrivateKey)+loadUnencryptedRsaSignerV6 = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    pure (setKeyVersion V6 signer, signingKey)++setKeyVersion :: KeyVersion -> SomePKPayload -> SomePKPayload+setKeyVersion keyVersion (PKPayload _ ts v3e pka pubkey) =+    PKPayload keyVersion ts v3e pka pubkey++setKeyTimestamp+    :: ThirtyTwoBitTimeStamp -> SomePKPayload -> SomePKPayload+setKeyTimestamp ts (PKPayload keyVersion _ v3e pka pubkey) =+    PKPayload keyVersion ts v3e pka pubkey++setPKAlgorithm+    :: PubKeyAlgorithm -> SomePKPayload -> SomePKPayload+setPKAlgorithm algorithm (PKPayload keyVersion ts v3e _ pubkey) =+    PKPayload keyVersion ts v3e algorithm pubkey++expectV4PKPayload+    :: String -> SomePKPayload -> IO (VersionedPKPayload V4)+expectV4PKPayload label pk =+    case asV4PKPayload pk of+        Left err ->+            assertFailure (label ++ " should have a v4 PKPayload: " ++ err)+                >> fail "expected v4 PKPayload"+        Right v4pk -> pure v4pk++expectV6PKPayload+    :: String -> SomePKPayload -> IO (VersionedPKPayload V6)+expectV6PKPayload label pk =+    case asV6PKPayload pk of+        Left err ->+            assertFailure (label ++ " should have a v6 PKPayload: " ++ err)+                >> fail "expected v6 PKPayload"+        Right v6pk -> pure v6pk++loadDeterministicEd25519Signer+    :: IO (SomePKPayload, Ed25519.SecretKey)+loadDeterministicEd25519Signer = do+    let seed = B.pack [1 .. 32]+    secretKey <-+        case CE.eitherCryptoError (Ed25519.secretKey seed) of+            Left err ->+                assertFailure+                    ( "failed to initialize deterministic Ed25519 secret key: "+                        ++ show err+                    )+                    >> fail "expected deterministic Ed25519 secret key"+            Right sk -> pure sk+    let publicKeyBytes = BA.convert (Ed25519.toPublic secretKey) :: B.ByteString+        signer =+            PKPayload+                V4+                0+                0+                EdDSA+                ( EdDSAPubKey+                    EdSigningCurve25519+                    ( PrefixedNativeEPoint+                        (EPoint (os2ip (B.cons 0x40 publicKeyBytes)))+                    )+                )+    pure (signer, secretKey)++loadDeterministicEd25519SignerV6+    :: IO (SomePKPayload, Ed25519.SecretKey)+loadDeterministicEd25519SignerV6 = do+    let seed = B.pack [1 .. 32]+    secretKey <-+        case CE.eitherCryptoError (Ed25519.secretKey seed) of+            Left err ->+                assertFailure+                    ( "failed to initialize deterministic Ed25519 secret key: "+                        ++ show err+                    )+                    >> fail "expected deterministic Ed25519 secret key"+            Right sk -> pure sk+    let publicKeyBytes = BA.convert (Ed25519.toPublic secretKey) :: B.ByteString+        signer =+            PKPayload+                V6+                0+                0+                EdDSA+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip publicKeyBytes)))+                )+    pure (signer, secretKey)++loadDeterministicEd448Signer+    :: IO (SomePKPayload, Ed448.SecretKey)+loadDeterministicEd448Signer = do+    let seed = B.pack [1 .. 57]+    secretKey <-+        case CE.eitherCryptoError (Ed448.secretKey seed) of+            Left err ->+                assertFailure+                    ( "failed to initialize deterministic Ed448 secret key: "+                        ++ show err+                    )+                    >> fail "expected deterministic Ed448 secret key"+            Right sk -> pure sk+    let publicKeyBytes = BA.convert (Ed448.toPublic secretKey) :: B.ByteString+        signer =+            PKPayload+                V4+                0+                0+                EdDSA+                ( EdDSAPubKey+                    EdSigningCurve448+                    ( PrefixedNativeEPoint+                        (EPoint (os2ip (B.cons 0x40 publicKeyBytes)))+                    )+                )+    pure (signer, secretKey)++loadDeterministicEd448SignerV6+    :: IO (SomePKPayload, Ed448.SecretKey)+loadDeterministicEd448SignerV6 = do+    let seed = B.pack [1 .. 57]+    secretKey <-+        case CE.eitherCryptoError (Ed448.secretKey seed) of+            Left err ->+                assertFailure+                    ( "failed to initialize deterministic Ed448 secret key: "+                        ++ show err+                    )+                    >> fail "expected deterministic Ed448 secret key"+            Right sk -> pure sk+    let publicKeyBytes = BA.convert (Ed448.toPublic secretKey) :: B.ByteString+        signer =+            PKPayload+                V6+                0+                0+                EdDSA+                ( EdDSAPubKey+                    EdSigningCurve448+                    (NativeEPoint (EPoint (os2ip publicKeyBytes)))+                )+    pure (signer, secretKey)++testSEIPDv2ForV4KeyArmor :: Assertion+testSEIPDv2ForV4KeyArmor = do+    armors <- loadArmor "seipdv2-for-v4-key.pgp.aa"+    armor <-+        case armors of+            [a] -> pure a+            _ ->+                assertFailure+                    "seipdv2-for-v4-key fixture should contain one armored payload"+                    >> fail "expected one armored payload"+    payload <-+        case armor of+            Armor ArmorMessage _ p -> pure p+            Armor atype _ _ ->+                assertFailure+                    ( "seipdv2-for-v4-key fixture should decode as a message block, got "+                        ++ show atype+                    )+                    >> fail "expected message block"+            _ ->+                assertFailure+                    "seipdv2-for-v4-key fixture should decode as an armored payload"+                    >> fail "expected armored payload"+    let packets = parsePkts (BL.fromStrict (BLC8.toStrict payload))+    case packets of+        [ PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka _))+            , SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize _ _)+            ] -> do+                let ridHex = map toUpper (BLC8.unpack (B16L.encode rid))+                if ridHex+                    `elem` [ "C8263FC6D676044B6E973959C2F2C2CAE30DE908"+                           , "04C8263FC6D676044B6E973959C2F2C2CAE30DE908"+                           ]+                    then pure ()+                    else+                        assertFailure+                            ( "seipdv2-for-v4-key fixture should target the expected recipient fingerprint, got "+                                ++ ridHex+                            )+                assertEqual+                    "seipdv2-for-v4-key fixture should use ECDH PKESKv6"+                    ECDH+                    pka+                assertEqual+                    "seipdv2-for-v4-key fixture should use AES-256"+                    AES256+                    sa+                assertEqual+                    "seipdv2-for-v4-key fixture should use OCB"+                    OCB+                    aa+                assertEqual+                    "seipdv2-for-v4-key fixture should use 4KiB chunks"+                    6+                    chunkSize+        _ ->+            assertFailure+                ( "seipdv2-for-v4-key fixture should contain [PKESKPkt (PKESK6 ...), SymEncIntegrityProtectedDataPkt (SEIPD2 ...)], got: "+                    ++ show packets+                )++loadSEIPDv2FixtureWithV4Secret+    :: FilePath -> IO ([Pkt], [Pkt], BL.ByteString)+loadSEIPDv2FixtureWithV4Secret fixture = do+    messageArmor <- loadFirstArmor fixture+    encryptedSecretArmor <-+        loadFirstArmor "v4-encrypted-secret.pgp.aa"+    passphrase <- readPKIPassphrase+    pure+        ( parsePkts (armorPayload messageArmor)+        , parsePkts (armorPayload encryptedSecretArmor)+        , passphrase+        )++forceVersionedRecipientIdentifier :: Pkt -> Pkt+forceVersionedRecipientIdentifier pkt =+    case pkt of+        PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka esk))+            | BL.length rid == 20 ->+                PKESKPkt+                    (PKESKPayloadV6Packet (PKESKPayloadV6 (BL.cons 0x04 rid) pka esk))+            | BL.length rid == 32 ->+                PKESKPkt+                    (PKESKPayloadV6Packet (PKESKPayloadV6 (BL.cons 0x06 rid) pka esk))+            | otherwise -> pkt+        _ -> pkt++selectRecipientKeyInfoByRawRecipientId+    :: Pkt -> [PKESKRecipientKey] -> Maybe PKESKRecipientKey+selectRecipientKeyInfoByRawRecipientId (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka _))) keyInfos =+    listToMaybe+        [ keyInfo+        | keyInfo <- keyInfos+        , supportsPKESKAlgorithm pka keyInfo+        , matchesRawRecipientFingerprint rid keyInfo+        ]+selectRecipientKeyInfoByRawRecipientId (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ rid pka _))) keyInfos+    | isWildcardEightOctetKeyId rid =+        listToMaybe+            [ keyInfo | keyInfo <- keyInfos, supportsPKESKAlgorithm pka keyInfo+            ]+    | otherwise =+        listToMaybe+            [ keyInfo+            | keyInfo <- keyInfos+            , supportsPKESKAlgorithm pka keyInfo+            , matchesEightOctetRecipientKeyId rid keyInfo+            ]+selectRecipientKeyInfoByRawRecipientId _ keyInfos = listToMaybe keyInfos++matchesRawRecipientFingerprint+    :: BL.ByteString -> PKESKRecipientKey -> Bool+matchesRawRecipientFingerprint rid keyInfo =+    case pkeskRecipientPKPayload keyInfo of+        Nothing -> False+        Just pkp ->+            BL.toStrict rid == BL.toStrict (unFingerprint (fingerprint pkp))++testSEIPDv2TwoRecipientsArmor :: Assertion+testSEIPDv2TwoRecipientsArmor =+    testSEIPDv2RecipientFixtureArmor+        "seipdv2-two-recipients.pgp.aa"+        2++testSEIPDv2ThreeRecipientsArmor :: Assertion+testSEIPDv2ThreeRecipientsArmor =+    testSEIPDv2RecipientFixtureArmor+        "seipdv2-three-recipients.pgp.aa"+        3++testSEIPDv2RecipientFixtureArmor :: FilePath -> Int -> Assertion+testSEIPDv2RecipientFixtureArmor file expectedRecipients = do+    armors <- loadArmor file+    armor <-+        case armors of+            [a] -> pure a+            _ ->+                assertFailure+                    (file ++ " fixture should contain one armored payload")+                    >> fail "expected one armored payload"+    payload <-+        case armor of+            Armor ArmorMessage _ p -> pure p+            Armor atype _ _ ->+                assertFailure+                    ( file+                        ++ " fixture should decode as a message block, got "+                        ++ show atype+                    )+                    >> fail "expected message block"+            _ ->+                assertFailure+                    (file ++ " fixture should decode as an armored payload")+                    >> fail "expected armored payload"+    let packets = parsePkts (BL.fromStrict (BLC8.toStrict payload))+        pkesks =+            [ (rid, pka)+            | PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka _)) <-+                packets+            ]+        x25519Esks =+            [ BL.toStrict esk+            | PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 _ X25519 esk)) <-+                packets+            ]+        x448Esks =+            [ BL.toStrict esk+            | PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 _ X448 esk)) <-+                packets+            ]+        seipdv2Packets =+            [ (sa, aa, chunkSize)+            | SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize _ _) <-+                packets+            ]+    assertEqual+        ( file+            ++ " fixture should contain expected number of PKESKv6 packets"+        )+        expectedRecipients+        (length pkesks)+    if all (\(_, pka) -> pka == ECDH || pka == X25519) pkesks+        then pure ()+        else+            assertFailure+                ( file+                    ++ " fixture should use only ECDH/X25519 PKESKv6 packets, got "+                    ++ show (map snd pkesks)+                )+    if any ((== ECDH) . snd) pkesks+        then pure ()+        else+            assertFailure+                ( file+                    ++ " fixture should include an ECDH recipient for the v4 key"+                )+    mapM_ (assertX25519EskShape file) x25519Esks+    mapM_ (assertX448EskShape file) x448Esks+    if all+        ( \(rid, _) ->+            let l = BL.length rid+             in l == 20 || l == 21 || l == 32 || l == 33+        )+        pkesks+        then pure ()+        else+            assertFailure+                ( file+                    ++ " fixture should use 20/21-byte or 32/33-byte recipient identifiers"+                )+    case seipdv2Packets of+        [(sa, aa, chunkSize)] -> do+            assertEqual (file ++ " fixture should use AES-256") AES256 sa+            assertEqual (file ++ " fixture should use OCB") OCB aa+            assertEqual+                (file ++ " fixture should use 4KiB chunks")+                6+                chunkSize+        _ ->+            assertFailure+                ( file+                    ++ " fixture should contain one SymEncIntegrityProtectedDataV2 packet"+                )++assertX25519EskShape :: FilePath -> B.ByteString -> Assertion+assertX25519EskShape file x25519Esk+    | B.length x25519Esk < 33 =+        assertFailure+            ( file+                ++ " X25519 PKESKv6 ESK should contain 32-octet ephemeral and wrapped-len"+            )+    | otherwise = do+        let wrappedLen = fromIntegral (B.index x25519Esk 32) :: Int+            wrapped = B.drop 33 x25519Esk+        assertEqual+            (file ++ " X25519 PKESKv6 wrapped length octet")+            wrappedLen+            (B.length wrapped)++assertX448EskShape :: FilePath -> B.ByteString -> Assertion+assertX448EskShape file x448Esk+    | B.length x448Esk < 57 =+        assertFailure+            ( file+                ++ " X448 PKESKv6 ESK should contain 56-octet ephemeral and wrapped-len"+            )+    | otherwise = do+        let wrappedLen = fromIntegral (B.index x448Esk 56) :: Int+            wrapped = B.drop 57 x448Esk+        assertEqual+            (file ++ " X448 PKESKv6 wrapped length octet")+            wrappedLen+            (B.length wrapped)++prependUnusableLatestPKESK :: [Pkt] -> [Pkt]+prependUnusableLatestPKESK packets =+    let bogusRid = BL.pack (0x06 : replicate 32 0x99)+        bogusPKESK =+            PKESKPkt+                (PKESKPayloadV6Packet (PKESKPayloadV6 bogusRid RSA "bogus-esk"))+        (eskPrefix, encryptedSuffix) = span isPrecedingESK packets+     in eskPrefix ++ [bogusPKESK] ++ encryptedSuffix++reorderPrecedingPKESKs :: [Pkt] -> [Pkt]+reorderPrecedingPKESKs packets =+    let (eskPrefix, encryptedSuffix) = span isPrecedingESK packets+        reorderedPKESKs = reverse [pkt | pkt@(PKESKPkt _) <- eskPrefix]+     in refillPKESKSlots eskPrefix reorderedPKESKs ++ encryptedSuffix+  where+    refillPKESKSlots [] _ = []+    refillPKESKSlots (pkt : rest) pkesks =+        case pkt of+            PKESKPkt {} ->+                case pkesks of+                    [] -> pkt : refillPKESKSlots rest []+                    (replacement : remaining) ->+                        replacement : refillPKESKSlots rest remaining+            _ -> pkt : refillPKESKSlots rest pkesks++isPrecedingESK :: Pkt -> Bool+isPrecedingESK (PKESKPkt _) = True+isPrecedingESK (SKESKPkt _) = True+isPrecedingESK _ = False++messageVerificationFixtures+    :: [(String, FilePath, FilePath, [Fingerprint])]+messageVerificationFixtures =+    [+        ( "uncompressed-ops-dsa"+        , "pubring.gpg"+        , "uncompressed-ops-dsa.gpg"+        , [fp "1EB2 0B2F 5A5C C3BE AFD6  E5CB 7732 CF98 8A63 EA86"]+        )+    ,+        ( "uncompressed-ops-dsa-sha384"+        , "pubring.gpg"+        , "uncompressed-ops-dsa-sha384.txt.gpg"+        , [fp "1EB2 0B2F 5A5C C3BE AFD6  E5CB 7732 CF98 8A63 EA86"]+        )+    ,+        ( "uncompressed-ops-rsa"+        , "pubring.gpg"+        , "uncompressed-ops-rsa.gpg"+        , [fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D"]+        )+    ,+        ( "compressedsig"+        , "pubring.gpg"+        , "compressedsig.gpg"+        , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]+        )+    ,+        ( "compressedsig-zlib"+        , "pubring.gpg"+        , "compressedsig-zlib.gpg"+        , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]+        )+    ,+        ( "compressedsig-bzip2"+        , "pubring.gpg"+        , "compressedsig-bzip2.gpg"+        , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]+        )+    ]++certificateVerificationFixtures+    :: [(String, FilePath, FilePath, [Fingerprint])]+certificateVerificationFixtures =+    [+        ( "userid"+        , "pubring.gpg"+        , "minimized.gpg"+        , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]+        )+    ,+        ( "subkey"+        , "pubring.gpg"+        , "subkey.gpg"+        , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]+        )+    ,+        ( "primary key binding"+        , "signing-subkey.gpg"+        , "primary-binding.gpg"+        , [fp "ED1B D216 F70E 5D5F 4444  48F9 B830 F2C4 83A9 9AE5"]+        )+    ,+        ( "attribute"+        , "pubring.gpg"+        , "uat.gpg"+        , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]+        )+    ,+        ( "primary key revocation"+        , "pubring.gpg"+        , "prikey-rev.gpg"+        , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]+        )+    ,+        ( "subkey revocation"+        , "pubring.gpg"+        , "subkey-rev.gpg"+        , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]+        )+    ,+        ( "6F87040E"+        , "pubring.gpg"+        , "6F87040E.pubkey"+        ,+            [ fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"+            , fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D"+            , fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"+            ]+        )+    ,+        ( "6F87040E-cr"+        , "pubring.gpg"+        , "6F87040E-cr.pubkey"+        ,+            [ fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"+            , fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"+            , fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"+            , fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D"+            , fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"+            ]+        )+    ,+        ( "simple RSA secret key"+        , "pubring.gpg"+        , "simple.seckey"+        , [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]+        )+    ,+        ( "simple ECDSA public key"+        , "ecdsa-key-without-ecdh.pubkey"+        , "ecdsa-key-without-ecdh.pubkey"+        , [fp "174C CF12 C571 6D0E 527F  B50E F770 8BAD D606 3224"]+        )+    ]++verificationFixtureGroup+    :: String+    -> (PublicKeyring -> BL.ByteString -> [Either String Verification])+    -> [(String, FilePath, FilePath, [Fingerprint])]+    -> TestTree+verificationFixtureGroup groupName verifier fixtures =+    testGroup+        groupName+        [ testCase+            name+            ( assertMessageVerification+                verifier+                keyringFile+                messageFile+                issuers+            )+        | (name, keyringFile, messageFile, issuers) <- fixtures+        ]++loadV6UnencryptedSecretKeyFixtureForProperty+    :: IO (Either String (SomePKPayload, SKAddendum, SKey))+loadV6UnencryptedSecretKeyFixtureForProperty = do+    armored <- readFixtureLazy "v6-secret.pgp.aa"+    pure $ do+        armors <-+            first+                ("failed to decode v6 secret fixture: " ++)+                (AA.decodeLazy armored)+        armor <-+            case armors of+                (a : _) -> Right a+                [] -> Left "v6-secret.pgp.aa should contain one armored payload"+        let packets = parsePkts (armorPayload armor)+        (pkp, ska) <-+            case packets of+                (SecretKeyPkt pkpayload skaddendum : _) -> Right (pkpayload, skaddendum)+                _ -> Left "v6-secret.pgp.aa should begin with a secret key packet"+        skey <-+            case ska of+                SUUnencrypted x _ -> Right x+                _ ->+                    Left+                        "v6-secret.pgp.aa should contain unencrypted secret key material"+        Right (pkp, ska, skey)++loadV4EncryptedSecretKeyFixtureForProperty+    :: IO+        (Either String (SomePKPayload, SKAddendum, SKey, BL.ByteString))+loadV4EncryptedSecretKeyFixtureForProperty = do+    passphrase <- readPKIPassphrase+    packets <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/aes256-sha512.seckey"+                DC..| conduitGet get+                DC..| CL.consume+    pure $ do+        (pkp, ska) <-+            case packets of+                (SecretKeyPkt pkpayload skaddendum : _) -> Right (pkpayload, skaddendum)+                _ ->+                    Left "aes256-sha512.seckey should begin with a secret key packet"+        skey <-+            case decryptPrivateKey (pkp, ska) passphrase of+                Right (SUUnencrypted x _) -> Right x+                Right other ->+                    Left+                        ("unexpected decrypted key shape for v4 fixture: " ++ show other)+                Left err ->+                    Left ("failed to decrypt v4 fixture secret key: " ++ err)+        Right (pkp, ska, skey, passphrase)++reverseIf :: Bool -> [a] -> [a]+reverseIf shouldReverse xs+    | shouldReverse = reverse xs+    | otherwise = xs++cgp :: DC.ConduitT B.ByteString Pkt (ResourceT IO) ()+cgp = conduitGet (get :: Get Pkt)++fp :: Text -> Fingerprint+fp = either error id . parseFingerprint++doPkeyAndSkeyMatch :: PKey -> SKey -> Assertion+doPkeyAndSkeyMatch (RSAPubKey (RSA_PublicKey rpub)) (RSAPrivateKey (RSA_PrivateKey rpriv)) =+    assertEqual+        "RSA private key matches RSA public key"+        rpub+        (RSA.private_pub rpriv)+doPkeyAndSkeyMatch (ECDSAPubKey (ECDSA_PublicKey ecpub)) (ECDSAPrivateKey (ECDSA_PrivateKey ecpriv)) =+    assertEqual+        "ECDSA private key curve matches ECDSA public key curve"+        (ECDSA.public_curve ecpub)+        (ECDSA.private_curve ecpriv)+doPkeyAndSkeyMatch _ _ = assertFailure "matching unimplemented"++{-# NOINLINE secretKeyInfoCacheRef #-}+secretKeyInfoCacheRef+    :: IORef [(([Pkt], BL.ByteString), [PKESKRecipientKey])]+secretKeyInfoCacheRef = unsafePerformIO (newIORef [])++collectSecretKeyInfos+    :: [Pkt] -> BL.ByteString -> IO [PKESKRecipientKey]+collectSecretKeyInfos pkts passphrase = do+    cache <- readIORef secretKeyInfoCacheRef+    case lookup (pkts, passphrase) cache of+        Just cached -> pure cached+        Nothing -> do+            keyInfos <- computeSecretKeyInfos+            modifyIORef'+                secretKeyInfoCacheRef+                (((pkts, passphrase), keyInfos) :)+            pure keyInfos+  where+    computeSecretKeyInfos = do+        let keyInfoResults = map toKeyInfo pkts+            keyInfos = catMaybes [mKeyInfo | Right mKeyInfo <- keyInfoResults]+            unlockErrors = [err | Left err <- keyInfoResults]+        unless (null unlockErrors) $+            assertFailure+                ( "one or more secret key packets failed to unlock (partial failures are surfaced to\+                  \ prevent silent key-context gaps):\n"+                    ++ unlines unlockErrors+                )+        pure keyInfos++    toKeyInfo (SecretKeyPkt pkp ska) = decryptToRecipientKey "SecretKeyPkt" pkp ska+    toKeyInfo (SecretSubkeyPkt pkp ska) = decryptToRecipientKey "SecretSubkeyPkt" pkp ska+    toKeyInfo _ = Right Nothing++    decryptToRecipientKey contextLabel pkp ska =+        case ska of+            SUUnencrypted skey _ ->+                Right+                    ( Just+                        ( PKESKRecipientKey+                            { pkeskRecipientPKPayload = Just pkp+                            , pkeskRecipientSKey = skey+                            }+                        )+                    )+            _ ->+                case decryptPrivateKey (pkp, ska) passphrase of+                    Right (SUUnencrypted skey _) ->+                        Right+                            ( Just+                                ( PKESKRecipientKey+                                    { pkeskRecipientPKPayload = Just pkp+                                    , pkeskRecipientSKey = skey+                                    }+                                )+                            )+                    Right decryptedSKA ->+                        Left+                            ( contextLabel+                                ++ " "+                                ++ show (fingerprint pkp)+                                ++ ": decryptPrivateKey returned unexpected protection: "+                                ++ show decryptedSKA+                            )+                    Left err ->+                        Left+                            ( contextLabel+                                ++ " "+                                ++ show (fingerprint pkp)+                                ++ ": decryptPrivateKey failed: "+                                ++ err+                            )++signSubkeyRevocationWithRSAAt+    :: SomePKPayload+    -> SomePKPayload+    -> RSA.PrivateKey+    -> ThirtyTwoBitTimeStamp+    -> IO SignaturePayload+signSubkeyRevocationWithRSAAt signer subkey signingKey creationTime = do+    (hashed, unhashed) <-+        messageIssuerSubpacketsAt signer creationTime+    case signSubkeyRevocationWithRSA+        signer+        subkey+        hashed+        unhashed+        signingKey of+        Left err ->+            assertFailure+                ("failed to sign subkey revocation: " ++ renderSignError err)+                >> fail "expected subkey revocation signature"+        Right sigPayload -> pure sigPayload++signSubkeyBindingWithRSAAt+    :: SomePKPayload+    -> SomePKPayload+    -> RSA.PrivateKey+    -> ThirtyTwoBitTimeStamp+    -> IO SignaturePayload+signSubkeyBindingWithRSAAt signer subkey signingKey creationTime = do+    signSubkeyBindingWithRSAExtrasAt+        signer+        subkey+        signingKey+        creationTime+        []++signDirectKeyWithRSAExtrasAt+    :: SomePKPayload+    -> RSA.PrivateKey+    -> ThirtyTwoBitTimeStamp+    -> [SigSubPacket]+    -> IO SignaturePayload+signDirectKeyWithRSAExtrasAt signer signingKey creationTime hashedExtras = do+    (hashed, unhashed) <-+        messageIssuerSubpacketsAt signer creationTime+    case signDirectKeyWithRSA+        SignatureDirectlyOnAKey+        signer+        (hashedExtras ++ hashed)+        unhashed+        signingKey of+        Left err ->+            assertFailure+                ( "failed to sign direct key self-signature: "+                    ++ renderSignError err+                )+                >> fail "expected direct key self-signature"+        Right sigPayload -> pure sigPayload++signSubkeyBindingWithRSAExtrasAt+    :: SomePKPayload+    -> SomePKPayload+    -> RSA.PrivateKey+    -> ThirtyTwoBitTimeStamp+    -> [SigSubPacket]+    -> IO SignaturePayload+signSubkeyBindingWithRSAExtrasAt signer subkey signingKey creationTime hashedExtras = do+    (hashed, unhashed) <-+        messageIssuerSubpacketsAt signer creationTime+    let bindingPayload =+            payloadForSig+                SubkeyBindingSig+                emptyPSC+                    { lastPrimaryKey = PublicKeyPkt signer+                    , lastSubkey = PublicSubkeyPkt subkey+                    }+    case signDataWithRSA+        SubkeyBindingSig+        signingKey+        (hashedExtras ++ hashed)+        unhashed+        bindingPayload of+        Left err ->+            assertFailure+                ("failed to sign subkey binding: " ++ renderSignError err)+                >> fail "expected subkey binding signature"+        Right sigPayload -> pure sigPayload++verifyTimelinePackets+    :: PublicKeyring+    -> BL.ByteString+    -> SignaturePayload+    -> [Either VerificationError Verification]+verifyTimelinePackets keyring payload sigPayload =+    verifyMessagePackets+        defaultVerificationOptions+            { verificationPolicy = VerifyStrict+            , verificationMode = VerificationBatch+            }+        keyring+        [ LiteralDataPkt BinaryData BL.empty 0 payload+        , SignaturePkt sigPayload+        ]++assertSingleSignerFingerprint+    :: String+    -> Fingerprint+    -> [Either VerificationError Verification]+    -> Assertion+assertSingleSignerFingerprint label expected results =+    case results of+        [Right verification] ->+            assertEqual+                label+                expected+                (fingerprint (_verificationSigner verification))+        other ->+            assertFailure+                ( label+                    ++ ", expected one successful verification result, got "+                    ++ show (length other)+                    ++ " result(s)"+                )++assertSingleFailureContainsTimeline+    :: String+    -> String+    -> [Either VerificationError Verification]+    -> Assertion+assertSingleFailureContainsTimeline label needle results =+    case results of+        [Left err] ->+            assertBool+                label+                (needle `isInfixOf` renderVerificationError err)+        other ->+            assertFailure+                ( label+                    ++ ", expected one verification failure result, got "+                    ++ show (length other)+                    ++ " result(s)"+                )++signCertificationWithEd25519At+    :: SomePKPayload+    -> SomePKPayload+    -> Ed25519.SecretKey+    -> UserId+    -> ThirtyTwoBitTimeStamp+    -> [SigSubPacket]+    -> IO SignaturePayload+signCertificationWithEd25519At certifiedSigner certifierSigner signingKey uid creationTime hashedExtras = do+    (hashed, unhashed) <-+        messageIssuerSubpacketsAt certifierSigner creationTime+    let state =+            emptyPSC+                { lastPrimaryKey = PublicKeyPkt certifiedSigner+                , lastUIDorUAt = UserIdPkt (let UserId uidText = uid in uidText)+                }+    case signDataWithEd25519+        GenericCert+        signingKey+        (hashedExtras ++ hashed)+        unhashed+        (payloadForSig GenericCert state) of+        Left err ->+            assertFailure+                ("failed to sign Ed25519 certification: " ++ renderSignError err)+                >> fail "expected Ed25519 certification signature"+        Right sigPayload -> pure sigPayload++signCertificationRevocationWithEd25519At+    :: SomePKPayload+    -> SomePKPayload+    -> Ed25519.SecretKey+    -> UserId+    -> ThirtyTwoBitTimeStamp+    -> [SigSubPacket]+    -> IO SignaturePayload+signCertificationRevocationWithEd25519At certifiedSigner certifierSigner signingKey uid creationTime hashedExtras = do+    (hashed, unhashed) <-+        messageIssuerSubpacketsAt certifierSigner creationTime+    let state =+            emptyPSC+                { lastPrimaryKey = PublicKeyPkt certifiedSigner+                , lastUIDorUAt = UserIdPkt (let UserId uidText = uid in uidText)+                }+    case signDataWithEd25519+        CertRevocationSig+        signingKey+        (hashedExtras ++ hashed)+        unhashed+        (payloadForSig CertRevocationSig state) of+        Left err ->+            assertFailure+                ( "failed to sign Ed25519 certification revocation: "+                    ++ renderSignError err+                )+                >> fail "expected Ed25519 certification revocation signature"+        Right sigPayload -> pure sigPayload++signKeyRevocationWithReasonAt+    :: SomePKPayload+    -> RSA.PrivateKey+    -> ThirtyTwoBitTimeStamp+    -> RevocationCode+    -> IO SignaturePayload+signKeyRevocationWithReasonAt signer signingKey creationTime reasonCode =+    signKeyRevocationWithReasonAndExtrasAt+        signer+        signingKey+        creationTime+        reasonCode+        []++signKeyRevocationWithReasonAndExtrasAt+    :: SomePKPayload+    -> RSA.PrivateKey+    -> ThirtyTwoBitTimeStamp+    -> RevocationCode+    -> [SigSubPacket]+    -> IO SignaturePayload+signKeyRevocationWithReasonAndExtrasAt signer signingKey creationTime reasonCode hashedExtras = do+    (hashed, unhashed) <-+        messageIssuerSubpacketsAt signer creationTime+    case signKeyRevocationWithRSA+        signer+        ( SigSubPacket False (ReasonForRevocation reasonCode "")+            : hashedExtras+            ++ hashed+        )+        unhashed+        signingKey of+        Left err ->+            assertFailure+                ("failed to sign key revocation: " ++ renderSignError err)+                >> fail "expected key revocation signature"+        Right sigPayload -> pure sigPayload++signBinaryMessageWithRSAAt+    :: SomePKPayload+    -> RSA.PrivateKey+    -> ThirtyTwoBitTimeStamp+    -> BL.ByteString+    -> IO SignaturePayload+signBinaryMessageWithRSAAt signer signingKey creationTime payload = do+    (hashed, unhashed) <-+        messageIssuerSubpacketsAt signer creationTime+    case signDataWithRSA BinarySig signingKey hashed unhashed payload of+        Left err ->+            assertFailure+                ("failed to sign RSA message payload: " ++ renderSignError err)+                >> fail "expected RSA message signature"+        Right sigPayload -> pure sigPayload++signBinaryMessageWithEd25519At+    :: SomePKPayload+    -> Ed25519.SecretKey+    -> ThirtyTwoBitTimeStamp+    -> BL.ByteString+    -> IO SignaturePayload+signBinaryMessageWithEd25519At signer signingKey creationTime payload = do+    (hashed, unhashed) <-+        messageIssuerSubpacketsAt signer creationTime+    case signDataWithEd25519 BinarySig signingKey hashed unhashed payload of+        Left err ->+            assertFailure+                ("failed to sign Ed25519 message payload: " ++ renderSignError err)+                >> fail "expected Ed25519 message signature"+        Right sigPayload -> pure sigPayload
tests/Tests/Encryption.hs view
@@ -2,5090 +2,7236 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).--{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}--module Tests.Encryption (encryptionAndCompressionTests) where--import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA-import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor(..))-import Codec.Encryption.OpenPGP.BlockCipher (keySize, withSymmetricCipher)-import Codec.Encryption.OpenPGP.CFB-import Codec.Encryption.OpenPGP.Compression (CompressionError(..), compressPkts, decompressPkt)-import Codec.Encryption.OpenPGP.Encrypt-  ( PKESKEncryptError(InvalidRecipientIdentifier, InvalidRecipientKeyMaterial, PayloadBuildFailure, RecipientCapabilitySelectionFailure, RecipientKdfFailure, UnsupportedRecipientAlgorithm)-  , RecipientCapabilityError(RecipientCapabilityMissingSEIPDv1Support, RecipientCapabilityNoCommonAEADAlgorithms, RecipientCapabilityNoCommonSymmetricAlgorithms, RecipientCapabilityNoEncryptableKeyMaterialInTK)-  , RecipientCapabilityNegotiationMode(..)-  , PassphraseSKESKVersionPolicy(..)-  , PassphraseEncryptRequest(..)-  , EncryptCompatibilityProfile(..)-  , RecipientCapabilities(..)-  , RecipientEncryptionTargetRejected(..)-  , RecipientEncryptionTargetsReport(..)-  , RecipientTargetRejectionReason(..)-  , RecipientTargetSelectionPolicy(..)-  , RecipientPKESKVersionStrategy(..)-  , RecipientEncryptionTarget(..)-  , RecipientPayloadShape(..)-  , RecipientEncryptRequest(..)-  , RecipientEncryptRequestOverrides(..)-  , defaultRecipientPayloadShape-  , RecipientEncryptResult(..)-  , PKESKVersionPolicy(..)-  , pkeskSessionAlgorithm-  , pkeskV3SessionMaterial-  , buildPKESKv3PayloadForRecipient-  , buildPKESKPayloadForRecipient-  , canonicalizePKESKRecipientId-  , encryptSEIPDv2Payload-  , encryptForRecipients-  , encryptForRecipientsLegacy-  , encryptForRecipientsWithCapabilityNegotiation-  , encryptPassphraseWithPolicy-  , recipientCapabilitiesFromSubpacketPayloads-  , recipientEncryptionTargetFromTKAtTimestamp-  , recipientEncryptionTargetFromTKAtTimestampWithPolicy-  , recipientEncryptionTargetsFromTKAtTimestamp-  , recipientEncryptionTargetsReportFromTKAtTimestamp-  , recipientEncryptionTargetFromTK-  , recipientEncryptionTargetsFromTK-  , recipientEncryptionTarget-  , recipientEncryptionTargetWithCapabilities-  , recipientEncryptionTargetWithStrategy-  , recipientVersionStrategyForProfile-  )-import Codec.Encryption.OpenPGP.Fingerprint (fingerprint)-import Codec.Encryption.OpenPGP.Internal.HOBlockCipher (HOBlockCipher(..))-import Codec.Encryption.OpenPGP.Internal (point2MBS)-import Codec.Encryption.OpenPGP.Message-  ( SessionMaterialExposure(..)-  , encryptedPayloadBytes-  , mkClearPayload-  , mkPassphrase-  )-import Codec.Encryption.OpenPGP.Policy-  ( OpenPGPPolicy(..)-  , OpenPGPRFC(..)-  , defaultDecryptPolicy-  , defaultPolicy-  , lenientDecryptPolicy-  , policyForRFC-  )-import Codec.Encryption.OpenPGP.S2K-  ( EncodedSessionKeyError(..)-  , S2KError(..)-  , decodeOpenPGPEncodedSessionKey-  , renderS2KError-  , skesk2SessionKey-  , string2Key-  )-import Codec.Encryption.OpenPGP.Serialize (parsePkts)-import Codec.Encryption.OpenPGP.SecretKey-  ( decryptPrivateKey-  , encryptPrivateKeyWithPolicyAndSaltAndIV-  )-import Codec.Encryption.OpenPGP.Types-import Control.Exception.Base (SomeException, catch, try)-import Control.Monad (void)-import Control.Monad.Trans.Resource (ResourceT)-import qualified Crypto.Error as CE-import Crypto.Number.ModArithmetic (inverse)-import Crypto.Number.Serialize (i2osp, os2ip)-import qualified Crypto.PubKey.Curve25519 as C25519-import qualified Crypto.PubKey.Curve448 as C448-import qualified Crypto.PubKey.ECC.DH as ECCDH-import qualified Crypto.PubKey.ECC.ECDSA as ECDSA-import qualified Crypto.PubKey.ECC.Generate as ECCGen-import qualified Crypto.PubKey.ECC.Types as ECCT-import Crypto.PubKey.ECC.Prim (pointBaseMul)-import qualified Crypto.PubKey.RSA.PKCS15 as P15-import qualified Crypto.PubKey.RSA as RSA-import Data.Binary.Get-  ( Get-  )-import qualified Data.ByteArray as BA-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Char8 as BLC8-import qualified Data.ByteString.Base16.Lazy as B16L-import Data.Char (toUpper)-import qualified Data.Conduit as DC-import Data.Conduit (fuseBoth)-import qualified Data.Conduit.Binary as CB-import qualified Data.Conduit.List as CL-import Data.Conduit.OpenPGP.Compression (conduitCompress)-import Data.Conduit.OpenPGP.Decrypt-  ( DecryptKeyResolution(..)-  , DecryptOptions(..)-  , DecryptOutcome(..)-  , PKESKRecipientKey(..)-  )-import qualified Data.Conduit.OpenPGP.Decrypt as DCD-import Data.Conduit.OpenPGP.Keyring-  ( conduitToSomeTKsDropping-  , conduitToSomeTKsDroppingEither-  , conduitToSomeTKsEither-  , conduitToTKsDropping-  , conduitToTKsDroppingEither-  , conduitToTKsEither-  , conduitToUnknownTKs-  )-import Data.Conduit.Serialization.Binary (conduitGet)-import Data.Binary (get, put)-import Data.Binary.Put (putWord16be, runPut)-import Data.Word (Word16)-import Data.List (find, isInfixOf)-import Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NE-import Data.Maybe (listToMaybe)-import qualified Data.Set as Set-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, assertFailure, testCase)-import Tests.Common-  ( aesKeyWrapRFC3394ForTest-  , armorPayload-  , assertX25519EskShape-  , assertX448EskShape-  , buildCurve25519LegacyKdfParamForTest-  , buildECDHKDFParamForTest-  , cgp-  , collectSecretKeyInfos-  , conduitDecrypt-  , conduitDecryptChecked-  , conduitDecryptCheckedWithDecryptPolicy-  , conduitDecryptWithCandidatesCallbackAndPolicy-  , conduitDecryptWithDecryptPolicy-  , conduitDecryptWithPKESKContext-  , deriveECDHKekForTest-  , deriveX25519KekForTest-  , deriveX448KekForTest-  , doPkeyAndSkeyMatch-  , encodeChecksum16-  , encryptMessageDefault-  , fixturePath-  , forceVersionedRecipientIdentifier-  , isPrecedingESK-  , loadArmor-  , loadDeterministicEd25519Signer-  , loadSEIPDv2FixtureWithV4Secret-  , loadUnencryptedRsaSigner-  , mkPKESKSessionMaterialOrFail-  , prependUnusableLatestPKESK-  , readFixtureLazy-  , readFixtureStrict-  , readFixturePackets-  , readPKIPassphrase-  , reorderPrecedingPKESKs-  , runGet-  , selectRecipientKeyInfo-  , selectRecipientKeyInfoByRawRecipientId-  , setKeyTimestamp-  , setKeyVersion-  , signDirectKeyWithRSAExtrasAt-  , signSubkeyBindingWithRSAExtrasAt-  , signSubkeyRevocationWithRSAAt-  , testEncodeOpenPGPSessionMaterial-  , testParsedRSASecretKeyPKCS15DecryptNotMessageNotRecognized-  , testSEIPDv2ForV4KeyArmor-  , testSEIPDv2TwoRecipientsArmor-  , testSEIPDv2ThreeRecipientsArmor-  )--mkLegacySymmetricCase :: (String, Bool, FilePath, FilePath, BL.ByteString) -> TestTree-mkLegacySymmetricCase (label, expectSEIPDv1, encFile, passFile, cleartext) =-  testCase label (testLegacySymmetricEncryption expectSEIPDv1 encFile passFile cleartext)--legacySymmetricCases :: [(String, Bool, FilePath, FilePath, BL.ByteString)]-legacySymmetricCases =-  [ ("Symmetric Encryption simple S2K SHA1 3DES, no MDC", False, "encryption-sym-3des-s2k0.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted S2K SHA1 3DES, no MDC", False, "encryption-sym-3des.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption simple S2K SHA1 3DES", True, "encryption-sym-3des-mdc-s2k0.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted S2K SHA1 3DES", True, "encryption-sym-3des-mdc.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption simple S2K SHA1 CAST5, no MDC", False, "encryption-sym-cast5-s2k0.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted S2K SHA1 CAST5, no MDC", False, "encryption-sym-cast5.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption simple S2K SHA1 CAST5", True, "encryption-sym-cast5-mdc-s2k0.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted S2K SHA1 CAST5", True, "encryption-sym-cast5-mdc.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption simple S2K SHA1 Blowfish, no MDC", False, "encryption-sym-blowfish-s2k0.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted S2K SHA1 Blowfish, no MDC", False, "encryption-sym-blowfish.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption simple S2K SHA1 Blowfish", True, "encryption-sym-blowfish-mdc-s2k0.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted S2K SHA1 Blowfish", True, "encryption-sym-blowfish-mdc.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption simple S2K SHA1 AES128", True, "encryption-sym-aes128-s2k0.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted S2K SHA1 AES128", True, "encryption-sym-aes128.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption simple S2K SHA1 AES192", True, "encryption-sym-aes192-s2k0.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted S2K SHA1 AES192", True, "encryption-sym-aes192.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption simple S2K SHA1 AES256", True, "encryption-sym-aes256-s2k0.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted S2K SHA1 AES256", True, "encryption-sym-aes256.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted S2K SHA256 AES256", True, "encryption-sym-aes256-sha256.pgp", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption simple S2K SHA1 Twofish", True, "encryption-sym-twofish-s2k0.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted S2K SHA1 Twofish", True, "encryption-sym-twofish.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption simple Camellia128", True, "encryption-sym-camellia128-s2k0.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted Camellia128", True, "encryption-sym-camellia128.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted Camellia192", True, "encryption-sym-camellia192.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption iterated-salted Camellia256", True, "encryption-sym-camellia256.gpg", "symmetric-password.txt", "test\n")-  , ("Symmetric Encryption pgcrypto", True, "encryption-sym-pgcrypto.pgp", "pgcrypto-passphrase.txt", "{\"t\":\"plus\"}")-  ]--mkStrictSymmetricCase :: (String, FilePath, FilePath, BL.ByteString) -> TestTree-mkStrictSymmetricCase (label, encFile, passFile, cleartext) =-  testCase label (testSymmetricEncryption encFile passFile cleartext)--strictSymmetricCases :: [(String, FilePath, FilePath, BL.ByteString)]-strictSymmetricCases =-  [ ("strict policy AES128 iterated-salted S2K SEIPDv1", "encryption-sym-aes128.gpg", "symmetric-password.txt", "test\n")-  , ("strict policy AES192 iterated-salted S2K SEIPDv1", "encryption-sym-aes192.gpg", "symmetric-password.txt", "test\n")-  , ("strict policy AES256 iterated-salted S2K SEIPDv1", "encryption-sym-aes256.gpg", "symmetric-password.txt", "test\n")-  ]--mkSyntheticNISTP256 :: B.ByteString -> (ECDSA.PublicKey, ECDSA.PrivateKey)-mkSyntheticNISTP256 bs =-  let curve = ECCT.getCurveByName ECCT.SEC_p256r1-      d = os2ip (B.pack [1 .. 32])-      q = pointBaseMul curve d-      pub = ECDSA.PublicKey curve q-      priv = ECDSA.PrivateKey curve d-  in (pub, priv)--syntheticNISTP256Low = mkSyntheticNISTP256 $ B.pack [1 .. 32]-syntheticNISTP256High = mkSyntheticNISTP256 $ B.pack [101 .. 132]--encryptionAndCompressionTests :: TestTree-encryptionAndCompressionTests =-  testGroup-    "Encryption and compression"-    [ testGroup-        "Compression group"-        [ testCase "compressedsig.gpg" (testCompression "compressedsig.gpg")-        , testCase-            "compressedsig-zlib.gpg"-            (testCompression "compressedsig-zlib.gpg")-        , testCase-            "compressedsig-bzip2.gpg"-            (testCompression "compressedsig-bzip2.gpg")-        , testCase-            "decompressPkt classifies empty ZIP payload"-            (assertEqual "empty ZIP"-               (Left (EmptyCompressedPayload ZIP))-               (decompressPkt (CompressedDataPkt ZIP "")))-        , testCase-            "decompressPkt classifies empty Uncompressed payload"-            (assertEqual "empty Uncompressed"-               (Left (EmptyCompressedPayload Uncompressed))-               (decompressPkt (CompressedDataPkt Uncompressed "")))-        , testCase-            "decompressPkt classifies marker-only ZIP payload"-            (let markerPkt = MarkerPkt "\x50\x47\x50"-                 compressed = compressPkts ZIP [markerPkt]-             in assertEqual "marker-only"-                  (Left (MarkerOnlyPayload ZIP))-                  (decompressPkt compressed))-        , testCase-            "decompressPkt passes through non-compressed packets"-            (let pkt = OtherPacketPkt 255 ""-             in assertEqual "passthrough"-                  (Right [pkt])-                  (decompressPkt pkt))-        ]-    , testGroup-        "Conduit length group"-        [ testCase-            "conduitCompress (ZIP)"-            (testConduitOutputLength-               "pubring.gpg"-               (cgp DC..| conduitCompress ZIP)-               1)-        , testCase-            "conduitCompress (Zlib)"-            (testConduitOutputLength-               "pubring.gpg"-               (cgp DC..| conduitCompress ZLIB)-               1)-        , testCase-            "conduitCompress (BZip2)"-            (testConduitOutputLength-               "pubring.gpg"-               (cgp DC..| conduitCompress BZip2)-               1)-        , testCase-            "conduitToUnknownTKs"-            (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitToUnknownTKs) 4)-        , testCase-            "conduitToTKsDropping"-            (testConduitOutputLength-               "pubring.gpg"-               (cgp DC..| conduitToTKsDropping)-               4)-        , testCase-            "conduitToSomeTKsDropping"-            (testConduitOutputLength-               "pubring.gpg"-               (cgp DC..| conduitToSomeTKsDropping)-               4)-        , testCase-            "conduitToTKsEither reports parse failures"-            testConduitToTKsEitherReportsParseFailure-        , testCase-            "conduitToSomeTKsEither reports parse failures"-            testConduitToSomeTKsEitherReportsParseFailure-        , testCase-            "conduitToTKsDroppingEither reports parse failures"-            testConduitToTKsDroppingEitherReportsParseFailure-        , testCase-            "conduitToSomeTKsDroppingEither reports parse failures"-            testConduitToSomeTKsDroppingEitherReportsParseFailure-        ]-    , testGroup-        "Encrypted data"-        ( [ testCase-            "Legacy symmetric encryption fixture shape"-            testLegacyEncryptionFixtureShape-        , testCase-            "SEIPDv1 resync nonce/MDC roundtrip"-            testSEIPDv1ResyncNonceMdcRoundTrip-        ]-        ++ map mkLegacySymmetricCase legacySymmetricCases-        ++ map mkStrictSymmetricCase strictSymmetricCases-        ++ [-          testCase-            "strict policy rejects SED (no MDC)"-            (testStrictPolicyRejectsEncryption-               "encryption-sym-cast5.gpg"-               "symmetric-password.txt"-               "unauthenticated SED")-        , testCase-            "strict policy rejects Simple S2K"-            (testStrictPolicyRejectsEncryption-               "encryption-sym-aes128-s2k0.gpg"-               "symmetric-password.txt"-               "Simple S2K specifier")-        , testCase-            "strict policy rejects non-encrypted packet after ESK prelude"-            testRejectsNonEncryptedAfterESKPrelude-        , testCase-            "strict policy rejects SEIPDv2 with only misaligned ESK versions"-            testRejectsMisalignedESKVersionForSEIPDv2-        , testCase-            "strict policy discards misaligned ESK when aligned ESK is present"-            testDiscardsMisalignedESKWhenAlignedCandidateExists-        , testCase-            "strict policy rejects trailing data after SEIPD v2"-            testTrailingDataRejectedStrictSEIPDv2-        , testCase-            "lenient policy reports DecryptTrailingData for trailing packet after SEIPD v2"-            testTrailingDataReportedLenientSEIPDv2-        , testCase-            "conduitDecryptChecked reports DecryptClean for well-formed SEIPD v2"-            testDecryptCleanSEIPDv2-        , testCase-            "conduitDecrypt matches conduitDecryptChecked (default)"-            testOptionsMatchesCheckedDefaultSEIPDv2-        , testCase-            "conduitDecrypt matches legacy conduitDecrypt output (default)"-            testOptionsMatchesLegacyDefaultOutputSEIPDv2-        , testCase-            "conduitDecrypt matches checked lenient trailing behavior"-            testOptionsMatchesCheckedLenientTrailingSEIPDv2-        ] )-    , testGroup-        "Encrypted secret keys"-        [ testCase-            "SUSSHA1 CAST5 IteratedSalted SHA1 RSA"-            (testSecretKeyDecryption "simple.seckey" "pki-password.txt")-        , testCase-            "SUS16bit CAST5 IteratedSalted SHA1 RSA"-            (testSecretKeyDecryption "16bitcksum.seckey" "pki-password.txt")-        , testCase-            "SUSSHA1 AES256 IteratedSalted SHA512 RSA"-            (testSecretKeyDecryption "aes256-sha512.seckey" "pki-password.txt")-        , testCase-            "SUSSHA1 AES128 IteratedSalted SHA256 ECDSA"-            (testSecretKeyDecryption-               "nist_p-256_secretkey.gpg"-               "pki-password.txt")-        ]-    , testGroup-        "Encrypting secret keys"-        [ testCase-            "legacy secret key encryption rejects implicit SHA-1 protection"-            (testLegacySecretKeyEncryptionRejected-               "unencrypted.seckey"-               "pki-password.txt")-        , testCase-            "SUSym secret key roundtrips"-            testSUSymSecretKeyRoundTrip-        , testCase-            "v6 secret key encryption roundtrips with SUSAEAD"-            testV6SecretKeyEncryptionRoundTrip-        , testCase-            "v4 AEAD OCB secret key compatibility roundtrip"-            testV4SecretKeyAEADOCBRoundTripCompat-        ]-    , testGroup-        "decrypt conduit stuff"-        [ testCase-            "conduitDecrypt supports PKESKv6 with raw session-key callback"-            testConduitDecryptSEIPDv2WithPKESKv6RawSessionKey-        , testCase-            "conduitDecrypt rejects invalid PKESKv6 raw session-key length"-            testConduitDecryptSEIPDv2RejectsWrongPKESKv6RawSessionKeyLength-        , testCase-            "conduitDecrypt unwraps PKESK RSA session keys in-library"-            testConduitDecryptSEIPDv2WithPKESKRSAUnwrap-        , testCase-            "conduitDecrypt probes wildcard callback fallback for PKESKv3 RSA key-id packets"-            testConduitDecryptSEIPDv2WithPKESKRSAUnwrapViaWildcardCallbackFallback-        , testCase-            "conduitDecrypt unwraps PKESKv3 RSA session keys via SHA1-CFB protected key loaded from file"-            testConduitDecryptSEIPDv2WithPKESKRSAUnwrapFromProtectedKey-        , testCase-            "parsed RSA secret key decrypts PKCS#1 v1.5 payload"-            testParsedRSASecretKeyPKCS15DecryptNotMessageNotRecognized-        , testCase-            "conduitDecrypt unwraps PKESK ECDH session keys in-library"-            testConduitDecryptSEIPDv2WithPKESKECDHUnwrap-        , testCase-            "conduitDecrypt rejects ECDH ephemeral points with wrong curve length"-            testConduitDecryptSEIPDv2RejectsECDHWrongEphemeralPointLength-        , testCase-            "conduitDecrypt unwraps PKESKv3 X25519 session keys in-library"-            testConduitDecryptSEIPDv2WithPKESKX25519V3Unwrap-        , testCase-            "conduitDecrypt retries wildcard PKESKv3 keys across callback order"-            testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossRecipientKeyOrder-        , testCase-            "conduitDecrypt retries wildcard PKESKv3 keys across long callback order"-            testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder-        , testCase-            "conduitDecrypt retries wildcard PKESKv3 keys across long callback order for SEIPDv1"-            testConduitDecryptSEIPDv1RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder-        , testCase-            "unwrap callback decrypts wildcard PKESKv3 via candidates list"-            testMkCandidateResolverDecryptsWildcardPKESKv3-        , testCase-            "conduitDecrypt wildcard resolver receives typed previous-failure diagnostics"-            testConduitDecryptWildcardResolverProvidesTypedPreviousFailures-        , testCase-            "conduitDecryptWithReport surfaces wildcard resolver diagnostics"-            testConduitDecryptWithReportCapturesWildcardResolverDiagnostics-        , testCase-            "conduitDecrypt rejects PKESKv3 X25519 ephemeral values with wrong length"-            testConduitDecryptSEIPDv2RejectsPKESKX25519V3WrongEphemeralLength-        , testCase-            "conduitDecrypt falls back from Argon2 SKESK to PKESKv3 X25519"-            testConduitDecryptSEIPDv2FallsBackFromArgon2SKESKToPKESKv3X25519-        , testCase-            "conduitDecrypt retries earlier Argon2 SKESKs when latest is unusable"-            testConduitDecryptSEIPDv2FallsBackToEarlierArgon2SKESK-        , testCase-            "conduitDecrypt rejects ECDH KDF/KEK params outside RFC9580 Table 30"-            testConduitDecryptSEIPDv2RejectsECDHNonTable30Params-        , testCase-            "conduitDecrypt allows v4 Curve25519Legacy RFC6637 accepted parameters"-            testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyRFC6637AcceptedParams-        , testCase-            "conduitDecrypt allows v4 Curve25519Legacy with truncated wrapped MPI"-            testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyWithTruncatedWrappedMPI-        , testCase-            "conduitDecrypt keeps v6 Curve25519Legacy ECDH strict"-            testConduitDecryptSEIPDv2RejectsV6Curve25519LegacyNonTable30Params-        , testCase-            "conduitDecrypt unwraps PKESK X448 session keys in-library"-            testConduitDecryptSEIPDv2WithPKESKX448Unwrap-        , testCase-            "conduitDecrypt rejects PKESKv6 X448 ephemeral values with wrong length"-            testConduitDecryptSEIPDv2RejectsPKESKX448WrongEphemeralLength-        , testCase-            "encrypt-side session material encoding uses OpenPGP format"-            testEncodeOpenPGPSessionMaterial-        , testCase-            "encrypt-side PKESK builder wraps RSA recipient session key"-            testBuildPKESKPayloadForRecipientRSA-        , testCase-            "encrypt-side PKESKv3 builder supports RSA v4 interop"-            testBuildPKESKv3PayloadForRecipientRSAInterop-        , testCase-            "encrypt-side PKESKv3 builder supports v6 recipients"-            testBuildPKESKv3PayloadForRecipientSupportsV6Key-        , testCase-            "encrypt-side PKESKv3 builder supports RFC6637 ECDH recipients"-            testBuildPKESKv3PayloadForRecipientECDHInterop-        , testCase-            "PKESKv3 ECDH serializer uses RFC 6637 wire format"-            testPKESKv3ECDHWireFormat-        , testCase-            "encrypt-side PKESKv3 builder supports RFC6637 Curve25519Legacy recipients"-            testBuildPKESKv3PayloadForRecipientCurve25519LegacyInterop-        , testCase-            "encrypt-side PKESKv3 builder rejects non-RFC6637 Curve448Legacy recipients"-            testBuildPKESKv3PayloadForRecipientRejectsCurve448Legacy-        , testCase-            "RFC 9580 v6 X25519 PKESK uses raw-key semantics, not v3-encoded material"-            testBuildPKESKv6PayloadForRecipientX25519RawKeySemantics-        , testCase-            "RFC 9580 v6 X448 PKESK uses raw-key semantics, not v3-encoded material"-            testBuildPKESKv6PayloadForRecipientX448RawKeySemantics-        , testCase-            "encrypt-side policy builder emits PKESK3 for ForceV3Interop"-            testBuildPKESKPayloadForRecipientWithPolicyForceV3Interop-        , testCase-            "encrypt-side profile helper honors recipient capability hints"-            testRecipientVersionStrategyForProfileHonorsHints-        , testCase-            "encryptForRecipients auto-detects mixed recipient PKESK strategies"-            testEncryptRecipientsWithRequestAutoDetectsMixedRecipientStrategies-        , testCase-            "encryptForRecipients negotiates symmetric algorithm from recipient capabilities when enabled"-            testEncryptRecipientsNegotiatesSymmetricAlgorithmWhenEnabled-        , testCase-            "encryptForRecipients negotiates recipient capabilities by default"-            testEncryptRecipientsNegotiatesSymmetricAlgorithmByDefault-        , testCase-            "encryptForRecipientsLegacy preserves capability negotiation opt-out"-            testEncryptRecipientsLegacyKeepsCapabilityNegotiationOptOut-        , testCase-            "encryptForRecipients capability negotiation fails when recipients share no symmetric algorithm"-            testEncryptRecipientsNegotiationFailsWithoutCommonSymmetricAlgorithm-        , testCase-            "recipientCapabilitiesFromSubpacketPayloads extracts preferred AEAD algorithms"-            testRecipientCapabilitiesFromSubpacketPayloadsExtractsPreferredAEADAlgorithms-        , testCase-            "encryptForRecipients negotiates AEAD algorithm from recipient capabilities when enabled"-            testEncryptRecipientsNegotiatesAEADAlgorithmWhenEnabled-        , testCase-            "encryptForRecipients capability negotiation fails when recipients share no AEAD algorithm"-            testEncryptRecipientsNegotiationFailsWithoutCommonAEADAlgorithm-        , testCase-            "encryptForRecipients falls back to SEIPDv1 when recipients do not advertise SEIPDv2 support"-            testEncryptRecipientsSEIPDv2FallsBackWhenRecipientsDoNotAdvertiseV2-        , testCase-            "encryptForRecipients rejects SEIPDv1 when recipients do not advertise MDC support"-            testEncryptRecipientsRejectsSEIPDv1WhenRecipientsDoNotAdvertiseMDC-        , testCase-            "recipientEncryptionTargetsFromTK returns only encryption-capable candidates"-            testRecipientEncryptionTargetsFromTKIncludesOnlyEncryptionCapableKeys-        , testCase-            "recipientEncryptionTargetFromTK prefers encryption-capable subkeys"-            testRecipientEncryptionTargetFromTKPrefersSubkeyOverPrimary-        , testCase-            "recipientEncryptionTargetFromTK rejects TKs without encryptable key material"-            testRecipientEncryptionTargetFromTKRejectsTKWithoutEncryptableKeys-        , testCase-            "recipientEncryptionTargetsReportFromTKAtTimestamp reports sign-only subkey rejection reasons"-            testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsRejections-        , testCase-            "recipientEncryptionTargetsReportFromTKAtTimestamp reports unsupported algorithm rejections"-            testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsUnsupportedAlgorithms-        , testCase-            "recipientEncryptionTargetsReportFromTKAtTimestamp rejects expired subkeys"-            testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsExpiredSubkey-        , testCase-            "recipientEncryptionTargetsReportFromTKAtTimestamp rejects revoked subkeys"-            testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsRevokedSubkey-        , testCase-            "recipientEncryptionTargetsFromTKAtTimestamp extracts effective self-signature capabilities"-            testRecipientEncryptionTargetsFromTKAtTimestampExtractsSelfSigCapabilities-        , testCase-            "recipientEncryptionTargetFromTKAtTimestamp filters subkey self-signatures by timestamp"-            testRecipientEncryptionTargetFromTKAtTimestampAppliesTimestampFiltering-        , testCase-            "recipientEncryptionTargetFromTKAtTimestampWithPolicy can prefer primary key"-            testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersPrimary-        , testCase-            "recipientEncryptionTargetFromTKAtTimestampWithPolicy can prefer newest key"-            testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersNewest-        , testCase-            "recipientEncryptionTargetsFromTK excludes subkeys with non-encrypt key flags"-            testRecipientEncryptionTargetsFromTKRejectsKeyWithNonEncryptFlags-        , testCase-            "recipientEncryptionTargetsFromTK includes subkeys with no key flags advertised"-            testRecipientEncryptionTargetsFromTKIncludesKeyWithNoFlags-        , testCase-            "encryptForRecipients optionally emits one-pass signature packets"-            testEncryptRecipientsWithRequestEmitsOnePassSignatures-        , testCase-            "encryptForRecipients one-pass mode requires issuer metadata"-            testEncryptRecipientsWithRequestRejectsOnePassWhenIssuerMetadataMissing-        , testCase-            "encryptForRecipients with EncryptInteropLegacy produces SEIPDv1 and PKESKv3"-            testEncryptInteropLegacyProducesSEIPDv1-        , testCase-            "encrypt-side PKESK builder reports unsupported recipient algorithms"-            testBuildPKESKPayloadUnsupportedRecipient-        , testCase-            "encrypt-side ECDH PKESK builder rejects SHA1 KDF policy"-            testBuildPKESKPayloadRejectsECDHSHA1-        , testCase-            "encrypt-side canonicalize PKESK recipient id helper"-            testCanonicalizePKESKRecipientIdHelper-        , testCase-            "conduitDecrypt decrypts seipdv2 fixture with matching v6 secret key"-            testConduitDecryptSEIPDv2FixtureWithMatchingV6SecretKey-        , testCase-            "seipdv2-for-v4-key fixture parses as PKESKv6+SEIPDv2"-            testSEIPDv2ForV4KeyArmor-        , testCase-            "conduitDecrypt decrypts seipdv2-for-v4-key fixture with matching v4 secret key"-            testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKey-        , testCase-            "conduitDecrypt tries earlier PKESKs when latest is unusable"-            testConduitDecryptSEIPDv2FixtureIgnoresUnusableLatestPKESK-        , testCase-            "conduitDecrypt matches valid recipient-id forms without caller retries"-            testConduitDecryptSEIPDv2FixtureAcceptsRecipientIdWithoutCallerPermutations-        , testCase-            "conduitDecrypt fails PKESK exhaustion without manual session-key prompt"-            testConduitDecryptPKESKFailureDoesNotRequireManualSessionMaterial-        , testCase-            "seipdv2-two-recipients fixture parses as PKESKv6*2+SEIPDv2"-            testSEIPDv2TwoRecipientsArmor-        , testCase-            "seipdv2-three-recipients fixture parses as PKESKv6*3+SEIPDv2"-            testSEIPDv2ThreeRecipientsArmor-        , testCase-            "conduitDecrypt decrypts seipdv2-two-recipients fixture with matching v4 secret key"-            testConduitDecryptSEIPDv2TwoRecipientsFixtureWithMatchingV4SecretKey-        , testCase-            "conduitDecrypt decrypts reordered+bogus seipdv2-two-recipients PKESKs"-            testConduitDecryptSEIPDv2TwoRecipientsFixtureWithReorderedAndUnusablePKESKs-        , testCase-            "conduitDecrypt decrypts seipdv2-three-recipients fixture with matching v4 secret key"-            testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithMatchingV4SecretKey-        , testCase-            "conduitDecrypt decrypts reordered+bogus seipdv2-three-recipients PKESKs"-            testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithReorderedAndUnusablePKESKs-        ]-      , testGroup "ESK/SKESK/ArgonS2K"-        [ testCase-            "encoded session key rejects too-short payloads"-            testDecodeOpenPGPEncodedSessionKeyRejectsTooShort-        , testCase-            "encoded session key rejects algorithm/key-length mismatches"-            testDecodeOpenPGPEncodedSessionKeyRejectsLengthMismatch-        , testCase-            "encoded session key rejects checksum mismatches"-            testDecodeOpenPGPEncodedSessionKeyRejectsChecksumMismatch-        , testCase "unknown SKESK version is rejected" testSKESKRejectsUnknownVersion-        , testCase-            "v4 SKESK encrypted session keys reject Simple S2K"-            testSKESK4EncryptedSessionKeyRejectsSimpleS2K-        , testCase-            "v4 SKESK Argon2 encrypted ESK roundtrip across AES-128/192/256"-            testSKESK4Argon2EncryptedSessionKeyRoundTripAcrossAES-        , testCase-            "v4 SKESK Argon2 encrypted ESK rejects legacy checksum trailer"-            testSKESK4Argon2EncryptedSessionKeyRejectsTrailingChecksum-        , testCase-            "passphrase SKESK policy ForceV4Interop emits SKESKv4 + SEIPDv1"-            testEncryptPassphraseWithPolicyForceV4Interop-        , testCase-            "passphrase SKESK policy PreferV6 emits SKESKv6 + SEIPDv2"-            testEncryptPassphraseWithPolicyPreferV6-        , testCase "Argon2 S2K derivation vector" testArgon2S2KVector-        , testCase "Argon2 S2K Ord instance is total" testArgon2S2KOrdTotal-        ]--    ]--testCompression :: FilePath -> Assertion-testCompression fpr = do-  bs <- BL.readFile $ "tests/data/" ++ fpr-  let firstpass = fmap (concatMap (either (const []) id . decompressPkt) . unBlock) . runGet get $ bs-  case firstpass of-    Left _ -> assertFailure $ "First pass failed on " ++ fpr-    Right [] ->-      assertFailure $ "First pass of " ++ fpr ++ " decoded to nothing."-    Right packs -> do-      let roundtrip = runPut $ put . Block $ [compressPkts ZIP packs]-      let secondpass =-            fmap (concatMap (either (const []) id . decompressPkt) . unBlock) . runGet get $ roundtrip-      if secondpass == Right []-        then assertFailure $ "Second pass of " ++ fpr ++ " decoded to nothing."-        else assertEqual ("for " ++ fpr) firstpass secondpass--counter :: Monad m => DC.ConduitT a DC.Void m Int-counter = CL.fold (const . (1 +)) 0--testConduitOutputLength ::-     FilePath-  -> DC.ConduitT B.ByteString b (ResourceT IO) ()-  -> Int-  -> Assertion-testConduitOutputLength fpr c target = do-  len <--    DC.runConduitRes $-    CB.sourceFile ("tests/data/" ++ fpr) DC..| c DC..| counter-  assertEqual ("expected length " ++ show target) target len--testConduitToTKsEitherReportsParseFailure :: Assertion-testConduitToTKsEitherReportsParseFailure = do-  results <--    DC.runConduitRes $-    CB.sourceFile "tests/data/uncompressed-ops-rsa.gpg" DC..|-    conduitGet get DC..| conduitToTKsEither DC..| CL.consume-  assertBool-    "conduitToTKsEither should report parse failures for non-key packet streams"-    (any (either (const True) (const False)) results)--testConduitToTKsDroppingEitherReportsParseFailure :: Assertion-testConduitToTKsDroppingEitherReportsParseFailure = do-  results <--    DC.runConduitRes $-    CB.sourceFile "tests/data/uncompressed-ops-rsa.gpg" DC..|-    conduitGet get DC..| conduitToTKsDroppingEither DC..| CL.consume-  assertBool-    "conduitToTKsDroppingEither should report parse failures for non-key packet streams"-    (any (either (const True) (const False)) results)--testConduitToSomeTKsEitherReportsParseFailure :: Assertion-testConduitToSomeTKsEitherReportsParseFailure = do-  results <--    DC.runConduitRes $-    CB.sourceFile "tests/data/uncompressed-ops-rsa.gpg" DC..|-    conduitGet get DC..| conduitToSomeTKsEither DC..| CL.consume-  assertBool-    "conduitToSomeTKsEither should report parse failures for non-key packet streams"-    (any (either (const True) (const False)) results)--testConduitToSomeTKsDroppingEitherReportsParseFailure :: Assertion-testConduitToSomeTKsDroppingEitherReportsParseFailure = do-  results <--    DC.runConduitRes $-    CB.sourceFile "tests/data/uncompressed-ops-rsa.gpg" DC..|-    conduitGet get DC..| conduitToSomeTKsDroppingEither DC..| CL.consume-  assertBool-    "conduitToSomeTKsDroppingEither should report parse failures for non-key packet streams"-    (any (either (const True) (const False)) results)---- This needs a lot of work--- | Decrypt a symmetric-encrypted fixture using 'defaultDecryptPolicy' and--- assert the packet structure is SKESK + SEIPDv1 and the cleartext matches.--- Only suitable for AES-128/192/256 fixtures with iterated-salted S2K.-testSymmetricEncryption :: FilePath -> FilePath -> BL.ByteString -> Assertion-testSymmetricEncryption encfile passfile cleartext = do-  passphrase <- readFixtureLazy passfile-  pt <- readFixturePackets encfile-  assertEqual "wrong number of packets" 2 (length pt)-  skesk <--    case pt of-      [] -> assertFailure ("expected SKESK packet in " ++ encfile ++ " but packet list was empty") >> fail "empty fixture packet list"-      (firstPkt:_) ->-        case (fromPktEither firstPkt :: Either String (SKESK 'SKESKV4)) of-          Left err -> assertFailure ("failed to coerce first packet to SKESK: " ++ err) >> fail err-          Right x -> pure x-  assertEqual "first packet should be SKESK" SKESKType (packetType skesk)-  case last pt of-    SymEncIntegrityProtectedDataPkt (SEIPD1 1 _) -> pure ()-    other ->-      assertFailure-        ("second packet should be SEIPDv1 (tag 18, version 1), got: " ++ show other)-  decrypted <--    catch-      (DC.runConduitRes $-       CL.sourceList pt DC..| conduitDecrypt (fakeCallback passphrase) DC..|-       CL.consume)-      (\e -> do-         let err = show (e :: SomeException)-         assertFailure ("decryption threw exception: " ++ err))-  payload <--    case decrypted of-      [] ->-        assertFailure ("decryption produced no packets for " ++ encfile) >>-        fail "expected decrypted literal packet"-      (firstDecrypted:_) ->-        case (fromPktEither firstDecrypted :: Either String LiteralData) of-          Left err ->-            assertFailure ("failed to coerce decrypted packet to literal data: " ++ err) >>-            fail err-          Right x -> pure (_literalDataPayload x)-  assertEqual ("cleartext for " ++ encfile) cleartext payload-  where-    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString-    fakeCallback = const . return--testSEIPDv1ResyncNonceMdcRoundTrip :: Assertion-testSEIPDv1ResyncNonceMdcRoundTrip = do-  let sa = AES256-      keyBytes = B.pack [0..31]-      iv = IV (B.pack [32..47])-      cleartext = B.pack [1..80]-      cleartextWithMDC = cleartext <> mdcTrailerForSEIPDv1 iv cleartext-  ciphertext <--    either-      (\e -> assertFailure ("encryptOpenPGPCfbRaw failed: " ++ show e) >> pure mempty)-      pure-      (encryptOpenPGPCfbRaw OpenPGPCFBResyncW sa iv cleartextWithMDC keyBytes)-  (nonce, decrypted) <--    either-      (\e -> assertFailure ("decryptOpenPGPCfbWithNonce failed: " ++ show e) >> pure (mempty, mempty))-      pure-      (decryptOpenPGPCfbWithNonce sa ciphertext keyBytes)-  assertEqual-    "SEIPDv1 nonce should match IV||IV[-2:]"-    (seipdv1NonceFromIV iv)-    nonce-  assertEqual-    "decrypted bytes should include payload+MDC"-    cleartextWithMDC-    decrypted-  payloadOut <--    either-      (\err -> assertFailure ("validateSEIPD1MDC failed: " ++ err) >> pure mempty)-      pure-      (validateSEIPD1MDC nonce decrypted)-  assertEqual "MDC-verified payload should round-trip" cleartext payloadOut---- | Like 'testSymmetricEncryption' but uses 'lenientDecryptPolicy' to permit--- legacy RFC4880/RFC2440 message formats (SED, deprecated S2K, old ciphers).--- The 'Bool' indicates whether the fixture uses SEIPDv1 (True) or SED (False).-testLegacySymmetricEncryption :: Bool -> FilePath -> FilePath -> BL.ByteString -> Assertion-testLegacySymmetricEncryption expectSEIPDv1 encfile passfile cleartext = do-  passphrase <- readFixtureLazy passfile-  pt <- readFixturePackets encfile-  assertEqual "wrong number of packets" 2 (length pt)-  skesk <--    case pt of-      [] -> assertFailure ("expected SKESK packet in " ++ encfile ++ " but packet list was empty") >> fail "empty fixture packet list"-      (firstPkt:_) ->-        case (fromPktEither firstPkt :: Either String (SKESK 'SKESKV4)) of-          Left err -> assertFailure ("failed to coerce first packet to SKESK: " ++ err) >> fail err-          Right x -> pure x-  assertEqual "first packet should be SKESK" SKESKType (packetType skesk)-  case last pt of-    SymEncDataPkt {}-      | not expectSEIPDv1 -> pure ()-      | otherwise ->-          assertFailure "expected SEIPDv1 packet (tag 18) but got SED (tag 9)"-    SymEncIntegrityProtectedDataPkt (SEIPD1 1 _)-      | expectSEIPDv1 -> pure ()-      | otherwise ->-          assertFailure "expected SED packet (tag 9) but got SEIPDv1 (tag 18)"-    other -> assertFailure ("unexpected second packet: " ++ show other)-  decrypted <--    catch-      (DC.runConduitRes $-       CL.sourceList pt DC..|-       conduitDecryptWithDecryptPolicy lenientDecryptPolicy (\_ -> pure Nothing) (fakeCallback passphrase) DC..|-       CL.consume)-      (\e -> do-         let err = show (e :: SomeException)-         assertFailure ("decryption threw exception: " ++ err))-  payload <--    case decrypted of-      [] ->-        assertFailure ("decryption produced no packets for " ++ encfile) >>-        fail "expected decrypted literal packet"-      (firstDecrypted:_) ->-        case (fromPktEither firstDecrypted :: Either String LiteralData) of-          Left err ->-            assertFailure ("failed to coerce decrypted packet to literal data: " ++ err) >>-            fail err-          Right x -> pure (_literalDataPayload x)-  assertEqual ("cleartext for " ++ encfile) cleartext payload-  where-    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString-    fakeCallback = const . return---- | Assert that decrypting with the strict 'defaultDecryptPolicy' throws an--- exception whose message contains the given substring.-testStrictPolicyRejectsEncryption :: FilePath -> FilePath -> String -> Assertion-testStrictPolicyRejectsEncryption encfile passfile expectedFragment = do-  passphrase <- readFixtureLazy passfile-  pt <- readFixturePackets encfile-  result <--    try-      (DC.runConduitRes $-       CL.sourceList pt DC..|-       conduitDecrypt (fakeCallback passphrase) DC..|-       CL.consume) :: IO (Either SomeException [Pkt])-  case result of-    Right _ ->-      assertFailure $-        "Expected strict policy to reject '" ++ encfile ++-        "' with error containing '" ++ expectedFragment ++ "', but decryption succeeded"-    Left err ->-      assertBool-        ("Expected error containing '" ++ expectedFragment ++-         "', got: " ++ show err)-        (expectedFragment `isInfixOf` show err)-  where-    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString-    fakeCallback = const . return---- | Decrypt a file and check the 'DecryptOutcome'.-testDecryptOutcome :: FilePath -> FilePath -> DecryptOutcome -> Assertion-testDecryptOutcome encfile passfile expectedOutcome = do-  passphrase <- readFixtureLazy passfile-  pt <- readFixturePackets encfile-  (outcome, _pkts) <--    catch-      (DC.runConduitRes $-       CL.sourceList pt DC..|-       fuseBoth (conduitDecryptChecked (fakeCallback passphrase)) CL.consume)-      (\e -> do-         let err = show (e :: SomeException)-         assertFailure ("decryption threw unexpected exception: " ++ err)-         fail "unreachable")-  assertEqual-    ("DecryptOutcome for " ++ encfile)-    expectedOutcome-    outcome-  where-    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString-    fakeCallback = const . return---- | Build a synthetic packet list with an appended trailing packet, decrypt--- with lenient policy, and verify 'DecryptTrailingData' is reported.-testTrailingDataReportedLenient :: FilePath -> FilePath -> Assertion-testTrailingDataReportedLenient encfile passfile = do-  passphrase <- readFixtureLazy passfile-  pt <- readFixturePackets encfile-  let trailingPkt = OtherPacketPkt 0xFE ""-      ptWithTrailing = pt ++ [trailingPkt]-  (outcome, _pkts) <--    catch-      (DC.runConduitRes $-       CL.sourceList ptWithTrailing DC..|-       fuseBoth (conduitDecryptCheckedWithDecryptPolicy lenientDecryptPolicy (\_ -> pure Nothing) (fakeCallback passphrase)) CL.consume)-      (\e -> do-         let err = show (e :: SomeException)-         assertFailure ("lenient decrypt threw unexpected exception: " ++ err)-         fail "unreachable")-  assertEqual-    ("DecryptTrailingData for " ++ encfile)-    DecryptTrailingData-    outcome-  where-    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString-    fakeCallback = const . return---- | Same as above but with strict policy: should throw "after message--- integrity boundary".-testTrailingDataRejectedStrict :: FilePath -> FilePath -> Assertion-testTrailingDataRejectedStrict encfile passfile = do-  passphrase <- readFixtureLazy passfile-  pt <- readFixturePackets encfile-  let trailingPkt = OtherPacketPkt 0xFE ""-      ptWithTrailing = pt ++ [trailingPkt]-  result <--    try-      (DC.runConduitRes $-       CL.sourceList ptWithTrailing DC..|-       fuseBoth (conduitDecryptChecked (fakeCallback passphrase)) CL.consume-      ) :: IO (Either SomeException (DecryptOutcome, [Pkt]))-  case result of-    Left err ->-      assertFailure ("Expected DecryptMalformedStructure but got exception: " ++ show err)-    Right (DecryptMalformedStructure malformedReason, _) ->-      assertBool-        ("Expected 'after message integrity boundary', got: " ++ malformedReason)-        ("after message integrity boundary" `isInfixOf` malformedReason)-    Right (other, _) ->-      assertFailure ("Expected DecryptMalformedStructure but got: " ++ show other)-  where-    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString-    fakeCallback = const . return--encryptedSEIPDv2Packets :: IO [Pkt]-encryptedSEIPDv2Packets = do-  let passphrase = mkPassphrase (BL.pack (map (fromIntegral . fromEnum) ("test" :: String)))-      payload = mkClearPayload (BL.pack (map (fromIntegral . fromEnum) ("hello" :: String)))-  let result = encryptMessageDefault DoNotExposeSessionMaterial passphrase payload-  case result of-    Left err -> fail ("encryptedSEIPDv2Packets: encryptMessageDefault failed: " ++ show err)-    Right (encPayload, _) ->-      DC.runConduitRes $-      CB.sourceLbs (encryptedPayloadBytes encPayload) DC..| conduitGet get DC..|-      CL.consume--defaultOptionsForPassphrase :: BL.ByteString -> DecryptOptions-defaultOptionsForPassphrase passphrase =-  DecryptOptions-    { decryptOptionsKeyResolution = DecryptWithoutPKESK-    , decryptOptionsPolicy = defaultDecryptPolicy-    , decryptOptionsPassphraseCallback = const (pure passphrase)-    }--testDecryptCleanSEIPDv2 :: Assertion-testDecryptCleanSEIPDv2 = do-  pt <- encryptedSEIPDv2Packets-  let passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))-      cb = const (pure passphrase)-  (outcome, _) <--    catch-      (DC.runConduitRes $-       CL.sourceList pt DC..| fuseBoth (conduitDecryptChecked cb) CL.consume)-      (\e -> assertFailure ("unexpected exception: " ++ show (e :: SomeException)) >> fail "unreachable")-  assertEqual "clean SEIPD v2 should yield DecryptClean" DecryptClean outcome--testOptionsMatchesCheckedDefaultSEIPDv2 :: Assertion-testOptionsMatchesCheckedDefaultSEIPDv2 = do-  pt <- encryptedSEIPDv2Packets-  let passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))-      cb = const (pure passphrase)-      opts = defaultOptionsForPassphrase passphrase-  checkedResult <--    DC.runConduitRes $-    CL.sourceList pt DC..| fuseBoth (conduitDecryptChecked cb) CL.consume-  optionsResult <--    DC.runConduitRes $-    CL.sourceList pt DC..| fuseBoth (DCD.conduitDecrypt opts) CL.consume-  assertEqual "options conduit should match checked conduit on clean decrypt" checkedResult optionsResult--testOptionsMatchesLegacyDefaultOutputSEIPDv2 :: Assertion-testOptionsMatchesLegacyDefaultOutputSEIPDv2 = do-  pt <- encryptedSEIPDv2Packets-  let passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))-      cb = const (pure passphrase)-      opts = defaultOptionsForPassphrase passphrase-  legacyOutput <--    DC.runConduitRes $-    CL.sourceList pt DC..| conduitDecrypt cb DC..| CL.consume-  (optionsOutcome, optionsOutput) <--    DC.runConduitRes $-    CL.sourceList pt DC..| fuseBoth (DCD.conduitDecrypt opts) CL.consume-  assertEqual-    "options conduit should report DecryptClean for clean stream"-    DecryptClean-    optionsOutcome-  assertEqual "legacy conduit output should match options conduit output" legacyOutput optionsOutput--testTrailingDataRejectedStrictSEIPDv2 :: Assertion-testTrailingDataRejectedStrictSEIPDv2 = do-  pt <- encryptedSEIPDv2Packets-  let ptWithTrailing = pt ++ [OtherPacketPkt 0xFE ""]-      passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))-      cb = const (pure passphrase)-  result <--    try-      (DC.runConduitRes $-       CL.sourceList ptWithTrailing DC..| fuseBoth (conduitDecryptChecked cb) CL.consume-      ) :: IO (Either SomeException (DecryptOutcome, [Pkt]))-  case result of-    Left err ->-      assertFailure ("Expected DecryptMalformedStructure but got exception: " ++ show err)-    Right (DecryptMalformedStructure reason, _) ->-      assertBool-        ("Expected 'after message integrity boundary', got: " ++ reason)-        ("after message integrity boundary" `isInfixOf` reason)-    Right (other, _) ->-      assertFailure ("Expected strict policy to reject trailing data but got: " ++ show other)--testTrailingDataReportedLenientSEIPDv2 :: Assertion-testTrailingDataReportedLenientSEIPDv2 = do-  pt <- encryptedSEIPDv2Packets-  let ptWithTrailing = pt ++ [OtherPacketPkt 0xFE ""]-      passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))-      cb = const (pure passphrase)-  (outcome, _) <--    catch-      (DC.runConduitRes $-       CL.sourceList ptWithTrailing DC..|-       fuseBoth (conduitDecryptCheckedWithDecryptPolicy lenientDecryptPolicy (\_ -> pure Nothing) cb) CL.consume)-      (\e -> assertFailure ("unexpected exception: " ++ show (e :: SomeException)) >> fail "unreachable")-  assertEqual "trailing packet should yield DecryptTrailingData" DecryptTrailingData outcome--testOptionsMatchesCheckedLenientTrailingSEIPDv2 :: Assertion-testOptionsMatchesCheckedLenientTrailingSEIPDv2 = do-  pt <- encryptedSEIPDv2Packets-  let ptWithTrailing = pt ++ [OtherPacketPkt 0xFE ""]-      passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))-      cb = const (pure passphrase)-      opts =-        DecryptOptions-          { decryptOptionsKeyResolution = DecryptWithoutPKESK-          , decryptOptionsPolicy = lenientDecryptPolicy-          , decryptOptionsPassphraseCallback = cb-          }-  checkedResult <--    DC.runConduitRes $-    CL.sourceList ptWithTrailing DC..|-    fuseBoth (conduitDecryptCheckedWithDecryptPolicy lenientDecryptPolicy (\_ -> pure Nothing) cb) CL.consume-  optionsResult <--    DC.runConduitRes $-    CL.sourceList ptWithTrailing DC..|-    fuseBoth (DCD.conduitDecrypt opts) CL.consume-  assertEqual "options conduit should match checked lenient conduit with trailing data" checkedResult optionsResult--testRejectsNonEncryptedAfterESKPrelude :: Assertion-testRejectsNonEncryptedAfterESKPrelude = do-  pt <- encryptedSEIPDv2Packets-  let malformed =-        case pt of-          [] -> []-          esk:_ ->-            [ esk-            , LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) "not-encrypted"-            ]-      passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))-      cb = const (pure passphrase)-  result <--    try-      (DC.runConduitRes $-       CL.sourceList malformed DC..| fuseBoth (conduitDecryptChecked cb) CL.consume-      ) :: IO (Either SomeException (DecryptOutcome, [Pkt]))-  case result of-    Left err ->-      assertFailure ("Expected DecryptMalformedStructure but got exception: " ++ show err)-    Right (DecryptMalformedStructure reason, _) ->-      assertBool-        ("Expected ESK prelude shape failure, got: " ++ reason)-        ("ESK packets must immediately precede encrypted data" `isInfixOf` reason)-    Right (other, _) ->-      assertFailure ("Expected DecryptMalformedStructure but got: " ++ show other)--testRejectsMisalignedESKVersionForSEIPDv2 :: Assertion-testRejectsMisalignedESKVersionForSEIPDv2 = do-  pt <- encryptedSEIPDv2Packets-  let malformed =-        case pt of-          (SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 sa _ s2k _ _ _)):rest) ->-            SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k Nothing)) : rest-          _ -> pt-      passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))-      cb = const (pure passphrase)-  result <--    try-      (DC.runConduitRes $-       CL.sourceList malformed DC..| fuseBoth (conduitDecryptChecked cb) CL.consume-      ) :: IO (Either SomeException (DecryptOutcome, [Pkt]))-  case result of-    Left err ->-      assertFailure ("Expected DecryptMalformedStructure but got exception: " ++ show err)-    Right (DecryptMalformedStructure reason, _) ->-      assertBool-        ("Expected payload/ESK alignment failure, got: " ++ reason)-        ("version-aligned" `isInfixOf` reason)-    Right (other, _) ->-      assertFailure ("Expected DecryptMalformedStructure but got: " ++ show other)--testDiscardsMisalignedESKWhenAlignedCandidateExists :: Assertion-testDiscardsMisalignedESKWhenAlignedCandidateExists = do-  pt <- encryptedSEIPDv2Packets-  let withMixedPrelude =-        case pt of-          (SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag)):rest) ->-            SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k Nothing)) : SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag)) : rest-          _ -> pt-      passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))-      cb = const (pure passphrase)-  (outcome, _) <--    catch-      (DC.runConduitRes $-       CL.sourceList withMixedPrelude DC..| fuseBoth (conduitDecryptChecked cb) CL.consume)-      (\e -> assertFailure ("unexpected exception: " ++ show (e :: SomeException)) >> fail "unreachable")-  assertEqual-    "misaligned ESKs should be discarded when an aligned ESK is present"-    DecryptClean-    outcome--testSecretKeyDecryption :: FilePath -> FilePath -> Assertion-testSecretKeyDecryption keyfile passfile = do-  passphrase <- readFixtureLazy passfile-  kr <--    DC.runConduitRes $-    CB.sourceFile (fixturePath keyfile) DC..| conduitGet get DC..|-    CL.consume-  SecretKey pkp ska <--    case kr of-      [] ->-        assertFailure ("no packets found in secret key fixture " ++ keyfile) >>-        fail "empty secret key fixture"-      (firstPkt:_) ->-        case (fromPktEither firstPkt :: Either String SecretKey) of-          Left err -> assertFailure ("failed to coerce key packet to SecretKey: " ++ err) >> fail err-          Right x -> pure x-  decrypted <--    case decryptPrivateKey (pkp, ska) passphrase of-      Left err ->-        assertFailure ("secret key decryption failed: " ++ err) >>-        fail "secret key decryption failed"-      Right x -> pure x-  case decrypted of-    SUUnencrypted skey _ -> doPkeyAndSkeyMatch (_pubkey pkp) skey-    other ->-      assertFailure-        ("secret key decryption should produce an unencrypted secret key, got: " ++-         show other)--testLegacySecretKeyEncryptionRejected :: FilePath -> FilePath -> Assertion-testLegacySecretKeyEncryptionRejected keyfile passfile = do-  passphrase <- readFixtureLazy passfile-  kr <--    DC.runConduitRes $-    CB.sourceFile (fixturePath keyfile) DC..| conduitGet get DC..|-    CL.consume-  SecretKey pkp ska <--    case kr of-      [] ->-        assertFailure ("no packets found in secret key fixture " ++ keyfile) >>-        fail "empty secret key fixture"-      (firstPkt:_) ->-        case (fromPktEither firstPkt :: Either String SecretKey) of-          Left err -> assertFailure ("failed to coerce key packet to SecretKey: " ++ err) >> fail err-          Right x -> pure x-  case-      encryptPrivateKeyWithPolicyAndSaltAndIV-        defaultPolicy-        pkp-        (Salt "\226~\197\a\202#\"G")-        (IV "\187\219\253I\236\204\t5D\196\NAK>;\202\185\t")-        ska-        passphrase of-    Left err | "explicit legacy override required" `isInfixOf` err -> pure ()-    Left err ->-      assertFailure-        ("legacy secret key encryption should be rejected with a policy error, got: " ++-         err)-    Right _ ->-      assertFailure "legacy secret key encryption should reject implicit SHA-1 protection"--testV6SecretKeyEncryptionRoundTrip :: Assertion-testV6SecretKeyEncryptionRoundTrip = do-  passphrase <- readPKIPassphrase-  armors <- loadArmor "v6-secret.pgp.aa"-  armor <--    case armors of-      (a:_) -> pure a-      [] ->-        assertFailure "v6-secret.pgp.aa should contain one armored payload" >>-        fail "expected one armored payload"-  let packets = parsePkts (armorPayload armor)-  SecretKey pkp ska <--    case [sk | pkt <- packets, Right sk <- [fromPktEither pkt :: Either String SecretKey]] of-      (sk:_) -> pure sk-      [] ->-        assertFailure "v6-secret.pgp.aa should contain a secret key packet" >>-        fail "expected secret key packet"-  originalSKey <--    case ska of-      SUUnencrypted skey _ -> pure skey-      _ ->-        assertFailure "v6-secret.pgp.aa should contain unencrypted secret key material" >>-        fail "expected unencrypted secret key"-  changed <--    case-        encryptPrivateKeyWithPolicyAndSaltAndIV-          defaultPolicy-          pkp-          (Salt "1234567890ABCDEF")-          (IV "1234567890ABCDE")-          ska-          passphrase of-      Left err ->-        assertFailure ("v6 secret key encryption failed: " ++ err) >>-        fail "v6 secret key encryption failed"-      Right x -> pure x-  case changed of-    SUSAEAD AES256 OCB (Argon2 _ t p em) _ encryptedPayload -> do-      assertEqual-        "v6 secret key encryption should use expected Argon2 t parameter"-        1-        t-      assertEqual-        "v6 secret key encryption should use expected Argon2 p parameter"-        4-        p-      assertEqual-        "v6 secret key encryption should use expected Argon2 encoded memory parameter"-        15-        em-      assertBool-        "v6 secret key encryption should emit encrypted payload"-        (not (BL.null encryptedPayload))-    _ ->-      assertFailure "v6 secret key encryption should emit SUSAEAD/AES256/OCB with Argon2 S2K"-  let serialized = runPut (put (toPkt (SecretKey pkp changed)))-      reparsed = parsePkts serialized-  (parsedPKP, parsedSKA) <--    case reparsed of-      (SecretKeyPkt pkpayload skaddendum:_) -> pure (pkpayload, skaddendum)-      _ ->-        assertFailure "re-serialized v6 secret key should parse back as a secret key packet" >>-        fail "expected serialized secret key packet"-  decrypted <--    case decryptPrivateKey (parsedPKP, parsedSKA) passphrase of-      Left err ->-        assertFailure ("v6 secret key roundtrip decryption failed: " ++ err) >>-        fail "v6 secret key roundtrip decryption failed"-      Right x -> pure x-  case decrypted of-    SUUnencrypted skey _ ->-      assertEqual-        "v6 secret key roundtrip should preserve secret key material"-        originalSKey-        skey-    _ -> assertFailure "v6 secret key roundtrip should decrypt to unencrypted secret material"--testV4SecretKeyAEADOCBRoundTripCompat :: Assertion-testV4SecretKeyAEADOCBRoundTripCompat = do-  (pkp, privateKey) <- loadUnencryptedRsaSigner-  let skey = RSAPrivateKey (RSA_PrivateKey privateKey)-      passphrase = "legacy-aead-passphrase"-      compatPolicy =-        (policyForRFC RFC4880)-          { policySecretKeyProtection = policySecretKeyProtection defaultPolicy-          }-      salt = Salt (B.pack [0x00 .. 0x0f])-      iv = IV (B.pack [0x10 .. 0x1e])-  encrypted <--    case-        encryptPrivateKeyWithPolicyAndSaltAndIV-          compatPolicy-          pkp-          salt-          iv-          (SUUnencrypted skey 0)-          passphrase of-      Left err ->-        assertFailure ("v4 AEAD secret key encryption failed: " ++ err) >>-        fail "v4 AEAD secret key encryption failed"-      Right x -> pure x-  case encrypted of-    SUSAEAD AES256 OCB (Argon2 _ t p em) _ encryptedPayload -> do-      assertEqual "v4 AEAD secret key encryption should use expected Argon2 t" 1 t-      assertEqual "v4 AEAD secret key encryption should use expected Argon2 p" 4 p-      assertEqual "v4 AEAD secret key encryption should use expected Argon2 encoded-memory" 15 em-      assertBool-        "v4 AEAD secret key encryption should emit encrypted payload"-        (not (BL.null encryptedPayload))-    _ ->-      assertFailure "v4 secret key encryption should emit SUSAEAD/AES256/OCB with Argon2 S2K"-  let serialized = runPut (put (toPkt (SecretKey pkp encrypted)))-      reparsed = parsePkts serialized-  (parsedPKP, parsedSKA) <--    case reparsed of-      (SecretKeyPkt pkpayload skaddendum:_) -> pure (pkpayload, skaddendum)-      _ ->-        assertFailure "re-serialized v4 AEAD secret key should parse back as a secret key packet" >>-        fail "expected serialized secret key packet"-  decrypted <--    case decryptPrivateKey (parsedPKP, parsedSKA) passphrase of-      Left err ->-        assertFailure ("v4 AEAD secret key roundtrip decryption failed: " ++ err) >>-        fail "v4 AEAD secret key roundtrip decryption failed"-      Right x -> pure x-  case decrypted of-    SUUnencrypted skey' _ ->-      assertEqual-        "v4 AEAD secret key roundtrip should preserve secret key material"-        skey-        skey'-    _ -> assertFailure "v4 AEAD secret key roundtrip should decrypt to unencrypted secret material"--testSUSymSecretKeyRoundTrip :: Assertion-testSUSymSecretKeyRoundTrip = do-  passphrase <- readPKIPassphrase-  packets <--    DC.runConduitRes $-    CB.sourceFile "tests/data/unencrypted.seckey" DC..| conduitGet get DC..|-    CL.consume-  (pkp, skey) <--    case packets of-      (SecretKeyPkt pkpayload (SUUnencrypted sk _):_) -> pure (pkpayload, sk)-      _ ->-        assertFailure "unencrypted.seckey did not begin with an unencrypted secret key packet" >>-        fail "expected unencrypted secret key packet"-  let cleartext = legacyRsaSecretKeyBytes skey-      cleartextLBS = BL.fromStrict cleartext-      clearWithChecksum = cleartextLBS <> runPut (putWord16be (legacyChecksum16 cleartext))-      iv = IV (B.pack [0..15])-      sa = AES128-  keyMaterial <--    case string2Key (Simple DeprecatedMD5) 16 passphrase of-      Left err ->-        assertFailure ("failed to derive SUSym key material: " ++ renderS2KError err) >>-        fail "failed to derive SUSym key material"-      Right km -> pure km-  encrypted <--    case encryptNoNonce sa (Simple DeprecatedMD5) iv (BL.toStrict clearWithChecksum) keyMaterial of-      Left err ->-        assertFailure ("failed to encrypt legacy SUSym secret key: " ++ show err) >>-        fail "failed to encrypt legacy SUSym secret key"-      Right bs -> pure bs-  let legacySka = SUSym sa iv (BL.fromStrict encrypted)-      serialized = runPut (put (toPkt (SecretKey pkp legacySka)))-      reparsed = parsePkts serialized-  (parsedPKP, parsedSKA) <--    case reparsed of-      (SecretKeyPkt pkpayload skaddendum:_) -> pure (pkpayload, skaddendum)-      _ ->-        assertFailure "serialized SUSym secret key should parse back as a secret key packet" >>-        fail "expected serialized secret key packet"-  decrypted <--    case decryptPrivateKey (parsedPKP, parsedSKA) passphrase of-      Left err ->-        assertFailure ("SUSym secret key decryption failed: " ++ err) >>-        fail "SUSym secret key decryption failed"-      Right x -> pure x-  case decrypted of-    SUUnencrypted parsedSKey _ ->-      assertEqual-        "SUSym secret key roundtrip should preserve secret key material"-        skey-        parsedSKey-    _ -> assertFailure "SUSym secret key roundtrip should decrypt to unencrypted secret material"--legacyRsaSecretKeyBytes :: SKey -> B.ByteString-legacyRsaSecretKeyBytes (RSAPrivateKey (RSA_PrivateKey (RSA.PrivateKey _ d p q _ _ _))) =-  BL.toStrict $-    runPut $-      case inverse q p of-        Just u -> do-          put (MPI d)-          put (MPI p)-          put (MPI q)-          put (MPI u)-        Nothing -> error "invalid RSA key in legacy secret key test"-legacyRsaSecretKeyBytes _ = error "legacyRsaSecretKeyBytes requires an RSA secret key"--legacyChecksum16 :: B.ByteString -> Word16-legacyChecksum16 =-  fromIntegral .-  B.foldl' (\acc octet -> (acc + fromIntegral octet) `mod` (65536 :: Integer)) 0--testLegacyEncryptionFixtureShape :: Assertion-testLegacyEncryptionFixtureShape = do-  packets <--    DC.runConduitRes $-    CB.sourceFile "tests/data/encryption.gpg" DC..| conduitGet get DC..| CL.consume-  let hasKeyEncapsulation = any isKeyEncapsulation packets-      hasEncryptedData = any isEncryptedData packets-  assertBool-    "encryption.gpg should contain PKESK or SKESK key-encapsulation"-    hasKeyEncapsulation-  assertBool "encryption.gpg should contain encrypted data" hasEncryptedData-  where-    isKeyEncapsulation (SKESKPkt _) = True-    isKeyEncapsulation (PKESKPkt _) = True-    isKeyEncapsulation _ = False-    isEncryptedData SymEncDataPkt {} = True-    isEncryptedData SymEncIntegrityProtectedDataPkt {} = True-    isEncryptedData _ = False--testBuildPKESKPayloadForRecipientRSA :: Assertion-testBuildPKESKPayloadForRecipientRSA = do-  (baseRecipient, privateKey) <- loadUnencryptedRsaSigner-  let recipient = setKeyVersion V6 baseRecipient-      sessionKey = SessionKey (B.replicate 32 0x2e)-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk builder rsa payload"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             PKESKRecipientKey-               { pkeskRecipientPKPayload = Nothing-               , pkeskRecipientSKey = RSAPrivateKey (RSA_PrivateKey privateKey)-               })-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  pkeskPayloadResult <- buildPKESKPayloadForRecipient PreferV6 recipient sessionMaterial-  pkeskPayload <--    case pkeskPayloadResult of-      Left err ->-        assertFailure ("buildPKESKPayloadForRecipient failed: " ++ show err) >>-        fail "buildPKESKPayloadForRecipient failed"-      Right p -> pure p-  case pkeskPayload of-    PKESKPayloadV6Packet (PKESKPayloadV6 _ RSA eskBytesLazy) -> do-      let eskBytes = BL.toStrict eskBytesLazy-      assertBool "PKESKv6 RSA ESK should include MPI framing" (B.length eskBytes >= 2)-      let mpiBits = fromIntegral (B.index eskBytes 0) * 256 + fromIntegral (B.index eskBytes 1)-          mpiLen = (mpiBits + 7) `div` 8-      assertEqual-        "PKESKv6 RSA ESK should be exactly one RFC9580 MPI"-        (2 + mpiLen)-        (B.length eskBytes)-    other ->-      assertFailure ("Expected PKESKv6 RSA payload, got " ++ show other)-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList-      [ PKESKPkt pkeskPayload-      , SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))-      ] DC..|-    conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESK builder RSA decrypt payload" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testBuildPKESKv3PayloadForRecipientRSAInterop :: Assertion-testBuildPKESKv3PayloadForRecipientRSAInterop = do-  (baseRecipient, privateKey) <- loadUnencryptedRsaSigner-  let recipient = setKeyVersion V4 baseRecipient-      sessionKey = SessionKey (B.replicate 32 0x2d)-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk builder rsa v3 interop payload"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyCallback _ = pure (Just (RSAPrivateKey (RSA_PrivateKey privateKey)))-      keyContextCallback pkt = do-        msk <- keyCallback pkt-        pure $-          fmap-            (\sk ->-               PKESKRecipientKey-                 { pkeskRecipientPKPayload = Nothing-                 , pkeskRecipientSKey = sk-                 })-            msk-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  pkeskPayloadResult <- buildPKESKv3PayloadForRecipient recipient (pkeskV3SessionMaterial sessionMaterial)-  pkeskPayload <--    case pkeskPayloadResult of-      Left err ->-        assertFailure ("buildPKESKv3PayloadForRecipient failed: " ++ show err) >>-        fail "buildPKESKv3PayloadForRecipient failed"-      Right p@(PKESKPayloadV3Packet (PKESKPayloadV3 _ _ RSA _)) -> pure p-      Right other ->-        assertFailure ("Expected PKESK3 RSA payload, got " ++ show other) >>-        fail "Unexpected PKESK payload variant"-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList-      [ PKESKPkt pkeskPayload-      , SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))-      ] DC..|-    conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESKv3 RSA interop decrypt payload" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testBuildPKESKv3PayloadForRecipientSupportsV6Key :: Assertion-testBuildPKESKv3PayloadForRecipientSupportsV6Key = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let recipient = setKeyVersion V6 baseRecipient-      sessionKey = SessionKey (B.replicate 32 0x11)-  let expectedKeyId = EightOctetKeyId (BL.take 8 (unFingerprint (fingerprint recipient)))-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  result <- buildPKESKv3PayloadForRecipient recipient (pkeskV3SessionMaterial sessionMaterial)-  case result of-    Right (PKESKPayloadV3Packet (PKESKPayloadV3 _ keyId RSA _)) ->-      assertEqual-        "PKESKv3 builder should derive v6 key ID from the high-order 64 bits of the fingerprint"-        expectedKeyId-        keyId-    Right payload ->-      assertFailure ("Expected PKESK3 RSA payload for v6 recipient, got " ++ show payload)-    Left err ->-      assertFailure ("Expected PKESK3 RSA payload for v6 recipient, got error " ++ show err)--testBuildPKESKv3PayloadForRecipientECDHInterop :: Assertion-testBuildPKESKv3PayloadForRecipientECDHInterop = do-  let (recipientPub, recipientPriv) = syntheticNISTP256Low-      recipient =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          ECDH-          (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey recipientPub)) SHA256 AES128)-      sessionKey = SessionKey (B.replicate 32 0x21)-      salt = Salt (B.pack [0x20 .. 0x3f])-      payload = "pkesk builder ecdh v3 interop payload"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      recipientSKey = ECDHPrivateKey (ECDSA_PrivateKey recipientPriv)-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipient-                , pkeskRecipientSKey = recipientSKey-                }))-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  pkeskPayloadResult <- buildPKESKv3PayloadForRecipient recipient (pkeskV3SessionMaterial sessionMaterial)-  pkeskPayload <--    case pkeskPayloadResult of-      Left err ->-        assertFailure ("buildPKESKv3PayloadForRecipient failed: " ++ show err) >>-        fail "buildPKESKv3PayloadForRecipient failed"-      Right p@(PKESKPayloadV3Packet (PKESKPayloadV3 _ _ ECDH _)) -> pure p-      Right other ->-        assertFailure ("Expected PKESK3 ECDH payload, got " ++ show other) >>-        fail "Unexpected PKESK payload variant"-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList-      [ PKESKPkt pkeskPayload-      , SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))-      ] DC..|-    conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESKv3 ECDH interop decrypt payload" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)---- | Verify that the PKESKv3 ECDH serializer writes the wrapped-key field using the--- RFC 6637 §8 wire format (MPI(ephemeral) || 1-octet-count || C) rather than the--- old double-MPI encoding that caused interoperability failures.-testPKESKv3ECDHWireFormat :: Assertion-testPKESKv3ECDHWireFormat = do-  let (recipientPub, _) = syntheticNISTP256Low-      recipient =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          ECDH-          (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey recipientPub)) SHA256 AES256)-      -- Use a session key whose first byte is 0x00 so leading-zero stripping-      -- is observable if i2osp truncates the wrapped key.-      sessionKey = SessionKey (B.cons 0x00 (B.replicate 31 0xAB))-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  pkeskResult <- buildPKESKv3PayloadForRecipient recipient (pkeskV3SessionMaterial sessionMaterial)-  case pkeskResult of-    Left err -> assertFailure ("buildPKESKv3PayloadForRecipient failed: " ++ show err)-    Right p -> do-      -- Serialise the packet to wire bytes then parse the PKESK body manually.-      let wire = BL.toStrict (runPut (put (PKESKPkt p)))-      -- Skip new-format tag byte (0xC1), then parse the packet length.-      -- For the test we just round-trip through parsePkts and check the body layout.-      case parsePkts (BL.fromStrict wire) of-        [PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ _ ECDH (ephMPI NE.:| [wrappedMPI])))] -> do-          -- The ephemeral MPI should be non-trivially large (EC point).-          assertBool "ephemeral MPI should be non-empty" (unMPI ephMPI > 0)-          -- The wrapped MPI stores the raw i2osp bytes; for AES-256 the RFC 3394-          -- ciphertext is 48 bytes.  i2osp strips leading zeros so the stored-          -- integer may represent fewer bytes, but candidateWrappedRFC3394Ciphertexts-          -- handles that. What we're checking here is the WIRE format:-          -- after the ephemeral MPI there must be exactly 1-byte-len + C bytes,-          -- not a second MPI header.-          ---          -- Re-serialise and inspect the bytes after the ephemeral MPI manually.-          let ephBytes = BL.toStrict (runPut (put ephMPI))-              pktBody =-                -- wire: 0xC1 | varlen | version(1) | keyid(8) | pka(1) | body-                -- skip tag(1) + len(variable) + version(1) + keyid(8) + pka(1)-                -- We just serialise the body directly via putPKESKv3SessionKeyMaterial equivalent:-                BL.toStrict (runPut (put (PKESKPkt (PKESKPayloadV3Packet-                  (PKESKPayloadV3 3 (EightOctetKeyId (BL.replicate 8 0)) ECDH-                    (ephMPI NE.:| [wrappedMPI]))))))-          -- Find the position of the body after tag+len+version+keyid+pka.-          -- Tag: 1 byte; new-format len: 1 or 2 bytes; version: 1; keyid: 8; pka: 1 = 12 or 13 bytes-          -- Instead of parsing the header, just verify the body doesn't start with-          -- the two-byte MPI bit-count of the wrapped key.-          -- After ephBytes in the body, the next byte should be the 1-byte count (24-48),-          -- not the high byte of an MPI bit-count (which would be 0x01 for 383-bit keys).-          -- We search for ephBytes in pktBody and check what follows.-          let stripped = dropPKESKv3Header pktBody-              afterEph = B.drop (B.length ephBytes) stripped-          assertBool-            "PKESKv3 ECDH wire body: after ephemeral MPI there must be at least 1 byte for wrapped-key length"-            (not (B.null afterEph))-          let wrappedLenByte = fromIntegral (B.head afterEph) :: Int-          assertBool-            ("PKESKv3 ECDH wire: wrapped-key length byte " ++-             show wrappedLenByte ++-             " should be a valid RFC 3394 wrapped-key length (24, 32, 40, or 48)")-            (wrappedLenByte `elem` [24, 32, 40, 48])-          assertEqual-            "PKESKv3 ECDH wire: bytes after length field must equal length"-            wrappedLenByte-            (B.length (B.tail afterEph))-        other ->-          assertFailure ("Expected single PKESKv3 ECDH packet after round-trip, got " ++ show other)-  where-    -- Drop the new-format packet header (tag byte + variable-length field +-    -- version byte + 8-byte key-id + pka byte) to reach the session-key material.-    dropPKESKv3Header bs-      | B.length bs < 3 = bs-      | otherwise =-          let lenByte = B.index bs 1-              headerLen-                | lenByte < 192 = 2    -- 1-byte length-                | lenByte < 224 = 3    -- 2-byte length-                | otherwise     = 6    -- 5-byte length (rare)-           in B.drop (headerLen + 1 + 8 + 1) bs-testBuildPKESKv3PayloadForRecipientCurve25519LegacyInterop :: Assertion-testBuildPKESKv3PayloadForRecipientCurve25519LegacyInterop = do-  let recipientSecretRaw = B.pack [1 .. 32]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize Curve25519Legacy recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      recipient =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          ECDH-          (ECDHPubKey-             (EdDSAPubKey Ed25519 (PrefixedNativeEPoint (EPoint (os2ip (B.cons 0x40 recipientPublicRaw)))))-             SHA256-             AES256)-      recipientSKey =-        ECDHPrivateKey-          (ECDSA_PrivateKey-             (ECDSA.PrivateKey (ECCT.getCurveByName ECCT.SEC_p256r1) (os2ip recipientSecretRaw)))-      sessionKey = SessionKey (B.replicate 32 0x22)-      salt = Salt (B.pack [0x40 .. 0x5f])-      payload = "pkesk builder curve25519legacy v3 interop payload"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipient-                , pkeskRecipientSKey = recipientSKey-                }))-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  pkeskPayloadResult <- buildPKESKv3PayloadForRecipient recipient (pkeskV3SessionMaterial sessionMaterial)-  pkeskPayload <--    case pkeskPayloadResult of-      Left err ->-        assertFailure ("buildPKESKv3PayloadForRecipient failed: " ++ show err) >>-        fail "buildPKESKv3PayloadForRecipient failed"-      Right p@(PKESKPayloadV3Packet (PKESKPayloadV3 _ _ ECDH (ephemeralMPI NE.:| _))) -> do-        let ephemeralBytes = i2osp (unMPI ephemeralMPI)-        assertEqual-          "PKESKv3 Curve25519Legacy ephemeral point should be 0x40-prefixed 33-octet value"-          33-          (B.length ephemeralBytes)-        assertEqual-          "PKESKv3 Curve25519Legacy ephemeral point should use RFC6637 0x40 prefix"-          0x40-          (B.head ephemeralBytes)-        pure p-      Right other ->-        assertFailure ("Expected PKESK3 ECDH payload, got " ++ show other) >>-        fail "Unexpected PKESK payload variant"-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList-      [ PKESKPkt pkeskPayload-      , SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))-      ] DC..|-    conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESKv3 Curve25519Legacy interop decrypt payload" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testBuildPKESKv3PayloadForRecipientRejectsCurve448Legacy :: Assertion-testBuildPKESKv3PayloadForRecipientRejectsCurve448Legacy = do-  let recipient =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          ECDH-          (ECDHPubKey-             (EdDSAPubKey Ed448 (PrefixedNativeEPoint (EPoint 1)))-             SHA512-             AES256)-      sessionKey = SessionKey (B.replicate 32 0x23)-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  result <- buildPKESKv3PayloadForRecipient recipient (pkeskV3SessionMaterial sessionMaterial)-  case result of-    Left (InvalidRecipientKeyMaterial ECDH err)-      | "RFC6637-compatible" `isInfixOf` err -> pure ()-      | otherwise ->-          assertFailure-            ("Expected RFC6637 compatibility rejection, got: " ++ err)-    Left err ->-      assertFailure ("Expected InvalidRecipientKeyMaterial ECDH, got " ++ show err)-    Right payload ->-      assertFailure ("Expected RFC6637 compatibility rejection, got payload: " ++ show payload)---- | Conformance test: v6 X25519 PKESK uses raw session key, not v3-encoded material.--- RFC 9580 specifies that v6 X25519 wraps the raw session key directly (no algorithm byte or checksum).--- When the raw 32-byte key is AES-KW wrapped with RFC3394: 32 bytes + 8-byte integrity = 40 bytes.--- If v3-encoded (1 byte algo + 32 bytes key + 2 bytes checksum + ~5 bytes padding = 40 bytes unwrapped),--- the wrapped result would be ~48 bytes, so we verify wrapped size is 40.-testBuildPKESKv6PayloadForRecipientX25519RawKeySemantics :: Assertion-testBuildPKESKv6PayloadForRecipientX25519RawKeySemantics = do-  let recipientSecretRaw = B.pack [1 .. 32]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X25519 recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      v4Recipient =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-      recipient = setKeyVersion V6 v4Recipient-      sessionKey = SessionKey (B.replicate 32 0x24)-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  pkeskPayloadResult <- buildPKESKPayloadForRecipient PreferV6 recipient sessionMaterial-  case pkeskPayloadResult of-    Left err ->-      assertFailure ("buildPKESKPayloadForRecipient failed for v6 X25519: " ++ show err)-    Right (PKESKPayloadV6Packet (PKESKPayloadV6 _ X25519 eskBytesLazy)) -> do-      let eskBytes = BL.toStrict eskBytesLazy-      assertX25519EskShape "v6 X25519 raw-key conformance" eskBytes-      let wrappedLen = fromIntegral (B.index eskBytes 32) :: Int-      assertEqual-        "v6 X25519 wrapped session key (AES-KW RFC3394 of raw 32 bytes) must be 40 bytes"-        40-        wrappedLen-    Right other ->-      assertFailure ("Expected PKESKPayloadV6 with X25519, got " ++ show other)---- | Conformance test: v6 X448 PKESK uses raw session key, not v3-encoded material.--- RFC 9580 specifies that v6 X448 wraps the raw session key directly (no algorithm byte or checksum).--- When the raw 32-byte key is AES-KW wrapped with RFC3394: 32 bytes + 8-byte integrity = 40 bytes.--- If v3-encoded (1 byte algo + 32 bytes key + 2 bytes checksum + ~5 bytes padding = 40 bytes unwrapped),--- the wrapped result would be ~48 bytes, so we verify wrapped size is 40.-testBuildPKESKv6PayloadForRecipientX448RawKeySemantics :: Assertion-testBuildPKESKv6PayloadForRecipientX448RawKeySemantics = do-  let recipientSecretRaw = B.pack [1 .. 56]-      recipientSecret =-        case CE.eitherCryptoError (C448.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X448 recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C448.toPublic recipientSecret) :: B.ByteString-      v4Recipient =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X448-          (EdDSAPubKey Ed448 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-      recipient = setKeyVersion V6 v4Recipient-      sessionKey = SessionKey (B.replicate 32 0x25)-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  pkeskPayloadResult <- buildPKESKPayloadForRecipient PreferV6 recipient sessionMaterial-  case pkeskPayloadResult of-    Left err ->-      assertFailure ("buildPKESKPayloadForRecipient failed for v6 X448: " ++ show err)-    Right (PKESKPayloadV6Packet (PKESKPayloadV6 _ X448 eskBytesLazy)) -> do-      let eskBytes = BL.toStrict eskBytesLazy-      assertX448EskShape "v6 X448 raw-key conformance" eskBytes-      let wrappedLen = fromIntegral (B.index eskBytes 56) :: Int-      assertEqual-        "v6 X448 wrapped session key (AES-KW RFC3394 of raw 32 bytes) must be 40 bytes"-        40-        wrappedLen-    Right other ->-      assertFailure ("Expected PKESKPayloadV6 with X448, got " ++ show other)--testBuildPKESKPayloadForRecipientWithPolicyForceV3Interop :: Assertion-testBuildPKESKPayloadForRecipientWithPolicyForceV3Interop = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let recipient = setKeyVersion V4 baseRecipient-      sessionKey = SessionKey (B.replicate 32 0x16)-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  result <--    buildPKESKPayloadForRecipient ForceV3Interop recipient sessionMaterial-  case result of-    Right (PKESKPayloadV3Packet (PKESKPayloadV3 _ _ RSA _)) -> pure ()-    Right payload ->-      assertFailure ("Expected PKESK3 RSA for ForceV3Interop, got " ++ show payload)-    Left err ->-      assertFailure ("Expected PKESK3 RSA for ForceV3Interop, got error " ++ show err)--testRecipientVersionStrategyForProfileHonorsHints :: Assertion-testRecipientVersionStrategyForProfileHonorsHints = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let recipient = setKeyVersion V6 baseRecipient-  case recipientVersionStrategyForProfile EncryptStrictDefault (recipientEncryptionTargetWithStrategy recipient RecipientForceV3Interop) of-    Right RecipientForceV3Interop -> pure ()-    other ->-      assertFailure ("Expected explicit recipient hint to win, got " ++ show other)-  case recipientVersionStrategyForProfile EncryptInteropLegacy (recipientEncryptionTarget recipient) of-    Right RecipientForceV3Interop -> pure ()-    other ->-      assertFailure ("Expected legacy profile fallback to force v3, got " ++ show other)-  let v4Recipient = setKeyVersion V4 recipient-  case recipientVersionStrategyForProfile EncryptStrictDefault (recipientEncryptionTarget recipient) of-    Right RecipientPreferV6 -> pure ()-    other ->-      assertFailure ("Expected strict profile auto-detect to prefer v6 for v6 recipients, got " ++ show other)-  case recipientVersionStrategyForProfile EncryptStrictDefault (recipientEncryptionTarget v4Recipient) of-    Right RecipientForceV3Interop -> pure ()-    other ->-      assertFailure ("Expected strict profile auto-detect to force v3 for legacy recipients, got " ++ show other)--testEncryptRecipientsWithRequestAutoDetectsMixedRecipientStrategies :: Assertion-testEncryptRecipientsWithRequestAutoDetectsMixedRecipientStrategies = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let v4Recipient = setKeyVersion V4 baseRecipient-      v6Recipient = setKeyVersion V6 baseRecipient-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets =-              [ recipientEncryptionTarget v6Recipient-              , recipientEncryptionTarget v4Recipient-              ]-          , recipientEncryptRequestPayloadShape = defaultRecipientPayloadShape-          , recipientEncryptRequestPayload = "recipient autodetect"-          , recipientEncryptRequestSymmetricOverride = Just AES256-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv2Overrides-                { recipientEncryptRequestAEADOverride = Just OCB-                , recipientEncryptRequestChunkSizeOverride = Just 6-                , recipientEncryptRequestSaltOverride = Just (Salt (B.replicate 32 0x77))-                }-          }-  result <- encryptForRecipients request-  case result of-    Left err ->-      assertFailure ("Expected mixed-recipient request to encrypt successfully, got " ++ show err)-    Right RecipientEncryptResult { recipientEncryptPackets = packets } -> do-      let pkesks = [p | PKESKPkt p <- packets]-      assertBool-        "strict profile auto-detect should emit PKESKv6 for v6 recipients"-        (any isPKESK6 pkesks)-      assertBool-        "strict profile auto-detect should emit PKESKv3 for v4 recipients"-        (any isPKESK3 pkesks)-  where-    isPKESK6 PKESKPayloadV6Packet {} = True-    isPKESK6 _ = False-    isPKESK3 PKESKPayloadV3Packet {} = True-    isPKESK3 _ = False--testEncryptRecipientsNegotiatesSymmetricAlgorithmWhenEnabled :: Assertion-testEncryptRecipientsNegotiatesSymmetricAlgorithmWhenEnabled = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let v4Recipient = setKeyVersion V4 baseRecipient-      v6Recipient = setKeyVersion V6 baseRecipient-      v6Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V6-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.empty-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES128, AES256]-          , recipientCapabilityPreferredAEADAlgorithms = [OCB]-          }-      v4Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V4-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.empty-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES128]-          , recipientCapabilityPreferredAEADAlgorithms = [OCB]-          }-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets =-              [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps-              , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps-              ]-          , recipientEncryptRequestPayloadShape = defaultRecipientPayloadShape-          , recipientEncryptRequestPayload = "recipient capability negotiation payload"-          , recipientEncryptRequestSymmetricOverride = Nothing-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv2Overrides-                { recipientEncryptRequestAEADOverride = Just OCB-                , recipientEncryptRequestChunkSizeOverride = Just 6-                , recipientEncryptRequestSaltOverride = Just (Salt (B.replicate 32 0x22))-                }-          }-  result <- encryptForRecipientsWithCapabilityNegotiation RecipientCapabilityNegotiationOn request-  case result of-    Left err ->-      assertFailure ("Expected recipient capability negotiation to succeed, got " ++ show err)-    Right RecipientEncryptResult { recipientEncryptSessionMaterial = material } ->-      assertEqual-        "capability negotiation should pick common preferred symmetric algorithm"-        AES128-        (pkeskSessionAlgorithm material)--testEncryptRecipientsNegotiatesSymmetricAlgorithmByDefault :: Assertion-testEncryptRecipientsNegotiatesSymmetricAlgorithmByDefault = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let v4Recipient = setKeyVersion V4 baseRecipient-      v6Recipient = setKeyVersion V6 baseRecipient-      v6Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V6-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.empty-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES128, AES256]-          , recipientCapabilityPreferredAEADAlgorithms = [OCB]-          }-      v4Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V4-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.empty-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES128]-          , recipientCapabilityPreferredAEADAlgorithms = [OCB]-          }-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets =-              [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps-              , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps-              ]-          , recipientEncryptRequestPayloadShape = defaultRecipientPayloadShape-          , recipientEncryptRequestPayload = "default recipient capability negotiation payload"-          , recipientEncryptRequestSymmetricOverride = Nothing-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv2Overrides-                { recipientEncryptRequestAEADOverride = Just OCB-                , recipientEncryptRequestChunkSizeOverride = Just 6-                , recipientEncryptRequestSaltOverride = Just (Salt (B.replicate 32 0x24))-                }-          }-  result <- encryptForRecipients request-  case result of-    Left err ->-      assertFailure ("Expected default encryptForRecipients negotiation to succeed, got " ++ show err)-    Right RecipientEncryptResult { recipientEncryptSessionMaterial = material } ->-      assertEqual-        "encryptForRecipients should negotiate recipient capabilities by default"-        AES128-        (pkeskSessionAlgorithm material)--testEncryptRecipientsLegacyKeepsCapabilityNegotiationOptOut :: Assertion-testEncryptRecipientsLegacyKeepsCapabilityNegotiationOptOut = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let v4Recipient = setKeyVersion V4 baseRecipient-      v6Recipient = setKeyVersion V6 baseRecipient-      v6Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V6-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.empty-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES128, AES256]-          , recipientCapabilityPreferredAEADAlgorithms = [OCB]-          }-      v4Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V4-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.empty-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES128]-          , recipientCapabilityPreferredAEADAlgorithms = [OCB]-          }-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets =-              [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps-              , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps-              ]-          , recipientEncryptRequestPayloadShape = defaultRecipientPayloadShape-          , recipientEncryptRequestPayload = "legacy recipient capability opt-out payload"-          , recipientEncryptRequestSymmetricOverride = Nothing-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv2Overrides-                { recipientEncryptRequestAEADOverride = Just OCB-                , recipientEncryptRequestChunkSizeOverride = Just 6-                , recipientEncryptRequestSaltOverride = Just (Salt (B.replicate 32 0x25))-                }-          }-  result <- encryptForRecipientsLegacy request-  case result of-    Left err ->-      assertFailure ("Expected legacy encryptForRecipients opt-out to succeed, got " ++ show err)-    Right RecipientEncryptResult { recipientEncryptSessionMaterial = material } ->-      assertEqual-        "encryptForRecipientsLegacy should preserve policy-default symmetric selection"-        AES256-        (pkeskSessionAlgorithm material)--testEncryptRecipientsNegotiationFailsWithoutCommonSymmetricAlgorithm :: Assertion-testEncryptRecipientsNegotiationFailsWithoutCommonSymmetricAlgorithm = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let v4Recipient = setKeyVersion V4 baseRecipient-      v6Recipient = setKeyVersion V6 baseRecipient-      v6Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V6-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.empty-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES128]-          , recipientCapabilityPreferredAEADAlgorithms = [OCB]-          }-      v4Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V4-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.empty-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES256]-          , recipientCapabilityPreferredAEADAlgorithms = [OCB]-          }-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets =-              [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps-              , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps-              ]-          , recipientEncryptRequestPayloadShape = defaultRecipientPayloadShape-          , recipientEncryptRequestPayload = "recipient capability mismatch payload"-          , recipientEncryptRequestSymmetricOverride = Nothing-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv2Overrides-                { recipientEncryptRequestAEADOverride = Just OCB-                , recipientEncryptRequestChunkSizeOverride = Just 6-                , recipientEncryptRequestSaltOverride = Just (Salt (B.replicate 32 0x23))-                }-          }-  result <- encryptForRecipientsWithCapabilityNegotiation RecipientCapabilityNegotiationOn request-  case result of-    Left (RecipientCapabilitySelectionFailure (RecipientCapabilityNoCommonSymmetricAlgorithms _)) -> pure ()-    Left other ->-      assertFailure ("Expected RecipientCapabilityNoCommonSymmetricAlgorithms, got " ++ show other)-    Right _ ->-      assertFailure "Expected recipient capability negotiation to fail without common symmetric algorithm"--testRecipientCapabilitiesFromSubpacketPayloadsExtractsPreferredAEADAlgorithms :: Assertion-testRecipientCapabilitiesFromSubpacketPayloadsExtractsPreferredAEADAlgorithms = do-  (recipient, _privateKey) <- loadUnencryptedRsaSigner-  let caps =-        recipientCapabilitiesFromSubpacketPayloads-          recipient-          [OtherSigSub 39 (BL.pack [9, 2, 7, 3, 9, 2])]-  assertEqual-    "preferred AEAD ciphersuites subpacket should extract unique AEAD preferences in declaration order"-    [OCB, GCM]-    (recipientCapabilityPreferredAEADAlgorithms caps)--testEncryptRecipientsNegotiatesAEADAlgorithmWhenEnabled :: Assertion-testEncryptRecipientsNegotiatesAEADAlgorithmWhenEnabled = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let v4Recipient = setKeyVersion V4 baseRecipient-      v6Recipient = setKeyVersion V6 baseRecipient-      v6Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V6-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.fromList [FeatureSEIPDv1, FeatureSEIPDv2]-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES128, AES256]-          , recipientCapabilityPreferredAEADAlgorithms = [GCM, OCB]-          }-      v4Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V4-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.fromList [FeatureSEIPDv1, FeatureSEIPDv2]-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES128]-          , recipientCapabilityPreferredAEADAlgorithms = [GCM]-          }-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets =-              [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps-              , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps-              ]-          , recipientEncryptRequestPayloadShape = defaultRecipientPayloadShape-          , recipientEncryptRequestPayload = "recipient AEAD capability negotiation payload"-          , recipientEncryptRequestSymmetricOverride = Nothing-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv2Overrides-                { recipientEncryptRequestAEADOverride = Nothing-                , recipientEncryptRequestChunkSizeOverride = Just 6-                , recipientEncryptRequestSaltOverride = Just (Salt (B.replicate 32 0x26))-                }-          }-  result <- encryptForRecipientsWithCapabilityNegotiation RecipientCapabilityNegotiationOn request-  case result of-    Left err ->-      assertFailure ("Expected AEAD capability negotiation to succeed, got " ++ show err)-    Right RecipientEncryptResult { recipientEncryptPackets = packets-                                 , recipientEncryptSessionMaterial = material-                                 } -> do-      assertEqual-        "AEAD capability negotiation should preserve symmetric negotiation"-        AES128-        (pkeskSessionAlgorithm material)-      case [aa | SymEncIntegrityProtectedDataPkt (SEIPD2 _ aa _ _ _) <- packets] of-        [selectedAEAD] ->-          assertEqual-            "AEAD capability negotiation should pick common preferred AEAD algorithm"-            GCM-            selectedAEAD-        other ->-          assertFailure ("Expected one SEIPDv2 packet, got " ++ show other)--testEncryptRecipientsNegotiationFailsWithoutCommonAEADAlgorithm :: Assertion-testEncryptRecipientsNegotiationFailsWithoutCommonAEADAlgorithm = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let v4Recipient = setKeyVersion V4 baseRecipient-      v6Recipient = setKeyVersion V6 baseRecipient-      v6Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V6-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.fromList [FeatureSEIPDv1, FeatureSEIPDv2]-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES256]-          , recipientCapabilityPreferredAEADAlgorithms = [OCB]-          }-      v4Caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V4-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.fromList [FeatureSEIPDv1, FeatureSEIPDv2]-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES256]-          , recipientCapabilityPreferredAEADAlgorithms = [GCM]-          }-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets =-              [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps-              , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps-              ]-          , recipientEncryptRequestPayloadShape = defaultRecipientPayloadShape-          , recipientEncryptRequestPayload = "recipient AEAD mismatch payload"-          , recipientEncryptRequestSymmetricOverride = Just AES256-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv2Overrides-                { recipientEncryptRequestAEADOverride = Nothing-                , recipientEncryptRequestChunkSizeOverride = Just 6-                , recipientEncryptRequestSaltOverride = Just (Salt (B.replicate 32 0x27))-                }-          }-  result <- encryptForRecipientsWithCapabilityNegotiation RecipientCapabilityNegotiationOn request-  case result of-    Left (RecipientCapabilitySelectionFailure (RecipientCapabilityNoCommonAEADAlgorithms _)) -> pure ()-    Left other ->-      assertFailure ("Expected RecipientCapabilityNoCommonAEADAlgorithms, got " ++ show other)-    Right _ ->-      assertFailure "Expected recipient capability negotiation to fail without common AEAD algorithm"--testEncryptRecipientsSEIPDv2FallsBackWhenRecipientsDoNotAdvertiseV2 :: Assertion-testEncryptRecipientsSEIPDv2FallsBackWhenRecipientsDoNotAdvertiseV2 = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let v4Recipient = setKeyVersion V4 baseRecipient-      v6Recipient = setKeyVersion V6 baseRecipient-      sharedCaps keyVersion recipient =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = keyVersion-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.singleton FeatureSEIPDv1-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES256]-          , recipientCapabilityPreferredAEADAlgorithms = [OCB]-          }-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets =-              [ recipientEncryptionTargetWithCapabilities v6Recipient (sharedCaps V6 v6Recipient)-              , recipientEncryptionTargetWithCapabilities v4Recipient (sharedCaps V4 v4Recipient)-              ]-          , recipientEncryptRequestPayloadShape = defaultRecipientPayloadShape-          , recipientEncryptRequestPayload = "recipient seipd fallback payload"-          , recipientEncryptRequestSymmetricOverride = Just AES256-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv2Overrides-                { recipientEncryptRequestAEADOverride = Nothing-                , recipientEncryptRequestChunkSizeOverride = Just 6-                , recipientEncryptRequestSaltOverride = Just (Salt (B.replicate 32 0x28))-                }-          }-  result <- encryptForRecipients request-  case result of-    Left err ->-      assertFailure ("Expected fallback to SEIPDv1 when recipients do not advertise SEIPDv2, got " ++ show err)-    Right RecipientEncryptResult { recipientEncryptPackets = packets } -> do-      let seipdPkts = [p | SymEncIntegrityProtectedDataPkt p <- packets]-      case seipdPkts of-        [SEIPD1 1 _] -> pure ()-        [SEIPD2 {}] -> assertFailure "Expected SEIPDv1 fallback when recipients do not advertise SEIPDv2 support"-        other -> assertFailure ("Unexpected SEIPD packets: " ++ show other)--testEncryptRecipientsRejectsSEIPDv1WhenRecipientsDoNotAdvertiseMDC :: Assertion-testEncryptRecipientsRejectsSEIPDv1WhenRecipientsDoNotAdvertiseMDC = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let v4Recipient = setKeyVersion V4 baseRecipient-      caps =-        RecipientCapabilities-          { recipientCapabilityKeyVersion = V4-          , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient-          , recipientCapabilityKeyFlags = Set.empty-          , recipientCapabilityFeatures = Set.singleton FeatureSEIPDv2-          , recipientCapabilityPreferredSymmetricAlgorithms = [AES256]-          , recipientCapabilityPreferredAEADAlgorithms = [OCB]-          }-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets =-              [recipientEncryptionTargetWithCapabilities v4Recipient caps]-          , recipientEncryptRequestPayloadShape = defaultRecipientPayloadShape-          , recipientEncryptRequestPayload = "recipient seipd v1 capability failure payload"-          , recipientEncryptRequestSymmetricOverride = Just AES256-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv1Overrides-                { recipientEncryptRequestIVOverride = Nothing-                }-          }-  result <- encryptForRecipients request-  case result of-    Left (RecipientCapabilitySelectionFailure (RecipientCapabilityMissingSEIPDv1Support _)) -> pure ()-    Left other ->-      assertFailure ("Expected RecipientCapabilityMissingSEIPDv1Support, got " ++ show other)-    Right _ ->-      assertFailure "Expected SEIPDv1 encryption to fail when recipients do not advertise MDC support"--testRecipientEncryptionTargetsFromTKIncludesOnlyEncryptionCapableKeys :: Assertion-testRecipientEncryptionTargetsFromTKIncludesOnlyEncryptionCapableKeys = do-  (signingPrimary, _signingKey) <- loadDeterministicEd25519Signer-  (baseEncryptingSubkey, _privateKey) <- loadUnencryptedRsaSigner-  let tkUnknown =-        TKUnknown-          { _tkuKey = (signingPrimary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs =-              [ ( PublicSubkeyPkt (setKeyTimestamp (_timestamp signingPrimary) baseEncryptingSubkey)-                , []-                )-              ]-          }-      tk =-        case fromUnknownToTK tkUnknown of-          Right (SomePublicTK publicTk) -> publicTk-          Right (SomeSecretTK _) -> error "expected public TK for recipient target test"-          Left err -> error err-      encryptingSubkey = setKeyTimestamp (_timestamp signingPrimary) baseEncryptingSubkey-      targets = recipientEncryptionTargetsFromTK tk-  assertEqual "TKUnknown-derived targets should include only encryption-capable keys" 1 (length targets)-  case targets of-    [target] ->-      assertEqual-        "TKUnknown-derived target should preserve selected encryption key"-        (fingerprint encryptingSubkey)-        (fingerprint (recipientEncryptionTargetKey target))-    _ ->-      assertFailure "Expected exactly one encryption-capable target"--testRecipientEncryptionTargetFromTKPrefersSubkeyOverPrimary :: Assertion-testRecipientEncryptionTargetFromTKPrefersSubkeyOverPrimary = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let primary = setKeyVersion V4 baseRecipient-      subkey = setKeyVersion V6 baseRecipient-      tkUnknown =-        TKUnknown-          { _tkuKey = (primary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = [(PublicSubkeyPkt subkey, [])]-          }-      tk =-        case fromUnknownToTK tkUnknown of-          Right (SomePublicTK publicTk) -> publicTk-          Right (SomeSecretTK _) -> error "expected public TK for recipient target selection test"-          Left err -> error err-  case recipientEncryptionTargetFromTK tk of-    Right target ->-      assertEqual-        "TKUnknown-derived single target should prioritize encryption subkeys"-        (fingerprint subkey)-        (fingerprint (recipientEncryptionTargetKey target))-    Left err ->-      assertFailure ("Expected TKUnknown-derived target selection to succeed, got " ++ show err)--testRecipientEncryptionTargetFromTKRejectsTKWithoutEncryptableKeys :: Assertion-testRecipientEncryptionTargetFromTKRejectsTKWithoutEncryptableKeys = do-  (signingPrimary, _signingKey) <- loadDeterministicEd25519Signer-  let tkUnknown =-        TKUnknown-          { _tkuKey = (signingPrimary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = []-          }-      tk =-        case fromUnknownToTK tkUnknown of-          Right (SomePublicTK publicTk) -> publicTk-          Right (SomeSecretTK _) -> error "expected public TK for recipient rejection test"-          Left err -> error err-  case recipientEncryptionTargetFromTK tk of-    Left RecipientCapabilityNoEncryptableKeyMaterialInTK -> pure ()-    Left other ->-      assertFailure ("Expected RecipientCapabilityNoEncryptableKeyMaterialInTK, got " ++ show other)-    Right _ ->-      assertFailure "Expected TKUnknown-derived target selection to reject non-encryptable TKs"--testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsRejections :: Assertion-testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsRejections = do-  (baseKey, signingKey) <- loadUnencryptedRsaSigner-  let signatureTime = ThirtyTwoBitTimeStamp 1700000000-      primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey-      subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey-  subkeyBindingSig <--    signSubkeyBindingWithRSAExtrasAt-      primary-      subkey-      signingKey-      signatureTime-      [SigSubPacket False (KeyFlags (Set.fromList [SignDataKey]))]-  let tk =-        TKUnknown-          { _tkuKey = (primary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]-          }-      report = recipientEncryptionTargetsReportFromTKAtTimestamp signatureTime tk-      acceptedFps =-        map (fingerprint . recipientEncryptionTargetKey) (recipientEncryptionTargetsAccepted report)-      rejectedReasons =-        map recipientEncryptionTargetRejectedReason (recipientEncryptionTargetsRejected report)-  assertBool-    "report should keep encryption-eligible primary key as accepted"-    (fingerprint primary `elem` acceptedFps)-  assertEqual-    "report should explain sign-only subkey rejection"-    [RecipientTargetMissingEncryptionFlags subkey (Set.fromList [SignDataKey])]-    rejectedReasons--testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsUnsupportedAlgorithms :: Assertion-testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsUnsupportedAlgorithms = do-  (signingPrimary, _signingKey) <- loadDeterministicEd25519Signer-  let tk =-        TKUnknown-          { _tkuKey = (signingPrimary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = []-          }-      report =-        recipientEncryptionTargetsReportFromTKAtTimestamp-          (_timestamp signingPrimary)-          tk-  assertEqual-    "unsupported key algorithms should be surfaced in report rejections"-    [RecipientTargetUnsupportedAlgorithm (_pkalgo signingPrimary)]-    (map recipientEncryptionTargetRejectedReason (recipientEncryptionTargetsRejected report))--testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsExpiredSubkey :: Assertion-testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsExpiredSubkey = do-  (baseKey, signingKey) <- loadUnencryptedRsaSigner-  let signatureTime = ThirtyTwoBitTimeStamp 1700000000-      targetTime = ThirtyTwoBitTimeStamp 1700000020-      primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey-      subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey-  subkeyBindingSig <--    signSubkeyBindingWithRSAExtrasAt-      primary-      subkey-      signingKey-      signatureTime-      [ SigSubPacket False (KeyFlags (Set.fromList [EncryptCommunicationsKey]))-      , SigSubPacket False (KeyExpirationTime (ThirtyTwoBitDuration 5))-      ]-  let tk =-        TKUnknown-          { _tkuKey = (primary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]-          }-      report = recipientEncryptionTargetsReportFromTKAtTimestamp targetTime tk-      rejectedReasons = map recipientEncryptionTargetRejectedReason (recipientEncryptionTargetsRejected report)-  assertBool-    "expired subkey should be rejected from recipient targets"-    (RecipientTargetNotValidAtTimestamp subkey targetTime `elem` rejectedReasons)--testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsRevokedSubkey :: Assertion-testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsRevokedSubkey = do-  (baseKey, signingKey) <- loadUnencryptedRsaSigner-  let bindingTime = ThirtyTwoBitTimeStamp 1700000000-      revocationTime = ThirtyTwoBitTimeStamp 1700000005-      targetTime = ThirtyTwoBitTimeStamp 1700000010-      primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey-      subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey-  subkeyBindingSig <--    signSubkeyBindingWithRSAExtrasAt-      primary-      subkey-      signingKey-      bindingTime-      [SigSubPacket False (KeyFlags (Set.fromList [EncryptCommunicationsKey]))]-  subkeyRevocationSig <--    signSubkeyRevocationWithRSAAt-      primary-      subkey-      signingKey-      revocationTime-  let tk =-        TKUnknown-          { _tkuKey = (primary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig, subkeyRevocationSig])]-          }-      report = recipientEncryptionTargetsReportFromTKAtTimestamp targetTime tk-      rejectedReasons = map recipientEncryptionTargetRejectedReason (recipientEncryptionTargetsRejected report)-  assertBool-    "revoked subkey should be rejected from recipient targets"-    (RecipientTargetRevoked subkey `elem` rejectedReasons)--testRecipientEncryptionTargetsFromTKAtTimestampExtractsSelfSigCapabilities :: Assertion-testRecipientEncryptionTargetsFromTKAtTimestampExtractsSelfSigCapabilities = do-  (primary, signingKey) <- loadUnencryptedRsaSigner-  (subkey, _privateKey) <- loadUnencryptedRsaSigner-  let signatureTime = ThirtyTwoBitTimeStamp 1700000000-  directKeySig <--    signDirectKeyWithRSAExtrasAt-      primary-      signingKey-      signatureTime-      [ SigSubPacket False (PreferredSymmetricAlgorithms [AES128])-      , SigSubPacket False (OtherSigSub 39 (BL.pack [9, 2, 7, 3]))-      ]-  subkeyBindingSig <--    signSubkeyBindingWithRSAExtrasAt-      primary-      subkey-      signingKey-      signatureTime-      [SigSubPacket False (KeyFlags (Set.fromList [EncryptCommunicationsKey]))]-  let tk =-        TKUnknown-          { _tkuKey = (primary, Nothing)-          , _tkuRevs = [directKeySig]-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]-          }-      targets = recipientEncryptionTargetsFromTKAtTimestamp signatureTime tk-  case targets of-    (target:_) ->-      case recipientEncryptionTargetCapabilities target of-        Nothing ->-          assertFailure "Expected TKUnknown-derived target to include extracted capabilities"-        Just caps -> do-          assertEqual-            "self-signature capability extraction should include primary-key symmetric preferences"-            [AES128]-            (recipientCapabilityPreferredSymmetricAlgorithms caps)-          assertEqual-            "self-signature capability extraction should include primary-key preferred AEAD algorithms"-            [OCB, GCM]-            (recipientCapabilityPreferredAEADAlgorithms caps)-          assertEqual-            "self-signature capability extraction should include subkey key flags"-            (Set.fromList [EncryptCommunicationsKey])-            (recipientCapabilityKeyFlags caps)-    [] ->-      assertFailure "Expected at least one TKUnknown-derived target"--testRecipientEncryptionTargetFromTKAtTimestampAppliesTimestampFiltering :: Assertion-testRecipientEncryptionTargetFromTKAtTimestampAppliesTimestampFiltering = do-  (primary, signingKey) <- loadUnencryptedRsaSigner-  (subkey, _privateKey) <- loadUnencryptedRsaSigner-  let signatureTime = ThirtyTwoBitTimeStamp 1700000100-      beforeSignature = ThirtyTwoBitTimeStamp 1699999999-  subkeyBindingSig <--    signSubkeyBindingWithRSAExtrasAt-      primary-      subkey-      signingKey-      signatureTime-      [SigSubPacket False (KeyFlags (Set.fromList [EncryptCommunicationsKey]))]-  let tk =-        TKUnknown-          { _tkuKey = (primary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]-          }-  case recipientEncryptionTargetFromTKAtTimestamp beforeSignature tk of-    Left err ->-      assertFailure ("Expected timestamp-scoped TKUnknown target selection to succeed, got " ++ show err)-    Right target ->-      case recipientEncryptionTargetCapabilities target of-        Nothing ->-          assertFailure "Expected TKUnknown-derived target to include capabilities when timestamp-scoped"-        Just caps ->-          assertEqual-            "subkey binding created after target timestamp should not contribute key flags"-            Set.empty-            (recipientCapabilityKeyFlags caps)--testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersPrimary :: Assertion-testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersPrimary = do-  (baseKey, signingKey) <- loadUnencryptedRsaSigner-  let signatureTime = ThirtyTwoBitTimeStamp 1700000000-      primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey-      subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey-  subkeyBindingSig <--    signSubkeyBindingWithRSAExtrasAt-      primary-      subkey-      signingKey-      signatureTime-      [SigSubPacket False (KeyFlags (Set.fromList [EncryptCommunicationsKey]))]-  let tk =-        TKUnknown-          { _tkuKey = (primary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]-          }-  case recipientEncryptionTargetFromTKAtTimestampWithPolicy RecipientTargetSelectionPreferPrimary signatureTime tk of-    Left err ->-      assertFailure ("Expected policy-based recipient selection to succeed, got " ++ show err)-    Right target ->-      assertEqual-        "prefer-primary policy should select primary key when both primary and subkey are valid"-        (fingerprint primary)-        (fingerprint (recipientEncryptionTargetKey target))--testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersNewest :: Assertion-testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersNewest = do-  (baseKey, signingKey) <- loadUnencryptedRsaSigner-  let signatureTime = ThirtyTwoBitTimeStamp 1700000000-      primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey-      subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000002) baseKey-  subkeyBindingSig <--    signSubkeyBindingWithRSAExtrasAt-      primary-      subkey-      signingKey-      signatureTime-      [SigSubPacket False (KeyFlags (Set.fromList [EncryptCommunicationsKey]))]-  let tk =-        TKUnknown-          { _tkuKey = (primary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]-          }-  case recipientEncryptionTargetFromTKAtTimestampWithPolicy RecipientTargetSelectionPreferNewestCreationTime signatureTime tk of-    Left err ->-      assertFailure ("Expected policy-based recipient selection to succeed, got " ++ show err)-    Right target ->-      assertEqual-        "prefer-newest policy should select newest valid key"-        (fingerprint subkey)-        (fingerprint (recipientEncryptionTargetKey target))--testRecipientEncryptionTargetsFromTKRejectsKeyWithNonEncryptFlags :: Assertion-testRecipientEncryptionTargetsFromTKRejectsKeyWithNonEncryptFlags = do-  (baseKey, signingKey) <- loadUnencryptedRsaSigner-  let signatureTime = ThirtyTwoBitTimeStamp 1700000000-      primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey-      subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey-  subkeyBindingSig <--    signSubkeyBindingWithRSAExtrasAt-      primary-      subkey-      signingKey-      signatureTime-      [SigSubPacket False (KeyFlags (Set.fromList [SignDataKey]))]-  let tk =-        TKUnknown-          { _tkuKey = (primary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]-          }-      targets = recipientEncryptionTargetsFromTKAtTimestamp signatureTime tk-  let subkeyFp = fingerprint subkey-      primaryFp = fingerprint primary-      targetFps = map (fingerprint . recipientEncryptionTargetKey) targets-  assertBool-    "subkey with sign-only key flags should be excluded from encryption targets"-    (subkeyFp `notElem` targetFps)-  assertBool-    "primary key (no explicit flags) should still be included as encryption target"-    (primaryFp `elem` targetFps)--testRecipientEncryptionTargetsFromTKIncludesKeyWithNoFlags :: Assertion-testRecipientEncryptionTargetsFromTKIncludesKeyWithNoFlags = do-  (baseKey, signingKey) <- loadUnencryptedRsaSigner-  let signatureTime = ThirtyTwoBitTimeStamp 1700000000-      primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey-      subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey-  subkeyBindingSig <--    signSubkeyBindingWithRSAExtrasAt-      primary-      subkey-      signingKey-      signatureTime-      []-  let tk =-        TKUnknown-          { _tkuKey = (primary, Nothing)-          , _tkuRevs = []-          , _tkuUIDs = []-          , _tkuUAts = []-          , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]-          }-      targets = recipientEncryptionTargetsFromTKAtTimestamp signatureTime tk-  let subkeyFp = fingerprint subkey-      targetFps = map (fingerprint . recipientEncryptionTargetKey) targets-  assertBool-    "subkey with no key flags should be included as encryption target (legacy-compatible)"-    (subkeyFp `elem` targetFps)--testEncryptRecipientsWithRequestEmitsOnePassSignatures :: Assertion-testEncryptRecipientsWithRequestEmitsOnePassSignatures = do-  (baseRecipient, privateKey) <- loadUnencryptedRsaSigner-  let recipient = setKeyVersion V6 baseRecipient-      signature =-        SigV4-          BinarySig-          RSA-          SHA256-          []-          [SigSubPacket False (Issuer (EightOctetKeyId (BL.pack [0x01 .. 0x08])))]-          0-          (MPI 1 :| [])-      payload = "recipient one-pass signature payload"-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets = [recipientEncryptionTarget recipient]-          , recipientEncryptRequestPayloadShape =-              defaultRecipientPayloadShape-                { recipientPayloadUseOnePassSignatures = True-                , recipientPayloadSignatures = [signature]-                }-          , recipientEncryptRequestPayload = payload-          , recipientEncryptRequestSymmetricOverride = Just AES256-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv2Overrides-                { recipientEncryptRequestAEADOverride = Just OCB-                , recipientEncryptRequestChunkSizeOverride = Just 6-                , recipientEncryptRequestSaltOverride = Just (Salt (B.replicate 32 0x55))-                }-          }-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipient-                , pkeskRecipientSKey = RSAPrivateKey (RSA_PrivateKey privateKey)-                }))-      passphraseCallback _ = pure BL.empty-  result <- encryptForRecipients request-  packets <--    case result of-      Left err ->-        assertFailure ("Expected one-pass encryption request to succeed, got " ++ show err) >>-        fail "encryptForRecipients failed"-      Right RecipientEncryptResult { recipientEncryptPackets = encryptedPackets } -> pure encryptedPackets-  decrypted <--    DC.runConduitRes $-    CL.sourceList packets DC..|-    conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [OnePassSignaturePkt (OPSPayloadV3Packet (OPSPayloadV3 3 BinarySig SHA256 RSA _ False)), LiteralDataPkt _ _ _ gotPayload, SignaturePkt _] ->-      assertEqual "decrypted payload matches original plaintext" (BL.fromStrict payload) gotPayload-    other ->-      assertFailure ("Expected decrypted [OPS3, LiteralData, Signature], got " ++ show other)--testEncryptRecipientsWithRequestRejectsOnePassWhenIssuerMetadataMissing :: Assertion-testEncryptRecipientsWithRequestRejectsOnePassWhenIssuerMetadataMissing = do-  (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner-  let recipient = setKeyVersion V6 baseRecipient-      signature = SigV4 BinarySig RSA SHA256 [] [] 0 (MPI 1 :| [])-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets = [recipientEncryptionTarget recipient]-          , recipientEncryptRequestPayloadShape =-              defaultRecipientPayloadShape-                { recipientPayloadUseOnePassSignatures = True-                , recipientPayloadSignatures = [signature]-                }-          , recipientEncryptRequestPayload = "recipient one-pass missing issuer metadata payload"-          , recipientEncryptRequestSymmetricOverride = Just AES256-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv2Overrides-                { recipientEncryptRequestAEADOverride = Just OCB-                , recipientEncryptRequestChunkSizeOverride = Just 6-                , recipientEncryptRequestSaltOverride = Just (Salt (B.replicate 32 0x56))-                }-          }-  result <- encryptForRecipients request-  case result of-    Left (PayloadBuildFailure err) ->-      assertBool-        "missing issuer metadata should surface as payload build failure"-        ("without issuer metadata" `isInfixOf` err)-    Left err ->-      assertFailure ("Expected PayloadBuildFailure for missing OPS issuer metadata, got " ++ show err)-    Right _ ->-      assertFailure "Expected one-pass request without issuer metadata to fail"--testEncryptInteropLegacyProducesSEIPDv1 :: Assertion-testEncryptInteropLegacyProducesSEIPDv1 = do-  (recipient, privateKey) <- loadUnencryptedRsaSigner-  let iv = IV (B.replicate 16 0xAB)-      payload = "legacy interop payload"-      request =-        RecipientEncryptRequest-          { recipientEncryptRequestTargets = [recipientEncryptionTarget recipient]-          , recipientEncryptRequestPayloadShape = defaultRecipientPayloadShape-          , recipientEncryptRequestPayload = payload-          , recipientEncryptRequestSymmetricOverride = Just AES256-          , recipientEncryptRequestOverrides =-              RecipientEncryptRequestSEIPDv1Overrides-                { recipientEncryptRequestIVOverride = Just iv-                }-          }-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipient-                , pkeskRecipientSKey = RSAPrivateKey (RSA_PrivateKey privateKey)-                }))-      passphraseCallback _ = pure BL.empty-  result <- encryptForRecipients request-  packets <--    case result of-      Left err ->-        assertFailure-          ("Expected EncryptInteropLegacy request to succeed, got " ++ show err) >>-        fail "encryptForRecipients failed"-      Right RecipientEncryptResult { recipientEncryptPackets = ps } -> pure ps-  let seipdPkts = [p | SymEncIntegrityProtectedDataPkt p <- packets]-  case seipdPkts of-    [SEIPD1 1 _] -> pure ()-    [SEIPD2 {}]  -> assertFailure "Expected SEIPDv1 but got SEIPDv2"-    other        -> assertFailure ("Unexpected SEIPD packets: " ++ show other)-  let pkeskPkts = [p | PKESKPkt p <- packets]-  assertBool "EncryptInteropLegacy should emit PKESKv3 packets" $-    all (\p -> case p of { PKESKPayloadV3Packet {} -> True; _ -> False }) pkeskPkts-  decrypted <--    DC.runConduitRes $-    CL.sourceList packets DC..|-    conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual-        "decrypted legacy interop payload matches original"-        (BL.fromStrict payload)-        gotPayload-    other ->-      assertFailure ("Expected [LiteralData] from legacy decrypt, got " ++ show other)--testCanonicalizePKESKRecipientIdHelper :: Assertion-testCanonicalizePKESKRecipientIdHelper = do-  let rid = BL.pack (0x04 : replicate 20 0x11)-      payload = PKESKPayloadV6Packet (PKESKPayloadV6 rid RSA "esk")-  case canonicalizePKESKRecipientId payload of-    Right (PKESKPayloadV6Packet (PKESKPayloadV6 normalized _ _))-      | BL.length normalized == 20 -> pure ()-      | otherwise ->-          assertFailure ("Expected canonicalized recipient id length 20, got " ++ show (BL.length normalized))-    Left err ->-      assertFailure ("canonicalizePKESKRecipientId failed unexpectedly: " ++ show err)-    Right other ->-      assertFailure ("Expected PKESK6 payload after canonicalization, got " ++ show other)-  case canonicalizePKESKRecipientId (PKESKPayloadV6Packet (PKESKPayloadV6 (BL.replicate 19 0x22) RSA "esk")) of-    Left (InvalidRecipientIdentifier _) -> pure ()-    other ->-      assertFailure ("Expected InvalidRecipientIdentifier for malformed rid, got " ++ show other)-  case canonicalizePKESKRecipientId (PKESKPayloadV6Packet (PKESKPayloadV6 (BL.pack (0x06 : replicate 32 0x33)) RSA "esk")) of-    Right (PKESKPayloadV6Packet (PKESKPayloadV6 normalized _ _))-      | BL.length normalized == 32 -> pure ()-      | otherwise ->-          assertFailure ("Expected canonicalized v6 recipient id length 32, got " ++ show (BL.length normalized))-    other ->-      assertFailure ("Expected 0x06-prefixed v6 recipient id to canonicalize, got " ++ show other)-  case canonicalizePKESKRecipientId (PKESKPayloadV6Packet (PKESKPayloadV6 (BL.pack (0x04 : replicate 32 0x44)) RSA "esk")) of-    Left (InvalidRecipientIdentifier _) -> pure ()-    other ->-      assertFailure-        ("Expected InvalidRecipientIdentifier for mismatched v4-prefixed v6-length rid, got " ++-         show other)--testBuildPKESKPayloadUnsupportedRecipient :: Assertion-testBuildPKESKPayloadUnsupportedRecipient = do-  let recipient =-        PKPayload-          V6-          (ThirtyTwoBitTimeStamp 0)-          0-          EdDSA-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint 1)))-      sessionKey = SessionKey (B.replicate 32 0x19)-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  result <- buildPKESKPayloadForRecipient PreferV6 recipient sessionMaterial-  case result of-    Left (UnsupportedRecipientAlgorithm EdDSA) -> pure ()-    Left err ->-     assertFailure ("Expected UnsupportedRecipientAlgorithm EdDSA, got " ++ show err)-    Right payload ->-     assertFailure ("Expected UnsupportedRecipientAlgorithm, got payload: " ++ show payload)--testBuildPKESKPayloadRejectsECDHSHA1 :: Assertion-testBuildPKESKPayloadRejectsECDHSHA1 = do-  let (recipientPub, _) = syntheticNISTP256Low-      recipient =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          ECDH-          (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey recipientPub)) SHA1 AES256)-      sessionKey = SessionKey (B.replicate 32 0x19)-  sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey-  result <- buildPKESKPayloadForRecipient PreferV6 recipient sessionMaterial-  case result of-    Left (RecipientKdfFailure ECDH err)-      | "SHA1 is disallowed by policy" `isInfixOf` err -> pure ()-      | otherwise ->-          assertFailure-            ("Expected SHA1 policy rejection in RecipientKdfFailure, got: " ++ err)-    Left err ->-     assertFailure ("Expected RecipientKdfFailure ECDH for SHA1, got " ++ show err)-    Right payload ->-     assertFailure ("Expected SHA1 policy rejection, got payload: " ++ show payload)--testConduitDecryptSEIPDv2FixtureWithMatchingV6SecretKey :: Assertion-testConduitDecryptSEIPDv2FixtureWithMatchingV6SecretKey = do-  armoredMessage <- readFixtureStrict "seipdv2.pgp.aa"-  armoredEncryptedSecret <- readFixtureStrict "v6-encrypted-secret.pgp.aa"-  armoredPlainSecret <- readFixtureStrict "v6-secret.pgp.aa"-  passphrase <- readPKIPassphrase-  messageArmors <--    case (AA.decode armoredMessage :: Either String [Armor]) of-      Left err -> assertFailure ("failed to decode seipdv2 armor: " ++ err) >> pure []-      Right as -> pure as-  encryptedSecretArmors <--    case (AA.decode armoredEncryptedSecret :: Either String [Armor]) of-      Left err ->-        assertFailure ("failed to decode v6 encrypted secret armor: " ++ err) >> pure []-      Right as -> pure as-  plainSecretArmors <--    case (AA.decode armoredPlainSecret :: Either String [Armor]) of-      Left err ->-        assertFailure ("failed to decode v6 plain secret armor: " ++ err) >> pure []-      Right as -> pure as-  messageBody <--    case messageArmors of-      (a:_) -> pure (armorPayload a)-      [] -> assertFailure "seipdv2 armor file contained no armor blocks" >> pure mempty-  encryptedSecretBody <--    case encryptedSecretArmors of-      (a:_) -> pure (armorPayload a)-      [] ->-        assertFailure "v6-encrypted-secret armor file contained no armor blocks" >>-        pure mempty-  plainSecretBody <--    case plainSecretArmors of-      (a:_) -> pure (armorPayload a)-      [] ->-        assertFailure "v6-secret armor file contained no armor blocks" >>-        pure mempty-  let messagePackets = parsePkts messageBody-      encryptedSecretPackets = parsePkts encryptedSecretBody-      plainSecretPackets = parsePkts plainSecretBody-      passphraseCallback _ = pure BL.empty-  encryptedKeyInfos <- collectSecretKeyInfos encryptedSecretPackets passphrase-  plainKeyInfos <- collectSecretKeyInfos plainSecretPackets passphrase-  let allKeyInfos = encryptedKeyInfos ++ plainKeyInfos-      keyContextCallback pkt = pure (selectRecipientKeyInfo pkt allKeyInfos)-      recipientKeyInfo =-        case [pkt | pkt@(PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 _ _ _))) <- messagePackets] of-          (pkt:_) -> selectRecipientKeyInfo pkt allKeyInfos-          [] -> listToMaybe allKeyInfos-  case recipientKeyInfo of-    Nothing ->-      assertFailure-        ("no usable secret key material found in v6-encrypted-secret fixture: " ++-         show-           ([(_pkalgo pkp, ska) | SecretKeyPkt pkp ska <- encryptedSecretPackets] ++-            [(_pkalgo pkp, ska) | SecretSubkeyPkt pkp ska <- encryptedSecretPackets]))-    Just _ -> do-      decrypted <--        DC.runConduitRes $-        CL.sourceList messagePackets DC..|-        conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..|-        CL.consume-      case [p | LiteralDataPkt _ _ _ p <- decrypted] of-        (payload:_) ->-          if BL.null payload-            then assertFailure "fixture decrypt produced empty literal payload"-            else pure ()-        [] ->-          assertFailure-            ("expected decrypted literal payload from seipdv2 fixture, got: " ++-             show decrypted)--testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKey :: Assertion-testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKey = do-  (messagePackets, encryptedSecretPackets, passphrase) <--    loadSEIPDv2FixtureWithV4Secret "seipdv2-for-v4-key.pgp.aa"-  let-      passphraseCallback _ = pure BL.empty-  keyInfos <- collectSecretKeyInfos encryptedSecretPackets passphrase-  let keyContextCallback pkt = pure (selectRecipientKeyInfo pkt keyInfos)-  decrypted <--    DC.runConduitRes $-    CL.sourceList messagePackets DC..|-    conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..|-    CL.consume-  case [p | LiteralDataPkt _ _ _ p <- decrypted] of-    (payload:_) ->-      if "This is a test of SEIPDv1" `isInfixOf` BLC8.unpack payload-        then pure ()-        else-          assertFailure-            ("unexpected decrypted payload for seipdv2-for-v4-key fixture: " ++-             show payload)-    [] ->-      assertFailure-        ("expected decrypted literal payload from seipdv2-for-v4-key fixture, got: " ++-         show decrypted)--testConduitDecryptSEIPDv2FixtureIgnoresUnusableLatestPKESK :: Assertion-testConduitDecryptSEIPDv2FixtureIgnoresUnusableLatestPKESK = do-  (messagePackets, encryptedSecretPackets, passphrase) <--    loadSEIPDv2FixtureWithV4Secret "seipdv2-for-v4-key.pgp.aa"-  let-      bogusRid = BL.pack (0x06 : replicate 32 0x99)-      bogusPKESK = PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 bogusRid RSA "bogus-esk"))-      (eskPrefix, encryptedSuffix) = span isPrecedingESK messagePackets-      packetsWithBogusLatestPKESK = eskPrefix ++ [bogusPKESK] ++ encryptedSuffix-      passphraseCallback _ = pure BL.empty-  keyInfos <- collectSecretKeyInfos encryptedSecretPackets passphrase-  let keyContextCallback pkt = pure (selectRecipientKeyInfo pkt keyInfos)-  decrypted <--    DC.runConduitRes $-    CL.sourceList packetsWithBogusLatestPKESK DC..|-    conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..|-    CL.consume-  case [p | LiteralDataPkt _ _ _ p <- decrypted] of-    (payload:_) ->-      if "This is a test of SEIPDv1" `isInfixOf` BLC8.unpack payload-        then pure ()-        else-          assertFailure-            ("unexpected decrypted payload for seipdv2-for-v4-key fixture with bogus latest PKESK: " ++-             show payload)-    [] ->-      assertFailure-        ("expected decrypted literal payload with bogus latest PKESK, got: " ++-         show decrypted)---testConduitDecryptSEIPDv2FixtureAcceptsRecipientIdWithoutCallerPermutations :: Assertion-testConduitDecryptSEIPDv2FixtureAcceptsRecipientIdWithoutCallerPermutations = do-  (messagePacketsRaw, encryptedSecretPackets, passphrase) <--    loadSEIPDv2FixtureWithV4Secret "seipdv2-for-v4-key.pgp.aa"-  let messagePackets = map forceVersionedRecipientIdentifier messagePacketsRaw-      passphraseCallback _ = pure BL.empty-  keyInfos <- collectSecretKeyInfos encryptedSecretPackets passphrase-  let keyContextCallback pkt = pure (selectRecipientKeyInfoByRawRecipientId pkt keyInfos)-  decrypted <--    DC.runConduitRes $-    CL.sourceList messagePackets DC..|-    conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..|-    CL.consume-  case [p | LiteralDataPkt _ _ _ p <- decrypted] of-    (payload:_) ->-      if "This is a test of SEIPDv1" `isInfixOf` BLC8.unpack payload-        then pure ()-        else-          assertFailure-            ("unexpected decrypted payload for recipient-id normalization fixture: " ++-             show payload)-    [] ->-      assertFailure-        ("expected decrypted literal payload for recipient-id normalization fixture, got: " ++-         show decrypted)--testConduitDecryptPKESKFailureDoesNotRequireManualSessionMaterial :: Assertion-testConduitDecryptPKESKFailureDoesNotRequireManualSessionMaterial = do-  armors <- loadArmor "seipdv2-for-v4-key.pgp.aa"-  armor <--    case armors of-      (a:_) -> pure a-      [] ->-        assertFailure "seipdv2-for-v4-key.pgp.aa should contain one armored payload" >>-        fail "expected one armored payload"-  let packets = parsePkts (armorPayload armor)-      keyContextCallback _ = pure Nothing-      passphraseCallback prompt =-        fail ("unexpected manual PKESK session key prompt: " ++ prompt)-  result <--    catch-      (Right <$> (DC.runConduitRes $ CL.sourceList packets DC..| conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..| CL.consume))-      (\e -> pure (Left (show (e :: SomeException))))-  case result of-    Left err -> do-      assertBool-        "failure should report PKESK candidate exhaustion"-        ("no matching key context" `isInfixOf` err)-      assertBool-        "failure should not request manual PKESK session material"-        (not ("unexpected manual PKESK session key prompt" `isInfixOf` err))-    Right decrypted ->-      assertFailure-        ("expected decryption failure when no PKESK key context is available, got: " ++-         show decrypted)--testConduitDecryptSEIPDv2TwoRecipientsFixtureWithMatchingV4SecretKey :: Assertion-testConduitDecryptSEIPDv2TwoRecipientsFixtureWithMatchingV4SecretKey =-  testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform-    "seipdv2-two-recipients.pgp.aa"-    id--testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithMatchingV4SecretKey :: Assertion-testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithMatchingV4SecretKey =-  testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform-    "seipdv2-three-recipients.pgp.aa"-    id--testConduitDecryptSEIPDv2TwoRecipientsFixtureWithReorderedAndUnusablePKESKs :: Assertion-testConduitDecryptSEIPDv2TwoRecipientsFixtureWithReorderedAndUnusablePKESKs =-  testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform-    "seipdv2-two-recipients.pgp.aa"-    (prependUnusableLatestPKESK . reorderPrecedingPKESKs)--testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithReorderedAndUnusablePKESKs :: Assertion-testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithReorderedAndUnusablePKESKs =-  testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform-    "seipdv2-three-recipients.pgp.aa"-    (prependUnusableLatestPKESK . reorderPrecedingPKESKs)--testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFile :: FilePath -> Assertion-testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFile fixture =-  testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform-    fixture-    id--testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform ::-     FilePath-  -> ([Pkt] -> [Pkt])-  -> Assertion-testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform fixture transformPackets = do-  (messagePacketsRaw, encryptedSecretPackets, passphrase) <- loadSEIPDv2FixtureWithV4Secret fixture-  let messagePackets = transformPackets messagePacketsRaw-      passphraseCallback _ = pure BL.empty-  keyInfos <- collectSecretKeyInfos encryptedSecretPackets passphrase-  let keyContextCallback pkt = pure (selectRecipientKeyInfo pkt keyInfos)-  decrypted <--    DC.runConduitRes $-    CL.sourceList messagePackets DC..|-    conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..|-    CL.consume-  case [p | LiteralDataPkt _ _ _ p <- decrypted] of-    (payload:_) ->-      if BL.null payload-        then assertFailure (fixture ++ " decrypt produced empty literal payload")-        else pure ()-    [] ->-      assertFailure-        ("expected decrypted literal payload from " ++ fixture ++ ", got: " ++-         show decrypted)--testConduitDecryptSEIPDv2WithPKESKv6RawSessionKey :: Assertion-testConduitDecryptSEIPDv2WithPKESKv6RawSessionKey = do-  let sessionKey = B.replicate 32 0x2a-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "v6 pkesk session key decrypt path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      packets ct =-        [ PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 "\x01\x02\x03\x04\x05\x06\x07\x08" RSA "\x99\x88\x77"))-        , SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ct))-        ]-      callback _ = pure (BL.fromStrict sessionKey)-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList (packets ciphertext) DC..| conduitDecrypt callback DC..| CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESKv6 raw session-key decrypt payload" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testConduitDecryptSEIPDv2RejectsWrongPKESKv6RawSessionKeyLength :: Assertion-testConduitDecryptSEIPDv2RejectsWrongPKESKv6RawSessionKeyLength = do-  let sessionKey = B.replicate 32 0x2a-      badSessionKey = B.replicate 31 0x2a-      salt = Salt (B.pack [0x00 .. 0x1f])-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) "payload"]-      packets ct =-        [ PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 "\x10\x11\x12\x13\x14\x15\x16\x17" RSA "\x01\x02\x03"))-        , SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ct))-        ]-      callback _ = pure (BL.fromStrict badSessionKey)-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  result <--    catch-      (Right <$>-       (DC.runConduitRes $-        CL.sourceList (packets ciphertext) DC..| conduitDecrypt callback DC..| CL.consume))-      (\e -> pure (Left (show (e :: SomeException))))-  case result of-    Left err ->-      if "PKESK raw session key length does not match payload algorithm" `isInfixOf` err-        then return ()-        else-          assertFailure-            ("Expected PKESKv6 raw session-key length validation failure, got: " ++ err)-    Right got ->-      assertFailure-        ("Expected PKESKv6 raw session-key length failure, got packets: " ++ show got)--testConduitDecryptSEIPDv2WithPKESKRSAUnwrap :: Assertion-testConduitDecryptSEIPDv2WithPKESKRSAUnwrap = do-  (baseRecipient, privateKey) <- loadUnencryptedRsaSigner-  publicKey <--    case _pubkey baseRecipient of-      RSAPubKey (RSA_PublicKey pub) -> pure pub-      other ->-        assertFailure-          ("unencrypted.seckey did not contain an RSA recipient, got " ++ show other) >>-        fail "expected RSA recipient"-  let sessionKey = B.replicate 32 0x2b-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk rsa unwrap decrypt path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ = do-        let msk = Just (RSAPrivateKey (RSA_PrivateKey privateKey))-        pure $-          fmap-            (\sk ->-               PKESKRecipientKey-                 { pkeskRecipientPKPayload = Nothing-                 , pkeskRecipientSKey = sk-                 })-            msk-  encryptedResult <- (P15.encrypt publicKey sessionKey :: IO (Either RSA.Error B.ByteString))-  encryptedSessionMaterial <--    case encryptedResult of-      Left err -> assertFailure ("RSA PKESK encryption failed: " ++ show err) >> pure mempty-      Right ct -> pure ct-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  let pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-             3-             (EightOctetKeyId "\x11\x22\x33\x44\x55\x66\x77\x88")-             RSA-             (MPI (os2ip encryptedSessionMaterial) :| [])))-  decrypted <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESK RSA unwrap decrypt payload" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testConduitDecryptSEIPDv2WithPKESKRSAUnwrapViaWildcardCallbackFallback :: Assertion-testConduitDecryptSEIPDv2WithPKESKRSAUnwrapViaWildcardCallbackFallback = do-  (baseRecipient, privateKey) <- loadUnencryptedRsaSigner-  publicKey <--    case _pubkey baseRecipient of-      RSAPubKey (RSA_PublicKey pub) -> pure pub-      other ->-        assertFailure-          ("unencrypted.seckey did not contain an RSA recipient, got " ++ show other) >>-        fail "expected RSA recipient"-  let sessionKey = B.replicate 32 0x2e-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk rsa unwrap decrypt path via wildcard callback fallback"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback pkt =-        case pkt of-          PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 _ (EightOctetKeyId rid) _ _))-            | BL.length rid == 8 && BL.all (== 0) rid ->-                pure-                  (Just-                     (PKESKRecipientKey-                        { pkeskRecipientPKPayload = Nothing-                        , pkeskRecipientSKey =-                            RSAPrivateKey (RSA_PrivateKey privateKey)-                        }))-          _ -> pure Nothing-  encryptedResult <- (P15.encrypt publicKey sessionKey :: IO (Either RSA.Error B.ByteString))-  encryptedSessionMaterial <--    case encryptedResult of-      Left err -> assertFailure ("RSA PKESK encryption failed: " ++ show err) >> pure mempty-      Right ct -> pure ct-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  let pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-                3-                (EightOctetKeyId "\xaa\xbb\xcc\xdd\xee\xff\x00\x11")-                RSA-                (MPI (os2ip encryptedSessionMaterial) :| [])))-  decrypted <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESK RSA unwrap via wildcard callback fallback payload" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testConduitDecryptSEIPDv2WithPKESKRSAUnwrapFromProtectedKey :: Assertion-testConduitDecryptSEIPDv2WithPKESKRSAUnwrapFromProtectedKey = do-  passphrase <- readPKIPassphrase-  secretPackets <--    DC.runConduitRes $-    CB.sourceFile "tests/data/aes256-sha512.seckey" DC..| conduitGet get DC..|-    CL.consume-  keyInfos <- collectSecretKeyInfos secretPackets passphrase-  keyInfo <--    case keyInfos of-      (ki:_) -> pure ki-      [] ->-        assertFailure-          "aes256-sha512.seckey should yield at least one RSA key context" >>-        fail "expected key info"-  publicKey <--    case pkeskRecipientPKPayload keyInfo of-      Nothing ->-        assertFailure "key info from file should include a public key payload" >>-        fail "expected public key payload"-      Just pkp ->-        case _pubkey pkp of-          RSAPubKey (RSA_PublicKey pub) -> pure pub-          other ->-            assertFailure-              ("expected RSA public key from aes256-sha512.seckey, got " ++ show other) >>-            fail "expected RSA public key"-  let sessionKey = B.replicate 32 0x42-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk rsa unwrap via sha1-cfb protected key loaded from file"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback pkt = pure (selectRecipientKeyInfo pkt keyInfos)-  encryptedResult <- (P15.encrypt publicKey sessionKey :: IO (Either RSA.Error B.ByteString))-  encryptedSessionMaterial <--    case encryptedResult of-      Left err ->-        assertFailure ("RSA PKESK encryption failed: " ++ show err) >> pure mempty-      Right ct -> pure ct-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  let pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-                3-                (EightOctetKeyId "\x11\x22\x33\x44\x55\x66\x77\x88")-                RSA-                (MPI (os2ip encryptedSessionMaterial) :| [])))-  decrypted <--    DC.runConduitRes $-    CL.sourceList-      [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual-        "PKESK RSA unwrap with SHA1-CFB protected key from file"-        payload-        gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testConduitDecryptSEIPDv2WithPKESKECDHUnwrap :: Assertion-testConduitDecryptSEIPDv2WithPKESKECDHUnwrap = do-  let (recipientPub, recipientPriv) = syntheticNISTP256Low-      (ephPub, ephPriv) = syntheticNISTP256High-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          ECDH-          (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey recipientPub)) SHA256 AES128)-      recipientSKey = ECDHPrivateKey (ECDSA_PrivateKey recipientPriv)-      sessionKey = B.replicate 32 0x2c-      encodedSession =-        B.singleton (fromFVal AES256) <>-        sessionKey <>-        encodeChecksum16 sessionKey <>-        B.replicate 5 0-      sharedSecret =-        BA.convert-          (ECCDH.getShared-             (ECDSA.public_curve recipientPub)-             (ECDSA.private_d ephPriv)-             (ECDSA.public_q recipientPub)) :: B.ByteString-      kdfParam =-        buildECDHKDFParamForTest recipientPKP ECDH (ECDSA.public_curve recipientPub) SHA256 AES128-      kek = deriveECDHKekForTest SHA256 AES128 sharedSecret kdfParam-      wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek encodedSession-      ephPointBytes =-        maybe-          (error "failed to encode ephemeral point")-          id-          (point2MBS (ECDSA.public_q ephPub))-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-             3-             (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")-             ECDH-             (MPI (os2ip ephPointBytes) :| [MPI (os2ip wrappedSession)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk ecdh unwrap decrypt path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipientPKP-                , pkeskRecipientSKey = recipientSKey-                }))-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESK ECDH unwrap decrypt payload" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testConduitDecryptSEIPDv2RejectsECDHWrongEphemeralPointLength :: Assertion-testConduitDecryptSEIPDv2RejectsECDHWrongEphemeralPointLength = do-  let (recipientPub, recipientPriv) = syntheticNISTP256Low-      (ephPub, ephPriv) = syntheticNISTP256High-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          ECDH-          (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey recipientPub)) SHA256 AES128)-      recipientSKey = ECDHPrivateKey (ECDSA_PrivateKey recipientPriv)-      sessionKey = B.replicate 32 0x2c-      encodedSession =-        B.singleton (fromFVal AES256) <>-        sessionKey <>-        encodeChecksum16 sessionKey <>-        B.replicate 5 0-      sharedSecret =-        BA.convert-          (ECCDH.getShared-             (ECDSA.public_curve recipientPub)-             (ECDSA.private_d ephPriv)-             (ECDSA.public_q recipientPub)) :: B.ByteString-      kdfParam =-        buildECDHKDFParamForTest recipientPKP ECDH (ECDSA.public_curve recipientPub) SHA256 AES128-      kek = deriveECDHKekForTest SHA256 AES128 sharedSecret kdfParam-      wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek encodedSession-      ephPointBytes =-        maybe-          (error "failed to encode ephemeral point")-          id-          (point2MBS (ECDSA.public_q ephPub))-      truncatedEphemeral = B.take (B.length ephPointBytes - 1) ephPointBytes-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-             3-             (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")-             ECDH-             (MPI (os2ip truncatedEphemeral) :| [MPI (os2ip wrappedSession)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk ecdh wrong ephemeral point length"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipientPKP-                , pkeskRecipientSKey = recipientSKey-                }))-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  result <--    catch-      (Right <$>-       DC.runConduitRes-         (CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-          conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-          CL.consume))-      (\e -> pure (Left (show (e :: SomeException))))-  case result of-    Left err ->-      assertBool-        "ECDH unwrap should reject wrong uncompressed point length for recipient curve"-        ("invalid length for recipient curve" `isInfixOf` err)-    Right packets ->-      assertFailure ("Expected ECDH point-length validation failure, got: " ++ show packets)--testConduitDecryptSEIPDv2WithPKESKX25519V3Unwrap :: Assertion-testConduitDecryptSEIPDv2WithPKESKX25519V3Unwrap = do-  let recipientSecretRaw = B.pack [0x21 .. 0x40]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X25519 recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-      recipientSKey = X25519PrivateKey recipientSecretRaw-      ephSecretRaw = B.pack [0x41 .. 0x60]-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize X25519 ephemeral secret key: " ++ show err)-          Right sk -> sk-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPub =-        case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of-          Left err -> error ("failed to initialize X25519 recipient public key: " ++ show err)-          Right pk -> pk-      sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-      kek = deriveX25519KekForTest ephPublicRaw recipientPublicRaw sharedSecret-      sessionKey = SessionKey (B.replicate 32 0x6a)-      wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)-      eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-             3-             (EightOctetKeyId "\x12\x34\x56\x78\x90\xab\xcd\xef")-             X25519-             (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk x25519 v3 unwrap decrypt path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipientPKP-                , pkeskRecipientSKey = recipientSKey-                }))-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESK X25519 v3 unwrap decrypt payload" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)---testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossRecipientKeyOrder :: Assertion-testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossRecipientKeyOrder = do-  let recipientSecretRaw = B.pack [0x21 .. 0x40]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X25519 recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-      recipientSKey = X25519PrivateKey recipientSecretRaw-      wrongRecipientSecretRaw = B.pack [0x61 .. 0x80]-      wrongRecipientSecret =-        case CE.eitherCryptoError (C25519.secretKey wrongRecipientSecretRaw) of-          Left err -> error ("failed to initialize wrong X25519 recipient secret key: " ++ show err)-          Right sk -> sk-      wrongRecipientPublicRaw = BA.convert (C25519.toPublic wrongRecipientSecret) :: B.ByteString-      wrongRecipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip wrongRecipientPublicRaw))))-      wrongRecipientSKey = X25519PrivateKey wrongRecipientSecretRaw-      ephSecretRaw = B.pack [0x41 .. 0x60]-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize X25519 ephemeral secret key: " ++ show err)-          Right sk -> sk-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPub =-        case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of-          Left err -> error ("failed to initialize X25519 recipient public key: " ++ show err)-          Right pk -> pk-      sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-      kek = deriveX25519KekForTest ephPublicRaw recipientPublicRaw sharedSecret-      sessionKey = SessionKey (B.replicate 32 0x6b)-      wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)-      eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-                3-                (EightOctetKeyId (BL.replicate 8 0))-                X25519-                (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk x25519 v3 wildcard key-id retry path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      wrongKeyInfo =-        PKESKRecipientKey-          { pkeskRecipientPKPayload = Just wrongRecipientPKP-          , pkeskRecipientSKey = wrongRecipientSKey-          }-      correctKeyInfo =-        PKESKRecipientKey-         { pkeskRecipientPKPayload = Just recipientPKP-         , pkeskRecipientSKey = recipientSKey-         }-      keyContextCallback _rid _pka = pure [wrongKeyInfo, correctKeyInfo]-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    conduitDecryptWithCandidatesCallbackAndPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESKv3 wildcard-keyid retries across recipient key order" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)---testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder :: Assertion-testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder = do-  let recipientSecretRaw = B.pack [0x21 .. 0x40]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X25519 recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      ephSecretRaw = B.pack [0x41 .. 0x60]-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize X25519 ephemeral secret key: " ++ show err)-          Right sk -> sk-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPub =-        case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of-          Left err -> error ("failed to initialize X25519 recipient public key: " ++ show err)-          Right pk -> pk-      sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-      kek = deriveX25519KekForTest ephPublicRaw recipientPublicRaw sharedSecret-      sessionKey = SessionKey (B.replicate 32 0x6c)-      wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)-      eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-                3-                (EightOctetKeyId (BL.replicate 8 0))-                X25519-                (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk x25519 v3 wildcard key-id long retry path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      mkSecretBytes offset =-        B.pack [fromIntegral ((offset + i) `mod` 256) | i <- [0 .. 31 :: Int]]-      mkX25519RecipientKeyInfo label secretRaw =-        let sk =-              case CE.eitherCryptoError (C25519.secretKey secretRaw) of-                Left err -> error ("failed to initialize " ++ label ++ " X25519 secret key: " ++ show err)-                Right secretKey -> secretKey-            publicRaw = BA.convert (C25519.toPublic sk) :: B.ByteString-         in PKESKRecipientKey-              { pkeskRecipientPKPayload =-                  Just-                    (PKPayload-                       V4-                       (ThirtyTwoBitTimeStamp 0)-                       0-                       X25519-                       (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip publicRaw)))))-              , pkeskRecipientSKey = X25519PrivateKey secretRaw-              }-      wrongKeyInfos =-        [ mkX25519RecipientKeyInfo ("wrong-" ++ show n) (mkSecretBytes (96 + n * 7))-        | n <- [1 .. 20 :: Int]-        ]-      correctKeyInfo = mkX25519RecipientKeyInfo "correct" recipientSecretRaw-      keyContextCallback _rid _pka = pure (wrongKeyInfos ++ [correctKeyInfo])-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    conduitDecryptWithCandidatesCallbackAndPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESKv3 wildcard-keyid retries long recipient key order" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)---testConduitDecryptSEIPDv1RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder :: Assertion-testConduitDecryptSEIPDv1RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder = do-  let recipientSecretRaw = B.pack [0x21 .. 0x40]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X25519 recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      ephSecretRaw = B.pack [0x41 .. 0x60]-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize X25519 ephemeral secret key: " ++ show err)-          Right sk -> sk-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPub =-        case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of-          Left err -> error ("failed to initialize X25519 recipient public key: " ++ show err)-          Right pk -> pk-      sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-      kek = deriveX25519KekForTest ephPublicRaw recipientPublicRaw sharedSecret-      sessionKey = SessionKey (B.replicate 32 0x6d)-      wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)-      eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-                3-                (EightOctetKeyId (BL.replicate 8 0))-                X25519-                (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])))-      payload = "pkesk x25519 v3 wildcard key-id long retry legacy seipd1 path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      cleartext = BL.toStrict (runPut (put literalBlock))-      iv = IV (B.pack [0x33 .. 0x42])-      cleartextWithMDC = cleartext <> mdcTrailerForSEIPDv1 iv cleartext-      passphraseCallback _ = pure BL.empty-      mkSecretBytes offset =-        B.pack [fromIntegral ((offset + i) `mod` 256) | i <- [0 .. 31 :: Int]]-      mkX25519RecipientKeyInfo label secretRaw =-        let sk =-              case CE.eitherCryptoError (C25519.secretKey secretRaw) of-                Left err -> error ("failed to initialize " ++ label ++ " X25519 secret key: " ++ show err)-                Right secretKey -> secretKey-            publicRaw = BA.convert (C25519.toPublic sk) :: B.ByteString-         in PKESKRecipientKey-              { pkeskRecipientPKPayload =-                  Just-                    (PKPayload-                       V4-                       (ThirtyTwoBitTimeStamp 0)-                       0-                       X25519-                       (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip publicRaw)))))-              , pkeskRecipientSKey = X25519PrivateKey secretRaw-              }-      wrongKeyInfos =-        [ mkX25519RecipientKeyInfo ("wrong-" ++ show n) (mkSecretBytes (96 + n * 7))-        | n <- [1 .. 20 :: Int]-        ]-      correctKeyInfo = mkX25519RecipientKeyInfo "correct" recipientSecretRaw-      keyContextCallback _rid _pka = pure (wrongKeyInfos ++ [correctKeyInfo])-  ciphertext <--    either-      (\e -> assertFailure ("encryptOpenPGPCfbRaw failed: " ++ show e) >> pure mempty)-      pure-      (encryptOpenPGPCfbRaw OpenPGPCFBNoResyncW AES256 iv cleartextWithMDC (unSessionKey sessionKey))-  decrypted <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD1 1 (BL.fromStrict ciphertext))] DC..|-    conduitDecryptWithCandidatesCallbackAndPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESKv3 wildcard-keyid retries long recipient key order for SEIPDv1" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)---testMkCandidateResolverDecryptsWildcardPKESKv3 :: Assertion-testMkCandidateResolverDecryptsWildcardPKESKv3 = do-  let recipientSecretRaw = B.pack [0x21 .. 0x40]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X25519 recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-      recipientSKey = X25519PrivateKey recipientSecretRaw-      wrongSecretRaw = B.pack [0x61 .. 0x80]-      wrongSecret =-        case CE.eitherCryptoError (C25519.secretKey wrongSecretRaw) of-          Left err -> error ("failed to initialize wrong X25519 secret key: " ++ show err)-          Right sk -> sk-      wrongPublicRaw = BA.convert (C25519.toPublic wrongSecret) :: B.ByteString-      wrongPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip wrongPublicRaw))))-      wrongSKey = X25519PrivateKey wrongSecretRaw-      ephSecretRaw = B.pack [0x41 .. 0x60]-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize X25519 ephemeral secret key: " ++ show err)-          Right sk -> sk-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPub =-        case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of-          Left err -> error ("failed to initialize X25519 recipient public key: " ++ show err)-          Right pk -> pk-      sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-      kek = deriveX25519KekForTest ephPublicRaw recipientPublicRaw sharedSecret-      sessionKey = SessionKey (B.replicate 32 0x6d)-      wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)-      eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-                3-                (EightOctetKeyId (BL.replicate 8 0))-                X25519-                (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "unwrap callback wildcard path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      wrongKeyInfo =-        PKESKRecipientKey {pkeskRecipientPKPayload = Just wrongPKP, pkeskRecipientSKey = wrongSKey}-      correctKeyInfo =-        PKESKRecipientKey {pkeskRecipientPKPayload = Just recipientPKP, pkeskRecipientSKey = recipientSKey}-  let resolver _rid _pka = pure [wrongKeyInfo, correctKeyInfo]-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    (void $-     DCD.conduitDecrypt-       DCD.DecryptOptions-         { DCD.decryptOptionsKeyResolution = DCD.DecryptWithUnwrapCandidatesCallback resolver-         , DCD.decryptOptionsPolicy = lenientDecryptPolicy-         , DCD.decryptOptionsPassphraseCallback = passphraseCallback-         }) DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "unwrap callback should decrypt wildcard PKESK via candidate list" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)---testConduitDecryptWildcardResolverProvidesTypedPreviousFailures :: Assertion-testConduitDecryptWildcardResolverProvidesTypedPreviousFailures = do-  let recipientSecretRaw = B.pack [0x21 .. 0x40]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X25519 recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-      recipientSKey = X25519PrivateKey recipientSecretRaw-      wrongSecretRaw = B.pack [0x61 .. 0x80]-      wrongSecret =-        case CE.eitherCryptoError (C25519.secretKey wrongSecretRaw) of-          Left err -> error ("failed to initialize wrong X25519 secret key: " ++ show err)-          Right sk -> sk-      wrongPublicRaw = BA.convert (C25519.toPublic wrongSecret) :: B.ByteString-      wrongPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip wrongPublicRaw))))-      wrongSKey = X25519PrivateKey wrongSecretRaw-      ephSecretRaw = B.pack [0x41 .. 0x60]-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize X25519 ephemeral secret key: " ++ show err)-          Right sk -> sk-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPub =-        case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of-          Left err -> error ("failed to initialize X25519 recipient public key: " ++ show err)-          Right pk -> pk-      sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-      kek = deriveX25519KekForTest ephPublicRaw recipientPublicRaw sharedSecret-      sessionKey = SessionKey (B.replicate 32 0x6e)-      wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)-      eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-                3-                (EightOctetKeyId (BL.replicate 8 0))-                X25519-                (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "typed previous failures for wildcard retries"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      wrongKeyInfo =-        PKESKRecipientKey {pkeskRecipientPKPayload = Just wrongPKP, pkeskRecipientSKey = wrongSKey}-      correctKeyInfo =-        PKESKRecipientKey {pkeskRecipientPKPayload = Just recipientPKP, pkeskRecipientSKey = recipientSKey}-  let resolver _rid _pka = pure [wrongKeyInfo, correctKeyInfo]-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    (void $-     DCD.conduitDecrypt-       DCD.DecryptOptions-        { DCD.decryptOptionsKeyResolution = DCD.DecryptWithUnwrapCandidatesCallback resolver-         , DCD.decryptOptionsPolicy = lenientDecryptPolicy-         , DCD.decryptOptionsPassphraseCallback = passphraseCallback-         }) DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "wildcard retries with typed previous failures should still decrypt" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)-  pure ()---testConduitDecryptWithReportCapturesWildcardResolverDiagnostics :: Assertion-testConduitDecryptWithReportCapturesWildcardResolverDiagnostics = do-  let recipientSecretRaw = B.pack [0x21 .. 0x40]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X25519 recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-      recipientSKey = X25519PrivateKey recipientSecretRaw-      wrongSecretRaw = B.pack [0x61 .. 0x80]-      wrongSecret =-        case CE.eitherCryptoError (C25519.secretKey wrongSecretRaw) of-          Left err -> error ("failed to initialize wrong X25519 secret key: " ++ show err)-          Right sk -> sk-      wrongPublicRaw = BA.convert (C25519.toPublic wrongSecret) :: B.ByteString-      wrongPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip wrongPublicRaw))))-      wrongSKey = X25519PrivateKey wrongSecretRaw-      ephSecretRaw = B.pack [0x41 .. 0x60]-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize X25519 ephemeral secret key: " ++ show err)-          Right sk -> sk-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPub =-        case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of-          Left err -> error ("failed to initialize X25519 recipient public key: " ++ show err)-          Right pk -> pk-      sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-      kek = deriveX25519KekForTest ephPublicRaw recipientPublicRaw sharedSecret-      sessionKey = SessionKey (B.replicate 32 0x6f)-      wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)-      eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-                3-                (EightOctetKeyId (BL.replicate 8 0))-                X25519-                (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "conduitDecryptWithReport wildcard diagnostics"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      wrongKeyInfo =-        PKESKRecipientKey {pkeskRecipientPKPayload = Just wrongPKP, pkeskRecipientSKey = wrongSKey}-      correctKeyInfo =-        PKESKRecipientKey {pkeskRecipientPKPayload = Just recipientPKP, pkeskRecipientSKey = recipientSKey}-  let resolver _rid _pka = pure [wrongKeyInfo, correctKeyInfo]-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  (report, decrypted) <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    DC.fuseBoth-      (DCD.conduitDecryptWithReport-         DCD.DecryptOptions-           { DCD.decryptOptionsKeyResolution = DCD.DecryptWithUnwrapCandidatesCallback resolver-           , DCD.decryptOptionsPolicy = lenientDecryptPolicy-           , DCD.decryptOptionsPassphraseCallback = passphraseCallback-           })-      CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "wildcard retries with report diagnostics should decrypt" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)-  assertEqual "decrypt report should preserve outcome" DCD.DecryptClean (DCD.decryptReportOutcome report)-  case DCD.decryptReportSessionKeyResolutions report of-    [resolution] -> do-      assertEqual "resolution path should be PKESK for wildcard key retries" DCD.DecryptResolvedViaPKESK (DCD.decryptSessionResolutionPath resolution)-      let attempts = DCD.decryptSessionResolutionResolverAttempts resolution-      assertBool-        "report should contain wildcard resolver attempts"-        (length attempts >= 2)-      assertBool-        "report should record typed previous failures in resolver attempt context"-        (any-           (\attempt ->-              any-                (\failure ->-                   DCD.pkeskAttemptFailureKind failure == DCD.PKESKAttemptUnwrapFailed &&-                   DCD.pkeskAttemptFailureKeyContext failure == Just (V4, X25519))-                (DCD.pkeskResolverAttemptPreviousFailures attempt))-           attempts)-      assertBool-        "report should capture ResolveWith key context for X25519"-        (any-           (\attempt ->-              DCD.pkeskResolverAttemptAction attempt ==-              DCD.ResolverAttemptResolveWith (Just (V4, X25519)))-           attempts)-    other ->-      assertFailure-        ("Expected exactly one session-key resolution report, got " ++ show (length other))--testConduitDecryptSEIPDv2RejectsPKESKX25519V3WrongEphemeralLength :: Assertion-testConduitDecryptSEIPDv2RejectsPKESKX25519V3WrongEphemeralLength = do-  let recipientSecretRaw = B.pack [0x21 .. 0x40]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X25519 recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-      recipientSKey = X25519PrivateKey recipientSecretRaw-      ephSecretRaw = B.pack [0x41 .. 0x60]-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize X25519 ephemeral secret key: " ++ show err)-          Right sk -> sk-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPub =-        case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of-          Left err -> error ("failed to initialize X25519 recipient public key: " ++ show err)-          Right pk -> pk-      sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-      kek = deriveX25519KekForTest ephPublicRaw recipientPublicRaw sharedSecret-      sessionKey = SessionKey (B.replicate 32 0x6a)-      wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)-      eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession-      overlongEphemeral = ephPublicRaw <> "\x00\x01"-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-             3-             (EightOctetKeyId "\x12\x34\x56\x78\x90\xab\xcd\xef")-             X25519-             (MPI (os2ip overlongEphemeral) :| [MPI (os2ip eskWithAlgo)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk x25519 v3 wrong ephemeral length"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipientPKP-                , pkeskRecipientSKey = recipientSKey-                }))-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  result <--    catch-      (Right <$>-       DC.runConduitRes-         (CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-          conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-          CL.consume))-      (\e -> pure (Left (show (e :: SomeException))))-  case result of-    Left err ->-      assertBool-        "PKESKv3 X25519 unwrap should reject non-32-byte ephemeral values"-        ("invalid X25519 ephemeral public key length/prefix" `isInfixOf` err)-    Right packets ->-      assertFailure-        ("Expected X25519 ephemeral-length validation failure, got: " ++ show packets)--testConduitDecryptSEIPDv2FallsBackFromArgon2SKESKToPKESKv3X25519 :: Assertion-testConduitDecryptSEIPDv2FallsBackFromArgon2SKESKToPKESKv3X25519 = do-  let recipientSecretRaw = B.pack [0x21 .. 0x40]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X25519 recipient secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          X25519-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-      recipientSKey = X25519PrivateKey recipientSecretRaw-      ephSecretRaw = B.pack [0x41 .. 0x60]-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize X25519 ephemeral secret key: " ++ show err)-          Right sk -> sk-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPub =-        case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of-          Left err -> error ("failed to initialize X25519 recipient public key: " ++ show err)-          Right pk -> pk-      sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString-      kek = deriveX25519KekForTest ephPublicRaw recipientPublicRaw sharedSecret-      sessionKeyBytes = B.replicate 32 0x6a-      sessionKey = SessionKey sessionKeyBytes-      wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek sessionKeyBytes-      eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-             3-             (EightOctetKeyId "\x12\x34\x56\x78\x90\xab\xcd\xef")-             X25519-             (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])))-      skeskS2K = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15-      skeskPassphrase = "correct horse battery staple"-      wrongPassphrase = "wrong passphrase"-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "skesk->pkesk fallback decrypt path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipientPKP-                , pkeskRecipientSKey = recipientSKey-                }))-      passphraseCallback _ = pure wrongPassphrase-  keyLen <--    case keySize AES256 of-      Left err -> assertFailure ("keySize failed for AES256: " ++ show err) >> fail "keySize failed"-      Right n -> pure n-  skeskKek <--    case string2Key skeskS2K keyLen skeskPassphrase of-      Left err -> assertFailure ("string2Key failed for Argon2 SKESK: " ++ renderS2KError err) >> fail "string2Key failed"-      Right x -> pure x-  skeskEncryptedEsk <--    case withSymmetricCipher AES256 skeskKek $ \cipher ->-           paddedCfbEncrypt-             cipher-             (B.replicate (blockSize cipher) 0)-             (B.singleton (fromFVal AES256) <> sessionKeyBytes) of-      Left err -> assertFailure ("encrypting Argon2 SKESK ESK failed: " ++ show err) >> fail "encrypting SKESK ESK failed"-      Right x -> pure x-  let skesk =-        SKESKPkt-          (SKESKPayloadV4Packet-             (SKESKPayloadV4 AES256 skeskS2K (Just (BL.fromStrict skeskEncryptedEsk))))-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList-      [ skesk-      , pkesk-      , SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))-      ] DC..|-    conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual-        "conduitDecrypt should fall back from failing Argon2 SKESK to PKESKv3 X25519"-        payload-        gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testConduitDecryptSEIPDv2FallsBackToEarlierArgon2SKESK :: Assertion-testConduitDecryptSEIPDv2FallsBackToEarlierArgon2SKESK = do-  let skeskS2K = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15-      passphrase = "password"-      sessionKeyBytes = B.replicate 32 0x7b-      sessionKey = SessionKey sessionKeyBytes-      badLatestEsk = BL.fromStrict (B.pack [0x00])-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "earlier argon2 skesk fallback decrypt path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure passphrase-  keyLen <--    case keySize AES256 of-      Left err -> assertFailure ("keySize failed for AES256: " ++ show err) >> fail "keySize failed"-      Right n -> pure n-  skeskKek <--    case string2Key skeskS2K keyLen passphrase of-      Left err -> assertFailure ("string2Key failed for Argon2 SKESK: " ++ renderS2KError err) >> fail "string2Key failed"-      Right x -> pure x-  validEsk <--    case withSymmetricCipher AES256 skeskKek $ \cipher ->-           paddedCfbEncrypt-             cipher-             (B.replicate (blockSize cipher) 0)-             (B.singleton (fromFVal AES256) <> sessionKeyBytes) of-      Left err -> assertFailure ("encrypting Argon2 SKESK ESK failed: " ++ show err) >> fail "encrypting SKESK ESK failed"-      Right x -> pure x-  let earlierValidSKESK =-        SKESKPkt-          (SKESKPayloadV4Packet-             (SKESKPayloadV4 AES256 skeskS2K (Just (BL.fromStrict validEsk))))-      latestUnusableSKESK =-        SKESKPkt-          (SKESKPayloadV4Packet-             (SKESKPayloadV4 AES256 skeskS2K (Just badLatestEsk)))-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList-      [ earlierValidSKESK-      , latestUnusableSKESK-      , SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))-      ] DC..|-    conduitDecryptWithDecryptPolicy lenientDecryptPolicy (\_ -> pure Nothing) passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual-        "conduitDecrypt should retry earlier Argon2 SKESK when latest SKESK is unusable"-        payload-        gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testConduitDecryptSEIPDv2RejectsECDHNonTable30Params :: Assertion-testConduitDecryptSEIPDv2RejectsECDHNonTable30Params = do-  let (recipientPub, recipientPriv) = syntheticNISTP256Low-      (ephPub, ephPriv) = syntheticNISTP256High-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          ECDH-          (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey recipientPub)) SHA256 AES256)-      recipientSKey = ECDHPrivateKey (ECDSA_PrivateKey recipientPriv)-      sessionKey = B.replicate 32 0x2c-      encodedSession =-        B.singleton (fromFVal AES256) <>-        sessionKey <>-        encodeChecksum16 sessionKey <>-        B.replicate 5 0-      sharedSecret =-        BA.convert-          (ECCDH.getShared-             (ECDSA.public_curve recipientPub)-             (ECDSA.private_d ephPriv)-             (ECDSA.public_q recipientPub)) :: B.ByteString-      kdfParam =-        buildECDHKDFParamForTest recipientPKP ECDH (ECDSA.public_curve recipientPub) SHA256 AES256-      kek = deriveECDHKekForTest SHA256 AES256 sharedSecret kdfParam-      wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession-      ephPointBytes =-        maybe-          (error "failed to encode ephemeral point")-          id-          (point2MBS (ECDSA.public_q ephPub))-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-             3-             (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")-             ECDH-             (MPI (os2ip ephPointBytes) :| [MPI (os2ip wrappedSession)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk ecdh unwrap policy failure path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipientPKP-                , pkeskRecipientSKey = recipientSKey-                }))-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  result <--    catch-      (Right <$>-       DC.runConduitRes-         (CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-          conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-          CL.consume))-      (\e -> pure (Left (show (e :: SomeException))))-  case result of-    Left err ->-      assertBool-        "ECDH unwrap should reject non-Table-30 parameters"-        ("Table 30 policy violation" `isInfixOf` err)-    Right packets ->-      assertFailure-        ("Expected Table 30 policy failure, got decrypted packets: " ++ show packets)--testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyRFC6637AcceptedParams :: Assertion-testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyRFC6637AcceptedParams = do-  let recipientSecretRaw = B.pack [1 .. 32]-      ephSecretRaw = B.pack [101 .. 132]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize Curve25519Legacy recipient secret key: " ++ show err)-          Right sk -> sk-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize Curve25519Legacy ephemeral secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          ECDH-          (ECDHPubKey-             (EdDSAPubKey Ed25519 (PrefixedNativeEPoint (EPoint (os2ip (B.cons 0x40 recipientPublicRaw)))))-             SHA256-             AES256)-      recipientSKey =-        ECDHPrivateKey-          (ECDSA_PrivateKey-             (ECDSA.PrivateKey (ECCT.getCurveByName ECCT.SEC_p256r1) (os2ip recipientSecretRaw)))-      sessionKey = B.replicate 32 0x3d-      encodedSession =-        B.singleton (fromFVal AES256) <>-        sessionKey <>-        encodeChecksum16 sessionKey <>-        B.replicate 5 0-      sharedSecret = BA.convert (C25519.dh (C25519.toPublic ephSecret) recipientSecret) :: B.ByteString-      kdfParam = buildCurve25519LegacyKdfParamForTest recipientPKP ECDH SHA256 AES256-      kek = deriveECDHKekForTest SHA256 AES256 sharedSecret kdfParam-      wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-             3-             (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")-             ECDH-             (MPI (os2ip ephPublicRaw) :| [MPI (os2ip wrappedSession)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk ecdh v4 curve25519legacy accepted-combo path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipientPKP-                , pkeskRecipientSKey = recipientSKey-                }))-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual-        "v4 Curve25519Legacy ECDH should allow RFC6637-accepted parameters"-        payload-        gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyWithTruncatedWrappedMPI :: Assertion-testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyWithTruncatedWrappedMPI = do-  let recipientSecretRaw = B.pack [1 .. 32]-      ephSecretRaw = B.pack [101 .. 132]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize Curve25519Legacy recipient secret key: " ++ show err)-          Right sk -> sk-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize Curve25519Legacy ephemeral secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPKP =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          ECDH-          (ECDHPubKey-             (EdDSAPubKey Ed25519 (PrefixedNativeEPoint (EPoint (os2ip (B.cons 0x40 recipientPublicRaw)))))-             SHA256-             AES256)-      recipientSKey =-        ECDHPrivateKey-          (ECDSA_PrivateKey-             (ECDSA.PrivateKey (ECCT.getCurveByName ECCT.SEC_p256r1) (os2ip recipientSecretRaw)))-      sharedSecret = BA.convert (C25519.dh (C25519.toPublic ephSecret) recipientSecret) :: B.ByteString-      kdfParam = buildCurve25519LegacyKdfParamForTest recipientPKP ECDH SHA256 AES256-      kek = deriveECDHKekForTest SHA256 AES256 sharedSecret kdfParam-      candidate =-        find-          (\(_, wrappedSession) -> not (B.null wrappedSession) && B.head wrappedSession == 0x00)-          [ let sessionKeyBytes =-                  B.pack-                    [ fromIntegral ((seed + offset) `mod` 256)-                    | offset <- [0 .. 31]-                    ]-                encodedSession =-                  B.singleton (fromFVal AES256) <>-                  sessionKeyBytes <>-                  encodeChecksum16 sessionKeyBytes <>-                  B.replicate 5 0-                wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession-             in (SessionKey sessionKeyBytes, wrappedSession)-          | seed <- [0 .. 4095 :: Int]-          ]-  case candidate of-    Nothing ->-      assertFailure-        "failed to find deterministic Curve25519Legacy wrapped session key with leading zero"-    Just (sessionKey, wrappedSession) -> do-      let pkesk =-            PKESKPkt-              (PKESKPayloadV3Packet-                 (PKESKPayloadV3-                 3-                 (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")-                 ECDH-                 (MPI (os2ip ephPublicRaw) :| [MPI (os2ip wrappedSession)])))-          salt = Salt (B.pack [0x00 .. 0x1f])-          payload = "pkesk ecdh v4 curve25519legacy truncated wrapped-mpi path"-          literalBlock =-            Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-          passphraseCallback _ = pure BL.empty-          keyContextCallback _ =-            pure-              (Just-                 (PKESKRecipientKey-                    { pkeskRecipientPKPayload = Just recipientPKP-                    , pkeskRecipientSKey = recipientSKey-                    }))-      ciphertext <--        case encryptSEIPDv2Payload AES256 OCB 6 salt sessionKey (BL.toStrict (runPut (put literalBlock))) of-          Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-          Right ct -> pure ct-      decrypted <--        DC.runConduitRes $-        CL.sourceList-          [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-        conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-        CL.consume-      case decrypted of-        [LiteralDataPkt _ _ _ gotPayload] ->-          assertEqual-            "v4 Curve25519Legacy ECDH should unwrap after wrapped-MPI leading-zero truncation"-            payload-            gotPayload-        other ->-          assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testConduitDecryptSEIPDv2RejectsV6Curve25519LegacyNonTable30Params :: Assertion-testConduitDecryptSEIPDv2RejectsV6Curve25519LegacyNonTable30Params = do-  let recipientSecretRaw = B.pack [1 .. 32]-      ephSecretRaw = B.pack [101 .. 132]-      recipientSecret =-        case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize Curve25519Legacy recipient secret key: " ++ show err)-          Right sk -> sk-      ephSecret =-        case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize Curve25519Legacy ephemeral secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString-      ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString-      recipientPKP =-        PKPayload-          V6-          (ThirtyTwoBitTimeStamp 0)-          0-          ECDH-          (ECDHPubKey-             (EdDSAPubKey Ed25519 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-             SHA512-             AES256)-      recipientSKey =-        ECDHPrivateKey-          (ECDSA_PrivateKey-             (ECDSA.PrivateKey (ECCT.getCurveByName ECCT.SEC_p256r1) (os2ip recipientSecretRaw)))-      sessionKey = B.replicate 32 0x3d-      encodedSession =-        B.singleton (fromFVal AES256) <>-        sessionKey <>-        encodeChecksum16 sessionKey <>-        B.replicate 5 0-      sharedSecret = BA.convert (C25519.dh (C25519.toPublic ephSecret) recipientSecret) :: B.ByteString-      kdfParam = buildCurve25519LegacyKdfParamForTest recipientPKP ECDH SHA512 AES256-      kek = deriveECDHKekForTest SHA512 AES256 sharedSecret kdfParam-      wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession-      pkesk =-        PKESKPkt-          (PKESKPayloadV3Packet-             (PKESKPayloadV3-             3-             (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")-             ECDH-             (MPI (os2ip ephPublicRaw) :| [MPI (os2ip wrappedSession)])))-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk ecdh v6 curve25519legacy strict path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipientPKP-                , pkeskRecipientSKey = recipientSKey-                }))-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  result <--    catch-      (Right <$>-       DC.runConduitRes-         (CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-          conduitDecryptWithDecryptPolicy lenientDecryptPolicy keyContextCallback passphraseCallback DC..|-          CL.consume))-      (\e -> pure (Left (show (e :: SomeException))))-  case result of-    Left err ->-      assertBool-        "v6 Curve25519Legacy ECDH should remain strict"-        ("Table 30 policy violation" `isInfixOf` err)-    Right packets ->-      assertFailure-        ("Expected Table 30 policy failure, got decrypted packets: " ++ show packets)--testConduitDecryptSEIPDv2WithPKESKX448Unwrap :: Assertion-testConduitDecryptSEIPDv2WithPKESKX448Unwrap = do-  let recipientSecretRaw = B.pack [1 .. 56]-      ephSecretRaw = B.pack [57 .. 112]-      sessionKey = B.replicate 32 0x4d-      encodedSession =-        B.singleton (fromFVal AES256) <>-        sessionKey <>-        encodeChecksum16 sessionKey <>-        B.replicate 5 0-      recipientSecret =-        case CE.eitherCryptoError (C448.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X448 recipient secret key: " ++ show err)-          Right sk -> sk-      ephSecret =-        case CE.eitherCryptoError (C448.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize X448 ephemeral secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C448.toPublic recipientSecret) :: B.ByteString-      ephPublicRaw = BA.convert (C448.toPublic ephSecret) :: B.ByteString-      sharedSecret = BA.convert (C448.dh (C448.toPublic recipientSecret) ephSecret) :: B.ByteString-      kek = deriveX448KekForTest ephPublicRaw recipientPublicRaw sharedSecret-      wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession-      esk =-        ephPublicRaw <>-        B.singleton (fromIntegral (B.length wrappedSession)) <>-        wrappedSession-      recipientPKP =-        PKPayload-          V6-          (ThirtyTwoBitTimeStamp 0)-          0-          X448-          (EdDSAPubKey Ed448 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-      recipientRid = unFingerprint (fingerprint recipientPKP)-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk x448 unwrap decrypt path"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipientPKP-                , pkeskRecipientSKey = X448PrivateKey recipientSecretRaw-                }))-      pkesk =-        PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 recipientRid X448 (BL.fromStrict esk)))-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  decrypted <--    DC.runConduitRes $-    CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-    conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..|-    CL.consume-  case decrypted of-    [LiteralDataPkt _ _ _ gotPayload] ->-      assertEqual "PKESK X448 unwrap decrypt payload" payload gotPayload-    other ->-      assertFailure ("Expected one decrypted literal packet, got " ++ show other)--testConduitDecryptSEIPDv2RejectsPKESKX448WrongEphemeralLength :: Assertion-testConduitDecryptSEIPDv2RejectsPKESKX448WrongEphemeralLength = do-  let recipientSecretRaw = B.pack [1 .. 56]-      ephSecretRaw = B.pack [57 .. 112]-      sessionKey = B.replicate 32 0x4d-      encodedSession =-        B.singleton (fromFVal AES256) <>-        sessionKey <>-        encodeChecksum16 sessionKey <>-        B.replicate 5 0-      recipientSecret =-        case CE.eitherCryptoError (C448.secretKey recipientSecretRaw) of-          Left err -> error ("failed to initialize X448 recipient secret key: " ++ show err)-          Right sk -> sk-      ephSecret =-        case CE.eitherCryptoError (C448.secretKey ephSecretRaw) of-          Left err -> error ("failed to initialize X448 ephemeral secret key: " ++ show err)-          Right sk -> sk-      recipientPublicRaw = BA.convert (C448.toPublic recipientSecret) :: B.ByteString-      ephPublicRaw = BA.convert (C448.toPublic ephSecret) :: B.ByteString-      shortEphemeral = B.tail ephPublicRaw-      sharedSecret = BA.convert (C448.dh (C448.toPublic recipientSecret) ephSecret) :: B.ByteString-      kek = deriveX448KekForTest ephPublicRaw recipientPublicRaw sharedSecret-      wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession-      esk =-        shortEphemeral <>-        B.singleton (fromIntegral (B.length wrappedSession)) <>-        wrappedSession-      recipientPKP =-        PKPayload-          V6-          (ThirtyTwoBitTimeStamp 0)-          0-          X448-          (EdDSAPubKey Ed448 (NativeEPoint (EPoint (os2ip recipientPublicRaw))))-      recipientRid = unFingerprint (fingerprint recipientPKP)-      salt = Salt (B.pack [0x00 .. 0x1f])-      payload = "pkesk x448 wrong ephemeral length"-      literalBlock =-        Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) payload]-      passphraseCallback _ = pure BL.empty-      keyContextCallback _ =-        pure-          (Just-             (PKESKRecipientKey-                { pkeskRecipientPKPayload = Just recipientPKP-                , pkeskRecipientSKey = X448PrivateKey recipientSecretRaw-                }))-      pkesk =-        PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 recipientRid X448 (BL.fromStrict esk)))-  ciphertext <--    case encryptSEIPDv2Payload AES256 OCB 6 salt (SessionKey sessionKey) (BL.toStrict (runPut (put literalBlock))) of-      Left err -> assertFailure ("encryptSEIPDv2Payload failed: " ++ err) >> pure mempty-      Right ct -> pure ct-  result <--    catch-      (Right <$>-       DC.runConduitRes-         (CL.sourceList [pkesk, SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))] DC..|-          conduitDecryptWithPKESKContext keyContextCallback passphraseCallback DC..|-          CL.consume))-      (\e -> pure (Left (show (e :: SomeException))))-  case result of-    Left err ->-      assertBool-        "PKESKv6 X448 unwrap should reject non-56-byte ephemeral values"-        ("expected 56-octet ephemeral value" `isInfixOf` err)-    Right packets ->-      assertFailure-        ("Expected X448 ephemeral-length validation failure, got: " ++ show packets)--testDecodeOpenPGPEncodedSessionKeyRejectsTooShort :: Assertion-testDecodeOpenPGPEncodedSessionKeyRejectsTooShort =-  assertEqual-    "encoded session key should reject too-short payloads"-    (Left EncodedSessionKeyTooShort)-    (decodeOpenPGPEncodedSessionKey (B.pack [0x09, 0x01]))--testDecodeOpenPGPEncodedSessionKeyRejectsLengthMismatch :: Assertion-testDecodeOpenPGPEncodedSessionKeyRejectsLengthMismatch =-  assertEqual-    "encoded session key should reject algorithm/key-length mismatches"-    (Left (EncodedSessionKeyLengthMismatch AES128 16 3))-    (decodeOpenPGPEncodedSessionKey (B.pack [fromFVal AES128, 0x01, 0x02, 0x03]))--testDecodeOpenPGPEncodedSessionKeyRejectsChecksumMismatch :: Assertion-testDecodeOpenPGPEncodedSessionKeyRejectsChecksumMismatch =-  assertEqual-    "encoded session key should reject checksum mismatches"-    (Left EncodedSessionKeyChecksumMismatch)-    (decodeOpenPGPEncodedSessionKey (B.pack ([fromFVal AES128] <> replicate 16 0x00 <> [0x00, 0x01])))--testSKESKRejectsUnknownVersion :: Assertion-testSKESKRejectsUnknownVersion = do-  let s2k = Simple SHA256-      pkt = SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 AES128 s2k Nothing))-      encoded = BL.toStrict (runPut (put pkt))-      malformed = BL.fromStrict (B.take 2 encoded <> B.singleton 5 <> B.drop 3 encoded)-  case runGet (get :: Get Pkt) malformed of-    Right (BrokenPacketPkt errReason 3 _) ->-      assertBool-        ("expected unsupported SKESK version error, got: " ++ errReason)-        ("unsupported SKESK packet version" `isInfixOf` errReason)-    Right other ->-      assertFailure ("unknown SKESK version should not parse successfully: " ++ show other)-    Left err ->-      assertFailure ("unknown SKESK version should be reported as a broken packet: " ++ err)--testSKESK4EncryptedSessionKeyRejectsSimpleS2K :: Assertion-testSKESK4EncryptedSessionKeyRejectsSimpleS2K = do-  let pkt =-        SKESKPkt-          (SKESKPayloadV4Packet-             (SKESKPayloadV4 AES128 (Simple SHA256) (Just (BL.pack [0x01, 0x02, 0x03]))))-      encoded = runPut (put pkt)-  case runGet (get :: Get Pkt) encoded of-    Right (BrokenPacketPkt errReason 3 _) ->-      assertBool-        ("expected Simple S2K rejection, got: " ++ errReason)-        ("must not use Simple S2K" `isInfixOf` errReason)-    Right other ->-      assertFailure-        ("Simple-S2K v4 SKESK with encrypted session key should not parse successfully: " ++-         show other)-    Left err ->-      assertFailure-        ("Simple-S2K v4 SKESK with encrypted session key should be reported as a broken packet: " ++-         err)--testSKESK4Argon2EncryptedSessionKeyRoundTripAcrossAES :: Assertion-testSKESK4Argon2EncryptedSessionKeyRoundTripAcrossAES =-  mapM_ assertRoundTrip [AES128, AES192, AES256]-  where-    passphrase = "password"-    s2k = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15-    assertRoundTrip sa = do-      keyLen <--        case keySize sa of-          Left err -> assertFailure ("keySize failed for " ++ show sa ++ ": " ++ show err) >> fail "keySize failed"-          Right n -> pure n-      kek <--        case string2Key s2k keyLen passphrase of-          Left err ->-            assertFailure ("string2Key failed for " ++ show sa ++ ": " ++ renderS2KError err) >>-            fail "string2Key failed"-          Right x -> pure x-      let sessionKey = B.pack (take keyLen (cycle [0x11, 0x22, 0x33, 0x44]))-          encodedSessionKey = B.singleton (fromFVal sa) <> sessionKey-      encryptedEsk <--        case withSymmetricCipher sa kek $ \cipher ->-               paddedCfbEncrypt-                 cipher-                 (B.replicate (blockSize cipher) 0)-                 encodedSessionKey of-          Left err ->-            assertFailure ("encrypting SKESK v4 ESK failed for " ++ show sa ++ ": " ++ show err) >>-            fail "encrypting SKESK v4 ESK failed"-          Right x -> pure x-      let skesk = SKESK4Packet sa s2k (Just (BL.fromStrict encryptedEsk))-      case skesk2SessionKey skesk passphrase of-        Right (decodedAlgo, decodedSessionKey) -> do-          assertEqual ("decoded SKESK v4 encrypted ESK algorithm for " ++ show sa) sa decodedAlgo-          assertEqual ("decoded SKESK v4 encrypted ESK session key for " ++ show sa) sessionKey decodedSessionKey-        Left err ->-          assertFailure-            ("decoding SKESK v4 encrypted ESK failed for " ++-             show sa ++ ": " ++ renderS2KError err)--testSKESK4Argon2EncryptedSessionKeyRejectsTrailingChecksum :: Assertion-testSKESK4Argon2EncryptedSessionKeyRejectsTrailingChecksum = do-  let sa = AES128-      passphrase = "password"-      s2k = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15-      sessionKey = B.pack (take 16 (cycle [0xaa, 0xbb, 0xcc, 0xdd]))-  keyLen <--    case keySize sa of-      Left err -> assertFailure ("keySize failed: " ++ show err) >> fail "keySize failed"-      Right n -> pure n-  kek <--    case string2Key s2k keyLen passphrase of-      Left err -> assertFailure ("string2Key failed: " ++ renderS2KError err) >> fail "string2Key failed"-      Right x -> pure x-  let encodedWithChecksum =-        B.singleton (fromFVal sa) <> sessionKey <> encodeChecksum16 sessionKey-  encryptedEsk <--    case withSymmetricCipher sa kek $ \cipher ->-           paddedCfbEncrypt-             cipher-             (B.replicate (blockSize cipher) 0)-             encodedWithChecksum of-      Left err ->-        assertFailure ("encrypting malformed SKESK v4 ESK failed: " ++ show err) >>-        fail "encrypting malformed SKESK v4 ESK failed"-      Right x -> pure x-  let skesk = SKESK4Packet sa s2k (Just (BL.fromStrict encryptedEsk))-  case skesk2SessionKey skesk passphrase of-    Left (S2KEncryptedSessionKeyDecodeError (EncodedSessionKeyLengthMismatch AES128 16 18)) -> pure ()-    Left err ->-      assertFailure-        ("expected SKESK v4 trailing-checksum rejection, got: " ++-         renderS2KError err)-    Right _ ->-      assertFailure "expected SKESK v4 trailing-checksum rejection, but decode succeeded"--testEncryptPassphraseWithPolicyForceV4Interop :: Assertion-testEncryptPassphraseWithPolicyForceV4Interop = do-  let request =-        PassphraseEncryptRequest-          { passphraseEncryptVersionPolicy = PassphraseSKESKForceV4Interop-          , passphraseEncryptSymmetricAlgorithm = AES128-          , passphraseEncryptS2K = Simple SHA256-          , passphraseEncryptPassphrase = "password"-          , passphraseEncryptPayload = "hello"-          , passphraseEncryptSEIPDv1IVOverride = Just (IV (B.replicate 16 0x22))-          , passphraseEncryptSEIPDv2AEADOverride = Nothing-          , passphraseEncryptSEIPDv2ChunkSizeOverride = Nothing-          , passphraseEncryptSEIPDv2SaltOverride = Nothing-          }-  result <- encryptPassphraseWithPolicy request-  case result of-    Left err ->-      assertFailure ("Expected passphrase SKESK force-v4 encryption to succeed, got: " ++ err)-    Right (SKESKPkt (SKESKPayloadV4Packet _):SymEncIntegrityProtectedDataPkt (SEIPD1 _ _):_) ->-      pure ()-    Right packets ->-      assertFailure-        ("Expected SKESKv4 + SEIPDv1 packet sequence, got: " ++ show packets)--testEncryptPassphraseWithPolicyPreferV6 :: Assertion-testEncryptPassphraseWithPolicyPreferV6 = do-  let request =-        PassphraseEncryptRequest-          { passphraseEncryptVersionPolicy = PassphraseSKESKPreferV6-          , passphraseEncryptSymmetricAlgorithm = AES128-          , passphraseEncryptS2K = Simple SHA256-          , passphraseEncryptPassphrase = "password"-          , passphraseEncryptPayload = "hello"-          , passphraseEncryptSEIPDv1IVOverride = Nothing-          , passphraseEncryptSEIPDv2AEADOverride = Just OCB-          , passphraseEncryptSEIPDv2ChunkSizeOverride = Just 6-          , passphraseEncryptSEIPDv2SaltOverride = Just (Salt (B.replicate 32 0x44))-          }-  result <- encryptPassphraseWithPolicy request-  case result of-    Left err ->-      assertFailure ("Expected passphrase SKESK prefer-v6 encryption to succeed, got: " ++ err)-    Right (SKESKPkt (SKESKPayloadV6Packet _):SymEncIntegrityProtectedDataPkt (SEIPD2 _ _ _ _ _):_) ->-      pure ()-    Right packets ->-      assertFailure-        ("Expected SKESKv6 + SEIPDv2 packet sequence, got: " ++ show packets)--testArgon2S2KVector :: Assertion-testArgon2S2KVector = do-  let s2k = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15-      pass = BLC8.pack "password"-      derivedKeyResult = string2Key s2k 16 pass-  derivedKey <--    case derivedKeyResult of-      Left err ->-        assertFailure ("Argon2 S2K key derivation failed: " ++ renderS2KError err) >>-        fail "Argon2 key derivation failed"-      Right x -> pure x-  let-      hex = map toUpper . BLC8.unpack . B16L.encode . BL.fromStrict $ derivedKey-  assertEqual-    "Argon2 S2K key derivation vector"-    "A3BDFE3814D790F1F366ABA6954EB386"-    hex--testArgon2S2KOrdTotal :: Assertion-testArgon2S2KOrdTotal = do-  let argon2A = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15-      argon2B = Argon2 (Salt16 (B.pack [0x01 .. 0x10])) 1 4 15-  assertEqual-    "Argon2 S2K compares after simple S2K"-    GT-    (compare argon2A (Simple SHA256))-  assertEqual-    "Argon2 S2K compares before unknown S2K types"-    LT-    (compare argon2A (OtherS2K 101 BL.empty))-  assertEqual-    "Argon2 S2K constructor compares lexicographically by fields"-    LT-    (compare argon2A argon2B)+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++module Tests.Encryption (encryptionAndCompressionTests) where++import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA+import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor (..))+import Control.Exception.Base (SomeException, catch, try)+import Control.Monad (void)+import Control.Monad.Trans.Resource (ResourceT)+import qualified Crypto.Error as CE+import Crypto.Number.ModArithmetic (inverse)+import Crypto.Number.Serialize (i2osp, os2ip)+import qualified Crypto.PubKey.Curve25519 as C25519+import qualified Crypto.PubKey.Curve448 as C448+import qualified Crypto.PubKey.ECC.DH as ECCDH+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import Crypto.PubKey.ECC.Prim (pointBaseMul)+import qualified Crypto.PubKey.ECC.Types as ECCT+import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.RSA.PKCS15 as P15+import Data.Binary (get, put)+import Data.Binary.Get+    ( Get+    )+import Data.Binary.Put (putWord16be, runPut)+import qualified Data.ByteArray as BA+import qualified Data.ByteString as B+import qualified Data.ByteString.Base16.Lazy as B16L+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC8+import Data.Char (toUpper)+import Data.Conduit (fuseBoth)+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.List (find, isInfixOf)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Maybe (listToMaybe)+import qualified Data.Set as Set+import Data.Word (Word16)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit+    ( Assertion+    , assertBool+    , assertEqual+    , assertFailure+    , testCase+    )++import Codec.Encryption.OpenPGP.BlockCipher+    ( keySize+    , withSymmetricCipher+    )+import Codec.Encryption.OpenPGP.CFB+import Codec.Encryption.OpenPGP.Compression+    ( CompressionError (..)+    , compressPkts+    , decompressPkt+    )+import Codec.Encryption.OpenPGP.Encrypt+    ( EncryptCompatibilityProfile (..)+    , PKESKEncryptError+        ( InvalidRecipientIdentifier+        , InvalidRecipientKeyMaterial+        , PayloadBuildFailure+        , RecipientCapabilitySelectionFailure+        , RecipientKdfFailure+        , UnsupportedRecipientAlgorithm+        )+    , PKESKVersionPolicy (..)+    , PassphraseEncryptRequest (..)+    , PassphraseSKESKVersionPolicy (..)+    , RecipientCapabilities (..)+    , RecipientCapabilityError+        ( RecipientCapabilityMissingSEIPDv1Support+        , RecipientCapabilityNoCommonAEADAlgorithms+        , RecipientCapabilityNoCommonSymmetricAlgorithms+        , RecipientCapabilityNoEncryptableKeyMaterialInTK+        )+    , RecipientCapabilityNegotiationMode (..)+    , RecipientEncryptRequest (..)+    , RecipientEncryptRequestOverrides (..)+    , RecipientEncryptResult (..)+    , RecipientEncryptionTarget (..)+    , RecipientEncryptionTargetRejected (..)+    , RecipientEncryptionTargetsReport (..)+    , RecipientPKESKVersionStrategy (..)+    , RecipientPayloadShape (..)+    , RecipientTargetRejectionReason (..)+    , RecipientTargetSelectionPolicy (..)+    , buildPKESKPayloadForRecipient+    , buildPKESKv3PayloadForRecipient+    , canonicalizePKESKRecipientId+    , defaultRecipientPayloadShape+    , encryptForRecipients+    , encryptForRecipientsLegacy+    , encryptForRecipientsWithCapabilityNegotiation+    , encryptPassphraseWithPolicy+    , encryptSEIPDv2Payload+    , pkeskSessionAlgorithm+    , pkeskV3SessionMaterial+    , recipientCapabilitiesFromSubpacketPayloads+    , recipientEncryptionTarget+    , recipientEncryptionTargetFromTK+    , recipientEncryptionTargetFromTKAtTimestamp+    , recipientEncryptionTargetFromTKAtTimestampWithPolicy+    , recipientEncryptionTargetWithCapabilities+    , recipientEncryptionTargetWithStrategy+    , recipientEncryptionTargetsFromTK+    , recipientEncryptionTargetsFromTKAtTimestamp+    , recipientEncryptionTargetsReportFromTKAtTimestamp+    , recipientVersionStrategyForProfile+    )+import Codec.Encryption.OpenPGP.Fingerprint (fingerprint)+import Codec.Encryption.OpenPGP.Internal (point2MBS)+import Codec.Encryption.OpenPGP.Internal.HOBlockCipher+    ( HOBlockCipher (..)+    )+import Codec.Encryption.OpenPGP.Message+    ( SessionMaterialExposure (..)+    , encryptedPayloadBytes+    , mkClearPayload+    , mkPassphrase+    )+import Codec.Encryption.OpenPGP.Policy+    ( OpenPGPPolicy (..)+    , OpenPGPRFC (..)+    , defaultDecryptPolicy+    , defaultPolicy+    , lenientDecryptPolicy+    , policyForRFC+    )+import Codec.Encryption.OpenPGP.S2K+    ( EncodedSessionKeyError (..)+    , S2KError (..)+    , decodeOpenPGPEncodedSessionKey+    , renderS2KError+    , skesk2SessionKey+    , string2Key+    )+import Codec.Encryption.OpenPGP.SecretKey+    ( decryptPrivateKey+    , encryptPrivateKeyWithPolicyAndSaltAndIV+    )+import Codec.Encryption.OpenPGP.Serialize (parsePkts)+import Codec.Encryption.OpenPGP.Types+import Data.Conduit.OpenPGP.Compression (conduitCompress)+import Data.Conduit.OpenPGP.Decrypt+    ( DecryptKeyResolution (..)+    , DecryptOptions (..)+    , DecryptOutcome (..)+    , PKESKRecipientKey (..)+    )+import qualified Data.Conduit.OpenPGP.Decrypt as DCD+import Data.Conduit.OpenPGP.Keyring+    ( conduitToSomeTKsDroppingEither+    , conduitToSomeTKsEither+    , conduitToTKsDroppingEither+    , conduitToTKsEither+    )+import Tests.Common+    ( aesKeyWrapRFC3394ForTest+    , armorPayload+    , assertX25519EskShape+    , assertX448EskShape+    , buildCurve25519LegacyKdfParamForTest+    , buildECDHKDFParamForTest+    , cgp+    , collectSecretKeyInfos+    , conduitDecrypt+    , conduitDecryptChecked+    , conduitDecryptCheckedWithDecryptPolicy+    , conduitDecryptWithCandidatesCallbackAndPolicy+    , conduitDecryptWithDecryptPolicy+    , conduitDecryptWithPKESKContext+    , deriveECDHKekForTest+    , deriveX25519KekForTest+    , deriveX448KekForTest+    , doPkeyAndSkeyMatch+    , encodeChecksum16+    , encryptMessageDefault+    , fixturePath+    , forceVersionedRecipientIdentifier+    , isPrecedingESK+    , loadArmor+    , loadDeterministicEd25519Signer+    , loadSEIPDv2FixtureWithV4Secret+    , loadUnencryptedRsaSigner+    , mkPKESKSessionMaterialOrFail+    , prependUnusableLatestPKESK+    , readFixtureLazy+    , readFixturePackets+    , readFixtureStrict+    , readPKIPassphrase+    , reorderPrecedingPKESKs+    , runGet+    , selectRecipientKeyInfo+    , selectRecipientKeyInfoByRawRecipientId+    , setKeyTimestamp+    , setKeyVersion+    , signDirectKeyWithRSAExtrasAt+    , signSubkeyBindingWithRSAExtrasAt+    , signSubkeyRevocationWithRSAAt+    , testEncodeOpenPGPSessionMaterial+    , testParsedRSASecretKeyPKCS15DecryptNotMessageNotRecognized+    , testSEIPDv2ForV4KeyArmor+    , testSEIPDv2ThreeRecipientsArmor+    , testSEIPDv2TwoRecipientsArmor+    )++mkLegacySymmetricCase+    :: (String, Bool, FilePath, FilePath, BL.ByteString) -> TestTree+mkLegacySymmetricCase (label, expectSEIPDv1, encFile, passFile, cleartext) =+    testCase+        label+        ( testLegacySymmetricEncryption+            expectSEIPDv1+            encFile+            passFile+            cleartext+        )++legacySymmetricCases+    :: [(String, Bool, FilePath, FilePath, BL.ByteString)]+legacySymmetricCases =+    [+        ( "Symmetric Encryption simple S2K SHA1 3DES, no MDC"+        , False+        , "encryption-sym-3des-s2k0.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted S2K SHA1 3DES, no MDC"+        , False+        , "encryption-sym-3des.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption simple S2K SHA1 3DES"+        , True+        , "encryption-sym-3des-mdc-s2k0.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted S2K SHA1 3DES"+        , True+        , "encryption-sym-3des-mdc.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption simple S2K SHA1 CAST5, no MDC"+        , False+        , "encryption-sym-cast5-s2k0.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted S2K SHA1 CAST5, no MDC"+        , False+        , "encryption-sym-cast5.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption simple S2K SHA1 CAST5"+        , True+        , "encryption-sym-cast5-mdc-s2k0.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted S2K SHA1 CAST5"+        , True+        , "encryption-sym-cast5-mdc.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption simple S2K SHA1 Blowfish, no MDC"+        , False+        , "encryption-sym-blowfish-s2k0.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted S2K SHA1 Blowfish, no MDC"+        , False+        , "encryption-sym-blowfish.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption simple S2K SHA1 Blowfish"+        , True+        , "encryption-sym-blowfish-mdc-s2k0.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted S2K SHA1 Blowfish"+        , True+        , "encryption-sym-blowfish-mdc.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption simple S2K SHA1 AES128"+        , True+        , "encryption-sym-aes128-s2k0.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted S2K SHA1 AES128"+        , True+        , "encryption-sym-aes128.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption simple S2K SHA1 AES192"+        , True+        , "encryption-sym-aes192-s2k0.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted S2K SHA1 AES192"+        , True+        , "encryption-sym-aes192.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption simple S2K SHA1 AES256"+        , True+        , "encryption-sym-aes256-s2k0.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted S2K SHA1 AES256"+        , True+        , "encryption-sym-aes256.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted S2K SHA256 AES256"+        , True+        , "encryption-sym-aes256-sha256.pgp"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption simple S2K SHA1 Twofish"+        , True+        , "encryption-sym-twofish-s2k0.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted S2K SHA1 Twofish"+        , True+        , "encryption-sym-twofish.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption simple Camellia128"+        , True+        , "encryption-sym-camellia128-s2k0.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted Camellia128"+        , True+        , "encryption-sym-camellia128.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted Camellia192"+        , True+        , "encryption-sym-camellia192.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption iterated-salted Camellia256"+        , True+        , "encryption-sym-camellia256.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "Symmetric Encryption pgcrypto"+        , True+        , "encryption-sym-pgcrypto.pgp"+        , "pgcrypto-passphrase.txt"+        , "{\"t\":\"plus\"}"+        )+    ]++mkStrictSymmetricCase+    :: (String, FilePath, FilePath, BL.ByteString) -> TestTree+mkStrictSymmetricCase (label, encFile, passFile, cleartext) =+    testCase+        label+        (testSymmetricEncryption encFile passFile cleartext)++strictSymmetricCases+    :: [(String, FilePath, FilePath, BL.ByteString)]+strictSymmetricCases =+    [+        ( "strict policy AES128 iterated-salted S2K SEIPDv1"+        , "encryption-sym-aes128.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "strict policy AES192 iterated-salted S2K SEIPDv1"+        , "encryption-sym-aes192.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ,+        ( "strict policy AES256 iterated-salted S2K SEIPDv1"+        , "encryption-sym-aes256.gpg"+        , "symmetric-password.txt"+        , "test\n"+        )+    ]++mkSyntheticNISTP256+    :: B.ByteString -> (ECDSA.PublicKey, ECDSA.PrivateKey)+mkSyntheticNISTP256 bs =+    let curve = ECCT.getCurveByName ECCT.SEC_p256r1+        d = os2ip bs+        q = pointBaseMul curve d+        pub = ECDSA.PublicKey curve q+        priv = ECDSA.PrivateKey curve d+     in (pub, priv)++syntheticNISTP256Low+    , syntheticNISTP256High+        :: (ECDSA.PublicKey, ECDSA.PrivateKey)+syntheticNISTP256Low = mkSyntheticNISTP256 $ B.pack [1 .. 32]+syntheticNISTP256High = mkSyntheticNISTP256 $ B.pack [101 .. 132]++encryptionAndCompressionTests :: TestTree+encryptionAndCompressionTests =+    testGroup+        "Encryption and compression"+        [ testGroup+            "Compression group"+            [ testCase+                "compressedsig.gpg"+                (testCompression "compressedsig.gpg")+            , testCase+                "compressedsig-zlib.gpg"+                (testCompression "compressedsig-zlib.gpg")+            , testCase+                "compressedsig-bzip2.gpg"+                (testCompression "compressedsig-bzip2.gpg")+            , testCase+                "decompressPkt classifies empty ZIP payload"+                ( assertEqual+                    "empty ZIP"+                    (Left (EmptyCompressedPayload ZIP))+                    (decompressPkt (CompressedDataPkt ZIP ""))+                )+            , testCase+                "decompressPkt classifies empty Uncompressed payload"+                ( assertEqual+                    "empty Uncompressed"+                    (Left (EmptyCompressedPayload Uncompressed))+                    (decompressPkt (CompressedDataPkt Uncompressed ""))+                )+            , testCase+                "decompressPkt classifies marker-only ZIP payload"+                ( let markerPkt = MarkerPkt "\x50\x47\x50"+                      compressed = compressPkts ZIP [markerPkt]+                   in assertEqual+                        "marker-only"+                        (Left (MarkerOnlyPayload ZIP))+                        (decompressPkt compressed)+                )+            , testCase+                "decompressPkt passes through non-compressed packets"+                ( let pkt = OtherPacketPkt 255 ""+                   in assertEqual+                        "passthrough"+                        (Right [pkt])+                        (decompressPkt pkt)+                )+            ]+        , testGroup+            "Conduit length group"+            [ testCase+                "conduitCompress (ZIP)"+                ( testConduitOutputLength+                    "pubring.gpg"+                    (cgp DC..| conduitCompress ZIP)+                    1+                )+            , testCase+                "conduitCompress (Zlib)"+                ( testConduitOutputLength+                    "pubring.gpg"+                    (cgp DC..| conduitCompress ZLIB)+                    1+                )+            , testCase+                "conduitCompress (BZip2)"+                ( testConduitOutputLength+                    "pubring.gpg"+                    (cgp DC..| conduitCompress BZip2)+                    1+                )+            , testCase+                "conduitToTKsDroppingEither"+                ( testConduitOutputLength+                    "pubring.gpg"+                    (cgp DC..| conduitToTKsDroppingEither)+                    4+                )+            , testCase+                "conduitToSomeTKsDroppingEither"+                ( testConduitOutputLength+                    "pubring.gpg"+                    (cgp DC..| conduitToSomeTKsDroppingEither)+                    4+                )+            , testCase+                "conduitToTKsEither reports parse failures"+                testConduitToTKsEitherReportsParseFailure+            , testCase+                "conduitToSomeTKsEither reports parse failures"+                testConduitToSomeTKsEitherReportsParseFailure+            , testCase+                "conduitToTKsDroppingEither reports parse failures"+                testConduitToTKsDroppingEitherReportsParseFailure+            , testCase+                "conduitToSomeTKsDroppingEither reports parse failures"+                testConduitToSomeTKsDroppingEitherReportsParseFailure+            ]+        , testGroup+            "Encrypted data"+            ( [ testCase+                    "Legacy symmetric encryption fixture shape"+                    testLegacyEncryptionFixtureShape+              , testCase+                    "SEIPDv1 resync nonce/MDC roundtrip"+                    testSEIPDv1ResyncNonceMdcRoundTrip+              ]+                ++ map mkLegacySymmetricCase legacySymmetricCases+                ++ map mkStrictSymmetricCase strictSymmetricCases+                ++ [ testCase+                        "strict policy rejects SED (no MDC)"+                        ( testStrictPolicyRejectsEncryption+                            "encryption-sym-cast5.gpg"+                            "symmetric-password.txt"+                            "unauthenticated SED"+                        )+                   , testCase+                        "strict policy rejects Simple S2K"+                        ( testStrictPolicyRejectsEncryption+                            "encryption-sym-aes128-s2k0.gpg"+                            "symmetric-password.txt"+                            "Simple S2K specifier"+                        )+                   , testCase+                        "strict policy rejects non-encrypted packet after ESK prelude"+                        testRejectsNonEncryptedAfterESKPrelude+                   , testCase+                        "strict policy rejects SEIPDv2 with only misaligned ESK versions"+                        testRejectsMisalignedESKVersionForSEIPDv2+                   , testCase+                        "strict policy discards misaligned ESK when aligned ESK is present"+                        testDiscardsMisalignedESKWhenAlignedCandidateExists+                   , testCase+                        "strict policy rejects trailing data after SEIPD v2"+                        testTrailingDataRejectedStrictSEIPDv2+                   , testCase+                        "lenient policy reports DecryptTrailingData for trailing packet after SEIPD v2"+                        testTrailingDataReportedLenientSEIPDv2+                   , testCase+                        "conduitDecryptChecked reports DecryptClean for well-formed SEIPD v2"+                        testDecryptCleanSEIPDv2+                   , testCase+                        "conduitDecrypt matches conduitDecryptChecked (default)"+                        testOptionsMatchesCheckedDefaultSEIPDv2+                   , testCase+                        "conduitDecrypt matches legacy conduitDecrypt output (default)"+                        testOptionsMatchesLegacyDefaultOutputSEIPDv2+                   , testCase+                        "conduitDecrypt matches checked lenient trailing behavior"+                        testOptionsMatchesCheckedLenientTrailingSEIPDv2+                   ]+            )+        , testGroup+            "Encrypted secret keys"+            [ testCase+                "SUSSHA1 CAST5 IteratedSalted SHA1 RSA"+                (testSecretKeyDecryption "simple.seckey" "pki-password.txt")+            , testCase+                "SUS16bit CAST5 IteratedSalted SHA1 RSA"+                (testSecretKeyDecryption "16bitcksum.seckey" "pki-password.txt")+            , testCase+                "SUSSHA1 AES256 IteratedSalted SHA512 RSA"+                (testSecretKeyDecryption "aes256-sha512.seckey" "pki-password.txt")+            , testCase+                "SUSSHA1 AES128 IteratedSalted SHA256 ECDSA"+                ( testSecretKeyDecryption+                    "nist_p-256_secretkey.gpg"+                    "pki-password.txt"+                )+            ]+        , testGroup+            "Encrypting secret keys"+            [ testCase+                "legacy secret key encryption rejects implicit SHA-1 protection"+                ( testLegacySecretKeyEncryptionRejected+                    "unencrypted.seckey"+                    "pki-password.txt"+                )+            , testCase+                "SUSym secret key roundtrips"+                testSUSymSecretKeyRoundTrip+            , testCase+                "v6 secret key encryption roundtrips with SUSAEAD"+                testV6SecretKeyEncryptionRoundTrip+            , testCase+                "v4 AEAD OCB secret key compatibility roundtrip"+                testV4SecretKeyAEADOCBRoundTripCompat+            ]+        , testGroup+            "decrypt conduit stuff"+            [ testCase+                "conduitDecrypt supports PKESKv6 with raw session-key callback"+                testConduitDecryptSEIPDv2WithPKESKv6RawSessionKey+            , testCase+                "conduitDecrypt rejects invalid PKESKv6 raw session-key length"+                testConduitDecryptSEIPDv2RejectsWrongPKESKv6RawSessionKeyLength+            , testCase+                "conduitDecrypt unwraps PKESK RSA session keys in-library"+                testConduitDecryptSEIPDv2WithPKESKRSAUnwrap+            , testCase+                "conduitDecrypt probes wildcard callback fallback for PKESKv3 RSA key-id packets"+                testConduitDecryptSEIPDv2WithPKESKRSAUnwrapViaWildcardCallbackFallback+            , testCase+                "conduitDecrypt unwraps PKESKv3 RSA session keys via SHA1-CFB protected key loaded from file"+                testConduitDecryptSEIPDv2WithPKESKRSAUnwrapFromProtectedKey+            , testCase+                "parsed RSA secret key decrypts PKCS#1 v1.5 payload"+                testParsedRSASecretKeyPKCS15DecryptNotMessageNotRecognized+            , testCase+                "conduitDecrypt unwraps PKESK ECDH session keys in-library"+                testConduitDecryptSEIPDv2WithPKESKECDHUnwrap+            , testCase+                "conduitDecrypt rejects ECDH ephemeral points with wrong curve length"+                testConduitDecryptSEIPDv2RejectsECDHWrongEphemeralPointLength+            , testCase+                "conduitDecrypt unwraps PKESKv3 X25519 session keys in-library"+                testConduitDecryptSEIPDv2WithPKESKX25519V3Unwrap+            , testCase+                "conduitDecrypt retries wildcard PKESKv3 keys across callback order"+                testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossRecipientKeyOrder+            , testCase+                "conduitDecrypt retries wildcard PKESKv3 keys across long callback order"+                testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder+            , testCase+                "conduitDecrypt retries wildcard PKESKv3 keys across long callback order for SEIPDv1"+                testConduitDecryptSEIPDv1RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder+            , testCase+                "unwrap callback decrypts wildcard PKESKv3 via candidates list"+                testMkCandidateResolverDecryptsWildcardPKESKv3+            , testCase+                "conduitDecrypt wildcard resolver receives typed previous-failure diagnostics"+                testConduitDecryptWildcardResolverProvidesTypedPreviousFailures+            , testCase+                "conduitDecryptWithReport surfaces wildcard resolver diagnostics"+                testConduitDecryptWithReportCapturesWildcardResolverDiagnostics+            , testCase+                "conduitDecrypt rejects PKESKv3 X25519 ephemeral values with wrong length"+                testConduitDecryptSEIPDv2RejectsPKESKX25519V3WrongEphemeralLength+            , testCase+                "conduitDecrypt falls back from Argon2 SKESK to PKESKv3 X25519"+                testConduitDecryptSEIPDv2FallsBackFromArgon2SKESKToPKESKv3X25519+            , testCase+                "conduitDecrypt retries earlier Argon2 SKESKs when latest is unusable"+                testConduitDecryptSEIPDv2FallsBackToEarlierArgon2SKESK+            , testCase+                "conduitDecrypt rejects ECDH KDF/KEK params outside RFC9580 Table 30"+                testConduitDecryptSEIPDv2RejectsECDHNonTable30Params+            , testCase+                "conduitDecrypt allows v4 Curve25519Legacy RFC6637 accepted parameters"+                testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyRFC6637AcceptedParams+            , testCase+                "conduitDecrypt allows v4 Curve25519Legacy with truncated wrapped MPI"+                testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyWithTruncatedWrappedMPI+            , testCase+                "conduitDecrypt keeps v6 Curve25519Legacy ECDH strict"+                testConduitDecryptSEIPDv2RejectsV6Curve25519LegacyNonTable30Params+            , testCase+                "conduitDecrypt unwraps PKESK X448 session keys in-library"+                testConduitDecryptSEIPDv2WithPKESKX448Unwrap+            , testCase+                "conduitDecrypt rejects PKESKv6 X448 ephemeral values with wrong length"+                testConduitDecryptSEIPDv2RejectsPKESKX448WrongEphemeralLength+            , testCase+                "encrypt-side session material encoding uses OpenPGP format"+                testEncodeOpenPGPSessionMaterial+            , testCase+                "encrypt-side PKESK builder wraps RSA recipient session key"+                testBuildPKESKPayloadForRecipientRSA+            , testCase+                "encrypt-side PKESKv3 builder supports RSA v4 interop"+                testBuildPKESKv3PayloadForRecipientRSAInterop+            , testCase+                "encrypt-side PKESKv3 builder supports v6 recipients"+                testBuildPKESKv3PayloadForRecipientSupportsV6Key+            , testCase+                "encrypt-side PKESKv3 builder supports RFC6637 ECDH recipients"+                testBuildPKESKv3PayloadForRecipientECDHInterop+            , testCase+                "PKESKv3 ECDH serializer uses RFC 6637 wire format"+                testPKESKv3ECDHWireFormat+            , testCase+                "encrypt-side PKESKv3 builder supports RFC6637 Curve25519Legacy recipients"+                testBuildPKESKv3PayloadForRecipientCurve25519LegacyInterop+            , testCase+                "encrypt-side PKESKv3 builder rejects non-RFC6637 Curve448Legacy recipients"+                testBuildPKESKv3PayloadForRecipientRejectsCurve448Legacy+            , testCase+                "RFC 9580 v6 X25519 PKESK uses raw-key semantics, not v3-encoded material"+                testBuildPKESKv6PayloadForRecipientX25519RawKeySemantics+            , testCase+                "RFC 9580 v6 X448 PKESK uses raw-key semantics, not v3-encoded material"+                testBuildPKESKv6PayloadForRecipientX448RawKeySemantics+            , testCase+                "encrypt-side policy builder emits PKESK3 for ForceV3Interop"+                testBuildPKESKPayloadForRecipientWithPolicyForceV3Interop+            , testCase+                "encrypt-side profile helper honors recipient capability hints"+                testRecipientVersionStrategyForProfileHonorsHints+            , testCase+                "encryptForRecipients auto-detects mixed recipient PKESK strategies"+                testEncryptRecipientsWithRequestAutoDetectsMixedRecipientStrategies+            , testCase+                "encryptForRecipients negotiates symmetric algorithm from recipient capabilities when enabled"+                testEncryptRecipientsNegotiatesSymmetricAlgorithmWhenEnabled+            , testCase+                "encryptForRecipients negotiates recipient capabilities by default"+                testEncryptRecipientsNegotiatesSymmetricAlgorithmByDefault+            , testCase+                "encryptForRecipientsLegacy preserves capability negotiation opt-out"+                testEncryptRecipientsLegacyKeepsCapabilityNegotiationOptOut+            , testCase+                "encryptForRecipients capability negotiation fails when recipients share no symmetric algorithm"+                testEncryptRecipientsNegotiationFailsWithoutCommonSymmetricAlgorithm+            , testCase+                "recipientCapabilitiesFromSubpacketPayloads extracts preferred AEAD algorithms"+                testRecipientCapabilitiesFromSubpacketPayloadsExtractsPreferredAEADAlgorithms+            , testCase+                "encryptForRecipients negotiates AEAD algorithm from recipient capabilities when enabled"+                testEncryptRecipientsNegotiatesAEADAlgorithmWhenEnabled+            , testCase+                "encryptForRecipients capability negotiation fails when recipients share no AEAD algorithm"+                testEncryptRecipientsNegotiationFailsWithoutCommonAEADAlgorithm+            , testCase+                "encryptForRecipients falls back to SEIPDv1 when recipients do not advertise SEIPDv2 support"+                testEncryptRecipientsSEIPDv2FallsBackWhenRecipientsDoNotAdvertiseV2+            , testCase+                "encryptForRecipients rejects SEIPDv1 when recipients do not advertise MDC support"+                testEncryptRecipientsRejectsSEIPDv1WhenRecipientsDoNotAdvertiseMDC+            , testCase+                "recipientEncryptionTargetsFromTK returns only encryption-capable candidates"+                testRecipientEncryptionTargetsFromTKIncludesOnlyEncryptionCapableKeys+            , testCase+                "recipientEncryptionTargetFromTK prefers encryption-capable subkeys"+                testRecipientEncryptionTargetFromTKPrefersSubkeyOverPrimary+            , testCase+                "recipientEncryptionTargetFromTK rejects TKs without encryptable key material"+                testRecipientEncryptionTargetFromTKRejectsTKWithoutEncryptableKeys+            , testCase+                "recipientEncryptionTargetsReportFromTKAtTimestamp reports sign-only subkey rejection reasons"+                testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsRejections+            , testCase+                "recipientEncryptionTargetsReportFromTKAtTimestamp reports unsupported algorithm rejections"+                testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsUnsupportedAlgorithms+            , testCase+                "recipientEncryptionTargetsReportFromTKAtTimestamp rejects expired subkeys"+                testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsExpiredSubkey+            , testCase+                "recipientEncryptionTargetsReportFromTKAtTimestamp rejects revoked subkeys"+                testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsRevokedSubkey+            , testCase+                "recipientEncryptionTargetsFromTKAtTimestamp extracts effective self-signature capabilities"+                testRecipientEncryptionTargetsFromTKAtTimestampExtractsSelfSigCapabilities+            , testCase+                "recipientEncryptionTargetFromTKAtTimestamp filters subkey self-signatures by timestamp"+                testRecipientEncryptionTargetFromTKAtTimestampAppliesTimestampFiltering+            , testCase+                "recipientEncryptionTargetFromTKAtTimestampWithPolicy can prefer primary key"+                testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersPrimary+            , testCase+                "recipientEncryptionTargetFromTKAtTimestampWithPolicy can prefer newest key"+                testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersNewest+            , testCase+                "recipientEncryptionTargetsFromTK excludes subkeys with non-encrypt key flags"+                testRecipientEncryptionTargetsFromTKRejectsKeyWithNonEncryptFlags+            , testCase+                "recipientEncryptionTargetsFromTK includes subkeys with no key flags advertised"+                testRecipientEncryptionTargetsFromTKIncludesKeyWithNoFlags+            , testCase+                "encryptForRecipients optionally emits one-pass signature packets"+                testEncryptRecipientsWithRequestEmitsOnePassSignatures+            , testCase+                "encryptForRecipients one-pass mode requires issuer metadata"+                testEncryptRecipientsWithRequestRejectsOnePassWhenIssuerMetadataMissing+            , testCase+                "encryptForRecipients with EncryptInteropLegacy produces SEIPDv1 and PKESKv3"+                testEncryptInteropLegacyProducesSEIPDv1+            , testCase+                "encrypt-side PKESK builder reports unsupported recipient algorithms"+                testBuildPKESKPayloadUnsupportedRecipient+            , testCase+                "encrypt-side ECDH PKESK builder rejects SHA1 KDF policy"+                testBuildPKESKPayloadRejectsECDHSHA1+            , testCase+                "encrypt-side canonicalize PKESK recipient id helper"+                testCanonicalizePKESKRecipientIdHelper+            , testCase+                "conduitDecrypt decrypts seipdv2 fixture with matching v6 secret key"+                testConduitDecryptSEIPDv2FixtureWithMatchingV6SecretKey+            , testCase+                "seipdv2-for-v4-key fixture parses as PKESKv6+SEIPDv2"+                testSEIPDv2ForV4KeyArmor+            , testCase+                "conduitDecrypt decrypts seipdv2-for-v4-key fixture with matching v4 secret key"+                testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKey+            , testCase+                "conduitDecrypt tries earlier PKESKs when latest is unusable"+                testConduitDecryptSEIPDv2FixtureIgnoresUnusableLatestPKESK+            , testCase+                "conduitDecrypt matches valid recipient-id forms without caller retries"+                testConduitDecryptSEIPDv2FixtureAcceptsRecipientIdWithoutCallerPermutations+            , testCase+                "conduitDecrypt fails PKESK exhaustion without manual session-key prompt"+                testConduitDecryptPKESKFailureDoesNotRequireManualSessionMaterial+            , testCase+                "seipdv2-two-recipients fixture parses as PKESKv6*2+SEIPDv2"+                testSEIPDv2TwoRecipientsArmor+            , testCase+                "seipdv2-three-recipients fixture parses as PKESKv6*3+SEIPDv2"+                testSEIPDv2ThreeRecipientsArmor+            , testCase+                "conduitDecrypt decrypts seipdv2-two-recipients fixture with matching v4 secret key"+                testConduitDecryptSEIPDv2TwoRecipientsFixtureWithMatchingV4SecretKey+            , testCase+                "conduitDecrypt decrypts reordered+bogus seipdv2-two-recipients PKESKs"+                testConduitDecryptSEIPDv2TwoRecipientsFixtureWithReorderedAndUnusablePKESKs+            , testCase+                "conduitDecrypt decrypts seipdv2-three-recipients fixture with matching v4 secret key"+                testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithMatchingV4SecretKey+            , testCase+                "conduitDecrypt decrypts reordered+bogus seipdv2-three-recipients PKESKs"+                testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithReorderedAndUnusablePKESKs+            ]+        , testGroup+            "ESK/SKESK/ArgonS2K"+            [ testCase+                "encoded session key rejects too-short payloads"+                testDecodeOpenPGPEncodedSessionKeyRejectsTooShort+            , testCase+                "encoded session key rejects algorithm/key-length mismatches"+                testDecodeOpenPGPEncodedSessionKeyRejectsLengthMismatch+            , testCase+                "encoded session key rejects checksum mismatches"+                testDecodeOpenPGPEncodedSessionKeyRejectsChecksumMismatch+            , testCase+                "unknown SKESK version is rejected"+                testSKESKRejectsUnknownVersion+            , testCase+                "v4 SKESK encrypted session keys reject Simple S2K"+                testSKESK4EncryptedSessionKeyRejectsSimpleS2K+            , testCase+                "v4 SKESK Argon2 encrypted ESK roundtrip across AES-128/192/256"+                testSKESK4Argon2EncryptedSessionKeyRoundTripAcrossAES+            , testCase+                "v4 SKESK Argon2 encrypted ESK rejects legacy checksum trailer"+                testSKESK4Argon2EncryptedSessionKeyRejectsTrailingChecksum+            , testCase+                "passphrase SKESK policy ForceV4Interop emits SKESKv4 + SEIPDv1"+                testEncryptPassphraseWithPolicyForceV4Interop+            , testCase+                "passphrase SKESK policy PreferV6 emits SKESKv6 + SEIPDv2"+                testEncryptPassphraseWithPolicyPreferV6+            , testCase "Argon2 S2K derivation vector" testArgon2S2KVector+            , testCase "Argon2 S2K Ord instance is total" testArgon2S2KOrdTotal+            ]+        ]++testCompression :: FilePath -> Assertion+testCompression fpr = do+    bs <- BL.readFile $ "tests/data/" ++ fpr+    let firstpass =+            fmap (concatMap (either (const []) id . decompressPkt) . unBlock)+                . runGet get+                $ bs+    case firstpass of+        Left _ -> assertFailure $ "First pass failed on " ++ fpr+        Right [] ->+            assertFailure $ "First pass of " ++ fpr ++ " decoded to nothing."+        Right packs -> do+            let roundtrip = runPut $ put . Block $ [compressPkts ZIP packs]+            let secondpass =+                    fmap (concatMap (either (const []) id . decompressPkt) . unBlock)+                        . runGet get+                        $ roundtrip+            if secondpass == Right []+                then+                    assertFailure $+                        "Second pass of " ++ fpr ++ " decoded to nothing."+                else assertEqual ("for " ++ fpr) firstpass secondpass++counter :: (Monad m) => DC.ConduitT a DC.Void m Int+counter = CL.fold (const . (1 +)) 0++testConduitOutputLength+    :: FilePath+    -> DC.ConduitT B.ByteString b (ResourceT IO) ()+    -> Int+    -> Assertion+testConduitOutputLength fpr c target = do+    len <-+        DC.runConduitRes $+            CB.sourceFile ("tests/data/" ++ fpr) DC..| c DC..| counter+    assertEqual ("expected length " ++ show target) target len++testConduitToTKsEitherReportsParseFailure :: Assertion+testConduitToTKsEitherReportsParseFailure = do+    results <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/uncompressed-ops-rsa.gpg"+                DC..| conduitGet get+                DC..| conduitToTKsEither+                DC..| CL.consume+    assertBool+        "conduitToTKsEither should report parse failures for non-key packet streams"+        (any (either (const True) (const False)) results)++testConduitToTKsDroppingEitherReportsParseFailure :: Assertion+testConduitToTKsDroppingEitherReportsParseFailure = do+    results <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/uncompressed-ops-rsa.gpg"+                DC..| conduitGet get+                DC..| conduitToTKsDroppingEither+                DC..| CL.consume+    assertBool+        "conduitToTKsDroppingEither should report parse failures for non-key packet streams"+        (any (either (const True) (const False)) results)++testConduitToSomeTKsEitherReportsParseFailure :: Assertion+testConduitToSomeTKsEitherReportsParseFailure = do+    results <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/uncompressed-ops-rsa.gpg"+                DC..| conduitGet get+                DC..| conduitToSomeTKsEither+                DC..| CL.consume+    assertBool+        "conduitToSomeTKsEither should report parse failures for non-key packet streams"+        (any (either (const True) (const False)) results)++testConduitToSomeTKsDroppingEitherReportsParseFailure+    :: Assertion+testConduitToSomeTKsDroppingEitherReportsParseFailure = do+    results <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/uncompressed-ops-rsa.gpg"+                DC..| conduitGet get+                DC..| conduitToSomeTKsDroppingEither+                DC..| CL.consume+    assertBool+        "conduitToSomeTKsDroppingEither should report parse failures for non-key packet streams"+        (any (either (const True) (const False)) results)++-- This needs a lot of work++{- | Decrypt a symmetric-encrypted fixture using 'defaultDecryptPolicy' and+assert the packet structure is SKESK + SEIPDv1 and the cleartext matches.+Only suitable for AES-128/192/256 fixtures with iterated-salted S2K.+-}+testSymmetricEncryption+    :: FilePath -> FilePath -> BL.ByteString -> Assertion+testSymmetricEncryption encfile passfile cleartext = do+    passphrase <- readFixtureLazy passfile+    pt <- readFixturePackets encfile+    assertEqual "wrong number of packets" 2 (length pt)+    skesk <-+        case pt of+            [] ->+                assertFailure+                    ( "expected SKESK packet in "+                        ++ encfile+                        ++ " but packet list was empty"+                    )+                    >> fail "empty fixture packet list"+            (firstPkt : _) ->+                case (fromPktEither firstPkt :: Either String (SKESK 'SKESKV4)) of+                    Left err ->+                        assertFailure ("failed to coerce first packet to SKESK: " ++ err)+                            >> fail err+                    Right x -> pure x+    assertEqual+        "first packet should be SKESK"+        SKESKType+        (packetType skesk)+    case last pt of+        SymEncIntegrityProtectedDataPkt (SEIPD1 1 _) -> pure ()+        other ->+            assertFailure+                ( "second packet should be SEIPDv1 (tag 18, version 1), got: "+                    ++ show other+                )+    decrypted <-+        catch+            ( DC.runConduitRes $+                CL.sourceList pt+                    DC..| conduitDecrypt (fakeCallback passphrase)+                    DC..| CL.consume+            )+            ( \e -> do+                let err = show (e :: SomeException)+                assertFailure ("decryption threw exception: " ++ err)+            )+    payload <-+        case decrypted of+            [] ->+                assertFailure ("decryption produced no packets for " ++ encfile)+                    >> fail "expected decrypted literal packet"+            (firstDecrypted : _) ->+                case (fromPktEither firstDecrypted :: Either String LiteralData) of+                    Left err ->+                        assertFailure+                            ("failed to coerce decrypted packet to literal data: " ++ err)+                            >> fail err+                    Right x -> pure (_literalDataPayload x)+    assertEqual ("cleartext for " ++ encfile) cleartext payload+  where+    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString+    fakeCallback = const . return++testSEIPDv1ResyncNonceMdcRoundTrip :: Assertion+testSEIPDv1ResyncNonceMdcRoundTrip = do+    let sa = AES256+        keyBytes = B.pack [0 .. 31]+        iv = IV (B.pack [32 .. 47])+        cleartext = B.pack [1 .. 80]+        cleartextWithMDC = cleartext <> mdcTrailerForSEIPDv1 iv cleartext+    ciphertext <-+        either+            ( \e ->+                assertFailure ("encryptOpenPGPCfbRaw failed: " ++ show e)+                    >> pure mempty+            )+            pure+            ( encryptOpenPGPCfbRaw+                OpenPGPCFBResyncW+                sa+                iv+                cleartextWithMDC+                keyBytes+            )+    (nonce, decrypted) <-+        either+            ( \e ->+                assertFailure ("decryptOpenPGPCfbWithNonce failed: " ++ show e)+                    >> pure (mempty, mempty)+            )+            pure+            (decryptOpenPGPCfbWithNonce sa ciphertext keyBytes)+    assertEqual+        "SEIPDv1 nonce should match IV||IV[-2:]"+        (seipdv1NonceFromIV iv)+        nonce+    assertEqual+        "decrypted bytes should include payload+MDC"+        cleartextWithMDC+        decrypted+    payloadOut <-+        either+            ( \err ->+                assertFailure ("validateSEIPD1MDC failed: " ++ err)+                    >> pure mempty+            )+            pure+            (validateSEIPD1MDC nonce decrypted)+    assertEqual+        "MDC-verified payload should round-trip"+        cleartext+        payloadOut++{- | Like 'testSymmetricEncryption' but uses 'lenientDecryptPolicy' to permit+legacy RFC4880/RFC2440 message formats (SED, deprecated S2K, old ciphers).+The 'Bool' indicates whether the fixture uses SEIPDv1 (True) or SED (False).+-}+testLegacySymmetricEncryption+    :: Bool -> FilePath -> FilePath -> BL.ByteString -> Assertion+testLegacySymmetricEncryption expectSEIPDv1 encfile passfile cleartext = do+    passphrase <- readFixtureLazy passfile+    pt <- readFixturePackets encfile+    assertEqual "wrong number of packets" 2 (length pt)+    skesk <-+        case pt of+            [] ->+                assertFailure+                    ( "expected SKESK packet in "+                        ++ encfile+                        ++ " but packet list was empty"+                    )+                    >> fail "empty fixture packet list"+            (firstPkt : _) ->+                case (fromPktEither firstPkt :: Either String (SKESK 'SKESKV4)) of+                    Left err ->+                        assertFailure ("failed to coerce first packet to SKESK: " ++ err)+                            >> fail err+                    Right x -> pure x+    assertEqual+        "first packet should be SKESK"+        SKESKType+        (packetType skesk)+    case last pt of+        SymEncDataPkt {}+            | not expectSEIPDv1 -> pure ()+            | otherwise ->+                assertFailure+                    "expected SEIPDv1 packet (tag 18) but got SED (tag 9)"+        SymEncIntegrityProtectedDataPkt (SEIPD1 1 _)+            | expectSEIPDv1 -> pure ()+            | otherwise ->+                assertFailure+                    "expected SED packet (tag 9) but got SEIPDv1 (tag 18)"+        other -> assertFailure ("unexpected second packet: " ++ show other)+    decrypted <-+        catch+            ( DC.runConduitRes $+                CL.sourceList pt+                    DC..| conduitDecryptWithDecryptPolicy+                        lenientDecryptPolicy+                        (\_ -> pure Nothing)+                        (fakeCallback passphrase)+                    DC..| CL.consume+            )+            ( \e -> do+                let err = show (e :: SomeException)+                assertFailure ("decryption threw exception: " ++ err)+            )+    payload <-+        case decrypted of+            [] ->+                assertFailure ("decryption produced no packets for " ++ encfile)+                    >> fail "expected decrypted literal packet"+            (firstDecrypted : _) ->+                case (fromPktEither firstDecrypted :: Either String LiteralData) of+                    Left err ->+                        assertFailure+                            ("failed to coerce decrypted packet to literal data: " ++ err)+                            >> fail err+                    Right x -> pure (_literalDataPayload x)+    assertEqual ("cleartext for " ++ encfile) cleartext payload+  where+    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString+    fakeCallback = const . return++{- | Assert that decrypting with the strict 'defaultDecryptPolicy' throws an+exception whose message contains the given substring.+-}+testStrictPolicyRejectsEncryption+    :: FilePath -> FilePath -> String -> Assertion+testStrictPolicyRejectsEncryption encfile passfile expectedFragment = do+    passphrase <- readFixtureLazy passfile+    pt <- readFixturePackets encfile+    result <-+        try+            ( DC.runConduitRes $+                CL.sourceList pt+                    DC..| conduitDecrypt (fakeCallback passphrase)+                    DC..| CL.consume+            )+            :: IO (Either SomeException [Pkt])+    case result of+        Right _ ->+            assertFailure $+                "Expected strict policy to reject '"+                    ++ encfile+                    ++ "' with error containing '"+                    ++ expectedFragment+                    ++ "', but decryption succeeded"+        Left err ->+            assertBool+                ( "Expected error containing '"+                    ++ expectedFragment+                    ++ "', got: "+                    ++ show err+                )+                (expectedFragment `isInfixOf` show err)+  where+    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString+    fakeCallback = const . return++-- | Decrypt a file and check the 'DecryptOutcome'.+testDecryptOutcome+    :: FilePath -> FilePath -> DecryptOutcome -> Assertion+testDecryptOutcome encfile passfile expectedOutcome = do+    passphrase <- readFixtureLazy passfile+    pt <- readFixturePackets encfile+    (outcome, _pkts) <-+        catch+            ( DC.runConduitRes $+                CL.sourceList pt+                    DC..| fuseBoth+                        (conduitDecryptChecked (fakeCallback passphrase))+                        CL.consume+            )+            ( \e -> do+                let err = show (e :: SomeException)+                assertFailure ("decryption threw unexpected exception: " ++ err)+                fail "unreachable"+            )+    assertEqual+        ("DecryptOutcome for " ++ encfile)+        expectedOutcome+        outcome+  where+    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString+    fakeCallback = const . return++{- | Build a synthetic packet list with an appended trailing packet, decrypt+with lenient policy, and verify 'DecryptTrailingData' is reported.+-}+testTrailingDataReportedLenient+    :: FilePath -> FilePath -> Assertion+testTrailingDataReportedLenient encfile passfile = do+    passphrase <- readFixtureLazy passfile+    pt <- readFixturePackets encfile+    let trailingPkt = OtherPacketPkt 0xFE ""+        ptWithTrailing = pt ++ [trailingPkt]+    (outcome, _pkts) <-+        catch+            ( DC.runConduitRes $+                CL.sourceList ptWithTrailing+                    DC..| fuseBoth+                        ( conduitDecryptCheckedWithDecryptPolicy+                            lenientDecryptPolicy+                            (\_ -> pure Nothing)+                            (fakeCallback passphrase)+                        )+                        CL.consume+            )+            ( \e -> do+                let err = show (e :: SomeException)+                assertFailure+                    ("lenient decrypt threw unexpected exception: " ++ err)+                fail "unreachable"+            )+    assertEqual+        ("DecryptTrailingData for " ++ encfile)+        DecryptTrailingData+        outcome+  where+    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString+    fakeCallback = const . return++{- | Same as above but with strict policy: should throw "after message+integrity boundary".+-}+testTrailingDataRejectedStrict+    :: FilePath -> FilePath -> Assertion+testTrailingDataRejectedStrict encfile passfile = do+    passphrase <- readFixtureLazy passfile+    pt <- readFixturePackets encfile+    let trailingPkt = OtherPacketPkt 0xFE ""+        ptWithTrailing = pt ++ [trailingPkt]+    result <-+        try+            ( DC.runConduitRes $+                CL.sourceList ptWithTrailing+                    DC..| fuseBoth+                        (conduitDecryptChecked (fakeCallback passphrase))+                        CL.consume+            )+            :: IO (Either SomeException (DecryptOutcome, [Pkt]))+    case result of+        Left err ->+            assertFailure+                ( "Expected DecryptMalformedStructure but got exception: "+                    ++ show err+                )+        Right (DecryptMalformedStructure malformedReason, _) ->+            assertBool+                ( "Expected 'after message integrity boundary', got: "+                    ++ malformedReason+                )+                ("after message integrity boundary" `isInfixOf` malformedReason)+        Right (other, _) ->+            assertFailure+                ("Expected DecryptMalformedStructure but got: " ++ show other)+  where+    fakeCallback :: BL.ByteString -> String -> IO BL.ByteString+    fakeCallback = const . return++encryptedSEIPDv2Packets :: IO [Pkt]+encryptedSEIPDv2Packets = do+    let passphrase =+            mkPassphrase+                (BL.pack (map (fromIntegral . fromEnum) ("test" :: String)))+        payload =+            mkClearPayload+                (BL.pack (map (fromIntegral . fromEnum) ("hello" :: String)))+    let result =+            encryptMessageDefault+                DoNotExposeSessionMaterial+                passphrase+                payload+    case result of+        Left err ->+            fail+                ( "encryptedSEIPDv2Packets: encryptMessageDefault failed: "+                    ++ show err+                )+        Right (encPayload, _) ->+            DC.runConduitRes $+                CB.sourceLbs (encryptedPayloadBytes encPayload)+                    DC..| conduitGet get+                    DC..| CL.consume++defaultOptionsForPassphrase :: BL.ByteString -> DecryptOptions+defaultOptionsForPassphrase passphrase =+    DecryptOptions+        { decryptOptionsKeyResolution = DecryptWithoutPKESK+        , decryptOptionsPolicy = defaultDecryptPolicy+        , decryptOptionsPassphraseCallback = const (pure passphrase)+        }++testDecryptCleanSEIPDv2 :: Assertion+testDecryptCleanSEIPDv2 = do+    pt <- encryptedSEIPDv2Packets+    let passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))+        cb = const (pure passphrase)+    (outcome, _) <-+        catch+            ( DC.runConduitRes $+                CL.sourceList pt+                    DC..| fuseBoth (conduitDecryptChecked cb) CL.consume+            )+            ( \e ->+                assertFailure+                    ("unexpected exception: " ++ show (e :: SomeException))+                    >> fail "unreachable"+            )+    assertEqual+        "clean SEIPD v2 should yield DecryptClean"+        DecryptClean+        outcome++testOptionsMatchesCheckedDefaultSEIPDv2 :: Assertion+testOptionsMatchesCheckedDefaultSEIPDv2 = do+    pt <- encryptedSEIPDv2Packets+    let passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))+        cb = const (pure passphrase)+        opts = defaultOptionsForPassphrase passphrase+    checkedResult <-+        DC.runConduitRes $+            CL.sourceList pt+                DC..| fuseBoth (conduitDecryptChecked cb) CL.consume+    optionsResult <-+        DC.runConduitRes $+            CL.sourceList pt+                DC..| fuseBoth (DCD.conduitDecrypt opts) CL.consume+    assertEqual+        "options conduit should match checked conduit on clean decrypt"+        checkedResult+        optionsResult++testOptionsMatchesLegacyDefaultOutputSEIPDv2 :: Assertion+testOptionsMatchesLegacyDefaultOutputSEIPDv2 = do+    pt <- encryptedSEIPDv2Packets+    let passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))+        cb = const (pure passphrase)+        opts = defaultOptionsForPassphrase passphrase+    legacyOutput <-+        DC.runConduitRes $+            CL.sourceList pt DC..| conduitDecrypt cb DC..| CL.consume+    (optionsOutcome, optionsOutput) <-+        DC.runConduitRes $+            CL.sourceList pt+                DC..| fuseBoth (DCD.conduitDecrypt opts) CL.consume+    assertEqual+        "options conduit should report DecryptClean for clean stream"+        DecryptClean+        optionsOutcome+    assertEqual+        "legacy conduit output should match options conduit output"+        legacyOutput+        optionsOutput++testTrailingDataRejectedStrictSEIPDv2 :: Assertion+testTrailingDataRejectedStrictSEIPDv2 = do+    pt <- encryptedSEIPDv2Packets+    let ptWithTrailing = pt ++ [OtherPacketPkt 0xFE ""]+        passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))+        cb = const (pure passphrase)+    result <-+        try+            ( DC.runConduitRes $+                CL.sourceList ptWithTrailing+                    DC..| fuseBoth (conduitDecryptChecked cb) CL.consume+            )+            :: IO (Either SomeException (DecryptOutcome, [Pkt]))+    case result of+        Left err ->+            assertFailure+                ( "Expected DecryptMalformedStructure but got exception: "+                    ++ show err+                )+        Right (DecryptMalformedStructure reason, _) ->+            assertBool+                ("Expected 'after message integrity boundary', got: " ++ reason)+                ("after message integrity boundary" `isInfixOf` reason)+        Right (other, _) ->+            assertFailure+                ( "Expected strict policy to reject trailing data but got: "+                    ++ show other+                )++testTrailingDataReportedLenientSEIPDv2 :: Assertion+testTrailingDataReportedLenientSEIPDv2 = do+    pt <- encryptedSEIPDv2Packets+    let ptWithTrailing = pt ++ [OtherPacketPkt 0xFE ""]+        passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))+        cb = const (pure passphrase)+    (outcome, _) <-+        catch+            ( DC.runConduitRes $+                CL.sourceList ptWithTrailing+                    DC..| fuseBoth+                        ( conduitDecryptCheckedWithDecryptPolicy+                            lenientDecryptPolicy+                            (\_ -> pure Nothing)+                            cb+                        )+                        CL.consume+            )+            ( \e ->+                assertFailure+                    ("unexpected exception: " ++ show (e :: SomeException))+                    >> fail "unreachable"+            )+    assertEqual+        "trailing packet should yield DecryptTrailingData"+        DecryptTrailingData+        outcome++testOptionsMatchesCheckedLenientTrailingSEIPDv2 :: Assertion+testOptionsMatchesCheckedLenientTrailingSEIPDv2 = do+    pt <- encryptedSEIPDv2Packets+    let ptWithTrailing = pt ++ [OtherPacketPkt 0xFE ""]+        passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))+        cb = const (pure passphrase)+        opts =+            DecryptOptions+                { decryptOptionsKeyResolution = DecryptWithoutPKESK+                , decryptOptionsPolicy = lenientDecryptPolicy+                , decryptOptionsPassphraseCallback = cb+                }+    checkedResult <-+        DC.runConduitRes $+            CL.sourceList ptWithTrailing+                DC..| fuseBoth+                    ( conduitDecryptCheckedWithDecryptPolicy+                        lenientDecryptPolicy+                        (\_ -> pure Nothing)+                        cb+                    )+                    CL.consume+    optionsResult <-+        DC.runConduitRes $+            CL.sourceList ptWithTrailing+                DC..| fuseBoth (DCD.conduitDecrypt opts) CL.consume+    assertEqual+        "options conduit should match checked lenient conduit with trailing data"+        checkedResult+        optionsResult++testRejectsNonEncryptedAfterESKPrelude :: Assertion+testRejectsNonEncryptedAfterESKPrelude = do+    pt <- encryptedSEIPDv2Packets+    let malformed =+            case pt of+                [] -> []+                esk : _ ->+                    [ esk+                    , LiteralDataPkt+                        BinaryData+                        BL.empty+                        (ThirtyTwoBitTimeStamp 0)+                        "not-encrypted"+                    ]+        passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))+        cb = const (pure passphrase)+    result <-+        try+            ( DC.runConduitRes $+                CL.sourceList malformed+                    DC..| fuseBoth (conduitDecryptChecked cb) CL.consume+            )+            :: IO (Either SomeException (DecryptOutcome, [Pkt]))+    case result of+        Left err ->+            assertFailure+                ( "Expected DecryptMalformedStructure but got exception: "+                    ++ show err+                )+        Right (DecryptMalformedStructure reason, _) ->+            assertBool+                ("Expected ESK prelude shape failure, got: " ++ reason)+                ( "ESK packets must immediately precede encrypted data"+                    `isInfixOf` reason+                )+        Right (other, _) ->+            assertFailure+                ("Expected DecryptMalformedStructure but got: " ++ show other)++testRejectsMisalignedESKVersionForSEIPDv2 :: Assertion+testRejectsMisalignedESKVersionForSEIPDv2 = do+    pt <- encryptedSEIPDv2Packets+    let malformed =+            case pt of+                ( SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 sa _ s2k _ _ _))+                        : rest+                    ) ->+                        SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k Nothing))+                            : rest+                _ -> pt+        passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))+        cb = const (pure passphrase)+    result <-+        try+            ( DC.runConduitRes $+                CL.sourceList malformed+                    DC..| fuseBoth (conduitDecryptChecked cb) CL.consume+            )+            :: IO (Either SomeException (DecryptOutcome, [Pkt]))+    case result of+        Left err ->+            assertFailure+                ( "Expected DecryptMalformedStructure but got exception: "+                    ++ show err+                )+        Right (DecryptMalformedStructure reason, _) ->+            assertBool+                ("Expected payload/ESK alignment failure, got: " ++ reason)+                ("version-aligned" `isInfixOf` reason)+        Right (other, _) ->+            assertFailure+                ("Expected DecryptMalformedStructure but got: " ++ show other)++testDiscardsMisalignedESKWhenAlignedCandidateExists :: Assertion+testDiscardsMisalignedESKWhenAlignedCandidateExists = do+    pt <- encryptedSEIPDv2Packets+    let withMixedPrelude =+            case pt of+                ( SKESKPkt+                        (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag))+                        : rest+                    ) ->+                        SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k Nothing))+                            : SKESKPkt+                                (SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag))+                            : rest+                _ -> pt+        passphrase = BL.pack (map (fromIntegral . fromEnum) ("test" :: String))+        cb = const (pure passphrase)+    (outcome, _) <-+        catch+            ( DC.runConduitRes $+                CL.sourceList withMixedPrelude+                    DC..| fuseBoth (conduitDecryptChecked cb) CL.consume+            )+            ( \e ->+                assertFailure+                    ("unexpected exception: " ++ show (e :: SomeException))+                    >> fail "unreachable"+            )+    assertEqual+        "misaligned ESKs should be discarded when an aligned ESK is present"+        DecryptClean+        outcome++testSecretKeyDecryption :: FilePath -> FilePath -> Assertion+testSecretKeyDecryption keyfile passfile = do+    passphrase <- readFixtureLazy passfile+    kr <-+        DC.runConduitRes $+            CB.sourceFile (fixturePath keyfile)+                DC..| conduitGet get+                DC..| CL.consume+    SecretKey pkp ska <-+        case kr of+            [] ->+                assertFailure+                    ("no packets found in secret key fixture " ++ keyfile)+                    >> fail "empty secret key fixture"+            (firstPkt : _) ->+                case (fromPktEither firstPkt :: Either String SecretKey) of+                    Left err ->+                        assertFailure+                            ("failed to coerce key packet to SecretKey: " ++ err)+                            >> fail err+                    Right x -> pure x+    decrypted <-+        case decryptPrivateKey (pkp, ska) passphrase of+            Left err ->+                assertFailure ("secret key decryption failed: " ++ err)+                    >> fail "secret key decryption failed"+            Right x -> pure x+    case decrypted of+        SUUnencrypted skey _ -> doPkeyAndSkeyMatch (_pubkey pkp) skey+        other ->+            assertFailure+                ( "secret key decryption should produce an unencrypted secret key, got: "+                    ++ show other+                )++testLegacySecretKeyEncryptionRejected+    :: FilePath -> FilePath -> Assertion+testLegacySecretKeyEncryptionRejected keyfile passfile = do+    passphrase <- readFixtureLazy passfile+    kr <-+        DC.runConduitRes $+            CB.sourceFile (fixturePath keyfile)+                DC..| conduitGet get+                DC..| CL.consume+    SecretKey pkp ska <-+        case kr of+            [] ->+                assertFailure+                    ("no packets found in secret key fixture " ++ keyfile)+                    >> fail "empty secret key fixture"+            (firstPkt : _) ->+                case (fromPktEither firstPkt :: Either String SecretKey) of+                    Left err ->+                        assertFailure+                            ("failed to coerce key packet to SecretKey: " ++ err)+                            >> fail err+                    Right x -> pure x+    case encryptPrivateKeyWithPolicyAndSaltAndIV+        defaultPolicy+        pkp+        (Salt "\226~\197\a\202#\"G")+        (IV "\187\219\253I\236\204\t5D\196\NAK>;\202\185\t")+        ska+        passphrase of+        Left err | "explicit legacy override required" `isInfixOf` err -> pure ()+        Left err ->+            assertFailure+                ( "legacy secret key encryption should be rejected with a policy error, got: "+                    ++ err+                )+        Right _ ->+            assertFailure+                "legacy secret key encryption should reject implicit SHA-1 protection"++testV6SecretKeyEncryptionRoundTrip :: Assertion+testV6SecretKeyEncryptionRoundTrip = do+    passphrase <- readPKIPassphrase+    armors <- loadArmor "v6-secret.pgp.aa"+    armor <-+        case armors of+            (a : _) -> pure a+            [] ->+                assertFailure+                    "v6-secret.pgp.aa should contain one armored payload"+                    >> fail "expected one armored payload"+    let packets = parsePkts (armorPayload armor)+    SecretKey pkp ska <-+        case [ sk+             | pkt <- packets+             , Right sk <- [fromPktEither pkt :: Either String SecretKey]+             ] of+            (sk : _) -> pure sk+            [] ->+                assertFailure+                    "v6-secret.pgp.aa should contain a secret key packet"+                    >> fail "expected secret key packet"+    originalSKey <-+        case ska of+            SUUnencrypted skey _ -> pure skey+            _ ->+                assertFailure+                    "v6-secret.pgp.aa should contain unencrypted secret key material"+                    >> fail "expected unencrypted secret key"+    changed <-+        case encryptPrivateKeyWithPolicyAndSaltAndIV+            defaultPolicy+            pkp+            (Salt "1234567890ABCDEF")+            (IV "1234567890ABCDE")+            ska+            passphrase of+            Left err ->+                assertFailure ("v6 secret key encryption failed: " ++ err)+                    >> fail "v6 secret key encryption failed"+            Right x -> pure x+    case changed of+        SUSAEAD AES256 OCB (Argon2 _ t p em) _ encryptedPayload -> do+            assertEqual+                "v6 secret key encryption should use expected Argon2 t parameter"+                1+                t+            assertEqual+                "v6 secret key encryption should use expected Argon2 p parameter"+                4+                p+            assertEqual+                "v6 secret key encryption should use expected Argon2 encoded memory parameter"+                15+                em+            assertBool+                "v6 secret key encryption should emit encrypted payload"+                (not (BL.null encryptedPayload))+        _ ->+            assertFailure+                "v6 secret key encryption should emit SUSAEAD/AES256/OCB with Argon2 S2K"+    let serialized = runPut (put (toPkt (SecretKey pkp changed)))+        reparsed = parsePkts serialized+    (parsedPKP, parsedSKA) <-+        case reparsed of+            (SecretKeyPkt pkpayload skaddendum : _) -> pure (pkpayload, skaddendum)+            _ ->+                assertFailure+                    "re-serialized v6 secret key should parse back as a secret key packet"+                    >> fail "expected serialized secret key packet"+    decrypted <-+        case decryptPrivateKey (parsedPKP, parsedSKA) passphrase of+            Left err ->+                assertFailure+                    ("v6 secret key roundtrip decryption failed: " ++ err)+                    >> fail "v6 secret key roundtrip decryption failed"+            Right x -> pure x+    case decrypted of+        SUUnencrypted skey _ ->+            assertEqual+                "v6 secret key roundtrip should preserve secret key material"+                originalSKey+                skey+        _ ->+            assertFailure+                "v6 secret key roundtrip should decrypt to unencrypted secret material"++testV4SecretKeyAEADOCBRoundTripCompat :: Assertion+testV4SecretKeyAEADOCBRoundTripCompat = do+    (pkp, privateKey) <- loadUnencryptedRsaSigner+    let skey = RSAPrivateKey (RSA_PrivateKey privateKey)+        passphrase = "legacy-aead-passphrase"+        compatPolicy =+            (policyForRFC RFC4880)+                { policySecretKeyProtection =+                    policySecretKeyProtection defaultPolicy+                }+        salt = Salt (B.pack [0x00 .. 0x0f])+        iv = IV (B.pack [0x10 .. 0x1e])+    encrypted <-+        case encryptPrivateKeyWithPolicyAndSaltAndIV+            compatPolicy+            pkp+            salt+            iv+            (SUUnencrypted skey 0)+            passphrase of+            Left err ->+                assertFailure ("v4 AEAD secret key encryption failed: " ++ err)+                    >> fail "v4 AEAD secret key encryption failed"+            Right x -> pure x+    case encrypted of+        SUSAEAD AES256 OCB (Argon2 _ t p em) _ encryptedPayload -> do+            assertEqual+                "v4 AEAD secret key encryption should use expected Argon2 t"+                1+                t+            assertEqual+                "v4 AEAD secret key encryption should use expected Argon2 p"+                4+                p+            assertEqual+                "v4 AEAD secret key encryption should use expected Argon2 encoded-memory"+                15+                em+            assertBool+                "v4 AEAD secret key encryption should emit encrypted payload"+                (not (BL.null encryptedPayload))+        _ ->+            assertFailure+                "v4 secret key encryption should emit SUSAEAD/AES256/OCB with Argon2 S2K"+    let serialized = runPut (put (toPkt (SecretKey pkp encrypted)))+        reparsed = parsePkts serialized+    (parsedPKP, parsedSKA) <-+        case reparsed of+            (SecretKeyPkt pkpayload skaddendum : _) -> pure (pkpayload, skaddendum)+            _ ->+                assertFailure+                    "re-serialized v4 AEAD secret key should parse back as a secret key packet"+                    >> fail "expected serialized secret key packet"+    decrypted <-+        case decryptPrivateKey (parsedPKP, parsedSKA) passphrase of+            Left err ->+                assertFailure+                    ("v4 AEAD secret key roundtrip decryption failed: " ++ err)+                    >> fail "v4 AEAD secret key roundtrip decryption failed"+            Right x -> pure x+    case decrypted of+        SUUnencrypted skey' _ ->+            assertEqual+                "v4 AEAD secret key roundtrip should preserve secret key material"+                skey+                skey'+        _ ->+            assertFailure+                "v4 AEAD secret key roundtrip should decrypt to unencrypted secret material"++testSUSymSecretKeyRoundTrip :: Assertion+testSUSymSecretKeyRoundTrip = do+    passphrase <- readPKIPassphrase+    packets <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/unencrypted.seckey"+                DC..| conduitGet get+                DC..| CL.consume+    (pkp, skey) <-+        case packets of+            (SecretKeyPkt pkpayload (SUUnencrypted sk _) : _) -> pure (pkpayload, sk)+            _ ->+                assertFailure+                    "unencrypted.seckey did not begin with an unencrypted secret key packet"+                    >> fail "expected unencrypted secret key packet"+    let cleartext = legacyRsaSecretKeyBytes skey+        cleartextLBS = BL.fromStrict cleartext+        clearWithChecksum =+            cleartextLBS <> runPut (putWord16be (legacyChecksum16 cleartext))+        iv = IV (B.pack [0 .. 15])+        sa = AES128+    keyMaterial <-+        case string2Key (Simple DeprecatedMD5) 16 passphrase of+            Left err ->+                assertFailure+                    ("failed to derive SUSym key material: " ++ renderS2KError err)+                    >> fail "failed to derive SUSym key material"+            Right km -> pure km+    encrypted <-+        case encryptNoNonce+            sa+            (Simple DeprecatedMD5)+            iv+            (BL.toStrict clearWithChecksum)+            keyMaterial of+            Left err ->+                assertFailure+                    ("failed to encrypt legacy SUSym secret key: " ++ show err)+                    >> fail "failed to encrypt legacy SUSym secret key"+            Right bs -> pure bs+    let legacySka = SUSym sa iv (BL.fromStrict encrypted)+        serialized = runPut (put (toPkt (SecretKey pkp legacySka)))+        reparsed = parsePkts serialized+    (parsedPKP, parsedSKA) <-+        case reparsed of+            (SecretKeyPkt pkpayload skaddendum : _) -> pure (pkpayload, skaddendum)+            _ ->+                assertFailure+                    "serialized SUSym secret key should parse back as a secret key packet"+                    >> fail "expected serialized secret key packet"+    decrypted <-+        case decryptPrivateKey (parsedPKP, parsedSKA) passphrase of+            Left err ->+                assertFailure ("SUSym secret key decryption failed: " ++ err)+                    >> fail "SUSym secret key decryption failed"+            Right x -> pure x+    case decrypted of+        SUUnencrypted parsedSKey _ ->+            assertEqual+                "SUSym secret key roundtrip should preserve secret key material"+                skey+                parsedSKey+        _ ->+            assertFailure+                "SUSym secret key roundtrip should decrypt to unencrypted secret material"++legacyRsaSecretKeyBytes :: SKey -> B.ByteString+legacyRsaSecretKeyBytes (RSAPrivateKey (RSA_PrivateKey (RSA.PrivateKey _ d p q _ _ _))) =+    BL.toStrict $+        runPut $+            case inverse q p of+                Just u -> do+                    put (MPI d)+                    put (MPI p)+                    put (MPI q)+                    put (MPI u)+                Nothing -> error "invalid RSA key in legacy secret key test"+legacyRsaSecretKeyBytes _ = error "legacyRsaSecretKeyBytes requires an RSA secret key"++legacyChecksum16 :: B.ByteString -> Word16+legacyChecksum16 =+    fromIntegral+        . B.foldl'+            (\acc octet -> (acc + fromIntegral octet) `mod` (65536 :: Integer))+            0++testLegacyEncryptionFixtureShape :: Assertion+testLegacyEncryptionFixtureShape = do+    packets <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/encryption.gpg"+                DC..| conduitGet get+                DC..| CL.consume+    let hasKeyEncapsulation = any isKeyEncapsulation packets+        hasEncryptedData = any isEncryptedData packets+    assertBool+        "encryption.gpg should contain PKESK or SKESK key-encapsulation"+        hasKeyEncapsulation+    assertBool+        "encryption.gpg should contain encrypted data"+        hasEncryptedData+  where+    isKeyEncapsulation (SKESKPkt _) = True+    isKeyEncapsulation (PKESKPkt _) = True+    isKeyEncapsulation _ = False+    isEncryptedData SymEncDataPkt {} = True+    isEncryptedData SymEncIntegrityProtectedDataPkt {} = True+    isEncryptedData _ = False++testBuildPKESKPayloadForRecipientRSA :: Assertion+testBuildPKESKPayloadForRecipientRSA = do+    (baseRecipient, privateKey) <- loadUnencryptedRsaSigner+    let recipient = setKeyVersion V6 baseRecipient+        sessionKey = SessionKey (B.replicate 32 0x2e)+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk builder rsa payload"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    PKESKRecipientKey+                        { pkeskRecipientPKPayload = Nothing+                        , pkeskRecipientSKey = RSAPrivateKey (RSA_PrivateKey privateKey)+                        }+                )+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    pkeskPayloadResult <-+        buildPKESKPayloadForRecipient PreferV6 recipient sessionMaterial+    pkeskPayload <-+        case pkeskPayloadResult of+            Left err ->+                assertFailure+                    ("buildPKESKPayloadForRecipient failed: " ++ show err)+                    >> fail "buildPKESKPayloadForRecipient failed"+            Right p -> pure p+    case pkeskPayload of+        PKESKPayloadV6Packet (PKESKPayloadV6 _ RSA eskBytesLazy) -> do+            let eskBytes = BL.toStrict eskBytesLazy+            assertBool+                "PKESKv6 RSA ESK should include MPI framing"+                (B.length eskBytes >= 2)+            let mpiBits =+                    fromIntegral (B.index eskBytes 0) * 256+                        + fromIntegral (B.index eskBytes 1)+                mpiLen = (mpiBits + 7) `div` 8+            assertEqual+                "PKESKv6 RSA ESK should be exactly one RFC9580 MPI"+                (2 + mpiLen)+                (B.length eskBytes)+        other ->+            assertFailure+                ("Expected PKESKv6 RSA payload, got " ++ show other)+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ PKESKPkt pkeskPayload+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithPKESKContext+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESK builder RSA decrypt payload"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testBuildPKESKv3PayloadForRecipientRSAInterop :: Assertion+testBuildPKESKv3PayloadForRecipientRSAInterop = do+    (baseRecipient, privateKey) <- loadUnencryptedRsaSigner+    let recipient = setKeyVersion V4 baseRecipient+        sessionKey = SessionKey (B.replicate 32 0x2d)+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk builder rsa v3 interop payload"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyCallback _ = pure (Just (RSAPrivateKey (RSA_PrivateKey privateKey)))+        keyContextCallback pkt = do+            msk <- keyCallback pkt+            pure $+                fmap+                    ( \sk ->+                        PKESKRecipientKey+                            { pkeskRecipientPKPayload = Nothing+                            , pkeskRecipientSKey = sk+                            }+                    )+                    msk+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    pkeskPayloadResult <-+        buildPKESKv3PayloadForRecipient+            recipient+            (pkeskV3SessionMaterial sessionMaterial)+    pkeskPayload <-+        case pkeskPayloadResult of+            Left err ->+                assertFailure+                    ("buildPKESKv3PayloadForRecipient failed: " ++ show err)+                    >> fail "buildPKESKv3PayloadForRecipient failed"+            Right p@(PKESKPayloadV3Packet (PKESKPayloadV3 _ _ RSA _)) -> pure p+            Right other ->+                assertFailure ("Expected PKESK3 RSA payload, got " ++ show other)+                    >> fail "Unexpected PKESK payload variant"+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ PKESKPkt pkeskPayload+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithDecryptPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESKv3 RSA interop decrypt payload"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testBuildPKESKv3PayloadForRecipientSupportsV6Key :: Assertion+testBuildPKESKv3PayloadForRecipientSupportsV6Key = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let recipient = setKeyVersion V6 baseRecipient+        sessionKey = SessionKey (B.replicate 32 0x11)+    let expectedKeyId =+            EightOctetKeyId+                (BL.take 8 (unFingerprint (fingerprint recipient)))+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    result <-+        buildPKESKv3PayloadForRecipient+            recipient+            (pkeskV3SessionMaterial sessionMaterial)+    case result of+        Right (PKESKPayloadV3Packet (PKESKPayloadV3 _ keyId RSA _)) ->+            assertEqual+                "PKESKv3 builder should derive v6 key ID from the high-order 64 bits of the fingerprint"+                expectedKeyId+                keyId+        Right payload ->+            assertFailure+                ( "Expected PKESK3 RSA payload for v6 recipient, got "+                    ++ show payload+                )+        Left err ->+            assertFailure+                ( "Expected PKESK3 RSA payload for v6 recipient, got error "+                    ++ show err+                )++testBuildPKESKv3PayloadForRecipientECDHInterop :: Assertion+testBuildPKESKv3PayloadForRecipientECDHInterop = do+    let (recipientPub, recipientPriv) = syntheticNISTP256Low+        recipient =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                ECDH+                ( ECDHPubKey+                    (ECDSAPubKey (ECDSA_PublicKey recipientPub))+                    SHA256+                    AES128+                )+        sessionKey = SessionKey (B.replicate 32 0x21)+        salt = Salt (B.pack [0x20 .. 0x3f])+        payload = "pkesk builder ecdh v3 interop payload"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        recipientSKey = ECDHPrivateKey (ECDSA_PrivateKey recipientPriv)+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipient+                        , pkeskRecipientSKey = recipientSKey+                        }+                    )+                )+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    pkeskPayloadResult <-+        buildPKESKv3PayloadForRecipient+            recipient+            (pkeskV3SessionMaterial sessionMaterial)+    pkeskPayload <-+        case pkeskPayloadResult of+            Left err ->+                assertFailure+                    ("buildPKESKv3PayloadForRecipient failed: " ++ show err)+                    >> fail "buildPKESKv3PayloadForRecipient failed"+            Right p@(PKESKPayloadV3Packet (PKESKPayloadV3 _ _ ECDH _)) -> pure p+            Right other ->+                assertFailure+                    ("Expected PKESK3 ECDH payload, got " ++ show other)+                    >> fail "Unexpected PKESK payload variant"+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ PKESKPkt pkeskPayload+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithDecryptPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESKv3 ECDH interop decrypt payload"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testPKESKv3ECDHWireFormat :: Assertion+testPKESKv3ECDHWireFormat = do+    let (recipientPub, _) = syntheticNISTP256Low+        recipient =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                ECDH+                ( ECDHPubKey+                    (ECDSAPubKey (ECDSA_PublicKey recipientPub))+                    SHA256+                    AES256+                )+        -- Use a session key whose first byte is 0x00 so leading-zero stripping+        -- is observable if i2osp truncates the wrapped key.+        sessionKey = SessionKey (B.cons 0x00 (B.replicate 31 0xAB))+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    pkeskResult <-+        buildPKESKv3PayloadForRecipient+            recipient+            (pkeskV3SessionMaterial sessionMaterial)+    case pkeskResult of+        Left err ->+            assertFailure+                ("buildPKESKv3PayloadForRecipient failed: " ++ show err)+        Right p -> do+            -- Serialise the packet to wire bytes then parse the PKESK body manually.+            let wire = BL.toStrict (runPut (put (PKESKPkt p)))+            -- Skip new-format tag byte (0xC1), then parse the packet length.+            -- For the test we just round-trip through parsePkts and check the body layout.+            case parsePkts (BL.fromStrict wire) of+                [ PKESKPkt+                        ( PKESKPayloadV3Packet+                                (PKESKPayloadV3 _ _ ECDH (ephMPI NE.:| [wrappedMPI]))+                            )+                    ] -> do+                        -- The ephemeral MPI should be non-trivially large (EC point).+                        assertBool "ephemeral MPI should be non-empty" (unMPI ephMPI > 0)+                        -- The wrapped MPI stores the raw i2osp bytes; for AES-256 the RFC 3394+                        -- ciphertext is 48 bytes.  i2osp strips leading zeros so the stored+                        -- integer may represent fewer bytes, but candidateWrappedRFC3394Ciphertexts+                        -- handles that. What we're checking here is the WIRE format:+                        -- after the ephemeral MPI there must be exactly 1-byte-len + C bytes,+                        -- not a second MPI header.+                        --+                        -- Re-serialise and inspect the bytes after the ephemeral MPI manually.+                        let ephBytes = BL.toStrict (runPut (put ephMPI))+                            pktBody =+                                -- wire: 0xC1 | varlen | version(1) | keyid(8) | pka(1) | body+                                -- skip tag(1) + len(variable) + version(1) + keyid(8) + pka(1)+                                -- We just serialise the body directly via putPKESKv3SessionKeyMaterial equivalent:+                                BL.toStrict+                                    ( runPut+                                        ( put+                                            ( PKESKPkt+                                                ( PKESKPayloadV3Packet+                                                    ( PKESKPayloadV3+                                                        3+                                                        (EightOctetKeyId (BL.replicate 8 0))+                                                        ECDH+                                                        (ephMPI NE.:| [wrappedMPI])+                                                    )+                                                )+                                            )+                                        )+                                    )+                        -- Find the position of the body after tag+len+version+keyid+pka.+                        -- Tag: 1 byte; new-format len: 1 or 2 bytes; version: 1; keyid: 8; pka: 1 = 12 or 13 bytes+                        -- Instead of parsing the header, just verify the body doesn't start with+                        -- the two-byte MPI bit-count of the wrapped key.+                        -- After ephBytes in the body, the next byte should be the 1-byte count (24-48),+                        -- not the high byte of an MPI bit-count (which would be 0x01 for 383-bit keys).+                        -- We search for ephBytes in pktBody and check what follows.+                        let stripped = dropPKESKv3Header pktBody+                            afterEph = B.drop (B.length ephBytes) stripped+                        assertBool+                            "PKESKv3 ECDH wire body: after ephemeral MPI there must be at least 1 byte for wrapped-key length"+                            (not (B.null afterEph))+                        let wrappedLenByte = fromIntegral (B.head afterEph) :: Int+                        assertBool+                            ( "PKESKv3 ECDH wire: wrapped-key length byte "+                                ++ show wrappedLenByte+                                ++ " should be a valid RFC 3394 wrapped-key length (24, 32, 40, or 48)"+                            )+                            (wrappedLenByte `elem` [24, 32, 40, 48])+                        assertEqual+                            "PKESKv3 ECDH wire: bytes after length field must equal length"+                            wrappedLenByte+                            (B.length (B.tail afterEph))+                other ->+                    assertFailure+                        ( "Expected single PKESKv3 ECDH packet after round-trip, got "+                            ++ show other+                        )+  where+    -- Drop the new-format packet header (tag byte + variable-length field ++    -- version byte + 8-byte key-id + pka byte) to reach the session-key material.+    dropPKESKv3Header bs+        | B.length bs < 3 = bs+        | otherwise =+            let lenByte = B.index bs 1+                headerLen+                    | lenByte < 192 = 2 -- 1-byte length+                    | lenByte < 224 = 3 -- 2-byte length+                    | otherwise = 6 -- 5-byte length (rare)+             in B.drop (headerLen + 1 + 8 + 1) bs++testBuildPKESKv3PayloadForRecipientCurve25519LegacyInterop+    :: Assertion+testBuildPKESKv3PayloadForRecipientCurve25519LegacyInterop = do+    let recipientSecretRaw = B.pack [1 .. 32]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ( "failed to initialize Curve25519Legacy recipient secret key: "+                            ++ show err+                        )+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        recipient =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                ECDH+                ( ECDHPubKey+                    ( EdDSAPubKey+                        EdSigningCurve25519+                        ( PrefixedNativeEPoint+                            (EPoint (os2ip (B.cons 0x40 recipientPublicRaw)))+                        )+                    )+                    SHA256+                    AES256+                )+        recipientSKey =+            ECDHPrivateKey+                ( ECDSA_PrivateKey+                    ( ECDSA.PrivateKey+                        (ECCT.getCurveByName ECCT.SEC_p256r1)+                        (os2ip recipientSecretRaw)+                    )+                )+        sessionKey = SessionKey (B.replicate 32 0x22)+        salt = Salt (B.pack [0x40 .. 0x5f])+        payload = "pkesk builder curve25519legacy v3 interop payload"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipient+                        , pkeskRecipientSKey = recipientSKey+                        }+                    )+                )+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    pkeskPayloadResult <-+        buildPKESKv3PayloadForRecipient+            recipient+            (pkeskV3SessionMaterial sessionMaterial)+    pkeskPayload <-+        case pkeskPayloadResult of+            Left err ->+                assertFailure+                    ("buildPKESKv3PayloadForRecipient failed: " ++ show err)+                    >> fail "buildPKESKv3PayloadForRecipient failed"+            Right+                p@( PKESKPayloadV3Packet+                        (PKESKPayloadV3 _ _ ECDH (ephemeralMPI NE.:| _))+                    ) -> do+                    let ephemeralBytes = i2osp (unMPI ephemeralMPI)+                    assertEqual+                        "PKESKv3 Curve25519Legacy ephemeral point should be 0x40-prefixed 33-octet value"+                        33+                        (B.length ephemeralBytes)+                    assertEqual+                        "PKESKv3 Curve25519Legacy ephemeral point should use RFC6637 0x40 prefix"+                        0x40+                        (B.head ephemeralBytes)+                    pure p+            Right other ->+                assertFailure+                    ("Expected PKESK3 ECDH payload, got " ++ show other)+                    >> fail "Unexpected PKESK payload variant"+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ PKESKPkt pkeskPayload+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithDecryptPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESKv3 Curve25519Legacy interop decrypt payload"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testBuildPKESKv3PayloadForRecipientRejectsCurve448Legacy+    :: Assertion+testBuildPKESKv3PayloadForRecipientRejectsCurve448Legacy = do+    let recipient =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                ECDH+                ( ECDHPubKey+                    (EdDSAPubKey EdSigningCurve448 (PrefixedNativeEPoint (EPoint 1)))+                    SHA512+                    AES256+                )+        sessionKey = SessionKey (B.replicate 32 0x23)+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    result <-+        buildPKESKv3PayloadForRecipient+            recipient+            (pkeskV3SessionMaterial sessionMaterial)+    case result of+        Left (InvalidRecipientKeyMaterial ECDH err)+            | "RFC6637-compatible" `isInfixOf` err -> pure ()+            | otherwise ->+                assertFailure+                    ("Expected RFC6637 compatibility rejection, got: " ++ err)+        Left err ->+            assertFailure+                ("Expected InvalidRecipientKeyMaterial ECDH, got " ++ show err)+        Right payload ->+            assertFailure+                ( "Expected RFC6637 compatibility rejection, got payload: "+                    ++ show payload+                )++testBuildPKESKv6PayloadForRecipientX25519RawKeySemantics+    :: Assertion+testBuildPKESKv6PayloadForRecipientX25519RawKeySemantics = do+    let recipientSecretRaw = B.pack [1 .. 32]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        v4Recipient =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                )+        recipient = setKeyVersion V6 v4Recipient+        sessionKey = SessionKey (B.replicate 32 0x24)+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    pkeskPayloadResult <-+        buildPKESKPayloadForRecipient PreferV6 recipient sessionMaterial+    case pkeskPayloadResult of+        Left err ->+            assertFailure+                ( "buildPKESKPayloadForRecipient failed for v6 X25519: "+                    ++ show err+                )+        Right+            (PKESKPayloadV6Packet (PKESKPayloadV6 _ X25519 eskBytesLazy)) -> do+                let eskBytes = BL.toStrict eskBytesLazy+                assertX25519EskShape "v6 X25519 raw-key conformance" eskBytes+                let wrappedLen = fromIntegral (B.index eskBytes 32) :: Int+                assertEqual+                    "v6 X25519 wrapped session key (AES-KW RFC3394 of raw 32 bytes) must be 40 bytes"+                    40+                    wrappedLen+        Right other ->+            assertFailure+                ("Expected PKESKPayloadV6 with X25519, got " ++ show other)++{- | Conformance test: v6 X448 PKESK uses raw session key, not v3-encoded material.+RFC 9580 specifies that v6 X448 wraps the raw session key directly (no algorithm byte or checksum).+When the raw 32-byte key is AES-KW wrapped with RFC3394: 32 bytes + 8-byte integrity = 40 bytes.+If v3-encoded (1 byte algo + 32 bytes key + 2 bytes checksum + ~5 bytes padding = 40 bytes unwrapped),+the wrapped result would be ~48 bytes, so we verify wrapped size is 40.+-}+testBuildPKESKv6PayloadForRecipientX448RawKeySemantics+    :: Assertion+testBuildPKESKv6PayloadForRecipientX448RawKeySemantics = do+    let recipientSecretRaw = B.pack [1 .. 56]+        recipientSecret =+            case CE.eitherCryptoError (C448.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X448 recipient secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C448.toPublic recipientSecret) :: B.ByteString+        v4Recipient =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X448+                ( EdDSAPubKey+                    EdSigningCurve448+                    (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                )+        recipient = setKeyVersion V6 v4Recipient+        sessionKey = SessionKey (B.replicate 32 0x25)+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    pkeskPayloadResult <-+        buildPKESKPayloadForRecipient PreferV6 recipient sessionMaterial+    case pkeskPayloadResult of+        Left err ->+            assertFailure+                ("buildPKESKPayloadForRecipient failed for v6 X448: " ++ show err)+        Right (PKESKPayloadV6Packet (PKESKPayloadV6 _ X448 eskBytesLazy)) -> do+            let eskBytes = BL.toStrict eskBytesLazy+            assertX448EskShape "v6 X448 raw-key conformance" eskBytes+            let wrappedLen = fromIntegral (B.index eskBytes 56) :: Int+            assertEqual+                "v6 X448 wrapped session key (AES-KW RFC3394 of raw 32 bytes) must be 40 bytes"+                40+                wrappedLen+        Right other ->+            assertFailure+                ("Expected PKESKPayloadV6 with X448, got " ++ show other)++testBuildPKESKPayloadForRecipientWithPolicyForceV3Interop+    :: Assertion+testBuildPKESKPayloadForRecipientWithPolicyForceV3Interop = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let recipient = setKeyVersion V4 baseRecipient+        sessionKey = SessionKey (B.replicate 32 0x16)+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    result <-+        buildPKESKPayloadForRecipient+            ForceV3Interop+            recipient+            sessionMaterial+    case result of+        Right (PKESKPayloadV3Packet (PKESKPayloadV3 _ _ RSA _)) -> pure ()+        Right payload ->+            assertFailure+                ("Expected PKESK3 RSA for ForceV3Interop, got " ++ show payload)+        Left err ->+            assertFailure+                ("Expected PKESK3 RSA for ForceV3Interop, got error " ++ show err)++testRecipientVersionStrategyForProfileHonorsHints :: Assertion+testRecipientVersionStrategyForProfileHonorsHints = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let recipient = setKeyVersion V6 baseRecipient+    case recipientVersionStrategyForProfile+        EncryptStrictDefault+        ( recipientEncryptionTargetWithStrategy+            recipient+            RecipientForceV3Interop+        ) of+        Right RecipientForceV3Interop -> pure ()+        other ->+            assertFailure+                ("Expected explicit recipient hint to win, got " ++ show other)+    case recipientVersionStrategyForProfile+        EncryptInteropLegacy+        (recipientEncryptionTarget recipient) of+        Right RecipientForceV3Interop -> pure ()+        other ->+            assertFailure+                ( "Expected legacy profile fallback to force v3, got "+                    ++ show other+                )+    let v4Recipient = setKeyVersion V4 recipient+    case recipientVersionStrategyForProfile+        EncryptStrictDefault+        (recipientEncryptionTarget recipient) of+        Right RecipientPreferV6 -> pure ()+        other ->+            assertFailure+                ( "Expected strict profile auto-detect to prefer v6 for v6 recipients, got "+                    ++ show other+                )+    case recipientVersionStrategyForProfile+        EncryptStrictDefault+        (recipientEncryptionTarget v4Recipient) of+        Right RecipientForceV3Interop -> pure ()+        other ->+            assertFailure+                ( "Expected strict profile auto-detect to force v3 for legacy recipients, got "+                    ++ show other+                )++testEncryptRecipientsWithRequestAutoDetectsMixedRecipientStrategies+    :: Assertion+testEncryptRecipientsWithRequestAutoDetectsMixedRecipientStrategies = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let v4Recipient = setKeyVersion V4 baseRecipient+        v6Recipient = setKeyVersion V6 baseRecipient+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [ recipientEncryptionTarget v6Recipient+                    , recipientEncryptionTarget v4Recipient+                    ]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                , recipientEncryptRequestPayload = "recipient autodetect"+                , recipientEncryptRequestSymmetricOverride = Just AES256+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv2Overrides+                        { recipientEncryptRequestAEADOverride = Just OCB+                        , recipientEncryptRequestChunkSizeOverride = Just 6+                        , recipientEncryptRequestSaltOverride =+                            Just (Salt (B.replicate 32 0x77))+                        }+                }+    result <- encryptForRecipients request+    case result of+        Left err ->+            assertFailure+                ( "Expected mixed-recipient request to encrypt successfully, got "+                    ++ show err+                )+        Right RecipientEncryptResult {recipientEncryptPackets = packets} -> do+            let pkesks = [p | PKESKPkt p <- packets]+            assertBool+                "strict profile auto-detect should emit PKESKv6 for v6 recipients"+                (any isPKESK6 pkesks)+            assertBool+                "strict profile auto-detect should emit PKESKv3 for v4 recipients"+                (any isPKESK3 pkesks)+  where+    isPKESK6 PKESKPayloadV6Packet {} = True+    isPKESK6 _ = False+    isPKESK3 PKESKPayloadV3Packet {} = True+    isPKESK3 _ = False++testEncryptRecipientsNegotiatesSymmetricAlgorithmWhenEnabled+    :: Assertion+testEncryptRecipientsNegotiatesSymmetricAlgorithmWhenEnabled = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let v4Recipient = setKeyVersion V4 baseRecipient+        v6Recipient = setKeyVersion V6 baseRecipient+        v6Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V6+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures = Set.empty+                , recipientCapabilityPreferredSymmetricAlgorithms =+                    [AES128, AES256]+                , recipientCapabilityPreferredAEADAlgorithms = [OCB]+                }+        v4Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V4+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures = Set.empty+                , recipientCapabilityPreferredSymmetricAlgorithms = [AES128]+                , recipientCapabilityPreferredAEADAlgorithms = [OCB]+                }+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps+                    , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps+                    ]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                , recipientEncryptRequestPayload =+                    "recipient capability negotiation payload"+                , recipientEncryptRequestSymmetricOverride = Nothing+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv2Overrides+                        { recipientEncryptRequestAEADOverride = Just OCB+                        , recipientEncryptRequestChunkSizeOverride = Just 6+                        , recipientEncryptRequestSaltOverride =+                            Just (Salt (B.replicate 32 0x22))+                        }+                }+    result <-+        encryptForRecipientsWithCapabilityNegotiation+            RecipientCapabilityNegotiationOn+            request+    case result of+        Left err ->+            assertFailure+                ( "Expected recipient capability negotiation to succeed, got "+                    ++ show err+                )+        Right+            RecipientEncryptResult+                { recipientEncryptSessionMaterial = material+                } ->+                assertEqual+                    "capability negotiation should pick common preferred symmetric algorithm"+                    AES128+                    (pkeskSessionAlgorithm material)++testEncryptRecipientsNegotiatesSymmetricAlgorithmByDefault+    :: Assertion+testEncryptRecipientsNegotiatesSymmetricAlgorithmByDefault = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let v4Recipient = setKeyVersion V4 baseRecipient+        v6Recipient = setKeyVersion V6 baseRecipient+        v6Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V6+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures = Set.empty+                , recipientCapabilityPreferredSymmetricAlgorithms =+                    [AES128, AES256]+                , recipientCapabilityPreferredAEADAlgorithms = [OCB]+                }+        v4Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V4+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures = Set.empty+                , recipientCapabilityPreferredSymmetricAlgorithms = [AES128]+                , recipientCapabilityPreferredAEADAlgorithms = [OCB]+                }+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps+                    , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps+                    ]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                , recipientEncryptRequestPayload =+                    "default recipient capability negotiation payload"+                , recipientEncryptRequestSymmetricOverride = Nothing+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv2Overrides+                        { recipientEncryptRequestAEADOverride = Just OCB+                        , recipientEncryptRequestChunkSizeOverride = Just 6+                        , recipientEncryptRequestSaltOverride =+                            Just (Salt (B.replicate 32 0x24))+                        }+                }+    result <- encryptForRecipients request+    case result of+        Left err ->+            assertFailure+                ( "Expected default encryptForRecipients negotiation to succeed, got "+                    ++ show err+                )+        Right+            RecipientEncryptResult+                { recipientEncryptSessionMaterial = material+                } ->+                assertEqual+                    "encryptForRecipients should negotiate recipient capabilities by default"+                    AES128+                    (pkeskSessionAlgorithm material)++testEncryptRecipientsLegacyKeepsCapabilityNegotiationOptOut+    :: Assertion+testEncryptRecipientsLegacyKeepsCapabilityNegotiationOptOut = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let v4Recipient = setKeyVersion V4 baseRecipient+        v6Recipient = setKeyVersion V6 baseRecipient+        v6Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V6+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures = Set.empty+                , recipientCapabilityPreferredSymmetricAlgorithms =+                    [AES128, AES256]+                , recipientCapabilityPreferredAEADAlgorithms = [OCB]+                }+        v4Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V4+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures = Set.empty+                , recipientCapabilityPreferredSymmetricAlgorithms = [AES128]+                , recipientCapabilityPreferredAEADAlgorithms = [OCB]+                }+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps+                    , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps+                    ]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                , recipientEncryptRequestPayload =+                    "legacy recipient capability opt-out payload"+                , recipientEncryptRequestSymmetricOverride = Nothing+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv2Overrides+                        { recipientEncryptRequestAEADOverride = Just OCB+                        , recipientEncryptRequestChunkSizeOverride = Just 6+                        , recipientEncryptRequestSaltOverride =+                            Just (Salt (B.replicate 32 0x25))+                        }+                }+    result <- encryptForRecipientsLegacy request+    case result of+        Left err ->+            assertFailure+                ( "Expected legacy encryptForRecipients opt-out to succeed, got "+                    ++ show err+                )+        Right+            RecipientEncryptResult+                { recipientEncryptSessionMaterial = material+                } ->+                assertEqual+                    "encryptForRecipientsLegacy should preserve policy-default symmetric selection"+                    AES256+                    (pkeskSessionAlgorithm material)++testEncryptRecipientsNegotiationFailsWithoutCommonSymmetricAlgorithm+    :: Assertion+testEncryptRecipientsNegotiationFailsWithoutCommonSymmetricAlgorithm = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let v4Recipient = setKeyVersion V4 baseRecipient+        v6Recipient = setKeyVersion V6 baseRecipient+        v6Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V6+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures = Set.empty+                , recipientCapabilityPreferredSymmetricAlgorithms = [AES128]+                , recipientCapabilityPreferredAEADAlgorithms = [OCB]+                }+        v4Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V4+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures = Set.empty+                , recipientCapabilityPreferredSymmetricAlgorithms = [AES256]+                , recipientCapabilityPreferredAEADAlgorithms = [OCB]+                }+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps+                    , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps+                    ]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                , recipientEncryptRequestPayload =+                    "recipient capability mismatch payload"+                , recipientEncryptRequestSymmetricOverride = Nothing+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv2Overrides+                        { recipientEncryptRequestAEADOverride = Just OCB+                        , recipientEncryptRequestChunkSizeOverride = Just 6+                        , recipientEncryptRequestSaltOverride =+                            Just (Salt (B.replicate 32 0x23))+                        }+                }+    result <-+        encryptForRecipientsWithCapabilityNegotiation+            RecipientCapabilityNegotiationOn+            request+    case result of+        Left+            ( RecipientCapabilitySelectionFailure+                    (RecipientCapabilityNoCommonSymmetricAlgorithms _)+                ) -> pure ()+        Left other ->+            assertFailure+                ( "Expected RecipientCapabilityNoCommonSymmetricAlgorithms, got "+                    ++ show other+                )+        Right _ ->+            assertFailure+                "Expected recipient capability negotiation to fail without common symmetric algorithm"++testRecipientCapabilitiesFromSubpacketPayloadsExtractsPreferredAEADAlgorithms+    :: Assertion+testRecipientCapabilitiesFromSubpacketPayloadsExtractsPreferredAEADAlgorithms = do+    (recipient, _privateKey) <- loadUnencryptedRsaSigner+    let caps =+            recipientCapabilitiesFromSubpacketPayloads+                recipient+                [OtherSigSub 39 (BL.pack [9, 2, 7, 3, 9, 2])]+    assertEqual+        "preferred AEAD ciphersuites subpacket should extract unique AEAD preferences in declaration order"+        [OCB, GCM]+        (recipientCapabilityPreferredAEADAlgorithms caps)++testEncryptRecipientsNegotiatesAEADAlgorithmWhenEnabled+    :: Assertion+testEncryptRecipientsNegotiatesAEADAlgorithmWhenEnabled = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let v4Recipient = setKeyVersion V4 baseRecipient+        v6Recipient = setKeyVersion V6 baseRecipient+        v6Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V6+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures =+                    Set.fromList [FeatureSEIPDv1, FeatureSEIPDv2]+                , recipientCapabilityPreferredSymmetricAlgorithms =+                    [AES128, AES256]+                , recipientCapabilityPreferredAEADAlgorithms = [GCM, OCB]+                }+        v4Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V4+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures =+                    Set.fromList [FeatureSEIPDv1, FeatureSEIPDv2]+                , recipientCapabilityPreferredSymmetricAlgorithms = [AES128]+                , recipientCapabilityPreferredAEADAlgorithms = [GCM]+                }+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps+                    , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps+                    ]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                , recipientEncryptRequestPayload =+                    "recipient AEAD capability negotiation payload"+                , recipientEncryptRequestSymmetricOverride = Nothing+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv2Overrides+                        { recipientEncryptRequestAEADOverride = Nothing+                        , recipientEncryptRequestChunkSizeOverride = Just 6+                        , recipientEncryptRequestSaltOverride =+                            Just (Salt (B.replicate 32 0x26))+                        }+                }+    result <-+        encryptForRecipientsWithCapabilityNegotiation+            RecipientCapabilityNegotiationOn+            request+    case result of+        Left err ->+            assertFailure+                ( "Expected AEAD capability negotiation to succeed, got "+                    ++ show err+                )+        Right+            RecipientEncryptResult+                { recipientEncryptPackets = packets+                , recipientEncryptSessionMaterial = material+                } -> do+                assertEqual+                    "AEAD capability negotiation should preserve symmetric negotiation"+                    AES128+                    (pkeskSessionAlgorithm material)+                case [ aa+                     | SymEncIntegrityProtectedDataPkt (SEIPD2 _ aa _ _ _) <- packets+                     ] of+                    [selectedAEAD] ->+                        assertEqual+                            "AEAD capability negotiation should pick common preferred AEAD algorithm"+                            GCM+                            selectedAEAD+                    other ->+                        assertFailure ("Expected one SEIPDv2 packet, got " ++ show other)++testEncryptRecipientsNegotiationFailsWithoutCommonAEADAlgorithm+    :: Assertion+testEncryptRecipientsNegotiationFailsWithoutCommonAEADAlgorithm = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let v4Recipient = setKeyVersion V4 baseRecipient+        v6Recipient = setKeyVersion V6 baseRecipient+        v6Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V6+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures =+                    Set.fromList [FeatureSEIPDv1, FeatureSEIPDv2]+                , recipientCapabilityPreferredSymmetricAlgorithms = [AES256]+                , recipientCapabilityPreferredAEADAlgorithms = [OCB]+                }+        v4Caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V4+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures =+                    Set.fromList [FeatureSEIPDv1, FeatureSEIPDv2]+                , recipientCapabilityPreferredSymmetricAlgorithms = [AES256]+                , recipientCapabilityPreferredAEADAlgorithms = [GCM]+                }+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [ recipientEncryptionTargetWithCapabilities v6Recipient v6Caps+                    , recipientEncryptionTargetWithCapabilities v4Recipient v4Caps+                    ]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                , recipientEncryptRequestPayload =+                    "recipient AEAD mismatch payload"+                , recipientEncryptRequestSymmetricOverride = Just AES256+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv2Overrides+                        { recipientEncryptRequestAEADOverride = Nothing+                        , recipientEncryptRequestChunkSizeOverride = Just 6+                        , recipientEncryptRequestSaltOverride =+                            Just (Salt (B.replicate 32 0x27))+                        }+                }+    result <-+        encryptForRecipientsWithCapabilityNegotiation+            RecipientCapabilityNegotiationOn+            request+    case result of+        Left+            ( RecipientCapabilitySelectionFailure+                    (RecipientCapabilityNoCommonAEADAlgorithms _)+                ) -> pure ()+        Left other ->+            assertFailure+                ( "Expected RecipientCapabilityNoCommonAEADAlgorithms, got "+                    ++ show other+                )+        Right _ ->+            assertFailure+                "Expected recipient capability negotiation to fail without common AEAD algorithm"++testEncryptRecipientsSEIPDv2FallsBackWhenRecipientsDoNotAdvertiseV2+    :: Assertion+testEncryptRecipientsSEIPDv2FallsBackWhenRecipientsDoNotAdvertiseV2 = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let v4Recipient = setKeyVersion V4 baseRecipient+        v6Recipient = setKeyVersion V6 baseRecipient+        sharedCaps keyVersion recipient =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = keyVersion+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures = Set.singleton FeatureSEIPDv1+                , recipientCapabilityPreferredSymmetricAlgorithms = [AES256]+                , recipientCapabilityPreferredAEADAlgorithms = [OCB]+                }+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [ recipientEncryptionTargetWithCapabilities+                        v6Recipient+                        (sharedCaps V6 v6Recipient)+                    , recipientEncryptionTargetWithCapabilities+                        v4Recipient+                        (sharedCaps V4 v4Recipient)+                    ]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                , recipientEncryptRequestPayload =+                    "recipient seipd fallback payload"+                , recipientEncryptRequestSymmetricOverride = Just AES256+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv2Overrides+                        { recipientEncryptRequestAEADOverride = Nothing+                        , recipientEncryptRequestChunkSizeOverride = Just 6+                        , recipientEncryptRequestSaltOverride =+                            Just (Salt (B.replicate 32 0x28))+                        }+                }+    result <- encryptForRecipients request+    case result of+        Left err ->+            assertFailure+                ( "Expected fallback to SEIPDv1 when recipients do not advertise SEIPDv2, got "+                    ++ show err+                )+        Right RecipientEncryptResult {recipientEncryptPackets = packets} -> do+            let seipdPkts = [p | SymEncIntegrityProtectedDataPkt p <- packets]+            case seipdPkts of+                [SEIPD1 1 _] -> pure ()+                [SEIPD2 {}] ->+                    assertFailure+                        "Expected SEIPDv1 fallback when recipients do not advertise SEIPDv2 support"+                other -> assertFailure ("Unexpected SEIPD packets: " ++ show other)++testEncryptRecipientsRejectsSEIPDv1WhenRecipientsDoNotAdvertiseMDC+    :: Assertion+testEncryptRecipientsRejectsSEIPDv1WhenRecipientsDoNotAdvertiseMDC = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let v4Recipient = setKeyVersion V4 baseRecipient+        caps =+            RecipientCapabilities+                { recipientCapabilityKeyVersion = V4+                , recipientCapabilityPublicKeyAlgorithm = _pkalgo v4Recipient+                , recipientCapabilityKeyFlags = Set.empty+                , recipientCapabilityFeatures = Set.singleton FeatureSEIPDv2+                , recipientCapabilityPreferredSymmetricAlgorithms = [AES256]+                , recipientCapabilityPreferredAEADAlgorithms = [OCB]+                }+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [recipientEncryptionTargetWithCapabilities v4Recipient caps]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                , recipientEncryptRequestPayload =+                    "recipient seipd v1 capability failure payload"+                , recipientEncryptRequestSymmetricOverride = Just AES256+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv1Overrides+                        { recipientEncryptRequestIVOverride = Nothing+                        }+                }+    result <- encryptForRecipients request+    case result of+        Left+            ( RecipientCapabilitySelectionFailure+                    (RecipientCapabilityMissingSEIPDv1Support _)+                ) -> pure ()+        Left other ->+            assertFailure+                ( "Expected RecipientCapabilityMissingSEIPDv1Support, got "+                    ++ show other+                )+        Right _ ->+            assertFailure+                "Expected SEIPDv1 encryption to fail when recipients do not advertise MDC support"++testRecipientEncryptionTargetsFromTKIncludesOnlyEncryptionCapableKeys+    :: Assertion+testRecipientEncryptionTargetsFromTKIncludesOnlyEncryptionCapableKeys = do+    (signingPrimary, _signingKey) <- loadDeterministicEd25519Signer+    (baseEncryptingSubkey, _privateKey) <- loadUnencryptedRsaSigner+    let tkUnknown =+            TKUnknown+                { _tkuKey = (signingPrimary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs =+                    [+                        ( PublicSubkeyPkt+                            (setKeyTimestamp (_timestamp signingPrimary) baseEncryptingSubkey)+                        , []+                        )+                    ]+                }+        tk =+            case fromUnknownToTK tkUnknown of+                Right (SomePublicTK publicTk) -> publicTk+                Right (SomeSecretTK _) -> error "expected public TK for recipient target test"+                Left err -> error err+        encryptingSubkey =+            setKeyTimestamp (_timestamp signingPrimary) baseEncryptingSubkey+        targets = recipientEncryptionTargetsFromTK tk+    assertEqual+        "TKUnknown-derived targets should include only encryption-capable keys"+        1+        (length targets)+    case targets of+        [target] ->+            assertEqual+                "TKUnknown-derived target should preserve selected encryption key"+                (fingerprint encryptingSubkey)+                (fingerprint (recipientEncryptionTargetKey target))+        _ ->+            assertFailure "Expected exactly one encryption-capable target"++testRecipientEncryptionTargetFromTKPrefersSubkeyOverPrimary+    :: Assertion+testRecipientEncryptionTargetFromTKPrefersSubkeyOverPrimary = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let primary = setKeyVersion V4 baseRecipient+        subkey = setKeyVersion V6 baseRecipient+        tkUnknown =+            TKUnknown+                { _tkuKey = (primary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs = [(PublicSubkeyPkt subkey, [])]+                }+        tk =+            case fromUnknownToTK tkUnknown of+                Right (SomePublicTK publicTk) -> publicTk+                Right (SomeSecretTK _) ->+                    error "expected public TK for recipient target selection test"+                Left err -> error err+    case recipientEncryptionTargetFromTK tk of+        Right target ->+            assertEqual+                "TKUnknown-derived single target should prioritize encryption subkeys"+                (fingerprint subkey)+                (fingerprint (recipientEncryptionTargetKey target))+        Left err ->+            assertFailure+                ( "Expected TKUnknown-derived target selection to succeed, got "+                    ++ show err+                )++testRecipientEncryptionTargetFromTKRejectsTKWithoutEncryptableKeys+    :: Assertion+testRecipientEncryptionTargetFromTKRejectsTKWithoutEncryptableKeys = do+    (signingPrimary, _signingKey) <- loadDeterministicEd25519Signer+    let tkUnknown =+            TKUnknown+                { _tkuKey = (signingPrimary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs = []+                }+        tk =+            case fromUnknownToTK tkUnknown of+                Right (SomePublicTK publicTk) -> publicTk+                Right (SomeSecretTK _) -> error "expected public TK for recipient rejection test"+                Left err -> error err+    case recipientEncryptionTargetFromTK tk of+        Left RecipientCapabilityNoEncryptableKeyMaterialInTK -> pure ()+        Left other ->+            assertFailure+                ( "Expected RecipientCapabilityNoEncryptableKeyMaterialInTK, got "+                    ++ show other+                )+        Right _ ->+            assertFailure+                "Expected TKUnknown-derived target selection to reject non-encryptable TKs"++testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsRejections+    :: Assertion+testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsRejections = do+    (baseKey, signingKey) <- loadUnencryptedRsaSigner+    let signatureTime = ThirtyTwoBitTimeStamp 1700000000+        primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey+        subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey+    subkeyBindingSig <-+        signSubkeyBindingWithRSAExtrasAt+            primary+            subkey+            signingKey+            signatureTime+            [SigSubPacket False (KeyFlags (Set.fromList [SignDataKey]))]+    let tk =+            TKUnknown+                { _tkuKey = (primary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]+                }+        report =+            recipientEncryptionTargetsReportFromTKAtTimestamp+                signatureTime+                tk+        acceptedFps =+            map+                (fingerprint . recipientEncryptionTargetKey)+                (recipientEncryptionTargetsAccepted report)+        rejectedReasons =+            map+                recipientEncryptionTargetRejectedReason+                (recipientEncryptionTargetsRejected report)+    assertBool+        "report should keep encryption-eligible primary key as accepted"+        (fingerprint primary `elem` acceptedFps)+    assertEqual+        "report should explain sign-only subkey rejection"+        [ RecipientTargetMissingEncryptionFlags+            subkey+            (Set.fromList [SignDataKey])+        ]+        rejectedReasons++testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsUnsupportedAlgorithms+    :: Assertion+testRecipientEncryptionTargetsReportFromTKAtTimestampExplainsUnsupportedAlgorithms = do+    (signingPrimary, _signingKey) <- loadDeterministicEd25519Signer+    let tk =+            TKUnknown+                { _tkuKey = (signingPrimary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs = []+                }+        report =+            recipientEncryptionTargetsReportFromTKAtTimestamp+                (_timestamp signingPrimary)+                tk+    assertEqual+        "unsupported key algorithms should be surfaced in report rejections"+        [RecipientTargetUnsupportedAlgorithm (_pkalgo signingPrimary)]+        ( map+            recipientEncryptionTargetRejectedReason+            (recipientEncryptionTargetsRejected report)+        )++testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsExpiredSubkey+    :: Assertion+testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsExpiredSubkey = do+    (baseKey, signingKey) <- loadUnencryptedRsaSigner+    let signatureTime = ThirtyTwoBitTimeStamp 1700000000+        targetTime = ThirtyTwoBitTimeStamp 1700000020+        primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey+        subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey+    subkeyBindingSig <-+        signSubkeyBindingWithRSAExtrasAt+            primary+            subkey+            signingKey+            signatureTime+            [ SigSubPacket+                False+                (KeyFlags (Set.fromList [EncryptCommunicationsKey]))+            , SigSubPacket False (KeyExpirationTime (ThirtyTwoBitDuration 5))+            ]+    let tk =+            TKUnknown+                { _tkuKey = (primary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]+                }+        report =+            recipientEncryptionTargetsReportFromTKAtTimestamp targetTime tk+        rejectedReasons =+            map+                recipientEncryptionTargetRejectedReason+                (recipientEncryptionTargetsRejected report)+    assertBool+        "expired subkey should be rejected from recipient targets"+        ( RecipientTargetNotValidAtTimestamp subkey targetTime+            `elem` rejectedReasons+        )++testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsRevokedSubkey+    :: Assertion+testRecipientEncryptionTargetsReportFromTKAtTimestampRejectsRevokedSubkey = do+    (baseKey, signingKey) <- loadUnencryptedRsaSigner+    let bindingTime = ThirtyTwoBitTimeStamp 1700000000+        revocationTime = ThirtyTwoBitTimeStamp 1700000005+        targetTime = ThirtyTwoBitTimeStamp 1700000010+        primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey+        subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey+    subkeyBindingSig <-+        signSubkeyBindingWithRSAExtrasAt+            primary+            subkey+            signingKey+            bindingTime+            [ SigSubPacket+                False+                (KeyFlags (Set.fromList [EncryptCommunicationsKey]))+            ]+    subkeyRevocationSig <-+        signSubkeyRevocationWithRSAAt+            primary+            subkey+            signingKey+            revocationTime+    let tk =+            TKUnknown+                { _tkuKey = (primary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs =+                    [ (PublicSubkeyPkt subkey, [subkeyBindingSig, subkeyRevocationSig])+                    ]+                }+        report =+            recipientEncryptionTargetsReportFromTKAtTimestamp targetTime tk+        rejectedReasons =+            map+                recipientEncryptionTargetRejectedReason+                (recipientEncryptionTargetsRejected report)+    assertBool+        "revoked subkey should be rejected from recipient targets"+        (RecipientTargetRevoked subkey `elem` rejectedReasons)++testRecipientEncryptionTargetsFromTKAtTimestampExtractsSelfSigCapabilities+    :: Assertion+testRecipientEncryptionTargetsFromTKAtTimestampExtractsSelfSigCapabilities = do+    (primary, signingKey) <- loadUnencryptedRsaSigner+    (subkey, _privateKey) <- loadUnencryptedRsaSigner+    let signatureTime = ThirtyTwoBitTimeStamp 1700000000+    directKeySig <-+        signDirectKeyWithRSAExtrasAt+            primary+            signingKey+            signatureTime+            [ SigSubPacket False (PreferredSymmetricAlgorithms [AES128])+            , SigSubPacket False (OtherSigSub 39 (BL.pack [9, 2, 7, 3]))+            ]+    subkeyBindingSig <-+        signSubkeyBindingWithRSAExtrasAt+            primary+            subkey+            signingKey+            signatureTime+            [ SigSubPacket+                False+                (KeyFlags (Set.fromList [EncryptCommunicationsKey]))+            ]+    let tk =+            TKUnknown+                { _tkuKey = (primary, Nothing)+                , _tkuRevs = [directKeySig]+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]+                }+        targets = recipientEncryptionTargetsFromTKAtTimestamp signatureTime tk+    case targets of+        (target : _) ->+            case recipientEncryptionTargetCapabilities target of+                Nothing ->+                    assertFailure+                        "Expected TKUnknown-derived target to include extracted capabilities"+                Just caps -> do+                    assertEqual+                        "self-signature capability extraction should include primary-key symmetric preferences"+                        [AES128]+                        (recipientCapabilityPreferredSymmetricAlgorithms caps)+                    assertEqual+                        "self-signature capability extraction should include primary-key preferred AEAD algorithms"+                        [OCB, GCM]+                        (recipientCapabilityPreferredAEADAlgorithms caps)+                    assertEqual+                        "self-signature capability extraction should include subkey key flags"+                        (Set.fromList [EncryptCommunicationsKey])+                        (recipientCapabilityKeyFlags caps)+        [] ->+            assertFailure "Expected at least one TKUnknown-derived target"++testRecipientEncryptionTargetFromTKAtTimestampAppliesTimestampFiltering+    :: Assertion+testRecipientEncryptionTargetFromTKAtTimestampAppliesTimestampFiltering = do+    (primary, signingKey) <- loadUnencryptedRsaSigner+    (subkey, _privateKey) <- loadUnencryptedRsaSigner+    let signatureTime = ThirtyTwoBitTimeStamp 1700000100+        beforeSignature = ThirtyTwoBitTimeStamp 1699999999+    subkeyBindingSig <-+        signSubkeyBindingWithRSAExtrasAt+            primary+            subkey+            signingKey+            signatureTime+            [ SigSubPacket+                False+                (KeyFlags (Set.fromList [EncryptCommunicationsKey]))+            ]+    let tk =+            TKUnknown+                { _tkuKey = (primary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]+                }+    case recipientEncryptionTargetFromTKAtTimestamp beforeSignature tk of+        Left err ->+            assertFailure+                ( "Expected timestamp-scoped TKUnknown target selection to succeed, got "+                    ++ show err+                )+        Right target ->+            case recipientEncryptionTargetCapabilities target of+                Nothing ->+                    assertFailure+                        "Expected TKUnknown-derived target to include capabilities when timestamp-scoped"+                Just caps ->+                    assertEqual+                        "subkey binding created after target timestamp should not contribute key flags"+                        Set.empty+                        (recipientCapabilityKeyFlags caps)++testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersPrimary+    :: Assertion+testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersPrimary = do+    (baseKey, signingKey) <- loadUnencryptedRsaSigner+    let signatureTime = ThirtyTwoBitTimeStamp 1700000000+        primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey+        subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey+    subkeyBindingSig <-+        signSubkeyBindingWithRSAExtrasAt+            primary+            subkey+            signingKey+            signatureTime+            [ SigSubPacket+                False+                (KeyFlags (Set.fromList [EncryptCommunicationsKey]))+            ]+    let tk =+            TKUnknown+                { _tkuKey = (primary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]+                }+    case recipientEncryptionTargetFromTKAtTimestampWithPolicy+        RecipientTargetSelectionPreferPrimary+        signatureTime+        tk of+        Left err ->+            assertFailure+                ( "Expected policy-based recipient selection to succeed, got "+                    ++ show err+                )+        Right target ->+            assertEqual+                "prefer-primary policy should select primary key when both primary and subkey are valid"+                (fingerprint primary)+                (fingerprint (recipientEncryptionTargetKey target))++testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersNewest+    :: Assertion+testRecipientEncryptionTargetFromTKAtTimestampWithPolicyPrefersNewest = do+    (baseKey, signingKey) <- loadUnencryptedRsaSigner+    let signatureTime = ThirtyTwoBitTimeStamp 1700000000+        primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey+        subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000002) baseKey+    subkeyBindingSig <-+        signSubkeyBindingWithRSAExtrasAt+            primary+            subkey+            signingKey+            signatureTime+            [ SigSubPacket+                False+                (KeyFlags (Set.fromList [EncryptCommunicationsKey]))+            ]+    let tk =+            TKUnknown+                { _tkuKey = (primary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]+                }+    case recipientEncryptionTargetFromTKAtTimestampWithPolicy+        RecipientTargetSelectionPreferNewestCreationTime+        signatureTime+        tk of+        Left err ->+            assertFailure+                ( "Expected policy-based recipient selection to succeed, got "+                    ++ show err+                )+        Right target ->+            assertEqual+                "prefer-newest policy should select newest valid key"+                (fingerprint subkey)+                (fingerprint (recipientEncryptionTargetKey target))++testRecipientEncryptionTargetsFromTKRejectsKeyWithNonEncryptFlags+    :: Assertion+testRecipientEncryptionTargetsFromTKRejectsKeyWithNonEncryptFlags = do+    (baseKey, signingKey) <- loadUnencryptedRsaSigner+    let signatureTime = ThirtyTwoBitTimeStamp 1700000000+        primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey+        subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey+    subkeyBindingSig <-+        signSubkeyBindingWithRSAExtrasAt+            primary+            subkey+            signingKey+            signatureTime+            [SigSubPacket False (KeyFlags (Set.fromList [SignDataKey]))]+    let tk =+            TKUnknown+                { _tkuKey = (primary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]+                }+        targets = recipientEncryptionTargetsFromTKAtTimestamp signatureTime tk+    let subkeyFp = fingerprint subkey+        primaryFp = fingerprint primary+        targetFps = map (fingerprint . recipientEncryptionTargetKey) targets+    assertBool+        "subkey with sign-only key flags should be excluded from encryption targets"+        (subkeyFp `notElem` targetFps)+    assertBool+        "primary key (no explicit flags) should still be included as encryption target"+        (primaryFp `elem` targetFps)++testRecipientEncryptionTargetsFromTKIncludesKeyWithNoFlags+    :: Assertion+testRecipientEncryptionTargetsFromTKIncludesKeyWithNoFlags = do+    (baseKey, signingKey) <- loadUnencryptedRsaSigner+    let signatureTime = ThirtyTwoBitTimeStamp 1700000000+        primary = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000000) baseKey+        subkey = setKeyTimestamp (ThirtyTwoBitTimeStamp 1600000001) baseKey+    subkeyBindingSig <-+        signSubkeyBindingWithRSAExtrasAt+            primary+            subkey+            signingKey+            signatureTime+            []+    let tk =+            TKUnknown+                { _tkuKey = (primary, Nothing)+                , _tkuRevs = []+                , _tkuUIDs = []+                , _tkuUAts = []+                , _tkuSubs = [(PublicSubkeyPkt subkey, [subkeyBindingSig])]+                }+        targets = recipientEncryptionTargetsFromTKAtTimestamp signatureTime tk+    let subkeyFp = fingerprint subkey+        targetFps = map (fingerprint . recipientEncryptionTargetKey) targets+    assertBool+        "subkey with no key flags should be included as encryption target (legacy-compatible)"+        (subkeyFp `elem` targetFps)++testEncryptRecipientsWithRequestEmitsOnePassSignatures+    :: Assertion+testEncryptRecipientsWithRequestEmitsOnePassSignatures = do+    (baseRecipient, privateKey) <- loadUnencryptedRsaSigner+    let recipient = setKeyVersion V6 baseRecipient+        signature =+            SigV4+                BinarySig+                RSA+                SHA256+                []+                [ SigSubPacket+                    False+                    (Issuer (EightOctetKeyId (BL.pack [0x01 .. 0x08])))+                ]+                0+                (MPI 1 :| [])+        payload = "recipient one-pass signature payload"+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [recipientEncryptionTarget recipient]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                        { recipientPayloadUseOnePassSignatures = True+                        , recipientPayloadSignatures = [signature]+                        }+                , recipientEncryptRequestPayload = payload+                , recipientEncryptRequestSymmetricOverride = Just AES256+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv2Overrides+                        { recipientEncryptRequestAEADOverride = Just OCB+                        , recipientEncryptRequestChunkSizeOverride = Just 6+                        , recipientEncryptRequestSaltOverride =+                            Just (Salt (B.replicate 32 0x55))+                        }+                }+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipient+                        , pkeskRecipientSKey = RSAPrivateKey (RSA_PrivateKey privateKey)+                        }+                    )+                )+        passphraseCallback _ = pure BL.empty+    result <- encryptForRecipients request+    packets <-+        case result of+            Left err ->+                assertFailure+                    ( "Expected one-pass encryption request to succeed, got "+                        ++ show err+                    )+                    >> fail "encryptForRecipients failed"+            Right+                RecipientEncryptResult+                    { recipientEncryptPackets = encryptedPackets+                    } -> pure encryptedPackets+    decrypted <-+        DC.runConduitRes $+            CL.sourceList packets+                DC..| conduitDecryptWithPKESKContext+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [ OnePassSignaturePkt+                (OPSPayloadV3Packet (OPSPayloadV3 3 BinarySig SHA256 RSA _ False))+            , LiteralDataPkt _ _ _ gotPayload+            , SignaturePkt _+            ] ->+                assertEqual+                    "decrypted payload matches original plaintext"+                    (BL.fromStrict payload)+                    gotPayload+        other ->+            assertFailure+                ( "Expected decrypted [OPS3, LiteralData, Signature], got "+                    ++ show other+                )++testEncryptRecipientsWithRequestRejectsOnePassWhenIssuerMetadataMissing+    :: Assertion+testEncryptRecipientsWithRequestRejectsOnePassWhenIssuerMetadataMissing = do+    (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner+    let recipient = setKeyVersion V6 baseRecipient+        signature = SigV4 BinarySig RSA SHA256 [] [] 0 (MPI 1 :| [])+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [recipientEncryptionTarget recipient]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                        { recipientPayloadUseOnePassSignatures = True+                        , recipientPayloadSignatures = [signature]+                        }+                , recipientEncryptRequestPayload =+                    "recipient one-pass missing issuer metadata payload"+                , recipientEncryptRequestSymmetricOverride = Just AES256+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv2Overrides+                        { recipientEncryptRequestAEADOverride = Just OCB+                        , recipientEncryptRequestChunkSizeOverride = Just 6+                        , recipientEncryptRequestSaltOverride =+                            Just (Salt (B.replicate 32 0x56))+                        }+                }+    result <- encryptForRecipients request+    case result of+        Left (PayloadBuildFailure err) ->+            assertBool+                "missing issuer metadata should surface as payload build failure"+                ("without issuer metadata" `isInfixOf` err)+        Left err ->+            assertFailure+                ( "Expected PayloadBuildFailure for missing OPS issuer metadata, got "+                    ++ show err+                )+        Right _ ->+            assertFailure+                "Expected one-pass request without issuer metadata to fail"++testEncryptInteropLegacyProducesSEIPDv1 :: Assertion+testEncryptInteropLegacyProducesSEIPDv1 = do+    (recipient, privateKey) <- loadUnencryptedRsaSigner+    let iv = IV (B.replicate 16 0xAB)+        payload = "legacy interop payload"+        request =+            RecipientEncryptRequest+                { recipientEncryptRequestTargets =+                    [recipientEncryptionTarget recipient]+                , recipientEncryptRequestPayloadShape =+                    defaultRecipientPayloadShape+                , recipientEncryptRequestPayload = payload+                , recipientEncryptRequestSymmetricOverride = Just AES256+                , recipientEncryptRequestOverrides =+                    RecipientEncryptRequestSEIPDv1Overrides+                        { recipientEncryptRequestIVOverride = Just iv+                        }+                }+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipient+                        , pkeskRecipientSKey = RSAPrivateKey (RSA_PrivateKey privateKey)+                        }+                    )+                )+        passphraseCallback _ = pure BL.empty+    result <- encryptForRecipients request+    packets <-+        case result of+            Left err ->+                assertFailure+                    ( "Expected EncryptInteropLegacy request to succeed, got "+                        ++ show err+                    )+                    >> fail "encryptForRecipients failed"+            Right RecipientEncryptResult {recipientEncryptPackets = ps} -> pure ps+    let seipdPkts = [p | SymEncIntegrityProtectedDataPkt p <- packets]+    case seipdPkts of+        [SEIPD1 1 _] -> pure ()+        [SEIPD2 {}] -> assertFailure "Expected SEIPDv1 but got SEIPDv2"+        other -> assertFailure ("Unexpected SEIPD packets: " ++ show other)+    let pkeskPkts = [p | PKESKPkt p <- packets]+    assertBool "EncryptInteropLegacy should emit PKESKv3 packets" $+        all+            (\p -> case p of PKESKPayloadV3Packet {} -> True; _ -> False)+            pkeskPkts+    decrypted <-+        DC.runConduitRes $+            CL.sourceList packets+                DC..| conduitDecryptWithPKESKContext+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "decrypted legacy interop payload matches original"+                (BL.fromStrict payload)+                gotPayload+        other ->+            assertFailure+                ("Expected [LiteralData] from legacy decrypt, got " ++ show other)++testCanonicalizePKESKRecipientIdHelper :: Assertion+testCanonicalizePKESKRecipientIdHelper = do+    let rid = BL.pack (0x04 : replicate 20 0x11)+        payload = PKESKPayloadV6Packet (PKESKPayloadV6 rid RSA "esk")+    case canonicalizePKESKRecipientId payload of+        Right (PKESKPayloadV6Packet (PKESKPayloadV6 normalized _ _))+            | BL.length normalized == 20 -> pure ()+            | otherwise ->+                assertFailure+                    ( "Expected canonicalized recipient id length 20, got "+                        ++ show (BL.length normalized)+                    )+        Left err ->+            assertFailure+                ("canonicalizePKESKRecipientId failed unexpectedly: " ++ show err)+        Right other ->+            assertFailure+                ( "Expected PKESK6 payload after canonicalization, got "+                    ++ show other+                )+    case canonicalizePKESKRecipientId+        ( PKESKPayloadV6Packet+            (PKESKPayloadV6 (BL.replicate 19 0x22) RSA "esk")+        ) of+        Left (InvalidRecipientIdentifier _) -> pure ()+        other ->+            assertFailure+                ( "Expected InvalidRecipientIdentifier for malformed rid, got "+                    ++ show other+                )+    case canonicalizePKESKRecipientId+        ( PKESKPayloadV6Packet+            (PKESKPayloadV6 (BL.pack (0x06 : replicate 32 0x33)) RSA "esk")+        ) of+        Right (PKESKPayloadV6Packet (PKESKPayloadV6 normalized _ _))+            | BL.length normalized == 32 -> pure ()+            | otherwise ->+                assertFailure+                    ( "Expected canonicalized v6 recipient id length 32, got "+                        ++ show (BL.length normalized)+                    )+        other ->+            assertFailure+                ( "Expected 0x06-prefixed v6 recipient id to canonicalize, got "+                    ++ show other+                )+    case canonicalizePKESKRecipientId+        ( PKESKPayloadV6Packet+            (PKESKPayloadV6 (BL.pack (0x04 : replicate 32 0x44)) RSA "esk")+        ) of+        Left (InvalidRecipientIdentifier _) -> pure ()+        other ->+            assertFailure+                ( "Expected InvalidRecipientIdentifier for mismatched v4-prefixed v6-length rid, got "+                    ++ show other+                )++testBuildPKESKPayloadUnsupportedRecipient :: Assertion+testBuildPKESKPayloadUnsupportedRecipient = do+    let recipient =+            PKPayload+                V6+                (ThirtyTwoBitTimeStamp 0)+                0+                EdDSA+                (EdDSAPubKey EdSigningCurve25519 (NativeEPoint (EPoint 1)))+        sessionKey = SessionKey (B.replicate 32 0x19)+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    result <-+        buildPKESKPayloadForRecipient PreferV6 recipient sessionMaterial+    case result of+        Left (UnsupportedRecipientAlgorithm EdDSA) -> pure ()+        Left err ->+            assertFailure+                ("Expected UnsupportedRecipientAlgorithm EdDSA, got " ++ show err)+        Right payload ->+            assertFailure+                ( "Expected UnsupportedRecipientAlgorithm, got payload: "+                    ++ show payload+                )++testBuildPKESKPayloadRejectsECDHSHA1 :: Assertion+testBuildPKESKPayloadRejectsECDHSHA1 = do+    let (recipientPub, _) = syntheticNISTP256Low+        recipient =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                ECDH+                ( ECDHPubKey+                    (ECDSAPubKey (ECDSA_PublicKey recipientPub))+                    SHA1+                    AES256+                )+        sessionKey = SessionKey (B.replicate 32 0x19)+    sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey+    result <-+        buildPKESKPayloadForRecipient PreferV6 recipient sessionMaterial+    case result of+        Left (RecipientKdfFailure ECDH err)+            | "SHA1 is disallowed by policy" `isInfixOf` err -> pure ()+            | otherwise ->+                assertFailure+                    ( "Expected SHA1 policy rejection in RecipientKdfFailure, got: "+                        ++ err+                    )+        Left err ->+            assertFailure+                ("Expected RecipientKdfFailure ECDH for SHA1, got " ++ show err)+        Right payload ->+            assertFailure+                ("Expected SHA1 policy rejection, got payload: " ++ show payload)++testConduitDecryptSEIPDv2FixtureWithMatchingV6SecretKey+    :: Assertion+testConduitDecryptSEIPDv2FixtureWithMatchingV6SecretKey = do+    armoredMessage <- readFixtureStrict "seipdv2.pgp.aa"+    armoredEncryptedSecret <-+        readFixtureStrict "v6-encrypted-secret.pgp.aa"+    armoredPlainSecret <- readFixtureStrict "v6-secret.pgp.aa"+    passphrase <- readPKIPassphrase+    messageArmors <-+        case (AA.decode armoredMessage :: Either String [Armor]) of+            Left err ->+                assertFailure ("failed to decode seipdv2 armor: " ++ err)+                    >> pure []+            Right as -> pure as+    encryptedSecretArmors <-+        case (AA.decode armoredEncryptedSecret :: Either String [Armor]) of+            Left err ->+                assertFailure+                    ("failed to decode v6 encrypted secret armor: " ++ err)+                    >> pure []+            Right as -> pure as+    plainSecretArmors <-+        case (AA.decode armoredPlainSecret :: Either String [Armor]) of+            Left err ->+                assertFailure ("failed to decode v6 plain secret armor: " ++ err)+                    >> pure []+            Right as -> pure as+    messageBody <-+        case messageArmors of+            (a : _) -> pure (armorPayload a)+            [] ->+                assertFailure "seipdv2 armor file contained no armor blocks"+                    >> pure mempty+    encryptedSecretBody <-+        case encryptedSecretArmors of+            (a : _) -> pure (armorPayload a)+            [] ->+                assertFailure+                    "v6-encrypted-secret armor file contained no armor blocks"+                    >> pure mempty+    plainSecretBody <-+        case plainSecretArmors of+            (a : _) -> pure (armorPayload a)+            [] ->+                assertFailure "v6-secret armor file contained no armor blocks"+                    >> pure mempty+    let messagePackets = parsePkts messageBody+        encryptedSecretPackets = parsePkts encryptedSecretBody+        plainSecretPackets = parsePkts plainSecretBody+        passphraseCallback _ = pure BL.empty+    allKeyInfos <-+        collectSecretKeyInfos+            (encryptedSecretPackets ++ plainSecretPackets)+            passphrase+    let keyContextCallback pkt = pure (selectRecipientKeyInfo pkt allKeyInfos)+    if null allKeyInfos+        then+            assertFailure+                ( "no usable secret key material found in v6-encrypted-secret fixture: "+                    ++ show+                        ( [ (_pkalgo pkp, ska)+                          | SecretKeyPkt pkp ska <- encryptedSecretPackets+                          ]+                            ++ [ (_pkalgo pkp, ska)+                               | SecretSubkeyPkt pkp ska <- encryptedSecretPackets+                               ]+                        )+                )+        else do+            decrypted <-+                DC.runConduitRes $+                    CL.sourceList messagePackets+                        DC..| conduitDecryptWithPKESKContext+                            keyContextCallback+                            passphraseCallback+                        DC..| CL.consume+            case [p | LiteralDataPkt _ _ _ p <- decrypted] of+                (payload : _) ->+                    if BL.null payload+                        then+                            assertFailure "fixture decrypt produced empty literal payload"+                        else pure ()+                [] ->+                    assertFailure+                        ( "expected decrypted literal payload from seipdv2 fixture, got: "+                            ++ show decrypted+                        )++testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKey+    :: Assertion+testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKey = do+    (messagePackets, encryptedSecretPackets, passphrase) <-+        loadSEIPDv2FixtureWithV4Secret "seipdv2-for-v4-key.pgp.aa"+    let+        passphraseCallback _ = pure BL.empty+    keyInfos <-+        collectSecretKeyInfos encryptedSecretPackets passphrase+    let keyContextCallback pkt = pure (selectRecipientKeyInfo pkt keyInfos)+    decrypted <-+        DC.runConduitRes $+            CL.sourceList messagePackets+                DC..| conduitDecryptWithPKESKContext+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case [p | LiteralDataPkt _ _ _ p <- decrypted] of+        (payload : _) ->+            if "This is a test of SEIPDv1" `isInfixOf` BLC8.unpack payload+                then pure ()+                else+                    assertFailure+                        ( "unexpected decrypted payload for seipdv2-for-v4-key fixture: "+                            ++ show payload+                        )+        [] ->+            assertFailure+                ( "expected decrypted literal payload from seipdv2-for-v4-key fixture, got: "+                    ++ show decrypted+                )++testConduitDecryptSEIPDv2FixtureIgnoresUnusableLatestPKESK+    :: Assertion+testConduitDecryptSEIPDv2FixtureIgnoresUnusableLatestPKESK = do+    (messagePackets, encryptedSecretPackets, passphrase) <-+        loadSEIPDv2FixtureWithV4Secret "seipdv2-for-v4-key.pgp.aa"+    let+        bogusRid = BL.pack (0x06 : replicate 32 0x99)+        bogusPKESK =+            PKESKPkt+                (PKESKPayloadV6Packet (PKESKPayloadV6 bogusRid RSA "bogus-esk"))+        (eskPrefix, encryptedSuffix) = span isPrecedingESK messagePackets+        packetsWithBogusLatestPKESK = eskPrefix ++ [bogusPKESK] ++ encryptedSuffix+        passphraseCallback _ = pure BL.empty+    keyInfos <-+        collectSecretKeyInfos encryptedSecretPackets passphrase+    let keyContextCallback pkt = pure (selectRecipientKeyInfo pkt keyInfos)+    decrypted <-+        DC.runConduitRes $+            CL.sourceList packetsWithBogusLatestPKESK+                DC..| conduitDecryptWithPKESKContext+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case [p | LiteralDataPkt _ _ _ p <- decrypted] of+        (payload : _) ->+            if "This is a test of SEIPDv1" `isInfixOf` BLC8.unpack payload+                then pure ()+                else+                    assertFailure+                        ( "unexpected decrypted payload for seipdv2-for-v4-key fixture with bogus latest PKESK: "+                            ++ show payload+                        )+        [] ->+            assertFailure+                ( "expected decrypted literal payload with bogus latest PKESK, got: "+                    ++ show decrypted+                )++testConduitDecryptSEIPDv2FixtureAcceptsRecipientIdWithoutCallerPermutations+    :: Assertion+testConduitDecryptSEIPDv2FixtureAcceptsRecipientIdWithoutCallerPermutations = do+    (messagePacketsRaw, encryptedSecretPackets, passphrase) <-+        loadSEIPDv2FixtureWithV4Secret "seipdv2-for-v4-key.pgp.aa"+    let messagePackets = map forceVersionedRecipientIdentifier messagePacketsRaw+        passphraseCallback _ = pure BL.empty+    keyInfos <-+        collectSecretKeyInfos encryptedSecretPackets passphrase+    let keyContextCallback pkt = pure (selectRecipientKeyInfoByRawRecipientId pkt keyInfos)+    decrypted <-+        DC.runConduitRes $+            CL.sourceList messagePackets+                DC..| conduitDecryptWithPKESKContext+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case [p | LiteralDataPkt _ _ _ p <- decrypted] of+        (payload : _) ->+            if "This is a test of SEIPDv1" `isInfixOf` BLC8.unpack payload+                then pure ()+                else+                    assertFailure+                        ( "unexpected decrypted payload for recipient-id normalization fixture: "+                            ++ show payload+                        )+        [] ->+            assertFailure+                ( "expected decrypted literal payload for recipient-id normalization fixture, got: "+                    ++ show decrypted+                )++testConduitDecryptPKESKFailureDoesNotRequireManualSessionMaterial+    :: Assertion+testConduitDecryptPKESKFailureDoesNotRequireManualSessionMaterial = do+    armors <- loadArmor "seipdv2-for-v4-key.pgp.aa"+    armor <-+        case armors of+            (a : _) -> pure a+            [] ->+                assertFailure+                    "seipdv2-for-v4-key.pgp.aa should contain one armored payload"+                    >> fail "expected one armored payload"+    let packets = parsePkts (armorPayload armor)+        keyContextCallback _ = pure Nothing+        passphraseCallback prompt =+            fail ("unexpected manual PKESK session key prompt: " ++ prompt)+    result <-+        catch+            ( Right+                <$> ( DC.runConduitRes $+                        CL.sourceList packets+                            DC..| conduitDecryptWithPKESKContext+                                keyContextCallback+                                passphraseCallback+                            DC..| CL.consume+                    )+            )+            (\e -> pure (Left (show (e :: SomeException))))+    case result of+        Left err -> do+            assertBool+                "failure should report PKESK candidate exhaustion"+                ("no matching key context" `isInfixOf` err)+            assertBool+                "failure should not request manual PKESK session material"+                ( not+                    ("unexpected manual PKESK session key prompt" `isInfixOf` err)+                )+        Right decrypted ->+            assertFailure+                ( "expected decryption failure when no PKESK key context is available, got: "+                    ++ show decrypted+                )++testConduitDecryptSEIPDv2TwoRecipientsFixtureWithMatchingV4SecretKey+    :: Assertion+testConduitDecryptSEIPDv2TwoRecipientsFixtureWithMatchingV4SecretKey =+    testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform+        "seipdv2-two-recipients.pgp.aa"+        id++testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithMatchingV4SecretKey+    :: Assertion+testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithMatchingV4SecretKey =+    testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform+        "seipdv2-three-recipients.pgp.aa"+        id++testConduitDecryptSEIPDv2TwoRecipientsFixtureWithReorderedAndUnusablePKESKs+    :: Assertion+testConduitDecryptSEIPDv2TwoRecipientsFixtureWithReorderedAndUnusablePKESKs =+    testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform+        "seipdv2-two-recipients.pgp.aa"+        (prependUnusableLatestPKESK . reorderPrecedingPKESKs)++testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithReorderedAndUnusablePKESKs+    :: Assertion+testConduitDecryptSEIPDv2ThreeRecipientsFixtureWithReorderedAndUnusablePKESKs =+    testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform+        "seipdv2-three-recipients.pgp.aa"+        (prependUnusableLatestPKESK . reorderPrecedingPKESKs)++testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFile+    :: FilePath -> Assertion+testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFile fixture =+    testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform+        fixture+        id++testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform+    :: FilePath+    -> ([Pkt] -> [Pkt])+    -> Assertion+testConduitDecryptSEIPDv2FixtureWithMatchingV4SecretKeyFromFileWithTransform fixture transformPackets = do+    (messagePacketsRaw, encryptedSecretPackets, passphrase) <-+        loadSEIPDv2FixtureWithV4Secret fixture+    let messagePackets = transformPackets messagePacketsRaw+        passphraseCallback _ = pure BL.empty+    keyInfos <-+        collectSecretKeyInfos encryptedSecretPackets passphrase+    let keyContextCallback pkt = pure (selectRecipientKeyInfo pkt keyInfos)+    decrypted <-+        DC.runConduitRes $+            CL.sourceList messagePackets+                DC..| conduitDecryptWithPKESKContext+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case [p | LiteralDataPkt _ _ _ p <- decrypted] of+        (payload : _) ->+            if BL.null payload+                then+                    assertFailure+                        (fixture ++ " decrypt produced empty literal payload")+                else pure ()+        [] ->+            assertFailure+                ( "expected decrypted literal payload from "+                    ++ fixture+                    ++ ", got: "+                    ++ show decrypted+                )++testConduitDecryptSEIPDv2WithPKESKv6RawSessionKey :: Assertion+testConduitDecryptSEIPDv2WithPKESKv6RawSessionKey = do+    let sessionKey = B.replicate 32 0x2a+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "v6 pkesk session key decrypt path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        packets ct =+            [ PKESKPkt+                ( PKESKPayloadV6Packet+                    ( PKESKPayloadV6+                        "\x01\x02\x03\x04\x05\x06\x07\x08"+                        RSA+                        "\x99\x88\x77"+                    )+                )+            , SymEncIntegrityProtectedDataPkt+                (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ct))+            ]+        callback _ = pure (BL.fromStrict sessionKey)+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList (packets ciphertext)+                DC..| conduitDecrypt callback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESKv6 raw session-key decrypt payload"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2RejectsWrongPKESKv6RawSessionKeyLength+    :: Assertion+testConduitDecryptSEIPDv2RejectsWrongPKESKv6RawSessionKeyLength = do+    let sessionKey = B.replicate 32 0x2a+        badSessionKey = B.replicate 31 0x2a+        salt = Salt (B.pack [0x00 .. 0x1f])+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    "payload"+                ]+        packets ct =+            [ PKESKPkt+                ( PKESKPayloadV6Packet+                    ( PKESKPayloadV6+                        "\x10\x11\x12\x13\x14\x15\x16\x17"+                        RSA+                        "\x01\x02\x03"+                    )+                )+            , SymEncIntegrityProtectedDataPkt+                (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ct))+            ]+        callback _ = pure (BL.fromStrict badSessionKey)+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    result <-+        catch+            ( Right+                <$> ( DC.runConduitRes $+                        CL.sourceList (packets ciphertext)+                            DC..| conduitDecrypt callback+                            DC..| CL.consume+                    )+            )+            (\e -> pure (Left (show (e :: SomeException))))+    case result of+        Left err ->+            if "PKESK raw session key length does not match payload algorithm"+                `isInfixOf` err+                then return ()+                else+                    assertFailure+                        ( "Expected PKESKv6 raw session-key length validation failure, got: "+                            ++ err+                        )+        Right got ->+            assertFailure+                ( "Expected PKESKv6 raw session-key length failure, got packets: "+                    ++ show got+                )++testConduitDecryptSEIPDv2WithPKESKRSAUnwrap :: Assertion+testConduitDecryptSEIPDv2WithPKESKRSAUnwrap = do+    (baseRecipient, privateKey) <- loadUnencryptedRsaSigner+    publicKey <-+        case _pubkey baseRecipient of+            RSAPubKey (RSA_PublicKey pub) -> pure pub+            other ->+                assertFailure+                    ( "unencrypted.seckey did not contain an RSA recipient, got "+                        ++ show other+                    )+                    >> fail "expected RSA recipient"+    let sessionKey = B.replicate 32 0x2b+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk rsa unwrap decrypt path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ = do+            let msk = Just (RSAPrivateKey (RSA_PrivateKey privateKey))+            pure $+                fmap+                    ( \sk ->+                        PKESKRecipientKey+                            { pkeskRecipientPKPayload = Nothing+                            , pkeskRecipientSKey = sk+                            }+                    )+                    msk+    encryptedResult <-+        ( P15.encrypt publicKey sessionKey+            :: IO (Either RSA.Error B.ByteString)+        )+    encryptedSessionMaterial <-+        case encryptedResult of+            Left err ->+                assertFailure ("RSA PKESK encryption failed: " ++ show err)+                    >> pure mempty+            Right ct -> pure ct+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    let pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId "\x11\x22\x33\x44\x55\x66\x77\x88")+                        RSA+                        (MPI (os2ip encryptedSessionMaterial) :| [])+                    )+                )+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithDecryptPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual "PKESK RSA unwrap decrypt payload" payload gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2WithPKESKRSAUnwrapViaWildcardCallbackFallback+    :: Assertion+testConduitDecryptSEIPDv2WithPKESKRSAUnwrapViaWildcardCallbackFallback = do+    (baseRecipient, privateKey) <- loadUnencryptedRsaSigner+    publicKey <-+        case _pubkey baseRecipient of+            RSAPubKey (RSA_PublicKey pub) -> pure pub+            other ->+                assertFailure+                    ( "unencrypted.seckey did not contain an RSA recipient, got "+                        ++ show other+                    )+                    >> fail "expected RSA recipient"+    let sessionKey = B.replicate 32 0x2e+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk rsa unwrap decrypt path via wildcard callback fallback"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback pkt =+            case pkt of+                PKESKPkt+                    (PKESKPayloadV3Packet (PKESKPayloadV3 _ (EightOctetKeyId rid) _ _))+                        | BL.length rid == 8 && BL.all (== 0) rid ->+                            pure+                                ( Just+                                    ( PKESKRecipientKey+                                        { pkeskRecipientPKPayload = Nothing+                                        , pkeskRecipientSKey =+                                            RSAPrivateKey (RSA_PrivateKey privateKey)+                                        }+                                    )+                                )+                _ -> pure Nothing+    encryptedResult <-+        ( P15.encrypt publicKey sessionKey+            :: IO (Either RSA.Error B.ByteString)+        )+    encryptedSessionMaterial <-+        case encryptedResult of+            Left err ->+                assertFailure ("RSA PKESK encryption failed: " ++ show err)+                    >> pure mempty+            Right ct -> pure ct+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    let pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId "\xaa\xbb\xcc\xdd\xee\xff\x00\x11")+                        RSA+                        (MPI (os2ip encryptedSessionMaterial) :| [])+                    )+                )+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithDecryptPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESK RSA unwrap via wildcard callback fallback payload"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2WithPKESKRSAUnwrapFromProtectedKey+    :: Assertion+testConduitDecryptSEIPDv2WithPKESKRSAUnwrapFromProtectedKey = do+    passphrase <- readPKIPassphrase+    secretPackets <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/aes256-sha512.seckey"+                DC..| conduitGet get+                DC..| CL.consume+    keyInfos <- collectSecretKeyInfos secretPackets passphrase+    keyInfo <-+        case keyInfos of+            (ki : _) -> pure ki+            [] ->+                assertFailure+                    "aes256-sha512.seckey should yield at least one RSA key context"+                    >> fail "expected key info"+    publicKey <-+        case pkeskRecipientPKPayload keyInfo of+            Nothing ->+                assertFailure+                    "key info from file should include a public key payload"+                    >> fail "expected public key payload"+            Just pkp ->+                case _pubkey pkp of+                    RSAPubKey (RSA_PublicKey pub) -> pure pub+                    other ->+                        assertFailure+                            ( "expected RSA public key from aes256-sha512.seckey, got "+                                ++ show other+                            )+                            >> fail "expected RSA public key"+    let sessionKey = B.replicate 32 0x42+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk rsa unwrap via sha1-cfb protected key loaded from file"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback pkt = pure (selectRecipientKeyInfo pkt keyInfos)+    encryptedResult <-+        ( P15.encrypt publicKey sessionKey+            :: IO (Either RSA.Error B.ByteString)+        )+    encryptedSessionMaterial <-+        case encryptedResult of+            Left err ->+                assertFailure ("RSA PKESK encryption failed: " ++ show err)+                    >> pure mempty+            Right ct -> pure ct+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    let pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId "\x11\x22\x33\x44\x55\x66\x77\x88")+                        RSA+                        (MPI (os2ip encryptedSessionMaterial) :| [])+                    )+                )+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithPKESKContext+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESK RSA unwrap with SHA1-CFB protected key from file"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2WithPKESKECDHUnwrap :: Assertion+testConduitDecryptSEIPDv2WithPKESKECDHUnwrap = do+    let (recipientPub, recipientPriv) = syntheticNISTP256Low+        (ephPub, ephPriv) = syntheticNISTP256High+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                ECDH+                ( ECDHPubKey+                    (ECDSAPubKey (ECDSA_PublicKey recipientPub))+                    SHA256+                    AES128+                )+        recipientSKey = ECDHPrivateKey (ECDSA_PrivateKey recipientPriv)+        sessionKey = B.replicate 32 0x2c+        encodedSession =+            B.singleton (fromFVal AES256)+                <> sessionKey+                <> encodeChecksum16 sessionKey+                <> B.replicate 5 0+        sharedSecret =+            BA.convert+                ( ECCDH.getShared+                    (ECDSA.public_curve recipientPub)+                    (ECDSA.private_d ephPriv)+                    (ECDSA.public_q recipientPub)+                )+                :: B.ByteString+        kdfParam =+            buildECDHKDFParamForTest+                recipientPKP+                ECDH+                (ECDSA.public_curve recipientPub)+                SHA256+                AES128+        kek = deriveECDHKekForTest SHA256 AES128 sharedSecret kdfParam+        wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek encodedSession+        ephPointBytes =+            maybe+                (error "failed to encode ephemeral point")+                id+                (point2MBS (ECDSA.public_q ephPub))+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")+                        ECDH+                        (MPI (os2ip ephPointBytes) :| [MPI (os2ip wrappedSession)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk ecdh unwrap decrypt path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipientPKP+                        , pkeskRecipientSKey = recipientSKey+                        }+                    )+                )+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithDecryptPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESK ECDH unwrap decrypt payload"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2RejectsECDHWrongEphemeralPointLength+    :: Assertion+testConduitDecryptSEIPDv2RejectsECDHWrongEphemeralPointLength = do+    let (recipientPub, recipientPriv) = syntheticNISTP256Low+        (ephPub, ephPriv) = syntheticNISTP256High+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                ECDH+                ( ECDHPubKey+                    (ECDSAPubKey (ECDSA_PublicKey recipientPub))+                    SHA256+                    AES128+                )+        recipientSKey = ECDHPrivateKey (ECDSA_PrivateKey recipientPriv)+        sessionKey = B.replicate 32 0x2c+        encodedSession =+            B.singleton (fromFVal AES256)+                <> sessionKey+                <> encodeChecksum16 sessionKey+                <> B.replicate 5 0+        sharedSecret =+            BA.convert+                ( ECCDH.getShared+                    (ECDSA.public_curve recipientPub)+                    (ECDSA.private_d ephPriv)+                    (ECDSA.public_q recipientPub)+                )+                :: B.ByteString+        kdfParam =+            buildECDHKDFParamForTest+                recipientPKP+                ECDH+                (ECDSA.public_curve recipientPub)+                SHA256+                AES128+        kek = deriveECDHKekForTest SHA256 AES128 sharedSecret kdfParam+        wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek encodedSession+        ephPointBytes =+            maybe+                (error "failed to encode ephemeral point")+                id+                (point2MBS (ECDSA.public_q ephPub))+        truncatedEphemeral = B.take (B.length ephPointBytes - 1) ephPointBytes+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")+                        ECDH+                        (MPI (os2ip truncatedEphemeral) :| [MPI (os2ip wrappedSession)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk ecdh wrong ephemeral point length"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipientPKP+                        , pkeskRecipientSKey = recipientSKey+                        }+                    )+                )+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    result <-+        catch+            ( Right+                <$> DC.runConduitRes+                    ( CL.sourceList+                        [ pkesk+                        , SymEncIntegrityProtectedDataPkt+                            (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                        ]+                        DC..| conduitDecryptWithDecryptPolicy+                            lenientDecryptPolicy+                            keyContextCallback+                            passphraseCallback+                        DC..| CL.consume+                    )+            )+            (\e -> pure (Left (show (e :: SomeException))))+    case result of+        Left err ->+            assertBool+                "ECDH unwrap should reject wrong uncompressed point length for recipient curve"+                ("invalid length for recipient curve" `isInfixOf` err)+        Right packets ->+            assertFailure+                ( "Expected ECDH point-length validation failure, got: "+                    ++ show packets+                )++testConduitDecryptSEIPDv2WithPKESKX25519V3Unwrap :: Assertion+testConduitDecryptSEIPDv2WithPKESKX25519V3Unwrap = do+    let recipientSecretRaw = B.pack [0x21 .. 0x40]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                )+        recipientSKey = X25519PrivateKey recipientSecretRaw+        ephSecretRaw = B.pack [0x41 .. 0x60]+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 ephemeral secret key: " ++ show err)+                Right sk -> sk+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPub =+            case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient public key: " ++ show err)+                Right pk -> pk+        sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+        kek =+            deriveX25519KekForTest+                ephPublicRaw+                recipientPublicRaw+                sharedSecret+        sessionKey = SessionKey (B.replicate 32 0x6a)+        wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)+        eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId "\x12\x34\x56\x78\x90\xab\xcd\xef")+                        X25519+                        (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk x25519 v3 unwrap decrypt path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipientPKP+                        , pkeskRecipientSKey = recipientSKey+                        }+                    )+                )+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithDecryptPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESK X25519 v3 unwrap decrypt payload"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossRecipientKeyOrder+    :: Assertion+testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossRecipientKeyOrder = do+    let recipientSecretRaw = B.pack [0x21 .. 0x40]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                )+        recipientSKey = X25519PrivateKey recipientSecretRaw+        wrongRecipientSecretRaw = B.pack [0x61 .. 0x80]+        wrongRecipientSecret =+            case CE.eitherCryptoError (C25519.secretKey wrongRecipientSecretRaw) of+                Left err ->+                    error+                        ( "failed to initialize wrong X25519 recipient secret key: "+                            ++ show err+                        )+                Right sk -> sk+        wrongRecipientPublicRaw =+            BA.convert (C25519.toPublic wrongRecipientSecret) :: B.ByteString+        wrongRecipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip wrongRecipientPublicRaw)))+                )+        wrongRecipientSKey = X25519PrivateKey wrongRecipientSecretRaw+        ephSecretRaw = B.pack [0x41 .. 0x60]+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 ephemeral secret key: " ++ show err)+                Right sk -> sk+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPub =+            case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient public key: " ++ show err)+                Right pk -> pk+        sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+        kek =+            deriveX25519KekForTest+                ephPublicRaw+                recipientPublicRaw+                sharedSecret+        sessionKey = SessionKey (B.replicate 32 0x6b)+        wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)+        eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId (BL.replicate 8 0))+                        X25519+                        (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk x25519 v3 wildcard key-id retry path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        wrongKeyInfo =+            PKESKRecipientKey+                { pkeskRecipientPKPayload = Just wrongRecipientPKP+                , pkeskRecipientSKey = wrongRecipientSKey+                }+        correctKeyInfo =+            PKESKRecipientKey+                { pkeskRecipientPKPayload = Just recipientPKP+                , pkeskRecipientSKey = recipientSKey+                }+        keyContextCallback _rid _pka = pure [wrongKeyInfo, correctKeyInfo]+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithCandidatesCallbackAndPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESKv3 wildcard-keyid retries across recipient key order"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder+    :: Assertion+testConduitDecryptSEIPDv2RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder = do+    let recipientSecretRaw = B.pack [0x21 .. 0x40]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        ephSecretRaw = B.pack [0x41 .. 0x60]+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 ephemeral secret key: " ++ show err)+                Right sk -> sk+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPub =+            case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient public key: " ++ show err)+                Right pk -> pk+        sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+        kek =+            deriveX25519KekForTest+                ephPublicRaw+                recipientPublicRaw+                sharedSecret+        sessionKey = SessionKey (B.replicate 32 0x6c)+        wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)+        eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId (BL.replicate 8 0))+                        X25519+                        (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk x25519 v3 wildcard key-id long retry path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        mkSecretBytes offset =+            B.pack+                [fromIntegral ((offset + i) `mod` 256) | i <- [0 .. 31 :: Int]]+        mkX25519RecipientKeyInfo label secretRaw =+            let sk =+                    case CE.eitherCryptoError (C25519.secretKey secretRaw) of+                        Left err ->+                            error+                                ( "failed to initialize "+                                    ++ label+                                    ++ " X25519 secret key: "+                                    ++ show err+                                )+                        Right secretKey -> secretKey+                publicRaw = BA.convert (C25519.toPublic sk) :: B.ByteString+             in PKESKRecipientKey+                    { pkeskRecipientPKPayload =+                        Just+                            ( PKPayload+                                V4+                                (ThirtyTwoBitTimeStamp 0)+                                0+                                X25519+                                ( EdDSAPubKey+                                    EdSigningCurve25519+                                    (NativeEPoint (EPoint (os2ip publicRaw)))+                                )+                            )+                    , pkeskRecipientSKey = X25519PrivateKey secretRaw+                    }+        wrongKeyInfos =+            [ mkX25519RecipientKeyInfo+                ("wrong-" ++ show n)+                (mkSecretBytes (96 + n * 7))+            | n <- [1 .. 20 :: Int]+            ]+        correctKeyInfo = mkX25519RecipientKeyInfo "correct" recipientSecretRaw+        keyContextCallback _rid _pka = pure (wrongKeyInfos ++ [correctKeyInfo])+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithCandidatesCallbackAndPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESKv3 wildcard-keyid retries long recipient key order"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv1RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder+    :: Assertion+testConduitDecryptSEIPDv1RetriesWildcardPKESKv3AcrossLongRecipientKeyOrder = do+    let recipientSecretRaw = B.pack [0x21 .. 0x40]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        ephSecretRaw = B.pack [0x41 .. 0x60]+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 ephemeral secret key: " ++ show err)+                Right sk -> sk+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPub =+            case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient public key: " ++ show err)+                Right pk -> pk+        sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+        kek =+            deriveX25519KekForTest+                ephPublicRaw+                recipientPublicRaw+                sharedSecret+        sessionKey = SessionKey (B.replicate 32 0x6d)+        wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)+        eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId (BL.replicate 8 0))+                        X25519+                        (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])+                    )+                )+        payload =+            "pkesk x25519 v3 wildcard key-id long retry legacy seipd1 path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        cleartext = BL.toStrict (runPut (put literalBlock))+        iv = IV (B.pack [0x33 .. 0x42])+        cleartextWithMDC = cleartext <> mdcTrailerForSEIPDv1 iv cleartext+        passphraseCallback _ = pure BL.empty+        mkSecretBytes offset =+            B.pack+                [fromIntegral ((offset + i) `mod` 256) | i <- [0 .. 31 :: Int]]+        mkX25519RecipientKeyInfo label secretRaw =+            let sk =+                    case CE.eitherCryptoError (C25519.secretKey secretRaw) of+                        Left err ->+                            error+                                ( "failed to initialize "+                                    ++ label+                                    ++ " X25519 secret key: "+                                    ++ show err+                                )+                        Right secretKey -> secretKey+                publicRaw = BA.convert (C25519.toPublic sk) :: B.ByteString+             in PKESKRecipientKey+                    { pkeskRecipientPKPayload =+                        Just+                            ( PKPayload+                                V4+                                (ThirtyTwoBitTimeStamp 0)+                                0+                                X25519+                                ( EdDSAPubKey+                                    EdSigningCurve25519+                                    (NativeEPoint (EPoint (os2ip publicRaw)))+                                )+                            )+                    , pkeskRecipientSKey = X25519PrivateKey secretRaw+                    }+        wrongKeyInfos =+            [ mkX25519RecipientKeyInfo+                ("wrong-" ++ show n)+                (mkSecretBytes (96 + n * 7))+            | n <- [1 .. 20 :: Int]+            ]+        correctKeyInfo = mkX25519RecipientKeyInfo "correct" recipientSecretRaw+        keyContextCallback _rid _pka = pure (wrongKeyInfos ++ [correctKeyInfo])+    ciphertext <-+        either+            ( \e ->+                assertFailure ("encryptOpenPGPCfbRaw failed: " ++ show e)+                    >> pure mempty+            )+            pure+            ( encryptOpenPGPCfbRaw+                OpenPGPCFBNoResyncW+                AES256+                iv+                cleartextWithMDC+                (unSessionKey sessionKey)+            )+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD1 1 (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithCandidatesCallbackAndPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESKv3 wildcard-keyid retries long recipient key order for SEIPDv1"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testMkCandidateResolverDecryptsWildcardPKESKv3 :: Assertion+testMkCandidateResolverDecryptsWildcardPKESKv3 = do+    let recipientSecretRaw = B.pack [0x21 .. 0x40]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                )+        recipientSKey = X25519PrivateKey recipientSecretRaw+        wrongSecretRaw = B.pack [0x61 .. 0x80]+        wrongSecret =+            case CE.eitherCryptoError (C25519.secretKey wrongSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize wrong X25519 secret key: " ++ show err)+                Right sk -> sk+        wrongPublicRaw = BA.convert (C25519.toPublic wrongSecret) :: B.ByteString+        wrongPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip wrongPublicRaw)))+                )+        wrongSKey = X25519PrivateKey wrongSecretRaw+        ephSecretRaw = B.pack [0x41 .. 0x60]+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 ephemeral secret key: " ++ show err)+                Right sk -> sk+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPub =+            case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient public key: " ++ show err)+                Right pk -> pk+        sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+        kek =+            deriveX25519KekForTest+                ephPublicRaw+                recipientPublicRaw+                sharedSecret+        sessionKey = SessionKey (B.replicate 32 0x6d)+        wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)+        eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId (BL.replicate 8 0))+                        X25519+                        (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "unwrap callback wildcard path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        wrongKeyInfo =+            PKESKRecipientKey+                { pkeskRecipientPKPayload = Just wrongPKP+                , pkeskRecipientSKey = wrongSKey+                }+        correctKeyInfo =+            PKESKRecipientKey+                { pkeskRecipientPKPayload = Just recipientPKP+                , pkeskRecipientSKey = recipientSKey+                }+    let resolver _rid _pka = pure [wrongKeyInfo, correctKeyInfo]+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| ( void $+                            DCD.conduitDecrypt+                                DCD.DecryptOptions+                                    { DCD.decryptOptionsKeyResolution =+                                        DCD.DecryptWithUnwrapCandidatesCallback resolver+                                    , DCD.decryptOptionsPolicy = lenientDecryptPolicy+                                    , DCD.decryptOptionsPassphraseCallback = passphraseCallback+                                    }+                      )+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "unwrap callback should decrypt wildcard PKESK via candidate list"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptWildcardResolverProvidesTypedPreviousFailures+    :: Assertion+testConduitDecryptWildcardResolverProvidesTypedPreviousFailures = do+    let recipientSecretRaw = B.pack [0x21 .. 0x40]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                )+        recipientSKey = X25519PrivateKey recipientSecretRaw+        wrongSecretRaw = B.pack [0x61 .. 0x80]+        wrongSecret =+            case CE.eitherCryptoError (C25519.secretKey wrongSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize wrong X25519 secret key: " ++ show err)+                Right sk -> sk+        wrongPublicRaw = BA.convert (C25519.toPublic wrongSecret) :: B.ByteString+        wrongPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip wrongPublicRaw)))+                )+        wrongSKey = X25519PrivateKey wrongSecretRaw+        ephSecretRaw = B.pack [0x41 .. 0x60]+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 ephemeral secret key: " ++ show err)+                Right sk -> sk+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPub =+            case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient public key: " ++ show err)+                Right pk -> pk+        sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+        kek =+            deriveX25519KekForTest+                ephPublicRaw+                recipientPublicRaw+                sharedSecret+        sessionKey = SessionKey (B.replicate 32 0x6e)+        wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)+        eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId (BL.replicate 8 0))+                        X25519+                        (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "typed previous failures for wildcard retries"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        wrongKeyInfo =+            PKESKRecipientKey+                { pkeskRecipientPKPayload = Just wrongPKP+                , pkeskRecipientSKey = wrongSKey+                }+        correctKeyInfo =+            PKESKRecipientKey+                { pkeskRecipientPKPayload = Just recipientPKP+                , pkeskRecipientSKey = recipientSKey+                }+    let resolver _rid _pka = pure [wrongKeyInfo, correctKeyInfo]+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| ( void $+                            DCD.conduitDecrypt+                                DCD.DecryptOptions+                                    { DCD.decryptOptionsKeyResolution =+                                        DCD.DecryptWithUnwrapCandidatesCallback resolver+                                    , DCD.decryptOptionsPolicy = lenientDecryptPolicy+                                    , DCD.decryptOptionsPassphraseCallback = passphraseCallback+                                    }+                      )+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "wildcard retries with typed previous failures should still decrypt"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)+    pure ()++testConduitDecryptWithReportCapturesWildcardResolverDiagnostics+    :: Assertion+testConduitDecryptWithReportCapturesWildcardResolverDiagnostics = do+    let recipientSecretRaw = B.pack [0x21 .. 0x40]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                )+        recipientSKey = X25519PrivateKey recipientSecretRaw+        wrongSecretRaw = B.pack [0x61 .. 0x80]+        wrongSecret =+            case CE.eitherCryptoError (C25519.secretKey wrongSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize wrong X25519 secret key: " ++ show err)+                Right sk -> sk+        wrongPublicRaw = BA.convert (C25519.toPublic wrongSecret) :: B.ByteString+        wrongPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip wrongPublicRaw)))+                )+        wrongSKey = X25519PrivateKey wrongSecretRaw+        ephSecretRaw = B.pack [0x41 .. 0x60]+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 ephemeral secret key: " ++ show err)+                Right sk -> sk+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPub =+            case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient public key: " ++ show err)+                Right pk -> pk+        sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+        kek =+            deriveX25519KekForTest+                ephPublicRaw+                recipientPublicRaw+                sharedSecret+        sessionKey = SessionKey (B.replicate 32 0x6f)+        wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)+        eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId (BL.replicate 8 0))+                        X25519+                        (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "conduitDecryptWithReport wildcard diagnostics"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        wrongKeyInfo =+            PKESKRecipientKey+                { pkeskRecipientPKPayload = Just wrongPKP+                , pkeskRecipientSKey = wrongSKey+                }+        correctKeyInfo =+            PKESKRecipientKey+                { pkeskRecipientPKPayload = Just recipientPKP+                , pkeskRecipientSKey = recipientSKey+                }+    let resolver _rid _pka = pure [wrongKeyInfo, correctKeyInfo]+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    (report, decrypted) <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| DC.fuseBoth+                    ( DCD.conduitDecryptWithReport+                        DCD.DecryptOptions+                            { DCD.decryptOptionsKeyResolution =+                                DCD.DecryptWithUnwrapCandidatesCallback resolver+                            , DCD.decryptOptionsPolicy = lenientDecryptPolicy+                            , DCD.decryptOptionsPassphraseCallback = passphraseCallback+                            }+                    )+                    CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "wildcard retries with report diagnostics should decrypt"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)+    assertEqual+        "decrypt report should preserve outcome"+        DCD.DecryptClean+        (DCD.decryptReportOutcome report)+    case DCD.decryptReportSessionKeyResolutions report of+        [resolution] -> do+            assertEqual+                "resolution path should be PKESK for wildcard key retries"+                DCD.DecryptResolvedViaPKESK+                (DCD.decryptSessionResolutionPath resolution)+            let attempts = DCD.decryptSessionResolutionResolverAttempts resolution+            assertBool+                "report should contain wildcard resolver attempts"+                (length attempts >= 2)+            assertBool+                "report should record typed previous failures in resolver attempt context"+                ( any+                    ( \attempt ->+                        any+                            ( \failure ->+                                DCD.pkeskAttemptFailureKind failure+                                    == DCD.PKESKAttemptUnwrapFailed+                                    && DCD.pkeskAttemptFailureKeyContext failure == Just (V4, X25519)+                            )+                            (DCD.pkeskResolverAttemptPreviousFailures attempt)+                    )+                    attempts+                )+            assertBool+                "report should capture ResolveWith key context for X25519"+                ( any+                    ( \attempt ->+                        DCD.pkeskResolverAttemptAction attempt+                            == DCD.ResolverAttemptResolveWith (Just (V4, X25519))+                    )+                    attempts+                )+        other ->+            assertFailure+                ( "Expected exactly one session-key resolution report, got "+                    ++ show (length other)+                )++testConduitDecryptSEIPDv2RejectsPKESKX25519V3WrongEphemeralLength+    :: Assertion+testConduitDecryptSEIPDv2RejectsPKESKX25519V3WrongEphemeralLength = do+    let recipientSecretRaw = B.pack [0x21 .. 0x40]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                )+        recipientSKey = X25519PrivateKey recipientSecretRaw+        ephSecretRaw = B.pack [0x41 .. 0x60]+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 ephemeral secret key: " ++ show err)+                Right sk -> sk+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPub =+            case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient public key: " ++ show err)+                Right pk -> pk+        sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+        kek =+            deriveX25519KekForTest+                ephPublicRaw+                recipientPublicRaw+                sharedSecret+        sessionKey = SessionKey (B.replicate 32 0x6a)+        wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek (unSessionKey sessionKey)+        eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession+        overlongEphemeral = ephPublicRaw <> "\x00\x01"+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId "\x12\x34\x56\x78\x90\xab\xcd\xef")+                        X25519+                        (MPI (os2ip overlongEphemeral) :| [MPI (os2ip eskWithAlgo)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk x25519 v3 wrong ephemeral length"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipientPKP+                        , pkeskRecipientSKey = recipientSKey+                        }+                    )+                )+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    result <-+        catch+            ( Right+                <$> DC.runConduitRes+                    ( CL.sourceList+                        [ pkesk+                        , SymEncIntegrityProtectedDataPkt+                            (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                        ]+                        DC..| conduitDecryptWithDecryptPolicy+                            lenientDecryptPolicy+                            keyContextCallback+                            passphraseCallback+                        DC..| CL.consume+                    )+            )+            (\e -> pure (Left (show (e :: SomeException))))+    case result of+        Left err ->+            assertBool+                "PKESKv3 X25519 unwrap should reject non-32-byte ephemeral values"+                ( "invalid X25519 ephemeral public key length/prefix"+                    `isInfixOf` err+                )+        Right packets ->+            assertFailure+                ( "Expected X25519 ephemeral-length validation failure, got: "+                    ++ show packets+                )++testConduitDecryptSEIPDv2FallsBackFromArgon2SKESKToPKESKv3X25519+    :: Assertion+testConduitDecryptSEIPDv2FallsBackFromArgon2SKESKToPKESKv3X25519 = do+    let recipientSecretRaw = B.pack [0x21 .. 0x40]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                X25519+                ( EdDSAPubKey+                    EdSigningCurve25519+                    (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                )+        recipientSKey = X25519PrivateKey recipientSecretRaw+        ephSecretRaw = B.pack [0x41 .. 0x60]+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 ephemeral secret key: " ++ show err)+                Right sk -> sk+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPub =+            case CE.eitherCryptoError (C25519.publicKey recipientPublicRaw) of+                Left err ->+                    error+                        ("failed to initialize X25519 recipient public key: " ++ show err)+                Right pk -> pk+        sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString+        kek =+            deriveX25519KekForTest+                ephPublicRaw+                recipientPublicRaw+                sharedSecret+        sessionKeyBytes = B.replicate 32 0x6a+        sessionKey = SessionKey sessionKeyBytes+        wrappedSession = aesKeyWrapRFC3394ForTest AES128 kek sessionKeyBytes+        eskWithAlgo = B.singleton (fromFVal AES256) <> wrappedSession+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId "\x12\x34\x56\x78\x90\xab\xcd\xef")+                        X25519+                        (MPI (os2ip ephPublicRaw) :| [MPI (os2ip eskWithAlgo)])+                    )+                )+        skeskS2K = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15+        skeskPassphrase = "correct horse battery staple"+        wrongPassphrase = "wrong passphrase"+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "skesk->pkesk fallback decrypt path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipientPKP+                        , pkeskRecipientSKey = recipientSKey+                        }+                    )+                )+        passphraseCallback _ = pure wrongPassphrase+    keyLen <-+        case keySize AES256 of+            Left err ->+                assertFailure ("keySize failed for AES256: " ++ show err)+                    >> fail "keySize failed"+            Right n -> pure n+    skeskKek <-+        case string2Key skeskS2K keyLen skeskPassphrase of+            Left err ->+                assertFailure+                    ("string2Key failed for Argon2 SKESK: " ++ renderS2KError err)+                    >> fail "string2Key failed"+            Right x -> pure x+    skeskEncryptedEsk <-+        case withSymmetricCipher AES256 skeskKek $ \cipher ->+            paddedCfbEncrypt+                cipher+                (B.replicate (blockSize cipher) 0)+                (B.singleton (fromFVal AES256) <> sessionKeyBytes) of+            Left err ->+                assertFailure+                    ("encrypting Argon2 SKESK ESK failed: " ++ show err)+                    >> fail "encrypting SKESK ESK failed"+            Right x -> pure x+    let skesk =+            SKESKPkt+                ( SKESKPayloadV4Packet+                    ( SKESKPayloadV4+                        AES256+                        skeskS2K+                        (Just (BL.fromStrict skeskEncryptedEsk))+                    )+                )+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ skesk+                , pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithDecryptPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "conduitDecrypt should fall back from failing Argon2 SKESK to PKESKv3 X25519"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2FallsBackToEarlierArgon2SKESK+    :: Assertion+testConduitDecryptSEIPDv2FallsBackToEarlierArgon2SKESK = do+    let skeskS2K = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15+        passphrase = "password"+        sessionKeyBytes = B.replicate 32 0x7b+        sessionKey = SessionKey sessionKeyBytes+        badLatestEsk = BL.fromStrict (B.pack [0x00])+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "earlier argon2 skesk fallback decrypt path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure passphrase+    keyLen <-+        case keySize AES256 of+            Left err ->+                assertFailure ("keySize failed for AES256: " ++ show err)+                    >> fail "keySize failed"+            Right n -> pure n+    skeskKek <-+        case string2Key skeskS2K keyLen passphrase of+            Left err ->+                assertFailure+                    ("string2Key failed for Argon2 SKESK: " ++ renderS2KError err)+                    >> fail "string2Key failed"+            Right x -> pure x+    validEsk <-+        case withSymmetricCipher AES256 skeskKek $ \cipher ->+            paddedCfbEncrypt+                cipher+                (B.replicate (blockSize cipher) 0)+                (B.singleton (fromFVal AES256) <> sessionKeyBytes) of+            Left err ->+                assertFailure+                    ("encrypting Argon2 SKESK ESK failed: " ++ show err)+                    >> fail "encrypting SKESK ESK failed"+            Right x -> pure x+    let earlierValidSKESK =+            SKESKPkt+                ( SKESKPayloadV4Packet+                    (SKESKPayloadV4 AES256 skeskS2K (Just (BL.fromStrict validEsk)))+                )+        latestUnusableSKESK =+            SKESKPkt+                ( SKESKPayloadV4Packet+                    (SKESKPayloadV4 AES256 skeskS2K (Just badLatestEsk))+                )+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            sessionKey+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ earlierValidSKESK+                , latestUnusableSKESK+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithDecryptPolicy+                    lenientDecryptPolicy+                    (\_ -> pure Nothing)+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "conduitDecrypt should retry earlier Argon2 SKESK when latest SKESK is unusable"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2RejectsECDHNonTable30Params :: Assertion+testConduitDecryptSEIPDv2RejectsECDHNonTable30Params = do+    let (recipientPub, recipientPriv) = syntheticNISTP256Low+        (ephPub, ephPriv) = syntheticNISTP256High+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                ECDH+                ( ECDHPubKey+                    (ECDSAPubKey (ECDSA_PublicKey recipientPub))+                    SHA256+                    AES256+                )+        recipientSKey = ECDHPrivateKey (ECDSA_PrivateKey recipientPriv)+        sessionKey = B.replicate 32 0x2c+        encodedSession =+            B.singleton (fromFVal AES256)+                <> sessionKey+                <> encodeChecksum16 sessionKey+                <> B.replicate 5 0+        sharedSecret =+            BA.convert+                ( ECCDH.getShared+                    (ECDSA.public_curve recipientPub)+                    (ECDSA.private_d ephPriv)+                    (ECDSA.public_q recipientPub)+                )+                :: B.ByteString+        kdfParam =+            buildECDHKDFParamForTest+                recipientPKP+                ECDH+                (ECDSA.public_curve recipientPub)+                SHA256+                AES256+        kek = deriveECDHKekForTest SHA256 AES256 sharedSecret kdfParam+        wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession+        ephPointBytes =+            maybe+                (error "failed to encode ephemeral point")+                id+                (point2MBS (ECDSA.public_q ephPub))+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")+                        ECDH+                        (MPI (os2ip ephPointBytes) :| [MPI (os2ip wrappedSession)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk ecdh unwrap policy failure path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipientPKP+                        , pkeskRecipientSKey = recipientSKey+                        }+                    )+                )+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    result <-+        catch+            ( Right+                <$> DC.runConduitRes+                    ( CL.sourceList+                        [ pkesk+                        , SymEncIntegrityProtectedDataPkt+                            (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                        ]+                        DC..| conduitDecryptWithDecryptPolicy+                            lenientDecryptPolicy+                            keyContextCallback+                            passphraseCallback+                        DC..| CL.consume+                    )+            )+            (\e -> pure (Left (show (e :: SomeException))))+    case result of+        Left err ->+            assertBool+                "ECDH unwrap should reject non-Table-30 parameters"+                ("Table 30 policy violation" `isInfixOf` err)+        Right packets ->+            assertFailure+                ( "Expected Table 30 policy failure, got decrypted packets: "+                    ++ show packets+                )++testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyRFC6637AcceptedParams+    :: Assertion+testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyRFC6637AcceptedParams = do+    let recipientSecretRaw = B.pack [1 .. 32]+        ephSecretRaw = B.pack [101 .. 132]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ( "failed to initialize Curve25519Legacy recipient secret key: "+                            ++ show err+                        )+                Right sk -> sk+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ( "failed to initialize Curve25519Legacy ephemeral secret key: "+                            ++ show err+                        )+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                ECDH+                ( ECDHPubKey+                    ( EdDSAPubKey+                        EdSigningCurve25519+                        ( PrefixedNativeEPoint+                            (EPoint (os2ip (B.cons 0x40 recipientPublicRaw)))+                        )+                    )+                    SHA256+                    AES256+                )+        recipientSKey =+            ECDHPrivateKey+                ( ECDSA_PrivateKey+                    ( ECDSA.PrivateKey+                        (ECCT.getCurveByName ECCT.SEC_p256r1)+                        (os2ip recipientSecretRaw)+                    )+                )+        sessionKey = B.replicate 32 0x3d+        encodedSession =+            B.singleton (fromFVal AES256)+                <> sessionKey+                <> encodeChecksum16 sessionKey+                <> B.replicate 5 0+        sharedSecret =+            BA.convert+                (C25519.dh (C25519.toPublic ephSecret) recipientSecret)+                :: B.ByteString+        kdfParam =+            buildCurve25519LegacyKdfParamForTest+                recipientPKP+                ECDH+                SHA256+                AES256+        kek = deriveECDHKekForTest SHA256 AES256 sharedSecret kdfParam+        wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")+                        ECDH+                        (MPI (os2ip ephPublicRaw) :| [MPI (os2ip wrappedSession)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk ecdh v4 curve25519legacy accepted-combo path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipientPKP+                        , pkeskRecipientSKey = recipientSKey+                        }+                    )+                )+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithDecryptPolicy+                    lenientDecryptPolicy+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "v4 Curve25519Legacy ECDH should allow RFC6637-accepted parameters"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyWithTruncatedWrappedMPI+    :: Assertion+testConduitDecryptSEIPDv2AllowsV4Curve25519LegacyWithTruncatedWrappedMPI = do+    let recipientSecretRaw = B.pack [1 .. 32]+        ephSecretRaw = B.pack [101 .. 132]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ( "failed to initialize Curve25519Legacy recipient secret key: "+                            ++ show err+                        )+                Right sk -> sk+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ( "failed to initialize Curve25519Legacy ephemeral secret key: "+                            ++ show err+                        )+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPKP =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                ECDH+                ( ECDHPubKey+                    ( EdDSAPubKey+                        EdSigningCurve25519+                        ( PrefixedNativeEPoint+                            (EPoint (os2ip (B.cons 0x40 recipientPublicRaw)))+                        )+                    )+                    SHA256+                    AES256+                )+        recipientSKey =+            ECDHPrivateKey+                ( ECDSA_PrivateKey+                    ( ECDSA.PrivateKey+                        (ECCT.getCurveByName ECCT.SEC_p256r1)+                        (os2ip recipientSecretRaw)+                    )+                )+        sharedSecret =+            BA.convert+                (C25519.dh (C25519.toPublic ephSecret) recipientSecret)+                :: B.ByteString+        kdfParam =+            buildCurve25519LegacyKdfParamForTest+                recipientPKP+                ECDH+                SHA256+                AES256+        kek = deriveECDHKekForTest SHA256 AES256 sharedSecret kdfParam+        candidate =+            find+                ( \(_, wrappedSession) -> not (B.null wrappedSession) && B.head wrappedSession == 0x00+                )+                [ let sessionKeyBytes =+                        B.pack+                            [ fromIntegral ((seed + offset) `mod` 256)+                            | offset <- [0 .. 31]+                            ]+                      encodedSession =+                        B.singleton (fromFVal AES256)+                            <> sessionKeyBytes+                            <> encodeChecksum16 sessionKeyBytes+                            <> B.replicate 5 0+                      wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession+                   in (SessionKey sessionKeyBytes, wrappedSession)+                | seed <- [0 .. 4095 :: Int]+                ]+    case candidate of+        Nothing ->+            assertFailure+                "failed to find deterministic Curve25519Legacy wrapped session key with leading zero"+        Just (sessionKey, wrappedSession) -> do+            let pkesk =+                    PKESKPkt+                        ( PKESKPayloadV3Packet+                            ( PKESKPayloadV3+                                3+                                (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")+                                ECDH+                                (MPI (os2ip ephPublicRaw) :| [MPI (os2ip wrappedSession)])+                            )+                        )+                salt = Salt (B.pack [0x00 .. 0x1f])+                payload = "pkesk ecdh v4 curve25519legacy truncated wrapped-mpi path"+                literalBlock =+                    Block+                        [ LiteralDataPkt+                            BinaryData+                            BL.empty+                            (ThirtyTwoBitTimeStamp 0)+                            payload+                        ]+                passphraseCallback _ = pure BL.empty+                keyContextCallback _ =+                    pure+                        ( Just+                            ( PKESKRecipientKey+                                { pkeskRecipientPKPayload = Just recipientPKP+                                , pkeskRecipientSKey = recipientSKey+                                }+                            )+                        )+            ciphertext <-+                case encryptSEIPDv2Payload+                    AES256+                    OCB+                    6+                    salt+                    sessionKey+                    (BL.toStrict (runPut (put literalBlock))) of+                    Left err ->+                        assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                            >> pure mempty+                    Right ct -> pure ct+            decrypted <-+                DC.runConduitRes $+                    CL.sourceList+                        [ pkesk+                        , SymEncIntegrityProtectedDataPkt+                            (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                        ]+                        DC..| conduitDecryptWithDecryptPolicy+                            lenientDecryptPolicy+                            keyContextCallback+                            passphraseCallback+                        DC..| CL.consume+            case decrypted of+                [LiteralDataPkt _ _ _ gotPayload] ->+                    assertEqual+                        "v4 Curve25519Legacy ECDH should unwrap after wrapped-MPI leading-zero truncation"+                        payload+                        gotPayload+                other ->+                    assertFailure+                        ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2RejectsV6Curve25519LegacyNonTable30Params+    :: Assertion+testConduitDecryptSEIPDv2RejectsV6Curve25519LegacyNonTable30Params = do+    let recipientSecretRaw = B.pack [1 .. 32]+        ephSecretRaw = B.pack [101 .. 132]+        recipientSecret =+            case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ( "failed to initialize Curve25519Legacy recipient secret key: "+                            ++ show err+                        )+                Right sk -> sk+        ephSecret =+            case CE.eitherCryptoError (C25519.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ( "failed to initialize Curve25519Legacy ephemeral secret key: "+                            ++ show err+                        )+                Right sk -> sk+        recipientPublicRaw = BA.convert (C25519.toPublic recipientSecret) :: B.ByteString+        ephPublicRaw = BA.convert (C25519.toPublic ephSecret) :: B.ByteString+        recipientPKP =+            PKPayload+                V6+                (ThirtyTwoBitTimeStamp 0)+                0+                ECDH+                ( ECDHPubKey+                    ( EdDSAPubKey+                        EdSigningCurve25519+                        (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                    )+                    SHA512+                    AES256+                )+        recipientSKey =+            ECDHPrivateKey+                ( ECDSA_PrivateKey+                    ( ECDSA.PrivateKey+                        (ECCT.getCurveByName ECCT.SEC_p256r1)+                        (os2ip recipientSecretRaw)+                    )+                )+        sessionKey = B.replicate 32 0x3d+        encodedSession =+            B.singleton (fromFVal AES256)+                <> sessionKey+                <> encodeChecksum16 sessionKey+                <> B.replicate 5 0+        sharedSecret =+            BA.convert+                (C25519.dh (C25519.toPublic ephSecret) recipientSecret)+                :: B.ByteString+        kdfParam =+            buildCurve25519LegacyKdfParamForTest+                recipientPKP+                ECDH+                SHA512+                AES256+        kek = deriveECDHKekForTest SHA512 AES256 sharedSecret kdfParam+        wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession+        pkesk =+            PKESKPkt+                ( PKESKPayloadV3Packet+                    ( PKESKPayloadV3+                        3+                        (EightOctetKeyId "\x99\x88\x77\x66\x55\x44\x33\x22")+                        ECDH+                        (MPI (os2ip ephPublicRaw) :| [MPI (os2ip wrappedSession)])+                    )+                )+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk ecdh v6 curve25519legacy strict path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipientPKP+                        , pkeskRecipientSKey = recipientSKey+                        }+                    )+                )+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    result <-+        catch+            ( Right+                <$> DC.runConduitRes+                    ( CL.sourceList+                        [ pkesk+                        , SymEncIntegrityProtectedDataPkt+                            (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                        ]+                        DC..| conduitDecryptWithDecryptPolicy+                            lenientDecryptPolicy+                            keyContextCallback+                            passphraseCallback+                        DC..| CL.consume+                    )+            )+            (\e -> pure (Left (show (e :: SomeException))))+    case result of+        Left err ->+            assertBool+                "v6 Curve25519Legacy ECDH should remain strict"+                ("Table 30 policy violation" `isInfixOf` err)+        Right packets ->+            assertFailure+                ( "Expected Table 30 policy failure, got decrypted packets: "+                    ++ show packets+                )++testConduitDecryptSEIPDv2WithPKESKX448Unwrap :: Assertion+testConduitDecryptSEIPDv2WithPKESKX448Unwrap = do+    let recipientSecretRaw = B.pack [1 .. 56]+        ephSecretRaw = B.pack [57 .. 112]+        sessionKey = B.replicate 32 0x4d+        encodedSession =+            B.singleton (fromFVal AES256)+                <> sessionKey+                <> encodeChecksum16 sessionKey+                <> B.replicate 5 0+        recipientSecret =+            case CE.eitherCryptoError (C448.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X448 recipient secret key: " ++ show err)+                Right sk -> sk+        ephSecret =+            case CE.eitherCryptoError (C448.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X448 ephemeral secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C448.toPublic recipientSecret) :: B.ByteString+        ephPublicRaw = BA.convert (C448.toPublic ephSecret) :: B.ByteString+        sharedSecret =+            BA.convert (C448.dh (C448.toPublic recipientSecret) ephSecret)+                :: B.ByteString+        kek =+            deriveX448KekForTest ephPublicRaw recipientPublicRaw sharedSecret+        wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession+        esk =+            ephPublicRaw+                <> B.singleton (fromIntegral (B.length wrappedSession))+                <> wrappedSession+        recipientPKP =+            PKPayload+                V6+                (ThirtyTwoBitTimeStamp 0)+                0+                X448+                ( EdDSAPubKey+                    EdSigningCurve448+                    (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                )+        recipientRid = unFingerprint (fingerprint recipientPKP)+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk x448 unwrap decrypt path"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipientPKP+                        , pkeskRecipientSKey = X448PrivateKey recipientSecretRaw+                        }+                    )+                )+        pkesk =+            PKESKPkt+                ( PKESKPayloadV6Packet+                    (PKESKPayloadV6 recipientRid X448 (BL.fromStrict esk))+                )+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    decrypted <-+        DC.runConduitRes $+            CL.sourceList+                [ pkesk+                , SymEncIntegrityProtectedDataPkt+                    (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                ]+                DC..| conduitDecryptWithPKESKContext+                    keyContextCallback+                    passphraseCallback+                DC..| CL.consume+    case decrypted of+        [LiteralDataPkt _ _ _ gotPayload] ->+            assertEqual+                "PKESK X448 unwrap decrypt payload"+                payload+                gotPayload+        other ->+            assertFailure+                ("Expected one decrypted literal packet, got " ++ show other)++testConduitDecryptSEIPDv2RejectsPKESKX448WrongEphemeralLength+    :: Assertion+testConduitDecryptSEIPDv2RejectsPKESKX448WrongEphemeralLength = do+    let recipientSecretRaw = B.pack [1 .. 56]+        ephSecretRaw = B.pack [57 .. 112]+        sessionKey = B.replicate 32 0x4d+        encodedSession =+            B.singleton (fromFVal AES256)+                <> sessionKey+                <> encodeChecksum16 sessionKey+                <> B.replicate 5 0+        recipientSecret =+            case CE.eitherCryptoError (C448.secretKey recipientSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X448 recipient secret key: " ++ show err)+                Right sk -> sk+        ephSecret =+            case CE.eitherCryptoError (C448.secretKey ephSecretRaw) of+                Left err ->+                    error+                        ("failed to initialize X448 ephemeral secret key: " ++ show err)+                Right sk -> sk+        recipientPublicRaw = BA.convert (C448.toPublic recipientSecret) :: B.ByteString+        ephPublicRaw = BA.convert (C448.toPublic ephSecret) :: B.ByteString+        shortEphemeral = B.tail ephPublicRaw+        sharedSecret =+            BA.convert (C448.dh (C448.toPublic recipientSecret) ephSecret)+                :: B.ByteString+        kek =+            deriveX448KekForTest ephPublicRaw recipientPublicRaw sharedSecret+        wrappedSession = aesKeyWrapRFC3394ForTest AES256 kek encodedSession+        esk =+            shortEphemeral+                <> B.singleton (fromIntegral (B.length wrappedSession))+                <> wrappedSession+        recipientPKP =+            PKPayload+                V6+                (ThirtyTwoBitTimeStamp 0)+                0+                X448+                ( EdDSAPubKey+                    EdSigningCurve448+                    (NativeEPoint (EPoint (os2ip recipientPublicRaw)))+                )+        recipientRid = unFingerprint (fingerprint recipientPKP)+        salt = Salt (B.pack [0x00 .. 0x1f])+        payload = "pkesk x448 wrong ephemeral length"+        literalBlock =+            Block+                [ LiteralDataPkt+                    BinaryData+                    BL.empty+                    (ThirtyTwoBitTimeStamp 0)+                    payload+                ]+        passphraseCallback _ = pure BL.empty+        keyContextCallback _ =+            pure+                ( Just+                    ( PKESKRecipientKey+                        { pkeskRecipientPKPayload = Just recipientPKP+                        , pkeskRecipientSKey = X448PrivateKey recipientSecretRaw+                        }+                    )+                )+        pkesk =+            PKESKPkt+                ( PKESKPayloadV6Packet+                    (PKESKPayloadV6 recipientRid X448 (BL.fromStrict esk))+                )+    ciphertext <-+        case encryptSEIPDv2Payload+            AES256+            OCB+            6+            salt+            (SessionKey sessionKey)+            (BL.toStrict (runPut (put literalBlock))) of+            Left err ->+                assertFailure ("encryptSEIPDv2Payload failed: " ++ err)+                    >> pure mempty+            Right ct -> pure ct+    result <-+        catch+            ( Right+                <$> DC.runConduitRes+                    ( CL.sourceList+                        [ pkesk+                        , SymEncIntegrityProtectedDataPkt+                            (SEIPD2 AES256 OCB 6 salt (BL.fromStrict ciphertext))+                        ]+                        DC..| conduitDecryptWithPKESKContext+                            keyContextCallback+                            passphraseCallback+                        DC..| CL.consume+                    )+            )+            (\e -> pure (Left (show (e :: SomeException))))+    case result of+        Left err ->+            assertBool+                "PKESKv6 X448 unwrap should reject non-56-byte ephemeral values"+                ("expected 56-octet ephemeral value" `isInfixOf` err)+        Right packets ->+            assertFailure+                ( "Expected X448 ephemeral-length validation failure, got: "+                    ++ show packets+                )++testDecodeOpenPGPEncodedSessionKeyRejectsTooShort :: Assertion+testDecodeOpenPGPEncodedSessionKeyRejectsTooShort =+    assertEqual+        "encoded session key should reject too-short payloads"+        (Left EncodedSessionKeyTooShort)+        (decodeOpenPGPEncodedSessionKey (B.pack [0x09, 0x01]))++testDecodeOpenPGPEncodedSessionKeyRejectsLengthMismatch+    :: Assertion+testDecodeOpenPGPEncodedSessionKeyRejectsLengthMismatch =+    assertEqual+        "encoded session key should reject algorithm/key-length mismatches"+        (Left (EncodedSessionKeyLengthMismatch AES128 16 3))+        ( decodeOpenPGPEncodedSessionKey+            (B.pack [fromFVal AES128, 0x01, 0x02, 0x03])+        )++testDecodeOpenPGPEncodedSessionKeyRejectsChecksumMismatch+    :: Assertion+testDecodeOpenPGPEncodedSessionKeyRejectsChecksumMismatch =+    assertEqual+        "encoded session key should reject checksum mismatches"+        (Left EncodedSessionKeyChecksumMismatch)+        ( decodeOpenPGPEncodedSessionKey+            (B.pack ([fromFVal AES128] <> replicate 16 0x00 <> [0x00, 0x01]))+        )++testSKESKRejectsUnknownVersion :: Assertion+testSKESKRejectsUnknownVersion = do+    let s2k = Simple SHA256+        pkt =+            SKESKPkt+                (SKESKPayloadV4Packet (SKESKPayloadV4 AES128 s2k Nothing))+        encoded = BL.toStrict (runPut (put pkt))+        malformed =+            BL.fromStrict+                (B.take 2 encoded <> B.singleton 5 <> B.drop 3 encoded)+    case runGet (get :: Get Pkt) malformed of+        Right (BrokenPacketPkt errReason 3 _) ->+            assertBool+                ("expected unsupported SKESK version error, got: " ++ errReason)+                ("unsupported SKESK packet version" `isInfixOf` errReason)+        Right other ->+            assertFailure+                ( "unknown SKESK version should not parse successfully: "+                    ++ show other+                )+        Left err ->+            assertFailure+                ( "unknown SKESK version should be reported as a broken packet: "+                    ++ err+                )++testSKESK4EncryptedSessionKeyRejectsSimpleS2K :: Assertion+testSKESK4EncryptedSessionKeyRejectsSimpleS2K = do+    let pkt =+            SKESKPkt+                ( SKESKPayloadV4Packet+                    ( SKESKPayloadV4+                        AES128+                        (Simple SHA256)+                        (Just (BL.pack [0x01, 0x02, 0x03]))+                    )+                )+        encoded = runPut (put pkt)+    case runGet (get :: Get Pkt) encoded of+        Right (BrokenPacketPkt errReason 3 _) ->+            assertBool+                ("expected Simple S2K rejection, got: " ++ errReason)+                ("must not use Simple S2K" `isInfixOf` errReason)+        Right other ->+            assertFailure+                ( "Simple-S2K v4 SKESK with encrypted session key should not parse successfully: "+                    ++ show other+                )+        Left err ->+            assertFailure+                ( "Simple-S2K v4 SKESK with encrypted session key should be reported as a broken packet: "+                    ++ err+                )++testSKESK4Argon2EncryptedSessionKeyRoundTripAcrossAES+    :: Assertion+testSKESK4Argon2EncryptedSessionKeyRoundTripAcrossAES =+    mapM_ assertRoundTrip [AES128, AES192, AES256]+  where+    passphrase = "password"+    s2k = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15+    assertRoundTrip sa = do+        keyLen <-+            case keySize sa of+                Left err ->+                    assertFailure+                        ("keySize failed for " ++ show sa ++ ": " ++ show err)+                        >> fail "keySize failed"+                Right n -> pure n+        kek <-+            case string2Key s2k keyLen passphrase of+                Left err ->+                    assertFailure+                        ("string2Key failed for " ++ show sa ++ ": " ++ renderS2KError err)+                        >> fail "string2Key failed"+                Right x -> pure x+        let sessionKey = B.pack (take keyLen (cycle [0x11, 0x22, 0x33, 0x44]))+            encodedSessionKey = B.singleton (fromFVal sa) <> sessionKey+        encryptedEsk <-+            case withSymmetricCipher sa kek $ \cipher ->+                paddedCfbEncrypt+                    cipher+                    (B.replicate (blockSize cipher) 0)+                    encodedSessionKey of+                Left err ->+                    assertFailure+                        ( "encrypting SKESK v4 ESK failed for "+                            ++ show sa+                            ++ ": "+                            ++ show err+                        )+                        >> fail "encrypting SKESK v4 ESK failed"+                Right x -> pure x+        let skesk = SKESK4Packet sa s2k (Just (BL.fromStrict encryptedEsk))+        case skesk2SessionKey skesk passphrase of+            Right (decodedAlgo, decodedSessionKey) -> do+                assertEqual+                    ("decoded SKESK v4 encrypted ESK algorithm for " ++ show sa)+                    sa+                    decodedAlgo+                assertEqual+                    ("decoded SKESK v4 encrypted ESK session key for " ++ show sa)+                    sessionKey+                    decodedSessionKey+            Left err ->+                assertFailure+                    ( "decoding SKESK v4 encrypted ESK failed for "+                        ++ show sa+                        ++ ": "+                        ++ renderS2KError err+                    )++testSKESK4Argon2EncryptedSessionKeyRejectsTrailingChecksum+    :: Assertion+testSKESK4Argon2EncryptedSessionKeyRejectsTrailingChecksum = do+    let sa = AES128+        passphrase = "password"+        s2k = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15+        sessionKey = B.pack (take 16 (cycle [0xaa, 0xbb, 0xcc, 0xdd]))+    keyLen <-+        case keySize sa of+            Left err ->+                assertFailure ("keySize failed: " ++ show err)+                    >> fail "keySize failed"+            Right n -> pure n+    kek <-+        case string2Key s2k keyLen passphrase of+            Left err ->+                assertFailure ("string2Key failed: " ++ renderS2KError err)+                    >> fail "string2Key failed"+            Right x -> pure x+    let encodedWithChecksum =+            B.singleton (fromFVal sa)+                <> sessionKey+                <> encodeChecksum16 sessionKey+    encryptedEsk <-+        case withSymmetricCipher sa kek $ \cipher ->+            paddedCfbEncrypt+                cipher+                (B.replicate (blockSize cipher) 0)+                encodedWithChecksum of+            Left err ->+                assertFailure+                    ("encrypting malformed SKESK v4 ESK failed: " ++ show err)+                    >> fail "encrypting malformed SKESK v4 ESK failed"+            Right x -> pure x+    let skesk = SKESK4Packet sa s2k (Just (BL.fromStrict encryptedEsk))+    case skesk2SessionKey skesk passphrase of+        Left+            ( S2KEncryptedSessionKeyDecodeError+                    (EncodedSessionKeyLengthMismatch AES128 16 18)+                ) -> pure ()+        Left err ->+            assertFailure+                ( "expected SKESK v4 trailing-checksum rejection, got: "+                    ++ renderS2KError err+                )+        Right _ ->+            assertFailure+                "expected SKESK v4 trailing-checksum rejection, but decode succeeded"++testEncryptPassphraseWithPolicyForceV4Interop :: Assertion+testEncryptPassphraseWithPolicyForceV4Interop = do+    let request =+            PassphraseEncryptRequest+                { passphraseEncryptVersionPolicy = PassphraseSKESKForceV4Interop+                , passphraseEncryptSymmetricAlgorithm = AES128+                , passphraseEncryptS2K = Simple SHA256+                , passphraseEncryptPassphrase = "password"+                , passphraseEncryptPayload = "hello"+                , passphraseEncryptSEIPDv1IVOverride =+                    Just (IV (B.replicate 16 0x22))+                , passphraseEncryptSEIPDv2AEADOverride = Nothing+                , passphraseEncryptSEIPDv2ChunkSizeOverride = Nothing+                , passphraseEncryptSEIPDv2SaltOverride = Nothing+                }+    result <- encryptPassphraseWithPolicy request+    case result of+        Left err ->+            assertFailure+                ( "Expected passphrase SKESK force-v4 encryption to succeed, got: "+                    ++ err+                )+        Right+            ( SKESKPkt (SKESKPayloadV4Packet _)+                    : SymEncIntegrityProtectedDataPkt (SEIPD1 _ _)+                    : _+                ) ->+                pure ()+        Right packets ->+            assertFailure+                ( "Expected SKESKv4 + SEIPDv1 packet sequence, got: "+                    ++ show packets+                )++testEncryptPassphraseWithPolicyPreferV6 :: Assertion+testEncryptPassphraseWithPolicyPreferV6 = do+    let request =+            PassphraseEncryptRequest+                { passphraseEncryptVersionPolicy = PassphraseSKESKPreferV6+                , passphraseEncryptSymmetricAlgorithm = AES128+                , passphraseEncryptS2K = Simple SHA256+                , passphraseEncryptPassphrase = "password"+                , passphraseEncryptPayload = "hello"+                , passphraseEncryptSEIPDv1IVOverride = Nothing+                , passphraseEncryptSEIPDv2AEADOverride = Just OCB+                , passphraseEncryptSEIPDv2ChunkSizeOverride = Just 6+                , passphraseEncryptSEIPDv2SaltOverride =+                    Just (Salt (B.replicate 32 0x44))+                }+    result <- encryptPassphraseWithPolicy request+    case result of+        Left err ->+            assertFailure+                ( "Expected passphrase SKESK prefer-v6 encryption to succeed, got: "+                    ++ err+                )+        Right+            ( SKESKPkt (SKESKPayloadV6Packet _)+                    : SymEncIntegrityProtectedDataPkt (SEIPD2 _ _ _ _ _)+                    : _+                ) ->+                pure ()+        Right packets ->+            assertFailure+                ( "Expected SKESKv6 + SEIPDv2 packet sequence, got: "+                    ++ show packets+                )++testArgon2S2KVector :: Assertion+testArgon2S2KVector = do+    let s2k = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15+        pass = BLC8.pack "password"+        derivedKeyResult = string2Key s2k 16 pass+    derivedKey <-+        case derivedKeyResult of+            Left err ->+                assertFailure+                    ("Argon2 S2K key derivation failed: " ++ renderS2KError err)+                    >> fail "Argon2 key derivation failed"+            Right x -> pure x+    let+        hex =+            map toUpper . BLC8.unpack . B16L.encode . BL.fromStrict $+                derivedKey+    assertEqual+        "Argon2 S2K key derivation vector"+        "A3BDFE3814D790F1F366ABA6954EB386"+        hex++testArgon2S2KOrdTotal :: Assertion+testArgon2S2KOrdTotal = do+    let argon2A = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15+        argon2B = Argon2 (Salt16 (B.pack [0x01 .. 0x10])) 1 4 15+    assertEqual+        "Argon2 S2K compares after simple S2K"+        GT+        (compare argon2A (Simple SHA256))+    assertEqual+        "Argon2 S2K compares before unknown S2K types"+        LT+        (compare argon2A (OtherS2K 101 BL.empty))+    assertEqual+        "Argon2 S2K constructor compares lexicographically by fields"+        LT+        (compare argon2A argon2B)
tests/Tests/Keys.hs view
@@ -2,1771 +2,2248 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).--{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--module Tests.Keys (keyAndVerificationTests) where--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(..)-  , isAllowedPrimaryKeySig-  , isAllowedSubkeySig-  , isAllowedUIDSig-  )-import Codec.Encryption.OpenPGP.SecretKey-  ( changePrivateKeyPassphrase-  , decryptPrivateKey-  , mkUnencryptedSKAddendum-  , 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-  ( sigBuilderInit-  , sigBuilderInitRuntime-  , sigBuilderInitV6-  , sigBuilderInitV6Runtime-  , addHashedSubs-  , addUnhashedSubs-  , LegalSubpacket(..)-  , listToHashedSubs-  , listToUnhashedSubs-  , listToLegalSubs-  )-import Codec.Encryption.OpenPGP.Types-import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA-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.OpenPGP.Compression (conduitDecompress)-import Data.Conduit.OpenPGP.Keyring (conduitToUnknownTKs)-import Data.Conduit.OpenPGP.Verify (conduitVerify)-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)-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 Tests.Common-  ( assertSingleFailureContainsTimeline-  , assertSingleSignerFingerprint-  , loadAndDecompressPkts-  , messageIssuerSubpacketsAt-  , addTimestampSeconds-  , armorPayload-  , assertFalse-  , assertTrue-  , certificateVerificationFixtures-  , fixturePath-  , loadArmor-  , loadDeterministicEd25519Signer-  , loadKeyring-  , loadUnencryptedRsaSigner-  , loadUnencryptedRsaSignerV6-  , 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-            "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-            "fromPrimaryKeyPktToTKUnknown rejects subkey packets"-            testFromPrimaryKeyPktToTKUnknownRejectsSubkey-        , 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..| conduitToUnknownTKs DC..|-    CL.consume-  assertLeftContains-    "signing key is revoked"-    (mapM (verifyUnknownTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks)--testKeysSelfVerification :: Bool -> FilePath -> Assertion-testKeysSelfVerification expectsuccess keyfile = do-  ks <--    DC.runConduitRes $-    CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..|-    conduitToUnknownTKs DC..|-    CL.consume-  let verifieds =-        mapM (verifyUnknownTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks-  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..|-    conduitToUnknownTKs DC..|-    CL.consume-  case mapM (verifyUnknownTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks 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 = [TKUnknown (primarySigner, Nothing) [] [] [] []]-      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 (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 = [TKUnknown (primarySigner, Nothing) [] [] [] []]-      state =-        emptyPSC-          { lastPrimaryKey = PublicKeyPkt primarySigner-          , lastSubkey = PublicSubkeyPkt subkeySigner-          }-  sigPayload <--    signSubkeyBindingWithRSAExtrasAt-      primarySigner-      subkeySigner-      primarySigningKey-      creationTime-      [SigSubPacket False (KeyFlags (Set.singleton SignDataKey))]-  case verifySigWith (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 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 = TKUnknown (signer, Nothing) [] [(uidText, [longValidityCert, temporaryValidityCert])] [] []-      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 = TKUnknown (signer, Nothing) [] [(uidText, [firstCertification, secondCertification])] [] []-      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 = TKUnknown (signer, Nothing) [] [(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 = TKUnknown (signer, Nothing) [] [(uidText, [certification, temporaryRevocation])] [] []-      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 = TKUnknown (signer, Nothing) [] [(uidText, [firstCertification, secondCertification])] [] []-      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 = TKUnknown (signer, Nothing) [] [(uidText, [certification, retirementRevocation])] [] []-      verifyAt ts =-        verifyUnknownTKWith-          (verifySigWith (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 (_tkuUIDs beforeRetirement))-  assertEqual-    "uid-retired revocation should retire the UID once effective"-    0-    (length (_tkuUIDs 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 = TKUnknown (targetSigner, Nothing) [] [(uidText, [thirdPartyCertification])] [] []-      certifierTK = TKUnknown (thirdPartySigner, Nothing) [] [] [] []-      verifyAt =-        verifyUnknownTKWith-          (verifySigWith (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 =-        TKUnknown-          (targetSigner, Nothing)-          []-          [(uidText, [selfCertification, thirdPartyCertification, thirdPartyRevocation])]-          []-          []-      certifierTK = TKUnknown (thirdPartySigner, Nothing) [] [] [] []-      verifyAt ts =-        verifyUnknownTKWith-          (verifySigWith (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) (_tkuUIDs beforeRevocation))-      afterSigs = maybe [] snd (find ((== uidText) . fst) (_tkuUIDs 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 =-        TKUnknown-          (signer, Nothing)-          []-          [(uidText, [initialCertification, updatedCertification, certificationRevocation])]-          []-          []--  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-          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-          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-          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 Ed25519 (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 Ed25519 (PrefixedNativeEPoint (EPoint (os2ip (B.cons 0x40 (B.replicate 32 0x01)))))))-          (SUUnencrypted (EdDSAPrivateKey Ed25519 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 Ed25519 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 Ed448 (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 Ed448 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 Ed25519 (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 Ed25519 secretBytes)-        skey--testFromPrimaryKeyPktToTKUnknownRejectsSubkey :: Assertion-testFromPrimaryKeyPktToTKUnknownRejectsSubkey = do-  packets <--    DC.runConduitRes $-    CB.sourceFile "tests/data/unencrypted.seckey" DC..| conduitGet get DC..| CL.consume-  case packets of-    (SecretKeyPkt pkp _ : _) ->-      case fromPrimaryKeyPktToTKUnknown (PublicSubkeyPkt pkp) of-        Left err ->-          assertBool-            "fromPrimaryKeyPktToTKUnknown should report non-primary packet tags"-            ("expected primary key packet" `isInfixOf` err)-        Right _ ->-          assertFailure "fromPrimaryKeyPktToTKUnknown should reject subkey packets"-    _ ->-      assertFailure "unencrypted.seckey did not begin with a secret key packet"+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# 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)+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 (..)+    , defaultVerificationPolicy+    , isAllowedPrimaryKeySig+    , isAllowedSubkeySig+    , isAllowedUIDSig+    )+import Codec.Encryption.OpenPGP.SecretKey+    ( changePrivateKeyPassphrase+    , decryptPrivateKey+    , mkUnencryptedSKAddendum+    , 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+    , conduitToTKsEither+    )+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+                "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+                "fromPrimaryKeyPktToTKUnknown rejects subkey packets"+                testFromPrimaryKeyPktToTKUnknownRejectsSubkey+            , 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..| conduitToTKsEither+                DC..| conduitDropErrorsAndNothings+                DC..| CL.consume+    assertLeftContains+        "signing key is revoked"+        ( mapM+            ( verifyUnknownTKWith+                (verifySigWith defaultVerificationPolicy (verifyAgainstKeys ks))+                Nothing+            )+            ks+        )++testKeysSelfVerification :: Bool -> FilePath -> Assertion+testKeysSelfVerification expectsuccess keyfile = do+    ks <-+        DC.runConduitRes $+            CB.sourceFile ("tests/data/" ++ keyfile)+                DC..| conduitGet get+                DC..| conduitToTKsEither+                DC..| conduitDropErrorsAndNothings+                DC..| CL.consume+    let verifieds =+            mapM+                ( verifyUnknownTKWith+                    (verifySigWith defaultVerificationPolicy (verifyAgainstKeys ks))+                    Nothing+                )+                ks+    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..| conduitToTKsEither+                DC..| conduitDropErrorsAndNothings+                DC..| CL.consume+    case mapM+        ( verifyUnknownTKWith+            (verifySigWith defaultVerificationPolicy (verifyAgainstKeys ks))+            Nothing+        )+        ks 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 = [TKUnknown (primarySigner, Nothing) [] [] [] []]+        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 = [TKUnknown (primarySigner, Nothing) [] [] [] []]+        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 =+            TKUnknown+                (signer, Nothing)+                []+                [(uidText, [longValidityCert, temporaryValidityCert])]+                []+                []+        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 =+            TKUnknown+                (signer, Nothing)+                []+                [(uidText, [firstCertification, secondCertification])]+                []+                []+        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 =+            TKUnknown (signer, Nothing) [] [(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 =+            TKUnknown+                (signer, Nothing)+                []+                [(uidText, [certification, temporaryRevocation])]+                []+                []+        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 =+            TKUnknown+                (signer, Nothing)+                []+                [(uidText, [firstCertification, secondCertification])]+                []+                []+        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 =+            TKUnknown+                (signer, Nothing)+                []+                [(uidText, [certification, retirementRevocation])]+                []+                []+        verifyAt ts =+            verifyUnknownTKWith+                (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 (_tkuUIDs beforeRetirement))+    assertEqual+        "uid-retired revocation should retire the UID once effective"+        0+        (length (_tkuUIDs 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 =+            TKUnknown+                (targetSigner, Nothing)+                []+                [(uidText, [thirdPartyCertification])]+                []+                []+        certifierTK = TKUnknown (thirdPartySigner, Nothing) [] [] [] []+        verifyAt =+            verifyUnknownTKWith+                ( 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 =+            TKUnknown+                (targetSigner, Nothing)+                []+                [+                    ( uidText+                    ,+                        [ selfCertification+                        , thirdPartyCertification+                        , thirdPartyRevocation+                        ]+                    )+                ]+                []+                []+        certifierTK = TKUnknown (thirdPartySigner, Nothing) [] [] [] []+        verifyAt ts =+            verifyUnknownTKWith+                ( 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) (_tkuUIDs beforeRevocation))+        afterSigs =+            maybe+                []+                snd+                (find ((== uidText) . fst) (_tkuUIDs 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 =+            TKUnknown+                (signer, Nothing)+                []+                [+                    ( uidText+                    ,+                        [ initialCertification+                        , updatedCertification+                        , certificationRevocation+                        ]+                    )+                ]+                []+                []++    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++testFromPrimaryKeyPktToTKUnknownRejectsSubkey :: Assertion+testFromPrimaryKeyPktToTKUnknownRejectsSubkey = do+    packets <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/unencrypted.seckey"+                DC..| conduitGet get+                DC..| CL.consume+    case packets of+        (SecretKeyPkt pkp _ : _) ->+            case fromPrimaryKeyPktToTKUnknown (PublicSubkeyPkt pkp) of+                Left err ->+                    assertBool+                        "fromPrimaryKeyPktToTKUnknown should report non-primary packet tags"+                        ("expected primary key packet" `isInfixOf` err)+                Right _ ->+                    assertFailure+                        "fromPrimaryKeyPktToTKUnknown should reject subkey packets"+        _ ->+            assertFailure+                "unencrypted.seckey did not begin with a secret key packet"
tests/Tests/MessageAndArmor.hs view
@@ -2,1940 +2,2640 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).--{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--module Tests.MessageAndArmor (messageAndArmorTests) where--import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor(..), ArmorType(..))-import Codec.Encryption.OpenPGP.BlockCipher (keySize)-import Codec.Encryption.OpenPGP.CFB (decryptPreservingNonce, validateSEIPD1MDC)-import Codec.Encryption.OpenPGP.Encrypt (encryptSEIPDv2WithSKESKBlock)-import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)-import Codec.Encryption.OpenPGP.Internal (emptyPSC, lastLD)-import Codec.Encryption.OpenPGP.KeyringParser (parseUnknownTKs)-import Codec.Encryption.OpenPGP.Message-import Codec.Encryption.OpenPGP.Policy (signatureV6SaltSizeForHashAlgorithm)-import Codec.Encryption.OpenPGP.S2K (renderS2KError, string2Key)-import Codec.Encryption.OpenPGP.Serialize-  ( armorPayloadsOfType-  , parsePkts-  , parsePktsEither-  , recommendedArmorType-  , singleClearSignedBlock-  , singleArmorPayloadOfType-  )-import Codec.Encryption.OpenPGP.SerializeForSigs (payloadForSig, payloadForSigWith)-import Codec.Encryption.OpenPGP.Signatures-  ( renderSignError-  , renderVerificationError-  , signCertRevocationWithRSA-  , signCertificationWithRSA-  , signDataWithEd25519-  , signDataWithEd25519V6-  , signDataWithEd448-  , signDataWithEd448V6-  , signDataWithRSA-  , signDataWithRSABuilder-  , signDataWithEd25519Builder-  , signDataWithEd25519V6Builder-  , signDirectKeyWithRSA-  , signKeyRevocationWithRSA-  , signSubkeyRevocationWithRSA-  , SignError(..)-  , verifyAgainstKeyring-  , verifyAgainstKeys-  , verifySigWith-  , VerificationError(..)-  )-import Codec.Encryption.OpenPGP.Subpackets-  ( addHashedSubs-  , addUnhashedSubs-  , listToHashedSubs-  , listToUnhashedSubs-  , sbTextNormMode-  , sigBuilderInit-  , TextNormalizationMode(..)-  )-import Codec.Encryption.OpenPGP.Types-import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA-import qualified Crypto.PubKey.RSA as RSA-import qualified Crypto.PubKey.Ed25519 as Ed25519-import Data.Binary (get, put)-import Data.Binary.Get (Get, runGetOrFail)-import Data.Binary.Put (putByteString, putWord16be, putWord32be, putWord8, runPut)-import Data.Bits (xor)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import Data.Conduit.OpenPGP.Message (verifyMessage, verifyMessagePackets)-import Data.Conduit.OpenPGP.Verify (VerificationMode(..))-import Data.Either (isLeft, isRight)-import Data.List (isInfixOf)-import qualified Data.List.NonEmpty as NE-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, assertFailure, testCase)-import Tests.Common-  ( addTimestampSeconds-  , assertSingleFailureContainsTimeline-  , assertSingleSignerFingerprint-  , encryptMessageDefault-  , expectV4PKPayload-  , expectV6PKPayload-  , extractV4SignatureAlgorithmFields-  , fp-  , loadAndDecompressPkts-  , loadArmor-  , loadKeyring-  , loadDeterministicEd25519Signer-  , loadDeterministicEd25519SignerV6-  , loadDeterministicEd448Signer-  , loadDeterministicEd448SignerV6-  , loadUnencryptedRsaSigner-  , loadUnencryptedRsaSignerV6-  , messageIssuerSubpacketsAt-  , mkTestKeyring-  , readFixtureLazy-  , setPKAlgorithm-  , signBinaryMessageWithRSAAt-  , signBinaryMessageWithEd25519At-  , signKeyRevocationWithReasonAt-  , signKeyRevocationWithReasonAndExtrasAt-  , signSubkeyBindingWithRSAAt-  , signSubkeyRevocationWithRSAAt-  , verifyTimelinePackets-  )--messageAndArmorTests :: TestTree-messageAndArmorTests =-  testGroup-    "Message API and armor fixtures"-    [ testGroup-        "Message API group"-        [ testCase "default encrypt/decrypt message" testDefaultedEncryptDecrypt-        , testCase "specific encrypt/decrypt message" testExplicitEncryptDecrypt-        , testCase-            "specific encrypt can expose effective session material"-            testExplicitEncryptExposesEffectiveSessionMaterial-        , testCase-            "default encrypt does not expose session material"-            testDefaultEncryptDoesNotExposeSessionMaterial-        , testCase "AES-128 EAX encrypt/decrypt message" testExplicitAES128EAXEncryptDecrypt-        , testCase "AES-128 GCM encrypt/decrypt message" testExplicitAES128GCMEncryptDecrypt-        , testCase-            "specific encrypt rejects deprecated S2K hash in modern mode"-            testExplicitEncryptRejectsDeprecatedS2KHash-        , testCase "legacy fallback encrypt/decrypt message" testLegacyFallbackEncryptDecrypt-        , testCase-            "RFC4880 encryptMessage SEIPDv1 cleartext parses without trailing junk"-            testRFC4880EncryptMessageSEIPDv1ParsesCleanly-        , testCase "decryptMessage returns typed parse failures" testDecryptMessageTypedParseFailure-        , testCase-            "decryptMessage rejects unknown critical packets"-            testDecryptMessageRejectsUnknownCriticalPacket-        , testCase "decryptMessage returns typed decrypt failures" testDecryptMessageTypedDecryptFailure-        , testCase-            "decryptMessage rejects SEIPDv1 MDC tampering"-            testDecryptMessageSEIPDv1MDCTampering-        , testCase "sign message shape" testSignMessageShape-        , testCase "sign message shape (RSA SigV6)" testSignMessageRSAV6-        , testCase "sign message shape (Ed25519)" testSignMessageEd25519-        , testCase "sign message shape (Ed25519 SigV6)" testSignMessageEd25519V6-        , testCase "sign message shape (Ed448)" testSignMessageEd448-        , testCase "sign message shape (Ed448 SigV6)" testSignMessageEd448V6-        , testCase-            "v4 Ed25519/Ed448 signatures use native fixed-width encoding"-            testV4EdSignaturesUseNativeFixedWidthEncoding-        , testCase-            "v4 Ed25519Legacy key parsing rejects missing 0x40 prefix"-            testV4Ed25519LegacyKeyRejectsMissingPrefix-        , testCase-            "detached v4 Ed25519 verification tolerates missing issuer hints"-            testVerifyDetachedEd25519WithoutIssuerHints-        , testCase-            "detached v4 Ed25519 verification tolerates fake issuer hints"-            testVerifyDetachedEd25519WithFakeIssuerHint-        , testCase-            "detached v4 Ed25519 verifyAgainstKeys tolerates missing issuer hints"-            testVerifyDetachedEd25519WithoutIssuerHintsAgainstKeys-        , testCase-            "detached v4 Ed25519 verifyAgainstKeys tolerates fake issuer hints"-            testVerifyDetachedEd25519WithFakeIssuerHintAgainstKeys-        , testCase-            "v4 EdDSA signatures verify with Ed25519 key algorithm identifier"-            testVerifyV4EdDSASignatureWithEd25519KeyAlgorithm-        , testCase "sign message convenience API" testSignMessageConvenience-        , testCase "typed verify surface matches legacy results" testTypedVerifySurfaceMatchesLegacy-        , testCase "strict typed verify rejects tamper" testVerifyMessageStrictRejectsTamper-        , testCase "verifySignedMessage convenience API" testVerifySignedMessageConvenience-        , testCase "signature generation primitives" testSignaturePrimitives-        , testCase-            "typed signature payload coercions"-            testSignatureDataKindsCoercions-        , testCase-            "typed armor payload helpers centralize block selection"-            testTypedArmorPayloadHelpers-        , testCase-            "recommendedArmorType infers canonical armor labels from packets"-            testRecommendedArmorType-        , testCase-            "singleClearSignedBlock validates cleartext signature envelopes"-            testSingleClearSignedBlock-        , testCase-            "canonical text signature payload normalization"-            testCanonicalTextSigPayloadNormalization-        , testCase-            "canonical text signatures normalize during signing"-            testCanonicalTextSignatureSigningPaths-        , testCase-            "text normalization modes (RFC9580Strict vs CleartextCompat)"-            testTextNormalizationModes-        ]-    , testGroup-        "ASCII armor fixture group"-        [ testCase-            "v4-encrypted-secret.pgp.aa decodes as an encrypted v4 secret key"-            testV4EncryptedSecretArmor-        , testCase-            "v4-encrypted.rev.aa decodes as a v4 revocation certificate"-            testV4EncryptedRevocationArmor-        , testCase-            "v4-encrypted.rev.aa SigV4 key-revocation semantics"-            testV4RevocationSignatureSemantics-        , testCase-            "v4-encrypted.rev.aa parses as single revocation TKUnknown"-            (testRevocationArmorParsesAsSingleTransferableKey "v4-encrypted.rev.aa" True)-        , testCase-            "v6.rev.aa decodes as a v6 revocation certificate"-            (testV6RevocationArmor "v6.rev.aa")-        , testCase-            "v6.rev.aa SigV6 salt semantics"-            (testV6RevocationSignatureSaltSemantics "v6.rev.aa")-        , testCase-            "v6.rev.aa forbids legacy Issuer key-id subpackets"-            (testV6RevocationSignatureRejectsLegacyIssuerKeyID "v6.rev.aa")-        , testCase-            "v6.rev.aa parses as single revocation TKUnknown"-            (testRevocationArmorParsesAsSingleTransferableKey "v6.rev.aa" True)-        , testCase-            "v6-encrypted.rev.aa decodes as a v6 revocation certificate"-            (testV6RevocationArmor "v6-encrypted.rev.aa")-        , testCase-            "v6-encrypted.rev.aa SigV6 salt semantics"-            (testV6RevocationSignatureSaltSemantics "v6-encrypted.rev.aa")-        , testCase-            "v6-encrypted.rev.aa forbids legacy Issuer key-id subpackets"-            (testV6RevocationSignatureRejectsLegacyIssuerKeyID "v6-encrypted.rev.aa")-        , testCase-            "v6-encrypted.rev.aa parses as single revocation TKUnknown"-            (testRevocationArmorParsesAsSingleTransferableKey "v6-encrypted.rev.aa" True)-        , testCase-            "msg1.asc decodes as a parseable armored message"-            testMsg1ArmorFixture-        ]-    , testGroup-        "timeline-aware group"-        [ testCase-            "timeline-aware primary soft revocation keeps pre-revocation signatures"-            testSignerTimelineSoftPrimaryRevocation-        , testCase-            "timeline-aware primary hard revocation rejects historical signatures"-            testSignerTimelineHardPrimaryRevocation-        , testCase-            "timeline-aware no-reason primary revocation rejects historical signatures"-            testSignerTimelineNoReasonPrimaryRevocation-        , testCase-            "timeline-aware unknown-reason primary revocation rejects historical signatures"-            testSignerTimelineUnknownReasonPrimaryRevocation-        , testCase-            "timeline-aware non-compromise primary revocation stays historical until effective"-            testSignerTimelineNonCompromisePrimaryRevocationIsHistorical-        , testCase-            "timeline-aware temporary primary revocation expires and restores validity"-            testSignerTimelineTemporaryPrimaryRevocationExpires-        , testCase-            "timeline-aware subkey revocation distinguishes pre/post signatures"-            testSignerTimelineSubkeyRevocation-        ]-  ]--testV4EncryptedSecretArmor :: Assertion-testV4EncryptedSecretArmor = do-  armors <- loadArmor "v4-encrypted-secret.pgp.aa"-  armor <--    case armors of-      [a] -> pure a-      _ ->-        assertFailure "v4 encrypted secret fixture should contain one armored payload" >>-        fail "expected one armored payload"-  (headers, payload) <--    case armor of-      Armor ArmorPrivateKeyBlock hs p -> pure (hs, p)-      Armor atype _ _ ->-        assertFailure-          ("v4 encrypted secret fixture should decode as a private key block, got " ++-           show atype) >>-        fail "expected private key block"-      _ ->-        assertFailure "v4 encrypted secret fixture should decode as an armored payload" >>-        fail "expected armored payload"-  assertEqual-    "v4 encrypted secret fixture should keep identifying comments"-    [ ("Comment", "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")-    , ("Comment", "<v4test@example.org>")-    , ("Comment", "v4 Test User")-    ]-    headers-  let packets = parsePkts payload-      userIds = [u | UserIdPkt u <- packets]-      primarySecretKeys = [(pkp, ska) | SecretKeyPkt pkp ska <- packets]-      secretSubkeys = [(pkp, ska) | SecretSubkeyPkt pkp ska <- packets]-  assertEqual-    "v4 encrypted secret fixture should include expected user IDs"-    ["<v4test@example.org>", "v4 Test User"]-    userIds-  assertEqual-    "v4 encrypted secret fixture should contain one primary secret key packet"-    1-    (length primarySecretKeys)-  assertEqual-    "v4 encrypted secret fixture should contain three encrypted secret subkeys"-    3-    (length secretSubkeys)-  case packets of-    (SecretKeyPkt pkp ska:_) -> do-      assertEqual-        "v4 encrypted secret fixture should contain a v4 primary key"-        V4-        (_keyVersion pkp)-      assertEqual-        "v4 encrypted secret fixture should have the expected primary-key fingerprint"-        (fp "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")-        (fingerprint pkp)-      assertEqual-        "v4 encrypted secret fixture should use EdDSA for its primary key"-        EdDSA-        (_pkalgo pkp)-      assertEncryptedS2K "primary key" ska-      mapM_ (assertEncryptedS2K "subkey" . snd) secretSubkeys-      assertEqual-        "v4 encrypted secret fixture should contain two EdDSA subkeys and one ECDH subkey"-        [EdDSA, EdDSA, ECDH]-        (map (_pkalgo . fst) secretSubkeys)-    _ -> assertFailure "v4 encrypted secret fixture should start with a secret key packet"-  where-    assertEncryptedS2K :: String -> SKAddendum -> Assertion-    assertEncryptedS2K testLabel ska =-      case ska of-        SUSSHA1 AES256 (IteratedSalted SHA256 _ iter) _ encryptedPayload -> do-          assertEqual-            (testLabel ++ " should use expected S2K iteration count")-            (IterationCount 65011712)-            iter-          if BL.null encryptedPayload-            then assertFailure (testLabel ++ " should have non-empty encrypted key material")-            else pure ()-        SUUnencrypted _ _ ->-          assertFailure (testLabel ++ " should be encrypted, got unencrypted secret material")-        _ ->-          assertFailure-            (testLabel ++ " should be encrypted with SUSSHA1/AES256/IteratedSalted SHA256")--testV4EncryptedRevocationArmor :: Assertion-testV4EncryptedRevocationArmor = do-  armors <- loadArmor "v4-encrypted.rev.aa"-  armor <--    case armors of-      [a] -> pure a-      _ ->-        assertFailure "v4 encrypted revocation fixture should contain one armored payload" >>-        fail "expected one armored payload"-  (headers, payload) <--    case armor of-      Armor ArmorPublicKeyBlock hs p -> pure (hs, p)-      Armor atype _ _ ->-        assertFailure-          ("v4 encrypted revocation fixture should decode as a public key block, got " ++-           show atype) >>-        fail "expected public key block"-      _ ->-        assertFailure-          "v4 encrypted revocation fixture should decode as an armored payload" >>-        fail "expected armored payload"-  assertEqual-    "v4 encrypted revocation fixture should keep identifying comments"-    [ ("Comment", "Revocation certificate for")-    , ("Comment", "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")-    , ("Comment", "<v4test@example.org>")-    , ("Comment", "v4 Test User")-    ]-    headers-  let packets = parsePkts payload-  case packets of-    [PublicKeyPkt pkp, SignaturePkt _] -> do-      assertEqual-        "v4 encrypted revocation fixture should contain a v4 public key"-        V4-        (_keyVersion pkp)-      assertEqual-        "v4 encrypted revocation fixture should contain the expected public key fingerprint"-        (fp "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")-        (fingerprint pkp)-      assertEqual-        "v4 encrypted revocation fixture should use EdDSA for its public key"-        EdDSA-        (_pkalgo pkp)-    _ ->-      assertFailure-        ("v4 encrypted revocation fixture should contain [PublicKeyPkt, SignaturePkt], got: " ++-         show packets)--testV6RevocationArmor :: FilePath -> Assertion-testV6RevocationArmor fixture = do-  armors <- loadArmor fixture-  armor <--    case armors of-      [a] -> pure a-      _ ->-        assertFailure (fixture ++ " fixture should contain one armored payload") >>-        fail "expected one armored payload"-  payload <--    case armor of-      Armor ArmorPublicKeyBlock _ p -> pure p-      Armor atype _ _ ->-        assertFailure-          (fixture ++ " fixture should decode as a public key block, got " ++ show atype) >>-        fail "expected public key block"-      _ ->-        assertFailure (fixture ++ " fixture should decode as an armored payload") >>-        fail "expected armored payload"-  let packets = parsePkts payload-  case packets of-    [PublicKeyPkt pkp, SignaturePkt sig] -> do-      assertEqual-        (fixture ++ " should contain a v6 public key")-        V6-        (_keyVersion pkp)-      case sig of-        SigV6 KeyRevocationSig _ _ _ hashed unhashed _ _ -> do-          let issuerFps =-                [ ifp-                | SigSubPacket _ (IssuerFingerprint IssuerFingerprintV6 ifp) <- hashed ++ unhashed-                ]-          if fingerprint pkp `elem` issuerFps-            then pure ()-            else-              assertFailure-                (fixture ++ " should include an IssuerFingerprint v6 matching the public key")-        _ ->-          assertFailure-            (fixture ++ " should contain a SigV6 key-revocation signature")-    _ ->-      assertFailure-        (fixture ++ " should contain [PublicKeyPkt, SignaturePkt], got: " ++-         show packets)--testV6RevocationSignatureSaltSemantics :: FilePath -> Assertion-testV6RevocationSignatureSaltSemantics fixture = do-  armors <- loadArmor fixture-  payload <--    case armors of-      [Armor ArmorPublicKeyBlock _ p] -> pure p-      _ ->-        assertFailure-          (fixture ++ " should contain one armored public-key payload") >>-        fail "expected one armored payload"-  let packets = parsePkts payload-  (pkp, sig) <--    case packets of-      [PublicKeyPkt pk, SignaturePkt sigV6@(SigV6 _ _ _ _ _ _ _ _)] -> pure (pk, sigV6)-      _ ->-        assertFailure-          (fixture ++ " should parse as [PublicKeyPkt, SignaturePkt SigV6], got " ++ show packets) >>-        fail "unexpected revocation fixture packet shape"-  case sig of-    SigV6 _ _ ha salt _ _ _ _ ->-      case expectedV6SaltSizeForTest ha of-        Nothing ->-          assertFailure-            (fixture ++ " uses unsupported v6 signature salt hash algorithm: " ++ show ha)-        Just expected ->-          assertEqual-            (fixture ++ " SigV6 salt size should match hash algorithm")-            expected-            (fromIntegral (BL.length (unSignatureSalt salt)))-    other ->-      assertFailure-        (fixture ++ " expected SigV6 revocation signature payload, got: " ++ show other)-  assertBool-    (fixture ++ " should include IssuerFingerprint v6 for the revoked key")-    (signatureHasIssuerFingerprintV6 (fingerprint pkp) sig)--testV4RevocationSignatureSemantics :: Assertion-testV4RevocationSignatureSemantics = do-  armors <- loadArmor "v4-encrypted.rev.aa"-  payload <--    case armors of-      [Armor ArmorPublicKeyBlock _ p] -> pure p-      _ ->-        assertFailure-          "v4-encrypted.rev.aa should contain one armored public-key payload" >>-        fail "expected one armored payload"-  let packets = parsePkts payload-  case packets of-    [PublicKeyPkt _, SignaturePkt (SigV4 KeyRevocationSig _ _ hashed unhashed _ _)] -> do-      assertBool-        "v4-encrypted.rev.aa key-revocation signature should include an Issuer key-id subpacket"-        (any isIssuerSubpacket (hashed ++ unhashed))-    _ ->-      assertFailure-        ("v4-encrypted.rev.aa should parse as [PublicKeyPkt, SignaturePkt SigV4 KeyRevocationSig], got " ++-         show packets)-  where-    isIssuerSubpacket (SigSubPacket _ Issuer {}) = True-    isIssuerSubpacket _ = False--testV6RevocationSignatureRejectsLegacyIssuerKeyID :: FilePath -> Assertion-testV6RevocationSignatureRejectsLegacyIssuerKeyID fixture = do-  armors <- loadArmor fixture-  payload <--    case armors of-      [Armor ArmorPublicKeyBlock _ p] -> pure p-      _ ->-        assertFailure-          (fixture ++ " should contain one armored public-key payload") >>-        fail "expected one armored payload"-  let packets = parsePkts payload-  case packets of-    [PublicKeyPkt _, SignaturePkt (SigV6 KeyRevocationSig _ _ _ hashed unhashed _ _)] ->-      assertBool-        (fixture ++ " SigV6 key-revocation signature must not include Issuer key-id subpackets")-        (all (not . isIssuerSubpacket) (hashed ++ unhashed))-    _ ->-      assertFailure-        (fixture ++-         " should parse as [PublicKeyPkt, SignaturePkt SigV6 KeyRevocationSig]")-  where-    isIssuerSubpacket (SigSubPacket _ Issuer {}) = True-    isIssuerSubpacket _ = False--testRevocationArmorParsesAsSingleTransferableKey :: FilePath -> Bool -> Assertion-testRevocationArmorParsesAsSingleTransferableKey fixture expectDirectRevs = do-  armors <- loadArmor fixture-  payload <--    case armors of-      [Armor ArmorPublicKeyBlock _ p] -> pure p-      _ ->-        assertFailure-          (fixture ++ " should contain one armored public-key payload") >>-        fail "expected one armored payload"-  let tks = parseUnknownTKs True (parsePkts payload)-  case tks of-    [tk] -> do-      if expectDirectRevs-        then-          assertBool-            (fixture ++ " transferable key should contain at least one direct-key revocation signature")-            (not (null (_tkuRevs tk)))-        else pure ()-      assertEqual-        (fixture ++ " revocation certificate should not carry user IDs")-        []-        (_tkuUIDs tk)-      assertEqual-        (fixture ++ " revocation certificate should not carry user attributes")-        []-        (_tkuUAts tk)-      assertEqual-        (fixture ++ " revocation certificate should not carry subkeys")-        []-        (_tkuSubs tk)-    _ ->-      assertFailure-        (fixture ++ " should parse into exactly one transferable key")--testMsg1ArmorFixture :: Assertion-testMsg1ArmorFixture = do-  armors <- loadArmor "msg1.asc"-  assertBool "msg1.asc should decode to at least one armor block" (not (null armors))-  let packetBlocks =-        [ parsePkts payload-        | Armor _ _ payload <- armors-        ]-  assertBool-    "msg1.asc should contain at least one parseable packet block"-    (any (not . null) packetBlocks)--expectedV6SaltSizeForTest :: HashAlgorithm -> Maybe Int-expectedV6SaltSizeForTest =-  fmap fromIntegral . signatureV6SaltSizeForHashAlgorithm--signatureHasIssuerFingerprintV6 :: Fingerprint -> SignaturePayload -> Bool-signatureHasIssuerFingerprintV6 expectedFp (SigV6 _ _ _ _ hashed unhashed _ _) =-  expectedFp `elem`-  [ ifp-  | SigSubPacket _ (IssuerFingerprint IssuerFingerprintV6 ifp) <- hashed ++ unhashed-  ]-signatureHasIssuerFingerprintV6 _ _ = False--testDefaultedEncryptDecrypt :: Assertion-testDefaultedEncryptDecrypt = do-  let passphrase = mkPassphrase "roundtrip1"-      payload = mkClearPayload "hello from a balloon farm on Mars"-      encryptedResult = encryptMessageDefault DoNotExposeSessionMaterial passphrase payload-  encrypted <--    case encryptedResult of-      Left err ->-        assertFailure ("encryptMessageDefault failed: " ++ show err) >>-        fail "encryptMessageDefault failed"-      Right (bs, _) -> pure bs-  case parsePkts (encryptedPayloadBytes encrypted) of-    [SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 AES256 OCB _ iv esk tag)), SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 _ _)] -> do-      assertBool "default SKESK v6 IV should be present" (not (BL.null iv))-      assertBool "default SKESK v6 wrapped session key should be present" (not (BL.null esk))-      assertEqual "default SKESK v6 tag length" 16 (BL.length tag)-    other ->-      assertFailure-        ("default encryption should emit SKESK v6 + SEIPD v2 packets, got " ++-         show other)-  decrypted <--    case decryptMessage passphrase encrypted of-      Left err ->-        assertFailure ("decryptMessage failed: " ++ show err) >> fail "decryptMessage failed"-      Right bs -> pure bs-  assertEqual "default encrypt/decrypt payload roundtrip" payload decrypted--testExplicitEncryptDecrypt :: Assertion-testExplicitEncryptDecrypt = do-  let passphrase = mkPassphrase "roundtrip2"-      payload = mkClearPayload "hello from nonsenseville"-      s2k = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15-      iv = IV "1234567890ABCDEF"-  encrypted <--    case-        encryptMessage-          (RFC9580EncryptMessageOptions-             { rfc9580EncryptMessageExposure = DoNotExposeSessionMaterial-             , rfc9580EncryptMessageSymmetricAlgorithm = AES128-             , rfc9580EncryptMessageS2K = s2k-             , rfc9580EncryptMessageIV = iv-             })-          passphrase-          payload of-      Left err ->-        assertFailure ("micro-managed encryption failed: " ++ show err) >>-        fail "encryptMessage failed"-      Right (bs, _) -> pure bs-  case parsePkts (encryptedPayloadBytes encrypted) of-    [SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 AES128 OCB _ packetIv esk tag)), SymEncIntegrityProtectedDataPkt (SEIPD2 AES128 OCB 6 _ _)] -> do-      assertBool "explicit SKESK v6 IV should be present" (not (BL.null packetIv))-      assertBool "explicit SKESK v6 wrapped session key should be present" (not (BL.null esk))-      assertEqual "explicit SKESK v6 tag length" 16 (BL.length tag)-    other ->-      assertFailure-        ("explicit AES encryption should default to SKESK v6 + SEIPD v2 packets, got " ++-         show other)-  decrypted <--    case decryptMessage passphrase encrypted of-      Left err ->-        assertFailure ("decryption failed: " ++ show err) >> fail "decryptMessage failed"-      Right bs -> pure bs-  assertEqual "specific encrypt/decrypt payload roundtrip" payload decrypted--testExplicitEncryptExposesEffectiveSessionMaterial :: Assertion-testExplicitEncryptExposesEffectiveSessionMaterial = do-  let passphraseBytes = "roundtrip2-session-material"-      passphrase = mkPassphrase passphraseBytes-      payload = mkClearPayload "hello from session material town"-      sa = AES128-      s2k = Argon2 (Salt16 (B.pack [0x40 .. 0x4f])) 1 4 15-      iv = IV "ABCDEF1234567890"-  (encrypted, recovered) <--    case-        encryptMessage-          (RFC9580EncryptMessageOptions-             { rfc9580EncryptMessageExposure = ExposeSessionMaterial-             , rfc9580EncryptMessageSymmetricAlgorithm = sa-             , rfc9580EncryptMessageS2K = s2k-             , rfc9580EncryptMessageIV = iv-             })-          passphrase-          payload of-      Left err ->-        assertFailure ("explicit encryption with session material failed: " ++ show err) >>-        fail "encryptMessage failed"-      Right x -> pure x-  expectedSessionKey <--    case keySize sa of-      Left err ->-        assertFailure ("failed to derive expected key size: " ++ show err) >>-        fail "keySize failed"-      Right keyLen ->-        case string2Key s2k keyLen passphraseBytes of-          Left err ->-            assertFailure ("failed to derive expected session key: " ++ renderS2KError err) >>-            fail "string2Key failed"-          Right bs -> pure bs-  case recovered of-    Just recoveredSessionMaterial -> do-      assertEqual "recovered session material algorithm" sa (recoveredSessionAlgorithm recoveredSessionMaterial)-      assertEqual-        "recovered session material key"-        (SessionKey expectedSessionKey)-        (recoveredSessionKey recoveredSessionMaterial)-    Nothing ->-      assertFailure "expected exposed session material"-  decrypted <--    case decryptMessage passphrase encrypted of-      Left err ->-        assertFailure ("decryption failed: " ++ show err) >> fail "decryptMessage failed"-      Right bs -> pure bs-  assertEqual "session-material exposing encrypt/decrypt payload roundtrip" payload decrypted--testDefaultEncryptDoesNotExposeSessionMaterial :: Assertion-testDefaultEncryptDoesNotExposeSessionMaterial = do-  let passphrase = mkPassphrase "roundtrip-default-no-session-material"-      payload = mkClearPayload "hello from hidden-session-material town"-  (_, recovered) <--    do-      let encryptedResult =-            encryptMessageDefault DoNotExposeSessionMaterial passphrase payload-      case encryptedResult of-        Left err ->-          assertFailure ("default encryption with exposure mode failed: " ++ show err) >>-          fail "encryptMessageDefault failed"-        Right x -> pure x-  case recovered of-    Nothing -> pure ()-    Just _ -> assertFailure "default exposure mode should not return session material"--testExplicitAES128AEADEncryptDecrypt :: AEADAlgorithm -> Int -> String -> Assertion-testExplicitAES128AEADEncryptDecrypt aead expectedIvLen label = do-  let passphraseBytes = "roundtrip-" <> BL.fromStrict (B.pack (map (fromIntegral . fromEnum) label))-      passphrase = mkPassphrase passphraseBytes-      payload = mkClearPayload ("hello from " <> BL.fromStrict (B.pack (map (fromIntegral . fromEnum) label)))-      s2k = Argon2 (Salt16 (B.pack [0x10 .. 0x1f])) 1 4 15-      salt = Salt (B.pack [0x20 .. 0x3f])-      block = Block [LiteralDataPkt BinaryData BL.empty 0 (clearPayloadBytes payload)]-  packets <--    case encryptSEIPDv2WithSKESKBlock AES128 aead 6 salt s2k passphraseBytes block of-      Left err ->-        assertFailure ("AES-128 " ++ label ++ " encryption failed: " ++ err) >>-        fail "encryptSEIPDv2WithSKESKBlock failed"-      Right ps -> pure ps-  let encrypted = mkEncryptedPayload (runPut (put (Block packets)))-  case parsePkts (encryptedPayloadBytes encrypted) of-    [SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 AES128 parsedAead _ iv esk tag)), SymEncIntegrityProtectedDataPkt (SEIPD2 AES128 payloadAead 6 _ _)] -> do-      assertEqual ("AES-128 " ++ label ++ " SKESK AEAD") aead parsedAead-      assertEqual ("AES-128 " ++ label ++ " payload AEAD") aead payloadAead-      assertEqual-        ("AES-128 " ++ label ++ " SKESK v6 IV length")-        (fromIntegral expectedIvLen)-        (BL.length iv)-      assertBool ("AES-128 " ++ label ++ " wrapped session key should be present") (not (BL.null esk))-      assertEqual ("AES-128 " ++ label ++ " SKESK tag length") 16 (BL.length tag)-    other ->-      assertFailure-        ("AES-128 " ++ label ++ " encryption should emit matching SKESK v6 + SEIPD v2 packets, got " ++-         show other)-  decrypted <--    case decryptMessage passphrase encrypted of-      Left err ->-        assertFailure ("AES-128 " ++ label ++ " decryption failed: " ++ show err) >>-        fail "decryptMessage failed"-      Right bs -> pure bs-  assertEqual ("AES-128 " ++ label ++ " payload roundtrip") payload decrypted--testExplicitAES128EAXEncryptDecrypt :: Assertion-testExplicitAES128EAXEncryptDecrypt = do-  let passphraseBytes = "roundtrip-EAX"-      s2k = Argon2 (Salt16 (B.pack [0x10 .. 0x1f])) 1 4 15-      salt = Salt (B.pack [0x20 .. 0x3f])-      block = Block [LiteralDataPkt BinaryData BL.empty 0 "hello from EAX"]-  case encryptSEIPDv2WithSKESKBlock AES128 EAX 6 salt s2k passphraseBytes block of-    Left err-      | "EAX is currently unsupported by the crypton AEAD backend" `isInfixOf` err ->-          pure ()-      | otherwise ->-          assertFailure ("expected explicit EAX backend limitation, got: " ++ err)-    Right packets ->-      assertFailure-        ("expected AES-128 EAX encryption to fail explicitly, got packets: " ++ show packets)--testExplicitAES128GCMEncryptDecrypt :: Assertion-testExplicitAES128GCMEncryptDecrypt =-  testExplicitAES128AEADEncryptDecrypt GCM 12 "GCM"--testExplicitEncryptRejectsDeprecatedS2KHash :: Assertion-testExplicitEncryptRejectsDeprecatedS2KHash = do-  let passphrase = mkPassphrase "roundtrip2b"-      payload = mkClearPayload "modern-path deprecated s2k hash rejection"-      s2k = Salted SHA1 (Salt8 "12345678")-      iv = IV "1234567890ABCDEF"-  case-      encryptMessage-        (RFC9580EncryptMessageOptions-           { rfc9580EncryptMessageExposure = DoNotExposeSessionMaterial-           , rfc9580EncryptMessageSymmetricAlgorithm = AES128-           , rfc9580EncryptMessageS2K = s2k-           , rfc9580EncryptMessageIV = iv-           })-        passphrase-        payload of-    Left (MessageEncryptError err)-      | "deprecated hash algorithm disallowed for modern message generation" `isInfixOf` err ->-          pure ()-      | otherwise ->-          assertFailure ("Expected deprecated modern S2K hash rejection, got: " ++ err)-    Left err ->-      assertFailure ("Expected MessageEncryptError for deprecated modern S2K hash, got " ++ show err)-    Right _ ->-      assertFailure "Expected encryptMessage AES128 to reject deprecated SHA1 S2K"--testLegacyFallbackEncryptDecrypt :: Assertion-testLegacyFallbackEncryptDecrypt = do-  let passphrase = mkPassphrase "roundtrip3"-      payload = mkClearPayload "hello from legacy town"-      s2k = Salted SHA1 (Salt8 "12345678")-      iv = IV mempty-  encrypted <--    case-        encryptMessage-          (RFC4880EncryptMessageOptions-             { rfc4880EncryptMessageExposure = DoNotExposeSessionMaterial-             , rfc4880EncryptMessageSymmetricAlgorithm = Plaintext-             , rfc4880EncryptMessageS2K = s2k-             , rfc4880EncryptMessageIV = iv-             })-          passphrase-          payload of-      Left err ->-        assertFailure ("legacy fallback encryption failed: " ++ show err) >>-        fail "encryptMessage fallback failed"-      Right (bs, _) -> pure bs-  case parsePkts (encryptedPayloadBytes encrypted) of-    [SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 Plaintext _ Nothing)), SymEncIntegrityProtectedDataPkt (SEIPD1 1 _)] -> pure ()-    other ->-      assertFailure-        ("non-AES explicit encryption should use RFC4880 SKESKv4 + SEIPDv1 packets, got " ++-         show other)-  decrypted <--    case decryptMessage passphrase encrypted of-      Left err ->-        assertFailure ("legacy fallback decryption failed: " ++ show err) >>-        fail "decryptMessage fallback failed"-      Right bs -> pure bs-  assertEqual "legacy fallback encrypt/decrypt payload roundtrip" payload decrypted--testRFC4880EncryptMessageSEIPDv1ParsesCleanly :: Assertion-testRFC4880EncryptMessageSEIPDv1ParsesCleanly = do-  let passphraseBytes = "legacy-clean-parse" :: BL.ByteString-      passphrase = mkPassphrase passphraseBytes-      payload = mkClearPayload "hello from clean legacy town"-      s2k = IteratedSalted SHA256 (Salt8 "saltxyz!") (IterationCount 65536)-      iv = IV "1234567890ABCDEF"-  encrypted <--    case-        encryptMessage-          (RFC4880EncryptMessageOptions-             { rfc4880EncryptMessageExposure = DoNotExposeSessionMaterial-             , rfc4880EncryptMessageSymmetricAlgorithm = AES128-             , rfc4880EncryptMessageS2K = s2k-             , rfc4880EncryptMessageIV = iv-             })-          passphrase-          payload of-      Left err ->-        assertFailure ("RFC4880 encryption failed: " ++ show err) >>-        fail "encryptMessage failed"-      Right (bs, _) -> pure bs-  packets <--    case parsePktsEither (encryptedPayloadBytes encrypted) of-      Left err ->-        assertFailure ("encrypted packet parse failed: " ++ show err) >>-        fail "parsePktsEither failed"-      Right ps -> pure ps-  ciphertext <--    case packets of-      [SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 parsedSA parsedS2K Nothing)), SymEncIntegrityProtectedDataPkt (SEIPD1 1 payloadBytes)] -> do-        assertEqual "RFC4880 encrypted SKESK algorithm" AES128 parsedSA-        assertEqual "RFC4880 encrypted S2K" s2k parsedS2K-        pure (BL.toStrict payloadBytes)-      other ->-        assertFailure-          ("RFC4880 encryption should emit SKESKv4 + SEIPDv1 packets, got " ++-           show other) >>-        fail "unexpected encrypted packet layout"-  keyLen <--    case keySize AES128 of-      Left err ->-        assertFailure ("keySize failed for AES128: " ++ show err) >>-        fail "keySize failed"-      Right n -> pure n-  sessionKey <--    case string2Key s2k keyLen passphraseBytes of-      Left err ->-        assertFailure ("string2Key failed: " ++ renderS2KError err) >>-        fail "string2Key failed"-      Right keyBytes -> pure keyBytes-  (nonce, decrypted) <--    case decryptPreservingNonce AES128 ciphertext sessionKey of-      Left err ->-        assertFailure ("decryptPreservingNonce failed: " ++ show err) >>-        fail "decryptPreservingNonce failed"-      Right out -> pure out-  cleartext <--    case validateSEIPD1MDC nonce decrypted of-      Left err ->-        assertFailure ("validateSEIPD1MDC failed: " ++ err) >>-        fail "validateSEIPD1MDC failed"-      Right out -> pure out-  case parsePktsEither (BL.fromStrict cleartext) of-    Right [LiteralDataPkt BinaryData filename timestamp clearPayload] -> do-      assertEqual "RFC4880 decrypted literal filename" BL.empty filename-      assertEqual "RFC4880 decrypted literal timestamp" 0 timestamp-      assertEqual "RFC4880 decrypted literal payload" (clearPayloadBytes payload) clearPayload-    Right other ->-      assertFailure-        ("RFC4880 decrypted cleartext should contain exactly one literal packet, got " ++-         show other)-    Left err ->-      assertFailure-        ("RFC4880 decrypted cleartext should parse without trailing junk, got " ++-         show err)--testDecryptMessageTypedParseFailure :: Assertion-testDecryptMessageTypedParseFailure = do-  let passphrase = mkPassphrase "unused"-      encrypted = mkEncryptedPayload BL.empty-  case decryptMessage passphrase encrypted of-    Left (MessageParseFailureError MissingEncryptedMessage) -> pure ()-    Left err ->-      assertFailure ("Expected MissingEncryptedMessage parse failure, got " ++ show err)-    Right clear ->-      assertFailure ("Expected parse failure, got payload " ++ show clear)--testDecryptMessageRejectsUnknownCriticalPacket :: Assertion-testDecryptMessageRejectsUnknownCriticalPacket = do-  let passphrase = mkPassphrase "unused"-      encrypted =-        mkEncryptedPayload . runPut . put $-          Block [OtherPacketPkt 39 "unknown-critical"]-  case decryptMessage passphrase encrypted of-    Left (MessageParseFailureError (UnknownCriticalPacketType 39)) -> pure ()-    Left err ->-      assertFailure-        ("Expected UnknownCriticalPacketType 39 parse failure, got " ++ show err)-    Right clear ->-      assertFailure-        ("Expected unknown critical packet rejection, got payload " ++ show clear)--testDecryptMessageTypedDecryptFailure :: Assertion-testDecryptMessageTypedDecryptFailure = do-  let correctPassphrase = mkPassphrase "correct passphrase"-      wrongPassphrase = mkPassphrase "wrong passphrase"-      payload = mkClearPayload "typed decrypt failure payload"-      encryptedResult =-        encryptMessageDefault DoNotExposeSessionMaterial correctPassphrase payload-  encrypted <--    case encryptedResult of-      Left err ->-        assertFailure ("encryptMessageDefault failed: " ++ show err) >>-        fail "encryptMessageDefault failed"-      Right (bs, _) -> pure bs-  case decryptMessage wrongPassphrase encrypted of-    Left (MessageDecryptFailureError (PayloadDecryptFailed _)) -> pure ()-    Left (MessageDecryptFailureError (SessionMaterialDerivationFailed _)) -> pure ()-    Left err ->-      assertFailure ("Expected typed decrypt failure, got " ++ show err)-    Right clear ->-      assertFailure ("Expected decrypt failure, got payload " ++ show clear)--testDecryptMessageSEIPDv1MDCTampering :: Assertion-testDecryptMessageSEIPDv1MDCTampering = do-  let passphrase = mkPassphrase "mdc-tamper-test"-      payload    = mkClearPayload "payload for MDC tampering test"-      s2k        = IteratedSalted SHA256 (Salt8 "saltxyz!") (IterationCount 65536)-      iv         = IV "1234567890ABCDEF"-  encrypted <--    case encryptMessage-           (RFC4880EncryptMessageOptions-              { rfc4880EncryptMessageExposure          = DoNotExposeSessionMaterial-              , rfc4880EncryptMessageSymmetricAlgorithm = AES128-              , rfc4880EncryptMessageS2K                = s2k-              , rfc4880EncryptMessageIV                 = iv-              })-           passphrase-           payload of-      Left err ->-        assertFailure ("SEIPDv1 encryption failed: " ++ show err) >>-        fail "encryptMessage failed"-      Right (bs, _) -> pure bs-  let raw        = encryptedPayloadBytes encrypted-      midpoint   = BL.length raw `div` 2-      tampered   = BL.take midpoint raw <>-                   BL.cons (BL.head (BL.drop midpoint raw) `xor` 0xFF)-                            (BL.drop (midpoint + 1) raw)-  case decryptMessage passphrase (mkEncryptedPayload tampered) of-    Left (MessageDecryptFailureError (PayloadDecryptFailed msg))-      | "MDC" `isInfixOf` msg -> pure ()-      | otherwise ->-          assertFailure-            ("Expected MDC-related PayloadDecryptFailed, got: " ++ msg)-    Left err ->-      assertFailure-        ("Expected PayloadDecryptFailed with MDC error, got: " ++ show err)-    Right _ ->-      assertFailure "Expected MDC tampering rejection, but decryption succeeded"--testSignMessageShape :: Assertion-testSignMessageShape = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  signerV4 <- expectV4PKPayload "RSA v4 signer" signer-  signedResult <- signMessageWith (mkRSASignerV4 signerV4 signingKey) (mkClearPayload "message-api signing payload")-  signedMessage <--    case signedResult of-      Left err ->-        assertFailure ("message signing failed: " ++ show err) >> pure mempty-      Right bs -> pure bs-  case parsePkts signedMessage of-    [LiteralDataPkt {}, SignaturePkt _] -> pure ()-    _ -> assertFailure "signing output should contain literal data and one signature packet"--testSignMessageRSAV6 :: Assertion-testSignMessageRSAV6 = do-  (signer, signingKey) <- loadUnencryptedRsaSignerV6-  signerV6 <- expectV6PKPayload "RSA v6 signer" signer-  let payload = "message-api signing payload with RSA SigV6"-  signedResult <- signMessageWith (mkRSASignerV6 signerV6 signingKey) (mkClearPayload payload)-  signedMessage <--    case signedResult of-      Left err ->-        assertFailure ("RSA SigV6 message signing failed: " ++ show err) >> pure mempty-      Right bs -> pure bs-  signaturePkt <--    case parsePkts signedMessage of-      [LiteralDataPkt {}, sig@(SignaturePkt (SigV6 BinarySig RSA SHA512 salt _ _ _ _))] -> do-        assertEqual "SigV6 RSA salt must be 32 bytes for SHA512" 32 (BL.length (unSignatureSalt salt))-        pure sig-      other ->-        assertFailure-          ("RSA SigV6 signing output should contain [LiteralDataPkt, RSA SigV6], got " ++-           show other) >>-        fail "unexpected RSA SigV6 signMessage output shape"-  let state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}-      keyring = [TKUnknown (signer, Nothing) [] [] [] []]-  case verifySigWith (verifyAgainstKeys keyring) signaturePkt state Nothing of-    Left err ->-      assertFailure-        ("RSA SigV6 signed message verification failed: " ++-         renderVerificationError err)-    Right _ -> pure ()--testSignMessageEd25519 :: Assertion-testSignMessageEd25519 = do-  (signer, signingKey) <- loadDeterministicEd25519Signer-  signerV4 <- expectV4PKPayload "Ed25519 v4 signer" signer-  let payload = "message-api signing payload with Ed25519"-  signedResult <- signMessageWith (mkEd25519SignerV4 signerV4 signingKey) (mkClearPayload payload)-  signedMessage <--    case signedResult of-      Left err ->-        assertFailure ("Ed25519 message signing failed: " ++ show err) >> pure mempty-      Right bs -> pure bs-  signaturePkt <--    case parsePkts signedMessage of-      [LiteralDataPkt {}, sig@(SignaturePkt (SigV4 BinarySig PKA.Ed25519 SHA512 _ _ _ _))] ->-        pure sig-      other ->-        assertFailure-          ("Ed25519 signing output should contain [LiteralDataPkt, Ed25519 SigV4], got " ++-           show other) >>-        fail "unexpected Ed25519 signMessage output shape"-  let state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}-      keyring = [TKUnknown (signer, Nothing) [] [] [] []]-  case verifySigWith (verifyAgainstKeys keyring) signaturePkt state Nothing of-    Left err ->-      assertFailure-        ("Ed25519 signed message verification failed: " ++-         renderVerificationError err)-    Right _ -> pure ()--testSignMessageEd25519V6 :: Assertion-testSignMessageEd25519V6 = do-  (signer, signingKey) <- loadDeterministicEd25519SignerV6-  signerV6 <- expectV6PKPayload "Ed25519 v6 signer" signer-  let payload = "message-api signing payload with Ed25519 SigV6"-  signedResult <- signMessageWith (mkEd25519SignerV6 signerV6 signingKey) (mkClearPayload payload)-  signedMessage <--    case signedResult of-      Left err ->-        assertFailure ("Ed25519 SigV6 message signing failed: " ++ show err) >> pure mempty-      Right bs -> pure bs-  signaturePkt <--    case parsePkts signedMessage of-      [LiteralDataPkt {}, sig@(SignaturePkt (SigV6 BinarySig PKA.Ed25519 SHA512 salt _ _ _ _))] -> do-        assertEqual "SigV6 Ed25519 salt must be 32 bytes for SHA512" 32 (BL.length (unSignatureSalt salt))-        pure sig-      other ->-        assertFailure-          ("Ed25519 SigV6 signing output should contain [LiteralDataPkt, Ed25519 SigV6], got " ++-           show other) >>-        fail "unexpected Ed25519 SigV6 signMessage output shape"-  case signaturePkt of-    SignaturePkt (SigV6 BinarySig PKA.Ed25519 SHA512 _ _ _ _ _) -> do-      let state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}-          keyring = [TKUnknown (signer, Nothing) [] [] [] []]-      case verifySigWith (verifyAgainstKeys keyring) signaturePkt state Nothing of-        Left err ->-          assertFailure-            ("Ed25519 SigV6 signed message verification failed: " ++-             renderVerificationError err)-        Right _ -> pure ()-    _ -> assertFailure "expected an Ed25519 SigV6 signature packet"--testV4Ed25519LegacyKeyRejectsMissingPrefix :: Assertion-testV4Ed25519LegacyKeyRejectsMissingPrefix = do-  let legacyEd25519Oid = B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0xDA, 0x47, 0x0F, 0x01]-      rawEd25519Public = B.replicate 32 0x01-      encoded =-        runPut $ do-          putWord8 4-          putWord32be 0-          putWord8 (fromFVal EdDSA)-          putWord8 (fromIntegral (B.length legacyEd25519Oid))-          putByteString legacyEd25519Oid-          putWord16be 256-          putByteString rawEd25519Public-  case runGetOrFail (get :: Get SomePKPayload) encoded of-    Left (_, _, err) ->-      assertBool-        ("expected invalid-legacy-point parse failure, got: " ++ err)-        ("invalid Ed25519Legacy public key" `isInfixOf` err)-    Right _ ->-      assertFailure "legacy Ed25519 key without 0x40 prefix should be rejected"--testSignMessageEd448 :: Assertion-testSignMessageEd448 = do-  (signer, signingKey) <- loadDeterministicEd448Signer-  signerV4 <- expectV4PKPayload "Ed448 v4 signer" signer-  let payload = "message-api signing payload with Ed448"-  signedResult <- signMessageWith (mkEd448SignerV4 signerV4 signingKey) (mkClearPayload payload)-  signedMessage <--    case signedResult of-      Left err ->-        assertFailure ("Ed448 message signing failed: " ++ show err) >> pure mempty-      Right bs -> pure bs-  signaturePkt <--    case parsePkts signedMessage of-      [LiteralDataPkt {}, sig@(SignaturePkt (SigV4 BinarySig PKA.Ed448 SHA512 _ _ _ _))] ->-        pure sig-      other ->-        assertFailure-          ("Ed448 signing output should contain [LiteralDataPkt, Ed448 SigV4], got " ++-           show other) >>-        fail "unexpected Ed448 signMessage output shape"-  let state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}-      keyring = [TKUnknown (signer, Nothing) [] [] [] []]-  case verifySigWith (verifyAgainstKeys keyring) signaturePkt state Nothing of-    Left err ->-      assertFailure-        ("Ed448 signed message verification failed: " ++-         renderVerificationError err)-    Right _ -> pure ()--testSignMessageEd448V6 :: Assertion-testSignMessageEd448V6 = do-  (signer, signingKey) <- loadDeterministicEd448SignerV6-  signerV6 <- expectV6PKPayload "Ed448 v6 signer" signer-  let payload = "message-api signing payload with Ed448 SigV6"-  signedResult <- signMessageWith (mkEd448SignerV6 signerV6 signingKey) (mkClearPayload payload)-  signedMessage <--    case signedResult of-      Left err ->-        assertFailure ("Ed448 SigV6 message signing failed: " ++ show err) >> pure mempty-      Right bs -> pure bs-  signaturePkt <--    case parsePkts signedMessage of-      [LiteralDataPkt {}, sig@(SignaturePkt (SigV6 BinarySig PKA.Ed448 SHA512 salt _ _ _ _))] -> do-        assertEqual "SigV6 Ed448 salt must be 32 bytes for SHA512" 32 (BL.length (unSignatureSalt salt))-        pure sig-      other ->-        assertFailure-          ("Ed448 SigV6 signing output should contain [LiteralDataPkt, Ed448 SigV6], got " ++-           show other) >>-        fail "unexpected Ed448 SigV6 signMessage output shape"-  case signaturePkt of-    SignaturePkt (SigV6 BinarySig PKA.Ed448 SHA512 _ _ _ _ _) -> pure ()-    _ -> assertFailure "expected an Ed448 SigV6 signature packet"--testV4EdSignaturesUseNativeFixedWidthEncoding :: Assertion-testV4EdSignaturesUseNativeFixedWidthEncoding = do-  (_, ed25519SigningKey) <- loadDeterministicEd25519Signer-  ed25519Sig <--    case signDataWithEd25519 BinarySig ed25519SigningKey [] [] "v4 ed25519 encoding" of-      Left err ->-        assertFailure ("Ed25519 v4 signing failed: " ++ renderSignError err) >>-        fail "expected Ed25519 signature"-      Right sig -> pure sig-  case extractV4SignatureAlgorithmFields (runPut (put ed25519Sig)) of-    Left err ->-      assertFailure ("failed to decode serialized Ed25519 v4 signature payload: " ++ err)-    Right (pka, algorithmFields) -> do-      assertEqual "Ed25519 v4 signature packet algorithm id" PKA.Ed25519 pka-      assertEqual "Ed25519 v4 algorithm field width" 64 (B.length algorithmFields)--  (_, ed448SigningKey) <- loadDeterministicEd448Signer-  ed448Sig <--    case signDataWithEd448 BinarySig ed448SigningKey [] [] "v4 ed448 encoding" of-      Left err ->-        assertFailure ("Ed448 v4 signing failed: " ++ renderSignError err) >>-        fail "expected Ed448 signature"-      Right sig -> pure sig-  case extractV4SignatureAlgorithmFields (runPut (put ed448Sig)) of-    Left err ->-      assertFailure ("failed to decode serialized Ed448 v4 signature payload: " ++ err)-    Right (pka, algorithmFields) -> do-      assertEqual "Ed448 v4 signature packet algorithm id" PKA.Ed448 pka-      assertEqual "Ed448 v4 algorithm field width" 114 (B.length algorithmFields)--testVerifyDetachedEd25519WithoutIssuerHints :: Assertion-testVerifyDetachedEd25519WithoutIssuerHints = do-  (signer, signingKey) <- loadDeterministicEd25519Signer-  let payload = "detached v4 eddsa payload without issuer hints"-      state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}-      keyring = mkTestKeyring [TKUnknown (signer, Nothing) [] [] [] []]-  sigPayload <--    case signDataWithEd25519 BinarySig signingKey [] [] payload of-      Left err ->-        assertFailure ("Ed25519 detached signing failed: " ++ renderSignError err) >>-        fail (renderSignError err)-      Right sig -> pure sig-  case verifySigWith (verifyAgainstKeyring keyring) (SignaturePkt sigPayload) state Nothing of-    Left err ->-      assertFailure-        ("Ed25519 detached verification without issuer hints failed: " ++-         renderVerificationError err)-    Right _ -> pure ()--testVerifyDetachedEd25519WithFakeIssuerHint :: Assertion-testVerifyDetachedEd25519WithFakeIssuerHint = do-  (signer, signingKey) <- loadDeterministicEd25519Signer-  let payload = "detached v4 eddsa payload with fake issuer hint"-      state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}-      keyring = mkTestKeyring [TKUnknown (signer, Nothing) [] [] [] []]-      fakeIssuer = EightOctetKeyId "\x01\x23\x45\x67\x89\xab\xcd\xef"-      unhashed = [SigSubPacket False (Issuer fakeIssuer)]-  sigPayload <--    case signDataWithEd25519 BinarySig signingKey [] unhashed payload of-      Left err ->-        assertFailure ("Ed25519 detached signing failed: " ++ renderSignError err) >>-        fail (renderSignError err)-      Right sig -> pure sig-  case verifySigWith (verifyAgainstKeyring keyring) (SignaturePkt sigPayload) state Nothing of-    Left err ->-      assertFailure-        ("Ed25519 detached verification with fake issuer hint failed: " ++-         renderVerificationError err)-    Right _ -> pure ()--testVerifyDetachedEd25519WithoutIssuerHintsAgainstKeys :: Assertion-testVerifyDetachedEd25519WithoutIssuerHintsAgainstKeys = do-  (signer, signingKey) <- loadDeterministicEd25519Signer-  let payload = "detached v4 eddsa payload without issuer hints (verifyAgainstKeys)"-      state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}-      keys = [TKUnknown (signer, Nothing) [] [] [] []]-  sigPayload <--    case signDataWithEd25519 BinarySig signingKey [] [] payload of-      Left err ->-        assertFailure ("Ed25519 detached signing failed: " ++ renderSignError err) >>-        fail (renderSignError err)-      Right sig -> pure sig-  case verifySigWith (verifyAgainstKeys keys) (SignaturePkt sigPayload) state Nothing of-    Left err ->-      assertFailure-        ("Ed25519 detached verification against keys without issuer hints failed: " ++-         renderVerificationError err)-    Right _ -> pure ()--testVerifyDetachedEd25519WithFakeIssuerHintAgainstKeys :: Assertion-testVerifyDetachedEd25519WithFakeIssuerHintAgainstKeys = do-  (signer, signingKey) <- loadDeterministicEd25519Signer-  let payload = "detached v4 eddsa payload with fake issuer hint (verifyAgainstKeys)"-      state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}-      keys = [TKUnknown (signer, Nothing) [] [] [] []]-      fakeIssuer = EightOctetKeyId "\x01\x23\x45\x67\x89\xab\xcd\xef"-      unhashed = [SigSubPacket False (Issuer fakeIssuer)]-  sigPayload <--    case signDataWithEd25519 BinarySig signingKey [] unhashed payload of-      Left err ->-        assertFailure ("Ed25519 detached signing failed: " ++ renderSignError err) >>-        fail (renderSignError err)-      Right sig -> pure sig-  case verifySigWith (verifyAgainstKeys keys) (SignaturePkt sigPayload) state Nothing of-    Left err ->-      assertFailure-        ("Ed25519 detached verification against keys with fake issuer hint failed: " ++-         renderVerificationError err)-    Right _ -> pure ()--testCanonicalTextSigPayloadNormalization :: Assertion-testCanonicalTextSigPayloadNormalization = do-  let state =-        emptyPSC-          { lastLD =-              LiteralDataPkt-                TextData-                BL.empty-                (ThirtyTwoBitTimeStamp 0)-                "line1 \t\nline2\t \rline3\t \r\nline4 \t"-          }-  assertEqual-    "Binary signatures preserve original line endings"-    "line1 \t\nline2\t \rline3\t \r\nline4 \t"-    (payloadForSig BinarySig state)-  assertEqual-    "Canonical text signatures normalize line endings and trim trailing whitespace"-    "line1\r\nline2\r\nline3\r\nline4"-    (payloadForSig CanonicalTextSig state)--testTextNormalizationModes :: Assertion-testTextNormalizationModes = do-  let state =-        emptyPSC-          { lastLD =-              LiteralDataPkt-                TextData-                BL.empty-                (ThirtyTwoBitTimeStamp 0)-                "line1 \t\nline2\t \r\nline3"-          }-  let cleartextResult = payloadForSigWith CleartextCompat CanonicalTextSig state-      strictResult     = payloadForSigWith RFC9580Strict    CanonicalTextSig state-  assertEqual-    "CleartextCompat mode strips trailing whitespace per line"-    "line1\r\nline2\r\nline3"-    cleartextResult-  assertEqual-    "RFC9580Strict mode preserves trailing whitespace (CRLF-only normalization)"-    "line1 \t\r\nline2\t \r\nline3"-    strictResult-  (signer, signingKey) <- loadUnencryptedRsaSigner-  issuerKeyId <--    case eightOctetKeyID signer of-      Left err ->-        assertFailure ("failed to derive issuer key id: " ++ err) >>-        fail "expected issuer key id"-      Right i -> pure i-  let payload = "line with trailing space \nno trailing space\n"-      hashed = [SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint signer))]-      unhashed = [SigSubPacket False (Issuer issuerKeyId)]-      builderCompat = sigBuilderInit @'PKA.RSA CanonicalTextSig SHA512-      builderStrict = (sigBuilderInit @'PKA.RSA CanonicalTextSig SHA512) { sbTextNormMode = RFC9580Strict }-      withSubs b = addUnhashedSubs (listToUnhashedSubs unhashed) (addHashedSubs (listToHashedSubs hashed) b)-      bc = withSubs builderCompat-      bs = withSubs builderStrict-  sigCompat  <- case signDataWithRSABuilder bc  signingKey payload of-    Left err -> assertFailure ("CleartextCompat sign failed: " ++ renderSignError err) >> fail ""-    Right s  -> pure s-  sigStrict  <- case signDataWithRSABuilder bs  signingKey payload of-    Left err -> assertFailure ("RFC9580Strict sign failed: " ++ renderSignError err) >> fail ""-    Right s  -> pure s-  assertBool-    "CleartextCompat and RFC9580Strict produce different signatures for payloads with trailing whitespace"-    (sigCompat /= sigStrict)--testCanonicalTextSignatureSigningPaths :: Assertion-testCanonicalTextSignatureSigningPaths = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  issuerKeyId <--    case eightOctetKeyID signer of-      Left err ->-        assertFailure ("failed to derive issuer key id: " ++ err) >>-        fail "expected issuer key id"-      Right i -> pure i-  let mixedPayload = "line1 \t\nline2\t \rline3\t \r\nline4 \t"-      normalizedPayload = "line1\r\nline2\r\nline3\r\nline4"-      hashed = [SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint signer))]-      unhashed = [SigSubPacket False (Issuer issuerKeyId)]-  primitiveMixed <--    case signDataWithRSA CanonicalTextSig signingKey hashed unhashed mixedPayload of-      Left err ->-        assertFailure ("canonical text primitive signing failed: " ++ renderSignError err) >>-        fail (renderSignError err)-      Right sig -> pure sig-  primitiveNormalized <--    case signDataWithRSA CanonicalTextSig signingKey hashed unhashed normalizedPayload of-      Left err ->-        assertFailure ("canonical text primitive signing (normalized payload) failed: " ++ renderSignError err) >>-        fail (renderSignError err)-      Right sig -> pure sig-  assertEqual-    "primitive canonical text signing should normalize mixed line endings"-    primitiveNormalized-    primitiveMixed--  let builder = sigBuilderInit @'PKA.RSA CanonicalTextSig SHA512-      withHashed = addHashedSubs (listToHashedSubs hashed) builder-      withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed-  builderMixed <--    case signDataWithRSABuilder withUnhashed signingKey mixedPayload of-      Left err ->-        assertFailure ("canonical text builder signing failed: " ++ renderSignError err) >>-        fail (renderSignError err)-      Right sig -> pure sig-  builderNormalized <--    case signDataWithRSABuilder withUnhashed signingKey normalizedPayload of-      Left err ->-        assertFailure ("canonical text builder signing (normalized payload) failed: " ++ renderSignError err) >>-        fail (renderSignError err)-      Right sig -> pure sig-  assertEqual-    "builder canonical text signing should normalize mixed line endings"-    builderNormalized-    builderMixed--testSignaturePrimitives :: Assertion-testSignaturePrimitives = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  let userId = UserId "primitive-api@example.org"-      assertSigType ::-           String -> SigType -> Either SignError SignaturePayload -> Assertion-      assertSigType testLabel expected result =-        case result of-          Left err -> assertFailure (testLabel ++ " failed: " ++ renderSignError err)-          Right (SigV4 sigType _ _ _ _ _ _) ->-            assertEqual (testLabel ++ " uses expected signature type") expected sigType-          Right _ -> assertFailure (testLabel ++ " should generate a V4 signature payload")-  assertSigType-    "certification signature"-    GenericCert-    (signCertificationWithRSA GenericCert signer userId [] [] signingKey)-  assertSigType-    "key revocation signature"-    KeyRevocationSig-    (signKeyRevocationWithRSA signer [] [] signingKey)-  assertSigType-    "subkey revocation signature"-    SubkeyRevocationSig-    (signSubkeyRevocationWithRSA signer signer [] [] signingKey)-  assertSigType-    "certification revocation signature"-    CertRevocationSig-    (signCertRevocationWithRSA signer userId [] [] signingKey)-  let left16Payload = "left16 primitive payload"-      left16Keyring = mkTestKeyring [TKUnknown (signer, Nothing) [] [] [] []]-  left16Sig <--    case signDataWithRSA BinarySig signingKey [] [] left16Payload of-      Left err ->-        assertFailure ("RSA primitive signing for left16 failed: " ++ renderSignError err) >>-        fail "expected RSA signature payload"-      Right sigPayload -> pure sigPayload-  case verifyAgainstKeyring left16Keyring (SignaturePkt left16Sig) Nothing left16Payload of-    Right _ -> pure ()-    Left err ->-      assertFailure-        ("fresh RSA signature should verify with matching left16, got: " ++-         renderVerificationError err)-  let tamperedLeft16Sig =-        case left16Sig of-          SigV4 st pka ha hs us l16 mpis -> SigV4 st pka ha hs us (l16 + 1) mpis-          other -> other-  case verifyAgainstKeyring left16Keyring (SignaturePkt tamperedLeft16Sig) Nothing left16Payload of-    Left _ -> pure ()-    Right _ ->-      assertFailure "verification unexpectedly succeeded with tampered left16"-  if isRight (signCertificationWithRSA KeyRevocationSig signer userId [] [] signingKey)-    then-      assertFailure-        "certification primitive should reject non-certification signature types"-    else pure ()-  (edSigner, edSigningKey) <- loadDeterministicEd25519Signer-  edIssuerKeyId <--    case eightOctetKeyID edSigner of-      Left err ->-        assertFailure ("failed to derive Ed25519 issuer key id: " ++ err) >>-        fail "expected Ed25519 issuer key id"-      Right i -> pure i-  let edPayload = "primitive Ed25519 payload"-      edHashed = [SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint edSigner))]-      edUnhashed = [SigSubPacket False (Issuer edIssuerKeyId)]-  case signDataWithEd25519 BinarySig edSigningKey edHashed edUnhashed edPayload of-    Left err -> assertFailure ("Ed25519 primitive signing failed: " ++ renderSignError err)-    Right (SigV4 BinarySig PKA.Ed25519 SHA512 _ _ _ _) -> pure ()-    Right other ->-      assertFailure ("Ed25519 primitive should generate an Ed25519 SigV4 payload, got " ++ show other)-  let v6Salt = SignatureSalt (BL.replicate 32 0x42)-  case signDataWithEd25519V6 BinarySig v6Salt edSigningKey edHashed edUnhashed edPayload of-    Left err -> assertFailure ("Ed25519 SigV6 primitive signing failed: " ++ renderSignError err)-    Right (SigV6 BinarySig PKA.Ed25519 SHA512 salt _ _ _ _) ->-      assertEqual "Ed25519 SigV6 primitive should preserve 32-byte salt" 32 (BL.length (unSignatureSalt salt))-    Right other ->-      assertFailure ("Ed25519 SigV6 primitive should generate an Ed25519 SigV6 payload, got " ++ show other)-  (ed448Signer, ed448SigningKey) <- loadDeterministicEd448Signer-  ed448IssuerKeyId <--    case eightOctetKeyID ed448Signer of-      Left err ->-        assertFailure ("failed to derive Ed448 issuer key id: " ++ err) >>-        fail "expected Ed448 issuer key id"-      Right i -> pure i-  let ed448Payload = "primitive Ed448 payload"-      ed448Hashed = [SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint ed448Signer))]-      ed448Unhashed = [SigSubPacket False (Issuer ed448IssuerKeyId)]-  case signDataWithEd448 BinarySig ed448SigningKey ed448Hashed ed448Unhashed ed448Payload of-    Left err -> assertFailure ("Ed448 primitive signing failed: " ++ renderSignError err)-    Right (SigV4 BinarySig PKA.Ed448 SHA512 _ _ _ _) -> pure ()-    Right other ->-      assertFailure ("Ed448 primitive should generate an Ed448 SigV4 payload, got " ++ show other)-  case signDataWithEd448V6 BinarySig v6Salt ed448SigningKey ed448Hashed ed448Unhashed ed448Payload of-    Left err -> assertFailure ("Ed448 SigV6 primitive signing failed: " ++ renderSignError err)-    Right (SigV6 BinarySig PKA.Ed448 SHA512 salt _ _ _ _) ->-      assertEqual "Ed448 SigV6 primitive should preserve 32-byte salt" 32 (BL.length (unSignatureSalt salt))-    Right other ->-      assertFailure ("Ed448 SigV6 primitive should generate an Ed448 SigV6 payload, got " ++ show other)--testSignatureDataKindsCoercions :: Assertion-testSignatureDataKindsCoercions = do-  let sigV3 =-        SigV3-          BinarySig-          (ThirtyTwoBitTimeStamp 1)-          (EightOctetKeyId "\x01\x02\x03\x04\x05\x06\x07\x08")-          RSA-          SHA256-          0-          (NE.fromList [MPI 1])-      sigV4 =-        SigV4-          BinarySig-          RSA-          SHA256-          []-          []-          0-          (NE.fromList [MPI 2])-      sigV6 =-        SigV6-          BinarySig-          PKA.Ed25519-          SHA512-          (SignatureSalt (BL.replicate 32 0x01))-          []-          []-          0-          (NE.fromList [MPI 3, MPI 4])-      sigOther = SigVOther 77 "opaque-signature-body"-      assertPacketRoundTrip label expected pkt =-        case fromPktEitherSomeSignatureV pkt of-          Left err -> assertFailure (label ++ " packet coercion failed: " ++ err)-          Right (SomeSignatureV typedSig) ->-            assertEqual-              (label ++ " packet coercion preserves payload")-              expected-              (signaturePayloadFromSignatureV typedSig)-  assertBool-    "toSomeSignaturePayload should preserve SigV3 witness"-    (isRight (asSignaturePayloadV3 sigV3))-  assertBool-    "toSomeSignaturePayload should preserve SigV4 witness"-    (isRight (asSignaturePayloadV4 sigV4))-  assertBool-    "toSomeSignaturePayload should preserve SigV6 witness"-    (isRight (asSignaturePayloadV6 sigV6))-  assertBool-    "toSomeSignaturePayload should preserve SigVOther witness"-    (isRight (asSignaturePayloadOther sigOther))-  case asSignaturePayloadV3 sigV3 of-    Left err -> assertFailure ("asSignaturePayloadV3 should accept SigV3: " ++ err)-    Right typed ->-      assertEqual "asSignaturePayloadV3 round-trips SigV3" sigV3 (toSignaturePayload typed)-  case asSignaturePayloadV4 sigV4 of-    Left err -> assertFailure ("asSignaturePayloadV4 should accept SigV4: " ++ err)-    Right typed ->-      assertEqual "asSignaturePayloadV4 round-trips SigV4" sigV4 (toSignaturePayload typed)-  case asSignaturePayloadV6 sigV6 of-    Left err -> assertFailure ("asSignaturePayloadV6 should accept SigV6: " ++ err)-    Right typed ->-      assertEqual "asSignaturePayloadV6 round-trips SigV6" sigV6 (toSignaturePayload typed)-  case asSignaturePayloadOther sigOther of-    Left err -> assertFailure ("asSignaturePayloadOther should accept SigVOther: " ++ err)-    Right typed ->-      assertEqual "asSignaturePayloadOther round-trips SigVOther" sigOther (toSignaturePayload typed)-  assertBool-    "asSignaturePayloadV6 rejects SigV4"-    (not (isRight (asSignaturePayloadV6 sigV4)))-  assertBool-    "asSignaturePayloadV4 rejects SigVOther"-    (not (isRight (asSignaturePayloadV4 sigOther)))-  assertPacketRoundTrip "SigV3" sigV3 (SignaturePkt sigV3)-  assertPacketRoundTrip "SigV4" sigV4 (SignaturePkt sigV4)-  assertPacketRoundTrip "SigV6" sigV6 (SignaturePkt sigV6)-  assertPacketRoundTrip "SigVOther" sigOther (SignaturePkt sigOther)-  assertBool-    "fromPktEitherSomeSignatureV rejects non-signature packets"-    (not (isRight (fromPktEitherSomeSignatureV (LiteralDataPkt BinaryData "" 0 ""))))--testTypedArmorPayloadHelpers :: Assertion-testTypedArmorPayloadHelpers = do-  let armors =-        [ Armor ArmorPublicKeyBlock [] "public-one"-        , Armor ArmorMessage [] "message-one"-        , Armor ArmorPublicKeyBlock [] "public-two"-        ]-      publicPayloads = map BL.toStrict (armorPayloadsOfType ArmorPublicKeyBlock armors)-  assertEqual-    "armorPayloadsOfType returns all matching typed blocks in order"-    ["public-one", "public-two"]-    publicPayloads-  assertEqual-    "singleArmorPayloadOfType returns the sole matching message payload"-    (Right "message-one")-    (fmap BL.toStrict (singleArmorPayloadOfType ArmorMessage armors))-  assertBool-    "singleArmorPayloadOfType fails when no typed blocks exist"-    (isLeft (singleArmorPayloadOfType ArmorPrivateKeyBlock armors))-  assertBool-    "singleArmorPayloadOfType fails when multiple typed blocks exist"-    (isLeft (singleArmorPayloadOfType ArmorPublicKeyBlock armors))-testRecommendedArmorType :: Assertion-testRecommendedArmorType = do-  secretArmors <- loadArmor "v4-encrypted-secret.pgp.aa"-  publicArmors <- loadArmor "v4-encrypted.rev.aa"-  secretPayload <--    case singleArmorPayloadOfType ArmorPrivateKeyBlock secretArmors of-      Left err -> assertFailure err >> fail err-      Right payload -> pure payload-  publicPayload <--    case singleArmorPayloadOfType ArmorPublicKeyBlock publicArmors of-      Left err -> assertFailure err >> fail err-      Right payload -> pure payload-  let secretPkts = parsePkts secretPayload-      publicPkts = parsePkts publicPayload-      firstPkt label pkts =-        case pkts of-          [] -> assertFailure (label ++ " should contain at least one packet") >> fail "missing packet"-          pkt:_ -> pure pkt-  firstSecret <- firstPkt "secret armor fixture" secretPkts-  firstPublic <- firstPkt "public armor fixture" publicPkts-  let sig = SignaturePkt (SigV4 BinarySig RSA SHA256 [] [] 0 (NE.fromList [MPI 1]))-  assertEqual "recommendedArmorType rejects empty packet streams" Nothing (recommendedArmorType [])-  assertEqual-    "recommendedArmorType maps secret-key packets to private key armor"-    (Just ArmorPrivateKeyBlock)-    (recommendedArmorType [firstSecret])-  assertEqual-    "recommendedArmorType maps public-key packets to public key armor"-    (Just ArmorPublicKeyBlock)-    (recommendedArmorType [firstPublic])-  assertEqual-    "recommendedArmorType maps signature packets to signature armor"-    (Just ArmorSignature)-    (recommendedArmorType [sig])-  assertEqual-    "recommendedArmorType defaults non-key/signature packets to message armor"-    (Just ArmorMessage)-    (recommendedArmorType [LiteralDataPkt BinaryData "" 0 "payload"])-testSingleClearSignedBlock :: Assertion-testSingleClearSignedBlock = do-  let clearSigned =-        ClearSigned-          [("Hash", "SHA256")]-          "signed cleartext payload\n"-          (Armor ArmorSignature [("Version", "test-suite")] "detached-signature")-  assertEqual-    "singleClearSignedBlock extracts cleartext and signature payloads"-    (Right ([("Hash", "SHA256")], "signed cleartext payload\n", "detached-signature"))-    (singleClearSignedBlock [clearSigned])-  assertBool-    "singleClearSignedBlock rejects absent clear-signed blocks"-    (isLeft (singleClearSignedBlock [Armor ArmorMessage [] "payload"]))-  assertBool-    "singleClearSignedBlock rejects multiple clear-signed blocks"-    (isLeft (singleClearSignedBlock [clearSigned, clearSigned]))-  assertBool-    "singleClearSignedBlock rejects non-signature inner armor blocks"-    (isLeft (singleClearSignedBlock [ClearSigned [] "payload" (Armor ArmorMessage [] "not-signature")]))-testSignerTimelineSoftPrimaryRevocation :: Assertion-testSignerTimelineSoftPrimaryRevocation = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  let payload = "soft primary revocation timeline payload"-      keyCreated = _timestamp signer-      sigBeforeTime = addTimestampSeconds keyCreated 10-      revocationTime = addTimestampSeconds keyCreated 20-      sigAfterTime = addTimestampSeconds keyCreated 30-  sigBefore <--    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload-  revocation <--    signKeyRevocationWithReasonAt signer signingKey revocationTime KeySuperseded-  sigAfter <--    signBinaryMessageWithRSAAt signer signingKey sigAfterTime payload-  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]-  assertSingleSignerFingerprint-    "soft primary revocation should preserve pre-revocation signatures"-    (fingerprint signer)-    (verifyTimelinePackets keyring payload sigBefore)-  assertSingleFailureContainsTimeline-    "soft primary revocation should reject post-revocation signatures"-    "signing key is revoked"-    (verifyTimelinePackets keyring payload sigAfter)--testSignerTimelineHardPrimaryRevocation :: Assertion-testSignerTimelineHardPrimaryRevocation = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  let payload = "hard primary revocation timeline payload"-      keyCreated = _timestamp signer-      sigBeforeTime = addTimestampSeconds keyCreated 10-      revocationTime = addTimestampSeconds keyCreated 20-  sigBefore <--    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload-  revocation <--    signKeyRevocationWithReasonAt signer signingKey revocationTime KeyMaterialCompromised-  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]-  assertSingleFailureContainsTimeline-    "hard primary revocation should reject even pre-revocation signatures"-    "signing key is revoked"-    (verifyTimelinePackets keyring payload sigBefore)--testSignerTimelineNoReasonPrimaryRevocation :: Assertion-testSignerTimelineNoReasonPrimaryRevocation = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  let payload = "no-reason primary revocation timeline payload"-      keyCreated = _timestamp signer-      sigBeforeTime = addTimestampSeconds keyCreated 10-      revocationTime = addTimestampSeconds keyCreated 20-  sigBefore <--    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload-  revocation <--    signKeyRevocationWithReasonAt signer signingKey revocationTime NoReason-  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]-  assertSingleFailureContainsTimeline-    "no-reason primary revocation should reject even pre-revocation signatures"-    "signing key is revoked"-    (verifyTimelinePackets keyring payload sigBefore)--testSignerTimelineUnknownReasonPrimaryRevocation :: Assertion-testSignerTimelineUnknownReasonPrimaryRevocation = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  let payload = "unknown-reason primary revocation timeline payload"-      keyCreated = _timestamp signer-      sigBeforeTime = addTimestampSeconds keyCreated 10-      revocationTime = addTimestampSeconds keyCreated 20-  sigBefore <--    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload-  revocation <--    signKeyRevocationWithReasonAt signer signingKey revocationTime (RCoOther 100)-  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]-  assertSingleFailureContainsTimeline-    "unknown-reason primary revocation should reject even pre-revocation signatures"-    "signing key is revoked"-    (verifyTimelinePackets keyring payload sigBefore)--testSignerTimelineNonCompromisePrimaryRevocationIsHistorical :: Assertion-testSignerTimelineNonCompromisePrimaryRevocationIsHistorical = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  let payload = "non-compromise primary revocation timeline payload"-      keyCreated = _timestamp signer-      sigBeforeTime = addTimestampSeconds keyCreated 10-      revocationTime = addTimestampSeconds keyCreated 20-      sigAfterTime = addTimestampSeconds keyCreated 30-  sigBefore <--    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload-  revocation <--    signKeyRevocationWithReasonAt-      signer-      signingKey-      revocationTime-      UserIdInfoNoLongerValid-  sigAfter <--    signBinaryMessageWithRSAAt signer signingKey sigAfterTime payload-  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]-  assertSingleSignerFingerprint-    "non-compromise primary revocation should preserve pre-revocation signatures"-    (fingerprint signer)-    (verifyTimelinePackets keyring payload sigBefore)-  assertSingleFailureContainsTimeline-    "non-compromise primary revocation should reject post-revocation signatures"-    "signing key is revoked"-    (verifyTimelinePackets keyring payload sigAfter)--testSignerTimelineTemporaryPrimaryRevocationExpires :: Assertion-testSignerTimelineTemporaryPrimaryRevocationExpires = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  let payload = "temporary primary revocation expiry timeline payload"-      keyCreated = _timestamp signer-      sigBeforeTime = addTimestampSeconds keyCreated 10-      revocationTime = addTimestampSeconds keyCreated 20-      sigDuringTime = addTimestampSeconds keyCreated 25-      sigAfterTime = addTimestampSeconds keyCreated 35-  sigBefore <--    signBinaryMessageWithRSAAt signer signingKey sigBeforeTime payload-  revocation <--    signKeyRevocationWithReasonAndExtrasAt-      signer-      signingKey-      revocationTime-      KeySuperseded-      [SigSubPacket False (SigExpirationTime 10)]-  sigDuring <--    signBinaryMessageWithRSAAt signer signingKey sigDuringTime payload-  sigAfter <--    signBinaryMessageWithRSAAt signer signingKey sigAfterTime payload-  let keyring = mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]-  assertSingleSignerFingerprint-    "temporary primary revocation should preserve pre-revocation signatures"-    (fingerprint signer)-    (verifyTimelinePackets keyring payload sigBefore)-  assertSingleFailureContainsTimeline-    "temporary primary revocation should reject signatures while revocation is effective"-    "signing key is revoked"-    (verifyTimelinePackets keyring payload sigDuring)-  assertSingleSignerFingerprint-    "temporary primary revocation should allow signatures after revocation expiration"-    (fingerprint signer)-    (verifyTimelinePackets keyring payload sigAfter)--testSignerTimelineSubkeyRevocation :: Assertion-testSignerTimelineSubkeyRevocation = do-  (primarySigner, primarySigningKey) <- loadUnencryptedRsaSigner-  (subkeySigner, subkeySigningKey) <- loadDeterministicEd25519Signer-  let payload = "subkey revocation timeline payload"-      keyCreated = _timestamp primarySigner-      bindingTime = addTimestampSeconds keyCreated 10-      sigBeforeTime = addTimestampSeconds keyCreated 20-      revocationTime = addTimestampSeconds keyCreated 30-      sigAfterTime = addTimestampSeconds keyCreated 40-      subkeyPacket = PublicSubkeyPkt subkeySigner-  bindingSig <--    signSubkeyBindingWithRSAAt primarySigner subkeySigner primarySigningKey bindingTime-  sigBefore <--    signBinaryMessageWithEd25519At subkeySigner subkeySigningKey sigBeforeTime payload-  revocationSig <--    signSubkeyRevocationWithRSAAt primarySigner subkeySigner primarySigningKey revocationTime-  sigAfter <--    signBinaryMessageWithEd25519At subkeySigner subkeySigningKey sigAfterTime payload-  let keyring =-        mkTestKeyring-          [TKUnknown (primarySigner, Nothing) [] [] [] [(subkeyPacket, [bindingSig, revocationSig])]]-  assertSingleSignerFingerprint-    "subkey revocation should preserve pre-revocation signatures"-    (fingerprint subkeySigner)-    (verifyTimelinePackets keyring payload sigBefore)-  assertSingleFailureContainsTimeline-    "subkey revocation should reject post-revocation signatures"-    "signing key was not valid at the signature creation time"-    (verifyTimelinePackets keyring payload sigAfter)--testSignMessageConvenience :: Assertion-testSignMessageConvenience = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  signerV4 <- expectV4PKPayload "RSA v4 convenience signer" signer-  signedResult <- signMessage (mkRSASignerV4 signerV4 signingKey) "message-api convenience signing payload"-  signedMessage <--    case signedResult of-      Left err ->-        assertFailure ("message signing convenience API failed: " ++ show err) >> pure mempty-      Right bs -> pure bs-  case parsePkts signedMessage of-    [LiteralDataPkt {}, SignaturePkt _] -> pure ()-    _ -> assertFailure "convenience signing output should contain literal data and one signature packet"--testTypedVerifySurfaceMatchesLegacy :: Assertion-testTypedVerifySurfaceMatchesLegacy = do-  kr <- loadKeyring "pubring.gpg"-  signedMessage <- readFixtureLazy "uncompressed-ops-rsa.gpg"-  let typedResults =-        verifyMessage-          defaultVerificationOptions-            { verificationPolicy = VerifyInformational-            , verificationMode = VerificationStreaming-            }-          kr-          signedMessage-      strictResults =-        verifyMessage-          defaultVerificationOptions-            { verificationPolicy = VerifyStrict-            , verificationMode = VerificationStreaming-            }-          kr-          signedMessage-      normalizeTyped :: Either VerificationError Verification -> Either Bool Fingerprint-      normalizeTyped (Left _) = Left False-      normalizeTyped (Right v) = Right (fingerprint (_verificationSigner v))-  assertEqual-    "strict verification should collapse informational failures"-    (map normalizeTyped (either (pure . Left) (Right <$>) (sequence typedResults)))-    (map normalizeTyped strictResults)-  assertBool-    "informational verification should emit at least one result for known-good fixture"-    (not (null (map normalizeTyped typedResults)))--testVerifyMessageStrictRejectsTamper :: Assertion-testVerifyMessageStrictRejectsTamper = do-  kr <- loadKeyring "pubring.gpg"-  packets <- loadAndDecompressPkts "uncompressed-ops-rsa.gpg"-  let tamperedPackets = map tamperLiteral packets-      strictOptions =-        defaultVerificationOptions-          { verificationPolicy = VerifyStrict-          , verificationMode = VerificationStreaming-          }-  case verifyMessagePackets strictOptions kr tamperedPackets of-    [Left _] -> pure ()-    _ -> assertFailure "strict typed verification should fail on tampered payload"-  where-    tamperLiteral (LiteralDataPkt dt fn ts payload) =-      LiteralDataPkt dt fn ts (BL.snoc payload 0)-    tamperLiteral pkt = pkt--testVerifySignedMessageConvenience :: Assertion-testVerifySignedMessageConvenience = do-  kr <- loadKeyring "pubring.gpg"-  signedMessage <- readFixtureLazy "uncompressed-ops-rsa.gpg"-  strictResult <--    pure-      (verifySignedMessage-         defaultVerificationOptions-           { verificationPolicy = VerifyStrict-           , verificationMode = VerificationStreaming-           }-         kr-         signedMessage)-  case strictResult of-    [Left _] -> assertFailure "verifySignedMessage should succeed for known-good fixture"-    verifications ->-      assertBool "verifySignedMessage should emit at least one verification" (not (null verifications))--testVerifyV4EdDSASignatureWithEd25519KeyAlgorithm :: Assertion-testVerifyV4EdDSASignatureWithEd25519KeyAlgorithm = do-  (signer, signingKey) <- loadDeterministicEd25519Signer-  let signerWithEd25519Pka = setPKAlgorithm PKA.Ed25519 signer-  signerV4 <- expectV4PKPayload "Ed25519 v4 signer with Ed25519 key algorithm" signerWithEd25519Pka-  let payload = "v4 eddsa signature with Ed25519 key algorithm"-      state = emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}-      keyring = mkTestKeyring [TKUnknown (signerWithEd25519Pka, Nothing) [] [] [] []]-  signedResult <--    signMessageWith-      (mkEd25519SignerV4 signerV4 signingKey)-      (mkClearPayload payload)-  signaturePkt <--    case signedResult of-      Left err ->-        assertFailure ("Ed25519 message signing failed: " ++ show err) >>-        fail "expected signed Ed25519 payload"-      Right signedMessage ->-        case parsePkts signedMessage of-          [LiteralDataPkt {}, sig@(SignaturePkt (SigV4 BinarySig PKA.Ed25519 SHA512 _ _ _ _))] ->-            pure sig-          other ->-            assertFailure-              ("Expected [LiteralDataPkt, Ed25519 SigV4] for Ed25519-key-algorithm verification test, got " ++-               show other) >>-            fail "unexpected Ed25519-key-algorithm signature shape"-  case verifySigWith (verifyAgainstKeyring keyring) signaturePkt state Nothing of-    Left err ->-      assertFailure-        ("Ed25519 SigV4 verification with Ed25519 key algorithm failed: " ++-         renderVerificationError err)-    Right _ -> pure ()+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Tests.MessageAndArmor (messageAndArmorTests) where++import Codec.Encryption.OpenPGP.ASCIIArmor.Types+    ( Armor (..)+    , ArmorType (..)+    )+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.RSA as RSA+import Data.Binary (get, put)+import Data.Binary.Get (Get, runGetOrFail)+import Data.Binary.Put+    ( putByteString+    , putWord16be+    , putWord32be+    , putWord8+    , runPut+    )+import Data.Bits (xor)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Either (isLeft, isRight)+import Data.List (isInfixOf)+import qualified Data.List.NonEmpty as NE+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit+    ( Assertion+    , assertBool+    , assertEqual+    , assertFailure+    , testCase+    )++import Codec.Encryption.OpenPGP.BlockCipher (keySize)+import Codec.Encryption.OpenPGP.CFB+    ( decryptPreservingNonce+    , validateSEIPD1MDC+    )+import Codec.Encryption.OpenPGP.Encrypt+    ( encryptSEIPDv2WithSKESKBlock+    )+import Codec.Encryption.OpenPGP.Fingerprint+    ( eightOctetKeyID+    , fingerprint+    )+import Codec.Encryption.OpenPGP.Internal (emptyPSC, lastLD)+import Codec.Encryption.OpenPGP.KeyringParser (parseUnknownTKs)+import Codec.Encryption.OpenPGP.Message+import Codec.Encryption.OpenPGP.Policy+    ( defaultVerificationPolicy+    , signatureV6SaltSizeForHashAlgorithm+    )+import Codec.Encryption.OpenPGP.S2K (renderS2KError, string2Key)+import Codec.Encryption.OpenPGP.Serialize+    ( armorPayloadsOfType+    , parsePkts+    , parsePktsEither+    , recommendedArmorType+    , singleArmorPayloadOfType+    , singleClearSignedBlock+    )+import Codec.Encryption.OpenPGP.SerializeForSigs+    ( payloadForSig+    , payloadForSigWith+    )+import Codec.Encryption.OpenPGP.Signatures+    ( SignError (..)+    , VerificationError (..)+    , renderSignError+    , renderVerificationError+    , signCertRevocationWithRSA+    , signCertificationWithRSA+    , signDataWithEd25519+    , signDataWithEd25519Builder+    , signDataWithEd25519V6+    , signDataWithEd25519V6Builder+    , signDataWithEd448+    , signDataWithEd448V6+    , signDataWithRSA+    , signDataWithRSABuilder+    , signDirectKeyWithRSA+    , signKeyRevocationWithRSA+    , signSubkeyRevocationWithRSA+    , verifyAgainstKeyring+    , verifyAgainstKeys+    , verifySigWith+    )+import Codec.Encryption.OpenPGP.Subpackets+    ( TextNormalizationMode (..)+    , addHashedSubs+    , addUnhashedSubs+    , listToHashedSubs+    , listToUnhashedSubs+    , sbTextNormMode+    , sigBuilderInit+    )+import Codec.Encryption.OpenPGP.Types+import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA+import Data.Conduit.OpenPGP.Message+    ( verifyMessage+    , verifyMessagePackets+    )+import Data.Conduit.OpenPGP.Verify (VerificationMode (..))+import Tests.Common+    ( addTimestampSeconds+    , assertSingleFailureContainsTimeline+    , assertSingleSignerFingerprint+    , encryptMessageDefault+    , expectV4PKPayload+    , expectV6PKPayload+    , extractV4SignatureAlgorithmFields+    , fp+    , loadAndDecompressPkts+    , loadArmor+    , loadDeterministicEd25519Signer+    , loadDeterministicEd25519SignerV6+    , loadDeterministicEd448Signer+    , loadDeterministicEd448SignerV6+    , loadKeyring+    , loadUnencryptedRsaSigner+    , loadUnencryptedRsaSignerV6+    , messageIssuerSubpacketsAt+    , mkTestKeyring+    , readFixtureLazy+    , setPKAlgorithm+    , signBinaryMessageWithEd25519At+    , signBinaryMessageWithRSAAt+    , signKeyRevocationWithReasonAndExtrasAt+    , signKeyRevocationWithReasonAt+    , signSubkeyBindingWithRSAAt+    , signSubkeyRevocationWithRSAAt+    , verifyTimelinePackets+    )++messageAndArmorTests :: TestTree+messageAndArmorTests =+    testGroup+        "Message API and armor fixtures"+        [ testGroup+            "Message API group"+            [ testCase+                "default encrypt/decrypt message"+                testDefaultedEncryptDecrypt+            , testCase+                "specific encrypt/decrypt message"+                testExplicitEncryptDecrypt+            , testCase+                "specific encrypt can expose effective session material"+                testExplicitEncryptExposesEffectiveSessionMaterial+            , testCase+                "default encrypt does not expose session material"+                testDefaultEncryptDoesNotExposeSessionMaterial+            , testCase+                "AES-128 EAX encrypt/decrypt message"+                testExplicitAES128EAXEncryptDecrypt+            , testCase+                "AES-128 GCM encrypt/decrypt message"+                testExplicitAES128GCMEncryptDecrypt+            , testCase+                "specific encrypt rejects deprecated S2K hash in modern mode"+                testExplicitEncryptRejectsDeprecatedS2KHash+            , testCase+                "legacy fallback encrypt/decrypt message"+                testLegacyFallbackEncryptDecrypt+            , testCase+                "RFC4880 encryptMessage SEIPDv1 cleartext parses without trailing junk"+                testRFC4880EncryptMessageSEIPDv1ParsesCleanly+            , testCase+                "decryptMessage returns typed parse failures"+                testDecryptMessageTypedParseFailure+            , testCase+                "decryptMessage rejects unknown critical packets"+                testDecryptMessageRejectsUnknownCriticalPacket+            , testCase+                "decryptMessage returns typed decrypt failures"+                testDecryptMessageTypedDecryptFailure+            , testCase+                "decryptMessage rejects SEIPDv1 MDC tampering"+                testDecryptMessageSEIPDv1MDCTampering+            , testCase "sign message shape" testSignMessageShape+            , testCase "sign message shape (RSA SigV6)" testSignMessageRSAV6+            , testCase "sign message shape (Ed25519)" testSignMessageEd25519+            , testCase+                "sign message shape (Ed25519 SigV6)"+                testSignMessageEd25519V6+            , testCase "sign message shape (Ed448)" testSignMessageEd448+            , testCase+                "sign message shape (Ed448 SigV6)"+                testSignMessageEd448V6+            , testCase+                "v4 Ed25519/Ed448 signatures use native fixed-width encoding"+                testV4EdSignaturesUseNativeFixedWidthEncoding+            , testCase+                "v4 Ed25519Legacy key parsing rejects missing 0x40 prefix"+                testV4Ed25519LegacyKeyRejectsMissingPrefix+            , testCase+                "detached v4 Ed25519 verification tolerates missing issuer hints"+                testVerifyDetachedEd25519WithoutIssuerHints+            , testCase+                "detached v4 Ed25519 verification tolerates fake issuer hints"+                testVerifyDetachedEd25519WithFakeIssuerHint+            , testCase+                "detached v4 Ed25519 verifyAgainstKeys tolerates missing issuer hints"+                testVerifyDetachedEd25519WithoutIssuerHintsAgainstKeys+            , testCase+                "detached v4 Ed25519 verifyAgainstKeys tolerates fake issuer hints"+                testVerifyDetachedEd25519WithFakeIssuerHintAgainstKeys+            , testCase+                "v4 EdDSA signatures verify with Ed25519 key algorithm identifier"+                testVerifyV4EdDSASignatureWithEd25519KeyAlgorithm+            , testCase+                "sign message convenience API"+                testSignMessageConvenience+            , testCase+                "typed verify surface matches legacy results"+                testTypedVerifySurfaceMatchesLegacy+            , testCase+                "strict typed verify rejects tamper"+                testVerifyMessageStrictRejectsTamper+            , testCase+                "verifySignedMessage convenience API"+                testVerifySignedMessageConvenience+            , testCase+                "signature generation primitives"+                testSignaturePrimitives+            , testCase+                "typed signature payload coercions"+                testSignatureDataKindsCoercions+            , testCase+                "typed armor payload helpers centralize block selection"+                testTypedArmorPayloadHelpers+            , testCase+                "recommendedArmorType infers canonical armor labels from packets"+                testRecommendedArmorType+            , testCase+                "singleClearSignedBlock validates cleartext signature envelopes"+                testSingleClearSignedBlock+            , testCase+                "canonical text signature payload normalization"+                testCanonicalTextSigPayloadNormalization+            , testCase+                "canonical text signatures normalize during signing"+                testCanonicalTextSignatureSigningPaths+            , testCase+                "text normalization modes (RFC9580Strict vs CleartextCompat)"+                testTextNormalizationModes+            ]+        , testGroup+            "ASCII armor fixture group"+            [ testCase+                "v4-encrypted-secret.pgp.aa decodes as an encrypted v4 secret key"+                testV4EncryptedSecretArmor+            , testCase+                "v4-encrypted.rev.aa decodes as a v4 revocation certificate"+                testV4EncryptedRevocationArmor+            , testCase+                "v4-encrypted.rev.aa SigV4 key-revocation semantics"+                testV4RevocationSignatureSemantics+            , testCase+                "v4-encrypted.rev.aa parses as single revocation TKUnknown"+                ( testRevocationArmorParsesAsSingleTransferableKey+                    "v4-encrypted.rev.aa"+                    True+                )+            , testCase+                "v6.rev.aa decodes as a v6 revocation certificate"+                (testV6RevocationArmor "v6.rev.aa")+            , testCase+                "v6.rev.aa SigV6 salt semantics"+                (testV6RevocationSignatureSaltSemantics "v6.rev.aa")+            , testCase+                "v6.rev.aa forbids legacy Issuer key-id subpackets"+                (testV6RevocationSignatureRejectsLegacyIssuerKeyID "v6.rev.aa")+            , testCase+                "v6.rev.aa parses as single revocation TKUnknown"+                (testRevocationArmorParsesAsSingleTransferableKey "v6.rev.aa" True)+            , testCase+                "v6-encrypted.rev.aa decodes as a v6 revocation certificate"+                (testV6RevocationArmor "v6-encrypted.rev.aa")+            , testCase+                "v6-encrypted.rev.aa SigV6 salt semantics"+                (testV6RevocationSignatureSaltSemantics "v6-encrypted.rev.aa")+            , testCase+                "v6-encrypted.rev.aa forbids legacy Issuer key-id subpackets"+                ( testV6RevocationSignatureRejectsLegacyIssuerKeyID+                    "v6-encrypted.rev.aa"+                )+            , testCase+                "v6-encrypted.rev.aa parses as single revocation TKUnknown"+                ( testRevocationArmorParsesAsSingleTransferableKey+                    "v6-encrypted.rev.aa"+                    True+                )+            , testCase+                "msg1.asc decodes as a parseable armored message"+                testMsg1ArmorFixture+            ]+        , testGroup+            "timeline-aware group"+            [ testCase+                "timeline-aware primary soft revocation keeps pre-revocation signatures"+                testSignerTimelineSoftPrimaryRevocation+            , testCase+                "timeline-aware primary hard revocation rejects historical signatures"+                testSignerTimelineHardPrimaryRevocation+            , testCase+                "timeline-aware no-reason primary revocation rejects historical signatures"+                testSignerTimelineNoReasonPrimaryRevocation+            , testCase+                "timeline-aware unknown-reason primary revocation rejects historical signatures"+                testSignerTimelineUnknownReasonPrimaryRevocation+            , testCase+                "timeline-aware non-compromise primary revocation stays historical until effective"+                testSignerTimelineNonCompromisePrimaryRevocationIsHistorical+            , testCase+                "timeline-aware temporary primary revocation expires and restores validity"+                testSignerTimelineTemporaryPrimaryRevocationExpires+            , testCase+                "timeline-aware subkey revocation distinguishes pre/post signatures"+                testSignerTimelineSubkeyRevocation+            ]+        ]++testV4EncryptedSecretArmor :: Assertion+testV4EncryptedSecretArmor = do+    armors <- loadArmor "v4-encrypted-secret.pgp.aa"+    armor <-+        case armors of+            [a] -> pure a+            _ ->+                assertFailure+                    "v4 encrypted secret fixture should contain one armored payload"+                    >> fail "expected one armored payload"+    (headers, payload) <-+        case armor of+            Armor ArmorPrivateKeyBlock hs p -> pure (hs, p)+            Armor atype _ _ ->+                assertFailure+                    ( "v4 encrypted secret fixture should decode as a private key block, got "+                        ++ show atype+                    )+                    >> fail "expected private key block"+            _ ->+                assertFailure+                    "v4 encrypted secret fixture should decode as an armored payload"+                    >> fail "expected armored payload"+    assertEqual+        "v4 encrypted secret fixture should keep identifying comments"+        [ ("Comment", "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")+        , ("Comment", "<v4test@example.org>")+        , ("Comment", "v4 Test User")+        ]+        headers+    let packets = parsePkts payload+        userIds = [u | UserIdPkt u <- packets]+        primarySecretKeys = [(pkp, ska) | SecretKeyPkt pkp ska <- packets]+        secretSubkeys = [(pkp, ska) | SecretSubkeyPkt pkp ska <- packets]+    assertEqual+        "v4 encrypted secret fixture should include expected user IDs"+        ["<v4test@example.org>", "v4 Test User"]+        userIds+    assertEqual+        "v4 encrypted secret fixture should contain one primary secret key packet"+        1+        (length primarySecretKeys)+    assertEqual+        "v4 encrypted secret fixture should contain three encrypted secret subkeys"+        3+        (length secretSubkeys)+    case packets of+        (SecretKeyPkt pkp ska : _) -> do+            assertEqual+                "v4 encrypted secret fixture should contain a v4 primary key"+                V4+                (_keyVersion pkp)+            assertEqual+                "v4 encrypted secret fixture should have the expected primary-key fingerprint"+                (fp "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")+                (fingerprint pkp)+            assertEqual+                "v4 encrypted secret fixture should use EdDSA for its primary key"+                EdDSA+                (_pkalgo pkp)+            assertEncryptedS2K "primary key" ska+            mapM_ (assertEncryptedS2K "subkey" . snd) secretSubkeys+            assertEqual+                "v4 encrypted secret fixture should contain two EdDSA subkeys and one ECDH subkey"+                [EdDSA, EdDSA, ECDH]+                (map (_pkalgo . fst) secretSubkeys)+        _ ->+            assertFailure+                "v4 encrypted secret fixture should start with a secret key packet"+  where+    assertEncryptedS2K :: String -> SKAddendum -> Assertion+    assertEncryptedS2K testLabel ska =+        case ska of+            SUSSHA1 AES256 (IteratedSalted SHA256 _ iter) _ encryptedPayload -> do+                assertEqual+                    (testLabel ++ " should use expected S2K iteration count")+                    (IterationCount 65011712)+                    iter+                if BL.null encryptedPayload+                    then+                        assertFailure+                            (testLabel ++ " should have non-empty encrypted key material")+                    else pure ()+            SUUnencrypted _ _ ->+                assertFailure+                    ( testLabel+                        ++ " should be encrypted, got unencrypted secret material"+                    )+            _ ->+                assertFailure+                    ( testLabel+                        ++ " should be encrypted with SUSSHA1/AES256/IteratedSalted SHA256"+                    )++testV4EncryptedRevocationArmor :: Assertion+testV4EncryptedRevocationArmor = do+    armors <- loadArmor "v4-encrypted.rev.aa"+    armor <-+        case armors of+            [a] -> pure a+            _ ->+                assertFailure+                    "v4 encrypted revocation fixture should contain one armored payload"+                    >> fail "expected one armored payload"+    (headers, payload) <-+        case armor of+            Armor ArmorPublicKeyBlock hs p -> pure (hs, p)+            Armor atype _ _ ->+                assertFailure+                    ( "v4 encrypted revocation fixture should decode as a public key block, got "+                        ++ show atype+                    )+                    >> fail "expected public key block"+            _ ->+                assertFailure+                    "v4 encrypted revocation fixture should decode as an armored payload"+                    >> fail "expected armored payload"+    assertEqual+        "v4 encrypted revocation fixture should keep identifying comments"+        [ ("Comment", "Revocation certificate for")+        , ("Comment", "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")+        , ("Comment", "<v4test@example.org>")+        , ("Comment", "v4 Test User")+        ]+        headers+    let packets = parsePkts payload+    case packets of+        [PublicKeyPkt pkp, SignaturePkt _] -> do+            assertEqual+                "v4 encrypted revocation fixture should contain a v4 public key"+                V4+                (_keyVersion pkp)+            assertEqual+                "v4 encrypted revocation fixture should contain the expected public key fingerprint"+                (fp "D2E0 81E9 3FDC A2E7 8B5F  C433 811D 9243 394B 79C1")+                (fingerprint pkp)+            assertEqual+                "v4 encrypted revocation fixture should use EdDSA for its public key"+                EdDSA+                (_pkalgo pkp)+        _ ->+            assertFailure+                ( "v4 encrypted revocation fixture should contain [PublicKeyPkt, SignaturePkt], got: "+                    ++ show packets+                )++testV6RevocationArmor :: FilePath -> Assertion+testV6RevocationArmor fixture = do+    armors <- loadArmor fixture+    armor <-+        case armors of+            [a] -> pure a+            _ ->+                assertFailure+                    (fixture ++ " fixture should contain one armored payload")+                    >> fail "expected one armored payload"+    payload <-+        case armor of+            Armor ArmorPublicKeyBlock _ p -> pure p+            Armor atype _ _ ->+                assertFailure+                    ( fixture+                        ++ " fixture should decode as a public key block, got "+                        ++ show atype+                    )+                    >> fail "expected public key block"+            _ ->+                assertFailure+                    (fixture ++ " fixture should decode as an armored payload")+                    >> fail "expected armored payload"+    let packets = parsePkts payload+    case packets of+        [PublicKeyPkt pkp, SignaturePkt sig] -> do+            assertEqual+                (fixture ++ " should contain a v6 public key")+                V6+                (_keyVersion pkp)+            case sig of+                SigV6 KeyRevocationSig _ _ _ hashed unhashed _ _ -> do+                    let issuerFps =+                            [ ifp+                            | SigSubPacket _ (IssuerFingerprint IssuerFingerprintV6 ifp) <-+                                hashed ++ unhashed+                            ]+                    if fingerprint pkp `elem` issuerFps+                        then pure ()+                        else+                            assertFailure+                                ( fixture+                                    ++ " should include an IssuerFingerprint v6 matching the public key"+                                )+                _ ->+                    assertFailure+                        (fixture ++ " should contain a SigV6 key-revocation signature")+        _ ->+            assertFailure+                ( fixture+                    ++ " should contain [PublicKeyPkt, SignaturePkt], got: "+                    ++ show packets+                )++testV6RevocationSignatureSaltSemantics :: FilePath -> Assertion+testV6RevocationSignatureSaltSemantics fixture = do+    armors <- loadArmor fixture+    payload <-+        case armors of+            [Armor ArmorPublicKeyBlock _ p] -> pure p+            _ ->+                assertFailure+                    (fixture ++ " should contain one armored public-key payload")+                    >> fail "expected one armored payload"+    let packets = parsePkts payload+    (pkp, sig) <-+        case packets of+            [PublicKeyPkt pk, SignaturePkt sigV6@(SigV6 _ _ _ _ _ _ _ _)] -> pure (pk, sigV6)+            _ ->+                assertFailure+                    ( fixture+                        ++ " should parse as [PublicKeyPkt, SignaturePkt SigV6], got "+                        ++ show packets+                    )+                    >> fail "unexpected revocation fixture packet shape"+    case sig of+        SigV6 _ _ ha salt _ _ _ _ ->+            case expectedV6SaltSizeForTest ha of+                Nothing ->+                    assertFailure+                        ( fixture+                            ++ " uses unsupported v6 signature salt hash algorithm: "+                            ++ show ha+                        )+                Just expected ->+                    assertEqual+                        (fixture ++ " SigV6 salt size should match hash algorithm")+                        expected+                        (fromIntegral (BL.length (unSignatureSalt salt)))+        other ->+            assertFailure+                ( fixture+                    ++ " expected SigV6 revocation signature payload, got: "+                    ++ show other+                )+    assertBool+        ( fixture+            ++ " should include IssuerFingerprint v6 for the revoked key"+        )+        (signatureHasIssuerFingerprintV6 (fingerprint pkp) sig)++testV4RevocationSignatureSemantics :: Assertion+testV4RevocationSignatureSemantics = do+    armors <- loadArmor "v4-encrypted.rev.aa"+    payload <-+        case armors of+            [Armor ArmorPublicKeyBlock _ p] -> pure p+            _ ->+                assertFailure+                    "v4-encrypted.rev.aa should contain one armored public-key payload"+                    >> fail "expected one armored payload"+    let packets = parsePkts payload+    case packets of+        [ PublicKeyPkt _+            , SignaturePkt (SigV4 KeyRevocationSig _ _ hashed unhashed _ _)+            ] -> do+                assertBool+                    "v4-encrypted.rev.aa key-revocation signature should include an Issuer key-id subpacket"+                    (any isIssuerSubpacket (hashed ++ unhashed))+        _ ->+            assertFailure+                ( "v4-encrypted.rev.aa should parse as [PublicKeyPkt, SignaturePkt SigV4 KeyRevocationSig], got "+                    ++ show packets+                )+  where+    isIssuerSubpacket (SigSubPacket _ Issuer {}) = True+    isIssuerSubpacket _ = False++testV6RevocationSignatureRejectsLegacyIssuerKeyID+    :: FilePath -> Assertion+testV6RevocationSignatureRejectsLegacyIssuerKeyID fixture = do+    armors <- loadArmor fixture+    payload <-+        case armors of+            [Armor ArmorPublicKeyBlock _ p] -> pure p+            _ ->+                assertFailure+                    (fixture ++ " should contain one armored public-key payload")+                    >> fail "expected one armored payload"+    let packets = parsePkts payload+    case packets of+        [ PublicKeyPkt _+            , SignaturePkt (SigV6 KeyRevocationSig _ _ _ hashed unhashed _ _)+            ] ->+                assertBool+                    ( fixture+                        ++ " SigV6 key-revocation signature must not include Issuer key-id subpackets"+                    )+                    (all (not . isIssuerSubpacket) (hashed ++ unhashed))+        _ ->+            assertFailure+                ( fixture+                    ++ " should parse as [PublicKeyPkt, SignaturePkt SigV6 KeyRevocationSig]"+                )+  where+    isIssuerSubpacket (SigSubPacket _ Issuer {}) = True+    isIssuerSubpacket _ = False++testRevocationArmorParsesAsSingleTransferableKey+    :: FilePath -> Bool -> Assertion+testRevocationArmorParsesAsSingleTransferableKey fixture expectDirectRevs = do+    armors <- loadArmor fixture+    payload <-+        case armors of+            [Armor ArmorPublicKeyBlock _ p] -> pure p+            _ ->+                assertFailure+                    (fixture ++ " should contain one armored public-key payload")+                    >> fail "expected one armored payload"+    let tks = parseUnknownTKs True (parsePkts payload)+    case tks of+        [tk] -> do+            if expectDirectRevs+                then+                    assertBool+                        ( fixture+                            ++ " transferable key should contain at least one direct-key revocation signature"+                        )+                        (not (null (_tkuRevs tk)))+                else pure ()+            assertEqual+                (fixture ++ " revocation certificate should not carry user IDs")+                []+                (_tkuUIDs tk)+            assertEqual+                ( fixture+                    ++ " revocation certificate should not carry user attributes"+                )+                []+                (_tkuUAts tk)+            assertEqual+                (fixture ++ " revocation certificate should not carry subkeys")+                []+                (_tkuSubs tk)+        _ ->+            assertFailure+                (fixture ++ " should parse into exactly one transferable key")++testMsg1ArmorFixture :: Assertion+testMsg1ArmorFixture = do+    armors <- loadArmor "msg1.asc"+    assertBool+        "msg1.asc should decode to at least one armor block"+        (not (null armors))+    let packetBlocks =+            [ parsePkts payload+            | Armor _ _ payload <- armors+            ]+    assertBool+        "msg1.asc should contain at least one parseable packet block"+        (any (not . null) packetBlocks)++expectedV6SaltSizeForTest :: HashAlgorithm -> Maybe Int+expectedV6SaltSizeForTest =+    fmap fromIntegral . signatureV6SaltSizeForHashAlgorithm++signatureHasIssuerFingerprintV6+    :: Fingerprint -> SignaturePayload -> Bool+signatureHasIssuerFingerprintV6 expectedFp (SigV6 _ _ _ _ hashed unhashed _ _) =+    expectedFp+        `elem` [ ifp+               | SigSubPacket _ (IssuerFingerprint IssuerFingerprintV6 ifp) <-+                    hashed ++ unhashed+               ]+signatureHasIssuerFingerprintV6 _ _ = False++testDefaultedEncryptDecrypt :: Assertion+testDefaultedEncryptDecrypt = do+    let passphrase = mkPassphrase "roundtrip1"+        payload = mkClearPayload "hello from a balloon farm on Mars"+        encryptedResult =+            encryptMessageDefault+                DoNotExposeSessionMaterial+                passphrase+                payload+    encrypted <-+        case encryptedResult of+            Left err ->+                assertFailure ("encryptMessageDefault failed: " ++ show err)+                    >> fail "encryptMessageDefault failed"+            Right (bs, _) -> pure bs+    case parsePkts (encryptedPayloadBytes encrypted) of+        [ SKESKPkt+                (SKESKPayloadV6Packet (SKESKPayloadV6 AES256 OCB _ iv esk tag))+            , SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 6 _ _)+            ] -> do+                assertBool+                    "default SKESK v6 IV should be present"+                    (not (BL.null iv))+                assertBool+                    "default SKESK v6 wrapped session key should be present"+                    (not (BL.null esk))+                assertEqual "default SKESK v6 tag length" 16 (BL.length tag)+        other ->+            assertFailure+                ( "default encryption should emit SKESK v6 + SEIPD v2 packets, got "+                    ++ show other+                )+    decrypted <-+        case decryptMessage passphrase encrypted of+            Left err ->+                assertFailure ("decryptMessage failed: " ++ show err)+                    >> fail "decryptMessage failed"+            Right bs -> pure bs+    assertEqual+        "default encrypt/decrypt payload roundtrip"+        payload+        decrypted++testExplicitEncryptDecrypt :: Assertion+testExplicitEncryptDecrypt = do+    let passphrase = mkPassphrase "roundtrip2"+        payload = mkClearPayload "hello from nonsenseville"+        s2k = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15+        iv = IV "1234567890ABCDEF"+    encrypted <-+        case encryptMessage+            ( RFC9580EncryptMessageOptions+                { rfc9580EncryptMessageExposure = DoNotExposeSessionMaterial+                , rfc9580EncryptMessageSymmetricAlgorithm = AES128+                , rfc9580EncryptMessageS2K = s2k+                , rfc9580EncryptMessageIV = iv+                }+            )+            passphrase+            payload of+            Left err ->+                assertFailure ("micro-managed encryption failed: " ++ show err)+                    >> fail "encryptMessage failed"+            Right (bs, _) -> pure bs+    case parsePkts (encryptedPayloadBytes encrypted) of+        [ SKESKPkt+                ( SKESKPayloadV6Packet+                        (SKESKPayloadV6 AES128 OCB _ packetIv esk tag)+                    )+            , SymEncIntegrityProtectedDataPkt (SEIPD2 AES128 OCB 6 _ _)+            ] -> do+                assertBool+                    "explicit SKESK v6 IV should be present"+                    (not (BL.null packetIv))+                assertBool+                    "explicit SKESK v6 wrapped session key should be present"+                    (not (BL.null esk))+                assertEqual "explicit SKESK v6 tag length" 16 (BL.length tag)+        other ->+            assertFailure+                ( "explicit AES encryption should default to SKESK v6 + SEIPD v2 packets, got "+                    ++ show other+                )+    decrypted <-+        case decryptMessage passphrase encrypted of+            Left err ->+                assertFailure ("decryption failed: " ++ show err)+                    >> fail "decryptMessage failed"+            Right bs -> pure bs+    assertEqual+        "specific encrypt/decrypt payload roundtrip"+        payload+        decrypted++testExplicitEncryptExposesEffectiveSessionMaterial :: Assertion+testExplicitEncryptExposesEffectiveSessionMaterial = do+    let passphraseBytes = "roundtrip2-session-material"+        passphrase = mkPassphrase passphraseBytes+        payload = mkClearPayload "hello from session material town"+        sa = AES128+        s2k = Argon2 (Salt16 (B.pack [0x40 .. 0x4f])) 1 4 15+        iv = IV "ABCDEF1234567890"+    (encrypted, recovered) <-+        case encryptMessage+            ( RFC9580EncryptMessageOptions+                { rfc9580EncryptMessageExposure = ExposeSessionMaterial+                , rfc9580EncryptMessageSymmetricAlgorithm = sa+                , rfc9580EncryptMessageS2K = s2k+                , rfc9580EncryptMessageIV = iv+                }+            )+            passphrase+            payload of+            Left err ->+                assertFailure+                    ("explicit encryption with session material failed: " ++ show err)+                    >> fail "encryptMessage failed"+            Right x -> pure x+    expectedSessionKey <-+        case keySize sa of+            Left err ->+                assertFailure+                    ("failed to derive expected key size: " ++ show err)+                    >> fail "keySize failed"+            Right keyLen ->+                case string2Key s2k keyLen passphraseBytes of+                    Left err ->+                        assertFailure+                            ("failed to derive expected session key: " ++ renderS2KError err)+                            >> fail "string2Key failed"+                    Right bs -> pure bs+    case recovered of+        Just recoveredSessionMaterial -> do+            assertEqual+                "recovered session material algorithm"+                sa+                (recoveredSessionAlgorithm recoveredSessionMaterial)+            assertEqual+                "recovered session material key"+                (SessionKey expectedSessionKey)+                (recoveredSessionKey recoveredSessionMaterial)+        Nothing ->+            assertFailure "expected exposed session material"+    decrypted <-+        case decryptMessage passphrase encrypted of+            Left err ->+                assertFailure ("decryption failed: " ++ show err)+                    >> fail "decryptMessage failed"+            Right bs -> pure bs+    assertEqual+        "session-material exposing encrypt/decrypt payload roundtrip"+        payload+        decrypted++testDefaultEncryptDoesNotExposeSessionMaterial :: Assertion+testDefaultEncryptDoesNotExposeSessionMaterial = do+    let passphrase = mkPassphrase "roundtrip-default-no-session-material"+        payload = mkClearPayload "hello from hidden-session-material town"+    (_, recovered) <-+        do+            let encryptedResult =+                    encryptMessageDefault+                        DoNotExposeSessionMaterial+                        passphrase+                        payload+            case encryptedResult of+                Left err ->+                    assertFailure+                        ("default encryption with exposure mode failed: " ++ show err)+                        >> fail "encryptMessageDefault failed"+                Right x -> pure x+    case recovered of+        Nothing -> pure ()+        Just _ ->+            assertFailure+                "default exposure mode should not return session material"++testExplicitAES128AEADEncryptDecrypt+    :: AEADAlgorithm -> Int -> String -> Assertion+testExplicitAES128AEADEncryptDecrypt aead expectedIvLen label = do+    let passphraseBytes =+            "roundtrip-"+                <> BL.fromStrict (B.pack (map (fromIntegral . fromEnum) label))+        passphrase = mkPassphrase passphraseBytes+        payload =+            mkClearPayload+                ( "hello from "+                    <> BL.fromStrict (B.pack (map (fromIntegral . fromEnum) label))+                )+        s2k = Argon2 (Salt16 (B.pack [0x10 .. 0x1f])) 1 4 15+        salt = Salt (B.pack [0x20 .. 0x3f])+        block =+            Block+                [ LiteralDataPkt BinaryData BL.empty 0 (clearPayloadBytes payload)+                ]+    packets <-+        case encryptSEIPDv2WithSKESKBlock+            AES128+            aead+            6+            salt+            s2k+            passphraseBytes+            block of+            Left err ->+                assertFailure+                    ("AES-128 " ++ label ++ " encryption failed: " ++ err)+                    >> fail "encryptSEIPDv2WithSKESKBlock failed"+            Right ps -> pure ps+    let encrypted = mkEncryptedPayload (runPut (put (Block packets)))+    case parsePkts (encryptedPayloadBytes encrypted) of+        [ SKESKPkt+                ( SKESKPayloadV6Packet+                        (SKESKPayloadV6 AES128 parsedAead _ iv esk tag)+                    )+            , SymEncIntegrityProtectedDataPkt (SEIPD2 AES128 payloadAead 6 _ _)+            ] -> do+                assertEqual+                    ("AES-128 " ++ label ++ " SKESK AEAD")+                    aead+                    parsedAead+                assertEqual+                    ("AES-128 " ++ label ++ " payload AEAD")+                    aead+                    payloadAead+                assertEqual+                    ("AES-128 " ++ label ++ " SKESK v6 IV length")+                    (fromIntegral expectedIvLen)+                    (BL.length iv)+                assertBool+                    ("AES-128 " ++ label ++ " wrapped session key should be present")+                    (not (BL.null esk))+                assertEqual+                    ("AES-128 " ++ label ++ " SKESK tag length")+                    16+                    (BL.length tag)+        other ->+            assertFailure+                ( "AES-128 "+                    ++ label+                    ++ " encryption should emit matching SKESK v6 + SEIPD v2 packets, got "+                    ++ show other+                )+    decrypted <-+        case decryptMessage passphrase encrypted of+            Left err ->+                assertFailure+                    ("AES-128 " ++ label ++ " decryption failed: " ++ show err)+                    >> fail "decryptMessage failed"+            Right bs -> pure bs+    assertEqual+        ("AES-128 " ++ label ++ " payload roundtrip")+        payload+        decrypted++testExplicitAES128EAXEncryptDecrypt :: Assertion+testExplicitAES128EAXEncryptDecrypt = do+    let passphraseBytes = "roundtrip-EAX"+        s2k = Argon2 (Salt16 (B.pack [0x10 .. 0x1f])) 1 4 15+        salt = Salt (B.pack [0x20 .. 0x3f])+        block = Block [LiteralDataPkt BinaryData BL.empty 0 "hello from EAX"]+    case encryptSEIPDv2WithSKESKBlock+        AES128+        EAX+        6+        salt+        s2k+        passphraseBytes+        block of+        Left err+            | "EAX is currently unsupported by the crypton AEAD backend"+                `isInfixOf` err ->+                pure ()+            | otherwise ->+                assertFailure+                    ("expected explicit EAX backend limitation, got: " ++ err)+        Right packets ->+            assertFailure+                ( "expected AES-128 EAX encryption to fail explicitly, got packets: "+                    ++ show packets+                )++testExplicitAES128GCMEncryptDecrypt :: Assertion+testExplicitAES128GCMEncryptDecrypt =+    testExplicitAES128AEADEncryptDecrypt GCM 12 "GCM"++testExplicitEncryptRejectsDeprecatedS2KHash :: Assertion+testExplicitEncryptRejectsDeprecatedS2KHash = do+    let passphrase = mkPassphrase "roundtrip2b"+        payload = mkClearPayload "modern-path deprecated s2k hash rejection"+        s2k = Salted SHA1 (Salt8 "12345678")+        iv = IV "1234567890ABCDEF"+    case encryptMessage+        ( RFC9580EncryptMessageOptions+            { rfc9580EncryptMessageExposure = DoNotExposeSessionMaterial+            , rfc9580EncryptMessageSymmetricAlgorithm = AES128+            , rfc9580EncryptMessageS2K = s2k+            , rfc9580EncryptMessageIV = iv+            }+        )+        passphrase+        payload of+        Left (MessageEncryptError err)+            | "deprecated hash algorithm disallowed for modern message generation"+                `isInfixOf` err ->+                pure ()+            | otherwise ->+                assertFailure+                    ("Expected deprecated modern S2K hash rejection, got: " ++ err)+        Left err ->+            assertFailure+                ( "Expected MessageEncryptError for deprecated modern S2K hash, got "+                    ++ show err+                )+        Right _ ->+            assertFailure+                "Expected encryptMessage AES128 to reject deprecated SHA1 S2K"++testLegacyFallbackEncryptDecrypt :: Assertion+testLegacyFallbackEncryptDecrypt = do+    let passphrase = mkPassphrase "roundtrip3"+        payload = mkClearPayload "hello from legacy town"+        s2k = Salted SHA1 (Salt8 "12345678")+        iv = IV mempty+    encrypted <-+        case encryptMessage+            ( RFC4880EncryptMessageOptions+                { rfc4880EncryptMessageExposure = DoNotExposeSessionMaterial+                , rfc4880EncryptMessageSymmetricAlgorithm = Plaintext+                , rfc4880EncryptMessageS2K = s2k+                , rfc4880EncryptMessageIV = iv+                }+            )+            passphrase+            payload of+            Left err ->+                assertFailure ("legacy fallback encryption failed: " ++ show err)+                    >> fail "encryptMessage fallback failed"+            Right (bs, _) -> pure bs+    case parsePkts (encryptedPayloadBytes encrypted) of+        [ SKESKPkt+                (SKESKPayloadV4Packet (SKESKPayloadV4 Plaintext _ Nothing))+            , SymEncIntegrityProtectedDataPkt (SEIPD1 1 _)+            ] -> pure ()+        other ->+            assertFailure+                ( "non-AES explicit encryption should use RFC4880 SKESKv4 + SEIPDv1 packets, got "+                    ++ show other+                )+    decrypted <-+        case decryptMessage passphrase encrypted of+            Left err ->+                assertFailure ("legacy fallback decryption failed: " ++ show err)+                    >> fail "decryptMessage fallback failed"+            Right bs -> pure bs+    assertEqual+        "legacy fallback encrypt/decrypt payload roundtrip"+        payload+        decrypted++testRFC4880EncryptMessageSEIPDv1ParsesCleanly :: Assertion+testRFC4880EncryptMessageSEIPDv1ParsesCleanly = do+    let passphraseBytes = "legacy-clean-parse" :: BL.ByteString+        passphrase = mkPassphrase passphraseBytes+        payload = mkClearPayload "hello from clean legacy town"+        s2k =+            IteratedSalted SHA256 (Salt8 "saltxyz!") (IterationCount 65536)+        iv = IV "1234567890ABCDEF"+    encrypted <-+        case encryptMessage+            ( RFC4880EncryptMessageOptions+                { rfc4880EncryptMessageExposure = DoNotExposeSessionMaterial+                , rfc4880EncryptMessageSymmetricAlgorithm = AES128+                , rfc4880EncryptMessageS2K = s2k+                , rfc4880EncryptMessageIV = iv+                }+            )+            passphrase+            payload of+            Left err ->+                assertFailure ("RFC4880 encryption failed: " ++ show err)+                    >> fail "encryptMessage failed"+            Right (bs, _) -> pure bs+    packets <-+        case parsePktsEither (encryptedPayloadBytes encrypted) of+            Left err ->+                assertFailure ("encrypted packet parse failed: " ++ show err)+                    >> fail "parsePktsEither failed"+            Right ps -> pure ps+    ciphertext <-+        case packets of+            [ SKESKPkt+                    (SKESKPayloadV4Packet (SKESKPayloadV4 parsedSA parsedS2K Nothing))+                , SymEncIntegrityProtectedDataPkt (SEIPD1 1 payloadBytes)+                ] -> do+                    assertEqual "RFC4880 encrypted SKESK algorithm" AES128 parsedSA+                    assertEqual "RFC4880 encrypted S2K" s2k parsedS2K+                    pure (BL.toStrict payloadBytes)+            other ->+                assertFailure+                    ( "RFC4880 encryption should emit SKESKv4 + SEIPDv1 packets, got "+                        ++ show other+                    )+                    >> fail "unexpected encrypted packet layout"+    keyLen <-+        case keySize AES128 of+            Left err ->+                assertFailure ("keySize failed for AES128: " ++ show err)+                    >> fail "keySize failed"+            Right n -> pure n+    sessionKey <-+        case string2Key s2k keyLen passphraseBytes of+            Left err ->+                assertFailure ("string2Key failed: " ++ renderS2KError err)+                    >> fail "string2Key failed"+            Right keyBytes -> pure keyBytes+    (nonce, decrypted) <-+        case decryptPreservingNonce AES128 ciphertext sessionKey of+            Left err ->+                assertFailure ("decryptPreservingNonce failed: " ++ show err)+                    >> fail "decryptPreservingNonce failed"+            Right out -> pure out+    cleartext <-+        case validateSEIPD1MDC nonce decrypted of+            Left err ->+                assertFailure ("validateSEIPD1MDC failed: " ++ err)+                    >> fail "validateSEIPD1MDC failed"+            Right out -> pure out+    case parsePktsEither (BL.fromStrict cleartext) of+        Right [LiteralDataPkt BinaryData filename timestamp clearPayload] -> do+            assertEqual+                "RFC4880 decrypted literal filename"+                BL.empty+                filename+            assertEqual "RFC4880 decrypted literal timestamp" 0 timestamp+            assertEqual+                "RFC4880 decrypted literal payload"+                (clearPayloadBytes payload)+                clearPayload+        Right other ->+            assertFailure+                ( "RFC4880 decrypted cleartext should contain exactly one literal packet, got "+                    ++ show other+                )+        Left err ->+            assertFailure+                ( "RFC4880 decrypted cleartext should parse without trailing junk, got "+                    ++ show err+                )++testDecryptMessageTypedParseFailure :: Assertion+testDecryptMessageTypedParseFailure = do+    let passphrase = mkPassphrase "unused"+        encrypted = mkEncryptedPayload BL.empty+    case decryptMessage passphrase encrypted of+        Left (MessageParseFailureError MissingEncryptedMessage) -> pure ()+        Left err ->+            assertFailure+                ( "Expected MissingEncryptedMessage parse failure, got "+                    ++ show err+                )+        Right clear ->+            assertFailure+                ("Expected parse failure, got payload " ++ show clear)++testDecryptMessageRejectsUnknownCriticalPacket :: Assertion+testDecryptMessageRejectsUnknownCriticalPacket = do+    let passphrase = mkPassphrase "unused"+        encrypted =+            mkEncryptedPayload . runPut . put $+                Block [OtherPacketPkt 39 "unknown-critical"]+    case decryptMessage passphrase encrypted of+        Left (MessageParseFailureError (UnknownCriticalPacketType 39)) -> pure ()+        Left err ->+            assertFailure+                ( "Expected UnknownCriticalPacketType 39 parse failure, got "+                    ++ show err+                )+        Right clear ->+            assertFailure+                ( "Expected unknown critical packet rejection, got payload "+                    ++ show clear+                )++testDecryptMessageTypedDecryptFailure :: Assertion+testDecryptMessageTypedDecryptFailure = do+    let correctPassphrase = mkPassphrase "correct passphrase"+        wrongPassphrase = mkPassphrase "wrong passphrase"+        payload = mkClearPayload "typed decrypt failure payload"+        encryptedResult =+            encryptMessageDefault+                DoNotExposeSessionMaterial+                correctPassphrase+                payload+    encrypted <-+        case encryptedResult of+            Left err ->+                assertFailure ("encryptMessageDefault failed: " ++ show err)+                    >> fail "encryptMessageDefault failed"+            Right (bs, _) -> pure bs+    case decryptMessage wrongPassphrase encrypted of+        Left (MessageDecryptFailureError (PayloadDecryptFailed _)) -> pure ()+        Left+            (MessageDecryptFailureError (SessionMaterialDerivationFailed _)) -> pure ()+        Left err ->+            assertFailure+                ("Expected typed decrypt failure, got " ++ show err)+        Right clear ->+            assertFailure+                ("Expected decrypt failure, got payload " ++ show clear)++testDecryptMessageSEIPDv1MDCTampering :: Assertion+testDecryptMessageSEIPDv1MDCTampering = do+    let passphrase = mkPassphrase "mdc-tamper-test"+        payload = mkClearPayload "payload for MDC tampering test"+        s2k =+            IteratedSalted SHA256 (Salt8 "saltxyz!") (IterationCount 65536)+        iv = IV "1234567890ABCDEF"+    encrypted <-+        case encryptMessage+            ( RFC4880EncryptMessageOptions+                { rfc4880EncryptMessageExposure =+                    DoNotExposeSessionMaterial+                , rfc4880EncryptMessageSymmetricAlgorithm = AES128+                , rfc4880EncryptMessageS2K = s2k+                , rfc4880EncryptMessageIV = iv+                }+            )+            passphrase+            payload of+            Left err ->+                assertFailure ("SEIPDv1 encryption failed: " ++ show err)+                    >> fail "encryptMessage failed"+            Right (bs, _) -> pure bs+    let raw = encryptedPayloadBytes encrypted+        midpoint = BL.length raw `div` 2+        tampered =+            BL.take midpoint raw+                <> BL.cons+                    (BL.head (BL.drop midpoint raw) `xor` 0xFF)+                    (BL.drop (midpoint + 1) raw)+    case decryptMessage passphrase (mkEncryptedPayload tampered) of+        Left (MessageDecryptFailureError (PayloadDecryptFailed msg))+            | "MDC" `isInfixOf` msg -> pure ()+            | otherwise ->+                assertFailure+                    ("Expected MDC-related PayloadDecryptFailed, got: " ++ msg)+        Left err ->+            assertFailure+                ("Expected PayloadDecryptFailed with MDC error, got: " ++ show err)+        Right _ ->+            assertFailure+                "Expected MDC tampering rejection, but decryption succeeded"++testSignMessageShape :: Assertion+testSignMessageShape = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    signerV4 <- expectV4PKPayload "RSA v4 signer" signer+    signedResult <-+        signMessageWith+            (mkRSASignerV4 signerV4 signingKey)+            (mkClearPayload "message-api signing payload")+    signedMessage <-+        case signedResult of+            Left err ->+                assertFailure ("message signing failed: " ++ show err)+                    >> pure mempty+            Right bs -> pure bs+    case parsePkts signedMessage of+        [LiteralDataPkt {}, SignaturePkt _] -> pure ()+        _ ->+            assertFailure+                "signing output should contain literal data and one signature packet"++testSignMessageRSAV6 :: Assertion+testSignMessageRSAV6 = do+    (signer, signingKey) <- loadUnencryptedRsaSignerV6+    signerV6 <- expectV6PKPayload "RSA v6 signer" signer+    let payload = "message-api signing payload with RSA SigV6"+    signedResult <-+        signMessageWith+            (mkRSASignerV6 signerV6 signingKey)+            (mkClearPayload payload)+    signedMessage <-+        case signedResult of+            Left err ->+                assertFailure ("RSA SigV6 message signing failed: " ++ show err)+                    >> pure mempty+            Right bs -> pure bs+    signaturePkt <-+        case parsePkts signedMessage of+            [ LiteralDataPkt {}+                , sig@(SignaturePkt (SigV6 BinarySig RSA SHA512 salt _ _ _ _))+                ] -> do+                    assertEqual+                        "SigV6 RSA salt must be 32 bytes for SHA512"+                        32+                        (BL.length (unSignatureSalt salt))+                    pure sig+            other ->+                assertFailure+                    ( "RSA SigV6 signing output should contain [LiteralDataPkt, RSA SigV6], got "+                        ++ show other+                    )+                    >> fail "unexpected RSA SigV6 signMessage output shape"+    let state =+            emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}+        keyring = [TKUnknown (signer, Nothing) [] [] [] []]+    case verifySigWith+        defaultVerificationPolicy+        (verifyAgainstKeys keyring)+        signaturePkt+        state+        Nothing of+        Left err ->+            assertFailure+                ( "RSA SigV6 signed message verification failed: "+                    ++ renderVerificationError err+                )+        Right _ -> pure ()++testSignMessageEd25519 :: Assertion+testSignMessageEd25519 = do+    (signer, signingKey) <- loadDeterministicEd25519Signer+    signerV4 <- expectV4PKPayload "Ed25519 v4 signer" signer+    let payload = "message-api signing payload with Ed25519"+    signedResult <-+        signMessageWith+            (mkEd25519SignerV4 signerV4 signingKey)+            (mkClearPayload payload)+    signedMessage <-+        case signedResult of+            Left err ->+                assertFailure ("Ed25519 message signing failed: " ++ show err)+                    >> pure mempty+            Right bs -> pure bs+    signaturePkt <-+        case parsePkts signedMessage of+            [ LiteralDataPkt {}+                , sig@(SignaturePkt (SigV4 BinarySig PKA.Ed25519 SHA512 _ _ _ _))+                ] ->+                    pure sig+            other ->+                assertFailure+                    ( "Ed25519 signing output should contain [LiteralDataPkt, Ed25519 SigV4], got "+                        ++ show other+                    )+                    >> fail "unexpected Ed25519 signMessage output shape"+    let state =+            emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}+        keyring = [TKUnknown (signer, Nothing) [] [] [] []]+    case verifySigWith+        defaultVerificationPolicy+        (verifyAgainstKeys keyring)+        signaturePkt+        state+        Nothing of+        Left err ->+            assertFailure+                ( "Ed25519 signed message verification failed: "+                    ++ renderVerificationError err+                )+        Right _ -> pure ()++testSignMessageEd25519V6 :: Assertion+testSignMessageEd25519V6 = do+    (signer, signingKey) <- loadDeterministicEd25519SignerV6+    signerV6 <- expectV6PKPayload "Ed25519 v6 signer" signer+    let payload = "message-api signing payload with Ed25519 SigV6"+    signedResult <-+        signMessageWith+            (mkEd25519SignerV6 signerV6 signingKey)+            (mkClearPayload payload)+    signedMessage <-+        case signedResult of+            Left err ->+                assertFailure+                    ("Ed25519 SigV6 message signing failed: " ++ show err)+                    >> pure mempty+            Right bs -> pure bs+    signaturePkt <-+        case parsePkts signedMessage of+            [ LiteralDataPkt {}+                , sig@(SignaturePkt (SigV6 BinarySig PKA.Ed25519 SHA512 salt _ _ _ _))+                ] -> do+                    assertEqual+                        "SigV6 Ed25519 salt must be 32 bytes for SHA512"+                        32+                        (BL.length (unSignatureSalt salt))+                    pure sig+            other ->+                assertFailure+                    ( "Ed25519 SigV6 signing output should contain [LiteralDataPkt, Ed25519 SigV6], got "+                        ++ show other+                    )+                    >> fail "unexpected Ed25519 SigV6 signMessage output shape"+    case signaturePkt of+        SignaturePkt (SigV6 BinarySig PKA.Ed25519 SHA512 _ _ _ _ _) -> do+            let state =+                    emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}+                keyring = [TKUnknown (signer, Nothing) [] [] [] []]+            case verifySigWith+                defaultVerificationPolicy+                (verifyAgainstKeys keyring)+                signaturePkt+                state+                Nothing of+                Left err ->+                    assertFailure+                        ( "Ed25519 SigV6 signed message verification failed: "+                            ++ renderVerificationError err+                        )+                Right _ -> pure ()+        _ -> assertFailure "expected an Ed25519 SigV6 signature packet"++testV4Ed25519LegacyKeyRejectsMissingPrefix :: Assertion+testV4Ed25519LegacyKeyRejectsMissingPrefix = do+    let legacyEd25519Oid = B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0xDA, 0x47, 0x0F, 0x01]+        rawEd25519Public = B.replicate 32 0x01+        encoded =+            runPut $ do+                putWord8 4+                putWord32be 0+                putWord8 (fromFVal EdDSA)+                putWord8 (fromIntegral (B.length legacyEd25519Oid))+                putByteString legacyEd25519Oid+                putWord16be 256+                putByteString rawEd25519Public+    case runGetOrFail (get :: Get SomePKPayload) encoded of+        Left (_, _, err) ->+            assertBool+                ("expected invalid-legacy-point parse failure, got: " ++ err)+                ("invalid Ed25519Legacy public key" `isInfixOf` err)+        Right _ ->+            assertFailure+                "legacy Ed25519 key without 0x40 prefix should be rejected"++testSignMessageEd448 :: Assertion+testSignMessageEd448 = do+    (signer, signingKey) <- loadDeterministicEd448Signer+    signerV4 <- expectV4PKPayload "Ed448 v4 signer" signer+    let payload = "message-api signing payload with Ed448"+    signedResult <-+        signMessageWith+            (mkEd448SignerV4 signerV4 signingKey)+            (mkClearPayload payload)+    signedMessage <-+        case signedResult of+            Left err ->+                assertFailure ("Ed448 message signing failed: " ++ show err)+                    >> pure mempty+            Right bs -> pure bs+    signaturePkt <-+        case parsePkts signedMessage of+            [ LiteralDataPkt {}+                , sig@(SignaturePkt (SigV4 BinarySig PKA.Ed448 SHA512 _ _ _ _))+                ] ->+                    pure sig+            other ->+                assertFailure+                    ( "Ed448 signing output should contain [LiteralDataPkt, Ed448 SigV4], got "+                        ++ show other+                    )+                    >> fail "unexpected Ed448 signMessage output shape"+    let state =+            emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}+        keyring = [TKUnknown (signer, Nothing) [] [] [] []]+    case verifySigWith+        defaultVerificationPolicy+        (verifyAgainstKeys keyring)+        signaturePkt+        state+        Nothing of+        Left err ->+            assertFailure+                ( "Ed448 signed message verification failed: "+                    ++ renderVerificationError err+                )+        Right _ -> pure ()++testSignMessageEd448V6 :: Assertion+testSignMessageEd448V6 = do+    (signer, signingKey) <- loadDeterministicEd448SignerV6+    signerV6 <- expectV6PKPayload "Ed448 v6 signer" signer+    let payload = "message-api signing payload with Ed448 SigV6"+    signedResult <-+        signMessageWith+            (mkEd448SignerV6 signerV6 signingKey)+            (mkClearPayload payload)+    signedMessage <-+        case signedResult of+            Left err ->+                assertFailure+                    ("Ed448 SigV6 message signing failed: " ++ show err)+                    >> pure mempty+            Right bs -> pure bs+    signaturePkt <-+        case parsePkts signedMessage of+            [ LiteralDataPkt {}+                , sig@(SignaturePkt (SigV6 BinarySig PKA.Ed448 SHA512 salt _ _ _ _))+                ] -> do+                    assertEqual+                        "SigV6 Ed448 salt must be 32 bytes for SHA512"+                        32+                        (BL.length (unSignatureSalt salt))+                    pure sig+            other ->+                assertFailure+                    ( "Ed448 SigV6 signing output should contain [LiteralDataPkt, Ed448 SigV6], got "+                        ++ show other+                    )+                    >> fail "unexpected Ed448 SigV6 signMessage output shape"+    case signaturePkt of+        SignaturePkt (SigV6 BinarySig PKA.Ed448 SHA512 _ _ _ _ _) -> pure ()+        _ -> assertFailure "expected an Ed448 SigV6 signature packet"++testV4EdSignaturesUseNativeFixedWidthEncoding :: Assertion+testV4EdSignaturesUseNativeFixedWidthEncoding = do+    (_, ed25519SigningKey) <- loadDeterministicEd25519Signer+    ed25519Sig <-+        case signDataWithEd25519+            BinarySig+            ed25519SigningKey+            []+            []+            "v4 ed25519 encoding" of+            Left err ->+                assertFailure+                    ("Ed25519 v4 signing failed: " ++ renderSignError err)+                    >> fail "expected Ed25519 signature"+            Right sig -> pure sig+    case extractV4SignatureAlgorithmFields (runPut (put ed25519Sig)) of+        Left err ->+            assertFailure+                ( "failed to decode serialized Ed25519 v4 signature payload: "+                    ++ err+                )+        Right (pka, algorithmFields) -> do+            assertEqual+                "Ed25519 v4 signature packet algorithm id"+                PKA.Ed25519+                pka+            assertEqual+                "Ed25519 v4 algorithm field width"+                64+                (B.length algorithmFields)++    (_, ed448SigningKey) <- loadDeterministicEd448Signer+    ed448Sig <-+        case signDataWithEd448+            BinarySig+            ed448SigningKey+            []+            []+            "v4 ed448 encoding" of+            Left err ->+                assertFailure+                    ("Ed448 v4 signing failed: " ++ renderSignError err)+                    >> fail "expected Ed448 signature"+            Right sig -> pure sig+    case extractV4SignatureAlgorithmFields (runPut (put ed448Sig)) of+        Left err ->+            assertFailure+                ("failed to decode serialized Ed448 v4 signature payload: " ++ err)+        Right (pka, algorithmFields) -> do+            assertEqual+                "Ed448 v4 signature packet algorithm id"+                PKA.Ed448+                pka+            assertEqual+                "Ed448 v4 algorithm field width"+                114+                (B.length algorithmFields)++testVerifyDetachedEd25519WithoutIssuerHints :: Assertion+testVerifyDetachedEd25519WithoutIssuerHints = do+    (signer, signingKey) <- loadDeterministicEd25519Signer+    let payload = "detached v4 eddsa payload without issuer hints"+        state =+            emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}+        keyring = mkTestKeyring [TKUnknown (signer, Nothing) [] [] [] []]+    sigPayload <-+        case signDataWithEd25519 BinarySig signingKey [] [] payload of+            Left err ->+                assertFailure+                    ("Ed25519 detached signing failed: " ++ renderSignError err)+                    >> fail (renderSignError err)+            Right sig -> pure sig+    case verifySigWith+        defaultVerificationPolicy+        (verifyAgainstKeyring keyring)+        (SignaturePkt sigPayload)+        state+        Nothing of+        Left err ->+            assertFailure+                ( "Ed25519 detached verification without issuer hints failed: "+                    ++ renderVerificationError err+                )+        Right _ -> pure ()++testVerifyDetachedEd25519WithFakeIssuerHint :: Assertion+testVerifyDetachedEd25519WithFakeIssuerHint = do+    (signer, signingKey) <- loadDeterministicEd25519Signer+    let payload = "detached v4 eddsa payload with fake issuer hint"+        state =+            emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}+        keyring = mkTestKeyring [TKUnknown (signer, Nothing) [] [] [] []]+        fakeIssuer = EightOctetKeyId "\x01\x23\x45\x67\x89\xab\xcd\xef"+        unhashed = [SigSubPacket False (Issuer fakeIssuer)]+    sigPayload <-+        case signDataWithEd25519 BinarySig signingKey [] unhashed payload of+            Left err ->+                assertFailure+                    ("Ed25519 detached signing failed: " ++ renderSignError err)+                    >> fail (renderSignError err)+            Right sig -> pure sig+    case verifySigWith+        defaultVerificationPolicy+        (verifyAgainstKeyring keyring)+        (SignaturePkt sigPayload)+        state+        Nothing of+        Left err ->+            assertFailure+                ( "Ed25519 detached verification with fake issuer hint failed: "+                    ++ renderVerificationError err+                )+        Right _ -> pure ()++testVerifyDetachedEd25519WithoutIssuerHintsAgainstKeys+    :: Assertion+testVerifyDetachedEd25519WithoutIssuerHintsAgainstKeys = do+    (signer, signingKey) <- loadDeterministicEd25519Signer+    let payload =+            "detached v4 eddsa payload without issuer hints (verifyAgainstKeys)"+        state =+            emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}+        keys = [TKUnknown (signer, Nothing) [] [] [] []]+    sigPayload <-+        case signDataWithEd25519 BinarySig signingKey [] [] payload of+            Left err ->+                assertFailure+                    ("Ed25519 detached signing failed: " ++ renderSignError err)+                    >> fail (renderSignError err)+            Right sig -> pure sig+    case verifySigWith+        defaultVerificationPolicy+        (verifyAgainstKeys keys)+        (SignaturePkt sigPayload)+        state+        Nothing of+        Left err ->+            assertFailure+                ( "Ed25519 detached verification against keys without issuer hints failed: "+                    ++ renderVerificationError err+                )+        Right _ -> pure ()++testVerifyDetachedEd25519WithFakeIssuerHintAgainstKeys+    :: Assertion+testVerifyDetachedEd25519WithFakeIssuerHintAgainstKeys = do+    (signer, signingKey) <- loadDeterministicEd25519Signer+    let payload =+            "detached v4 eddsa payload with fake issuer hint (verifyAgainstKeys)"+        state =+            emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}+        keys = [TKUnknown (signer, Nothing) [] [] [] []]+        fakeIssuer = EightOctetKeyId "\x01\x23\x45\x67\x89\xab\xcd\xef"+        unhashed = [SigSubPacket False (Issuer fakeIssuer)]+    sigPayload <-+        case signDataWithEd25519 BinarySig signingKey [] unhashed payload of+            Left err ->+                assertFailure+                    ("Ed25519 detached signing failed: " ++ renderSignError err)+                    >> fail (renderSignError err)+            Right sig -> pure sig+    case verifySigWith+        defaultVerificationPolicy+        (verifyAgainstKeys keys)+        (SignaturePkt sigPayload)+        state+        Nothing of+        Left err ->+            assertFailure+                ( "Ed25519 detached verification against keys with fake issuer hint failed: "+                    ++ renderVerificationError err+                )+        Right _ -> pure ()++testCanonicalTextSigPayloadNormalization :: Assertion+testCanonicalTextSigPayloadNormalization = do+    let state =+            emptyPSC+                { lastLD =+                    LiteralDataPkt+                        TextData+                        BL.empty+                        (ThirtyTwoBitTimeStamp 0)+                        "line1 \t\nline2\t \rline3\t \r\nline4 \t"+                }+    assertEqual+        "Binary signatures preserve original line endings"+        "line1 \t\nline2\t \rline3\t \r\nline4 \t"+        (payloadForSig BinarySig state)+    assertEqual+        "Canonical text signatures normalize line endings and trim trailing whitespace"+        "line1\r\nline2\r\nline3\r\nline4"+        (payloadForSig CanonicalTextSig state)++testTextNormalizationModes :: Assertion+testTextNormalizationModes = do+    let state =+            emptyPSC+                { lastLD =+                    LiteralDataPkt+                        TextData+                        BL.empty+                        (ThirtyTwoBitTimeStamp 0)+                        "line1 \t\nline2\t \r\nline3"+                }+    let cleartextResult = payloadForSigWith CleartextCompat CanonicalTextSig state+        strictResult = payloadForSigWith RFC9580Strict CanonicalTextSig state+    assertEqual+        "CleartextCompat mode strips trailing whitespace per line"+        "line1\r\nline2\r\nline3"+        cleartextResult+    assertEqual+        "RFC9580Strict mode preserves trailing whitespace (CRLF-only normalization)"+        "line1 \t\r\nline2\t \r\nline3"+        strictResult+    (signer, signingKey) <- loadUnencryptedRsaSigner+    issuerKeyId <-+        case eightOctetKeyID signer of+            Left err ->+                assertFailure ("failed to derive issuer key id: " ++ err)+                    >> fail "expected issuer key id"+            Right i -> pure i+    let payload = "line with trailing space \nno trailing space\n"+        hashed =+            [ SigSubPacket+                False+                (IssuerFingerprint IssuerFingerprintV4 (fingerprint signer))+            ]+        unhashed = [SigSubPacket False (Issuer issuerKeyId)]+        builderCompat = sigBuilderInit @'PKA.RSA CanonicalTextSig SHA512+        builderStrict =+            (sigBuilderInit @'PKA.RSA CanonicalTextSig SHA512)+                { sbTextNormMode = RFC9580Strict+                }+        withSubs b =+            addUnhashedSubs+                (listToUnhashedSubs unhashed)+                (addHashedSubs (listToHashedSubs hashed) b)+        bc = withSubs builderCompat+        bs = withSubs builderStrict+    sigCompat <- case signDataWithRSABuilder bc signingKey payload of+        Left err ->+            assertFailure+                ("CleartextCompat sign failed: " ++ renderSignError err)+                >> fail ""+        Right s -> pure s+    sigStrict <- case signDataWithRSABuilder bs signingKey payload of+        Left err ->+            assertFailure+                ("RFC9580Strict sign failed: " ++ renderSignError err)+                >> fail ""+        Right s -> pure s+    assertBool+        "CleartextCompat and RFC9580Strict produce different signatures for payloads with trailing whitespace"+        (sigCompat /= sigStrict)++testCanonicalTextSignatureSigningPaths :: Assertion+testCanonicalTextSignatureSigningPaths = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    issuerKeyId <-+        case eightOctetKeyID signer of+            Left err ->+                assertFailure ("failed to derive issuer key id: " ++ err)+                    >> fail "expected issuer key id"+            Right i -> pure i+    let mixedPayload = "line1 \t\nline2\t \rline3\t \r\nline4 \t"+        normalizedPayload = "line1\r\nline2\r\nline3\r\nline4"+        hashed =+            [ SigSubPacket+                False+                (IssuerFingerprint IssuerFingerprintV4 (fingerprint signer))+            ]+        unhashed = [SigSubPacket False (Issuer issuerKeyId)]+    primitiveMixed <-+        case signDataWithRSA+            CanonicalTextSig+            signingKey+            hashed+            unhashed+            mixedPayload of+            Left err ->+                assertFailure+                    ( "canonical text primitive signing failed: "+                        ++ renderSignError err+                    )+                    >> fail (renderSignError err)+            Right sig -> pure sig+    primitiveNormalized <-+        case signDataWithRSA+            CanonicalTextSig+            signingKey+            hashed+            unhashed+            normalizedPayload of+            Left err ->+                assertFailure+                    ( "canonical text primitive signing (normalized payload) failed: "+                        ++ renderSignError err+                    )+                    >> fail (renderSignError err)+            Right sig -> pure sig+    assertEqual+        "primitive canonical text signing should normalize mixed line endings"+        primitiveNormalized+        primitiveMixed++    let builder = sigBuilderInit @'PKA.RSA CanonicalTextSig SHA512+        withHashed = addHashedSubs (listToHashedSubs hashed) builder+        withUnhashed = addUnhashedSubs (listToUnhashedSubs unhashed) withHashed+    builderMixed <-+        case signDataWithRSABuilder withUnhashed signingKey mixedPayload of+            Left err ->+                assertFailure+                    ("canonical text builder signing failed: " ++ renderSignError err)+                    >> fail (renderSignError err)+            Right sig -> pure sig+    builderNormalized <-+        case signDataWithRSABuilder withUnhashed signingKey normalizedPayload of+            Left err ->+                assertFailure+                    ( "canonical text builder signing (normalized payload) failed: "+                        ++ renderSignError err+                    )+                    >> fail (renderSignError err)+            Right sig -> pure sig+    assertEqual+        "builder canonical text signing should normalize mixed line endings"+        builderNormalized+        builderMixed++testSignaturePrimitives :: Assertion+testSignaturePrimitives = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    let userId = UserId "primitive-api@example.org"+        assertSigType+            :: String+            -> SigType+            -> Either SignError SignaturePayload+            -> Assertion+        assertSigType testLabel expected result =+            case result of+                Left err ->+                    assertFailure (testLabel ++ " failed: " ++ renderSignError err)+                Right (SigV4 sigType _ _ _ _ _ _) ->+                    assertEqual+                        (testLabel ++ " uses expected signature type")+                        expected+                        sigType+                Right _ ->+                    assertFailure+                        (testLabel ++ " should generate a V4 signature payload")+    assertSigType+        "certification signature"+        GenericCert+        ( signCertificationWithRSA+            GenericCert+            signer+            userId+            []+            []+            signingKey+        )+    assertSigType+        "key revocation signature"+        KeyRevocationSig+        (signKeyRevocationWithRSA signer [] [] signingKey)+    assertSigType+        "subkey revocation signature"+        SubkeyRevocationSig+        (signSubkeyRevocationWithRSA signer signer [] [] signingKey)+    assertSigType+        "certification revocation signature"+        CertRevocationSig+        (signCertRevocationWithRSA signer userId [] [] signingKey)+    let left16Payload = "left16 primitive payload"+        left16Keyring = mkTestKeyring [TKUnknown (signer, Nothing) [] [] [] []]+    left16Sig <-+        case signDataWithRSA BinarySig signingKey [] [] left16Payload of+            Left err ->+                assertFailure+                    ( "RSA primitive signing for left16 failed: "+                        ++ renderSignError err+                    )+                    >> fail "expected RSA signature payload"+            Right sigPayload -> pure sigPayload+    case verifyAgainstKeyring+        left16Keyring+        (SignaturePkt left16Sig)+        Nothing+        left16Payload of+        Right _ -> pure ()+        Left err ->+            assertFailure+                ( "fresh RSA signature should verify with matching left16, got: "+                    ++ renderVerificationError err+                )+    let tamperedLeft16Sig =+            case left16Sig of+                SigV4 st pka ha hs us l16 mpis -> SigV4 st pka ha hs us (l16 + 1) mpis+                other -> other+    case verifyAgainstKeyring+        left16Keyring+        (SignaturePkt tamperedLeft16Sig)+        Nothing+        left16Payload of+        Left _ -> pure ()+        Right _ ->+            assertFailure+                "verification unexpectedly succeeded with tampered left16"+    if isRight+        ( signCertificationWithRSA+            KeyRevocationSig+            signer+            userId+            []+            []+            signingKey+        )+        then+            assertFailure+                "certification primitive should reject non-certification signature types"+        else pure ()+    (edSigner, edSigningKey) <- loadDeterministicEd25519Signer+    edIssuerKeyId <-+        case eightOctetKeyID edSigner of+            Left err ->+                assertFailure ("failed to derive Ed25519 issuer key id: " ++ err)+                    >> fail "expected Ed25519 issuer key id"+            Right i -> pure i+    let edPayload = "primitive Ed25519 payload"+        edHashed =+            [ SigSubPacket+                False+                (IssuerFingerprint IssuerFingerprintV4 (fingerprint edSigner))+            ]+        edUnhashed = [SigSubPacket False (Issuer edIssuerKeyId)]+    case signDataWithEd25519+        BinarySig+        edSigningKey+        edHashed+        edUnhashed+        edPayload of+        Left err ->+            assertFailure+                ("Ed25519 primitive signing failed: " ++ renderSignError err)+        Right (SigV4 BinarySig PKA.Ed25519 SHA512 _ _ _ _) -> pure ()+        Right other ->+            assertFailure+                ( "Ed25519 primitive should generate an Ed25519 SigV4 payload, got "+                    ++ show other+                )+    let v6Salt = SignatureSalt (BL.replicate 32 0x42)+    case signDataWithEd25519V6+        BinarySig+        v6Salt+        edSigningKey+        edHashed+        edUnhashed+        edPayload of+        Left err ->+            assertFailure+                ("Ed25519 SigV6 primitive signing failed: " ++ renderSignError err)+        Right (SigV6 BinarySig PKA.Ed25519 SHA512 salt _ _ _ _) ->+            assertEqual+                "Ed25519 SigV6 primitive should preserve 32-byte salt"+                32+                (BL.length (unSignatureSalt salt))+        Right other ->+            assertFailure+                ( "Ed25519 SigV6 primitive should generate an Ed25519 SigV6 payload, got "+                    ++ show other+                )+    (ed448Signer, ed448SigningKey) <- loadDeterministicEd448Signer+    ed448IssuerKeyId <-+        case eightOctetKeyID ed448Signer of+            Left err ->+                assertFailure ("failed to derive Ed448 issuer key id: " ++ err)+                    >> fail "expected Ed448 issuer key id"+            Right i -> pure i+    let ed448Payload = "primitive Ed448 payload"+        ed448Hashed =+            [ SigSubPacket+                False+                (IssuerFingerprint IssuerFingerprintV4 (fingerprint ed448Signer))+            ]+        ed448Unhashed = [SigSubPacket False (Issuer ed448IssuerKeyId)]+    case signDataWithEd448+        BinarySig+        ed448SigningKey+        ed448Hashed+        ed448Unhashed+        ed448Payload of+        Left err ->+            assertFailure+                ("Ed448 primitive signing failed: " ++ renderSignError err)+        Right (SigV4 BinarySig PKA.Ed448 SHA512 _ _ _ _) -> pure ()+        Right other ->+            assertFailure+                ( "Ed448 primitive should generate an Ed448 SigV4 payload, got "+                    ++ show other+                )+    case signDataWithEd448V6+        BinarySig+        v6Salt+        ed448SigningKey+        ed448Hashed+        ed448Unhashed+        ed448Payload of+        Left err ->+            assertFailure+                ("Ed448 SigV6 primitive signing failed: " ++ renderSignError err)+        Right (SigV6 BinarySig PKA.Ed448 SHA512 salt _ _ _ _) ->+            assertEqual+                "Ed448 SigV6 primitive should preserve 32-byte salt"+                32+                (BL.length (unSignatureSalt salt))+        Right other ->+            assertFailure+                ( "Ed448 SigV6 primitive should generate an Ed448 SigV6 payload, got "+                    ++ show other+                )++testSignatureDataKindsCoercions :: Assertion+testSignatureDataKindsCoercions = do+    let sigV3 =+            SigV3+                BinarySig+                (ThirtyTwoBitTimeStamp 1)+                (EightOctetKeyId "\x01\x02\x03\x04\x05\x06\x07\x08")+                RSA+                SHA256+                0+                (NE.fromList [MPI 1])+        sigV4 =+            SigV4+                BinarySig+                RSA+                SHA256+                []+                []+                0+                (NE.fromList [MPI 2])+        sigV6 =+            SigV6+                BinarySig+                PKA.Ed25519+                SHA512+                (SignatureSalt (BL.replicate 32 0x01))+                []+                []+                0+                (NE.fromList [MPI 3, MPI 4])+        sigOther = SigVOther 77 "opaque-signature-body"+        assertPacketRoundTrip label expected pkt =+            case fromPktEitherSomeSignatureV pkt of+                Left err -> assertFailure (label ++ " packet coercion failed: " ++ err)+                Right (SomeSignatureV typedSig) ->+                    assertEqual+                        (label ++ " packet coercion preserves payload")+                        expected+                        (signaturePayloadFromSignatureV typedSig)+    assertBool+        "toSomeSignaturePayload should preserve SigV3 witness"+        (isRight (asSignaturePayloadV3 sigV3))+    assertBool+        "toSomeSignaturePayload should preserve SigV4 witness"+        (isRight (asSignaturePayloadV4 sigV4))+    assertBool+        "toSomeSignaturePayload should preserve SigV6 witness"+        (isRight (asSignaturePayloadV6 sigV6))+    assertBool+        "toSomeSignaturePayload should preserve SigVOther witness"+        (isRight (asSignaturePayloadOther sigOther))+    case asSignaturePayloadV3 sigV3 of+        Left err ->+            assertFailure+                ("asSignaturePayloadV3 should accept SigV3: " ++ err)+        Right typed ->+            assertEqual+                "asSignaturePayloadV3 round-trips SigV3"+                sigV3+                (toSignaturePayload typed)+    case asSignaturePayloadV4 sigV4 of+        Left err ->+            assertFailure+                ("asSignaturePayloadV4 should accept SigV4: " ++ err)+        Right typed ->+            assertEqual+                "asSignaturePayloadV4 round-trips SigV4"+                sigV4+                (toSignaturePayload typed)+    case asSignaturePayloadV6 sigV6 of+        Left err ->+            assertFailure+                ("asSignaturePayloadV6 should accept SigV6: " ++ err)+        Right typed ->+            assertEqual+                "asSignaturePayloadV6 round-trips SigV6"+                sigV6+                (toSignaturePayload typed)+    case asSignaturePayloadOther sigOther of+        Left err ->+            assertFailure+                ("asSignaturePayloadOther should accept SigVOther: " ++ err)+        Right typed ->+            assertEqual+                "asSignaturePayloadOther round-trips SigVOther"+                sigOther+                (toSignaturePayload typed)+    assertBool+        "asSignaturePayloadV6 rejects SigV4"+        (not (isRight (asSignaturePayloadV6 sigV4)))+    assertBool+        "asSignaturePayloadV4 rejects SigVOther"+        (not (isRight (asSignaturePayloadV4 sigOther)))+    assertPacketRoundTrip "SigV3" sigV3 (SignaturePkt sigV3)+    assertPacketRoundTrip "SigV4" sigV4 (SignaturePkt sigV4)+    assertPacketRoundTrip "SigV6" sigV6 (SignaturePkt sigV6)+    assertPacketRoundTrip+        "SigVOther"+        sigOther+        (SignaturePkt sigOther)+    assertBool+        "fromPktEitherSomeSignatureV rejects non-signature packets"+        ( not+            ( isRight+                (fromPktEitherSomeSignatureV (LiteralDataPkt BinaryData "" 0 ""))+            )+        )++testTypedArmorPayloadHelpers :: Assertion+testTypedArmorPayloadHelpers = do+    let armors =+            [ Armor ArmorPublicKeyBlock [] "public-one"+            , Armor ArmorMessage [] "message-one"+            , Armor ArmorPublicKeyBlock [] "public-two"+            ]+        publicPayloads =+            map BL.toStrict (armorPayloadsOfType ArmorPublicKeyBlock armors)+    assertEqual+        "armorPayloadsOfType returns all matching typed blocks in order"+        ["public-one", "public-two"]+        publicPayloads+    assertEqual+        "singleArmorPayloadOfType returns the sole matching message payload"+        (Right "message-one")+        (fmap BL.toStrict (singleArmorPayloadOfType ArmorMessage armors))+    assertBool+        "singleArmorPayloadOfType fails when no typed blocks exist"+        (isLeft (singleArmorPayloadOfType ArmorPrivateKeyBlock armors))+    assertBool+        "singleArmorPayloadOfType fails when multiple typed blocks exist"+        (isLeft (singleArmorPayloadOfType ArmorPublicKeyBlock armors))+testRecommendedArmorType :: Assertion+testRecommendedArmorType = do+    secretArmors <- loadArmor "v4-encrypted-secret.pgp.aa"+    publicArmors <- loadArmor "v4-encrypted.rev.aa"+    secretPayload <-+        case singleArmorPayloadOfType ArmorPrivateKeyBlock secretArmors of+            Left err -> assertFailure err >> fail err+            Right payload -> pure payload+    publicPayload <-+        case singleArmorPayloadOfType ArmorPublicKeyBlock publicArmors of+            Left err -> assertFailure err >> fail err+            Right payload -> pure payload+    let secretPkts = parsePkts secretPayload+        publicPkts = parsePkts publicPayload+        firstPkt label pkts =+            case pkts of+                [] ->+                    assertFailure (label ++ " should contain at least one packet")+                        >> fail "missing packet"+                pkt : _ -> pure pkt+    firstSecret <- firstPkt "secret armor fixture" secretPkts+    firstPublic <- firstPkt "public armor fixture" publicPkts+    let sig =+            SignaturePkt+                (SigV4 BinarySig RSA SHA256 [] [] 0 (NE.fromList [MPI 1]))+    assertEqual+        "recommendedArmorType rejects empty packet streams"+        Nothing+        (recommendedArmorType [])+    assertEqual+        "recommendedArmorType maps secret-key packets to private key armor"+        (Just ArmorPrivateKeyBlock)+        (recommendedArmorType [firstSecret])+    assertEqual+        "recommendedArmorType maps public-key packets to public key armor"+        (Just ArmorPublicKeyBlock)+        (recommendedArmorType [firstPublic])+    assertEqual+        "recommendedArmorType maps signature packets to signature armor"+        (Just ArmorSignature)+        (recommendedArmorType [sig])+    assertEqual+        "recommendedArmorType defaults non-key/signature packets to message armor"+        (Just ArmorMessage)+        (recommendedArmorType [LiteralDataPkt BinaryData "" 0 "payload"])+testSingleClearSignedBlock :: Assertion+testSingleClearSignedBlock = do+    let clearSigned =+            ClearSigned+                [("Hash", "SHA256")]+                "signed cleartext payload\n"+                ( Armor+                    ArmorSignature+                    [("Version", "test-suite")]+                    "detached-signature"+                )+    assertEqual+        "singleClearSignedBlock extracts cleartext and signature payloads"+        ( Right+            ( [("Hash", "SHA256")]+            , "signed cleartext payload\n"+            , "detached-signature"+            )+        )+        (singleClearSignedBlock [clearSigned])+    assertBool+        "singleClearSignedBlock rejects absent clear-signed blocks"+        (isLeft (singleClearSignedBlock [Armor ArmorMessage [] "payload"]))+    assertBool+        "singleClearSignedBlock rejects multiple clear-signed blocks"+        (isLeft (singleClearSignedBlock [clearSigned, clearSigned]))+    assertBool+        "singleClearSignedBlock rejects non-signature inner armor blocks"+        ( isLeft+            ( singleClearSignedBlock+                [ ClearSigned [] "payload" (Armor ArmorMessage [] "not-signature")+                ]+            )+        )+testSignerTimelineSoftPrimaryRevocation :: Assertion+testSignerTimelineSoftPrimaryRevocation = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    let payload = "soft primary revocation timeline payload"+        keyCreated = _timestamp signer+        sigBeforeTime = addTimestampSeconds keyCreated 10+        revocationTime = addTimestampSeconds keyCreated 20+        sigAfterTime = addTimestampSeconds keyCreated 30+    sigBefore <-+        signBinaryMessageWithRSAAt+            signer+            signingKey+            sigBeforeTime+            payload+    revocation <-+        signKeyRevocationWithReasonAt+            signer+            signingKey+            revocationTime+            KeySuperseded+    sigAfter <-+        signBinaryMessageWithRSAAt signer signingKey sigAfterTime payload+    let keyring =+            mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]+    assertSingleSignerFingerprint+        "soft primary revocation should preserve pre-revocation signatures"+        (fingerprint signer)+        (verifyTimelinePackets keyring payload sigBefore)+    assertSingleFailureContainsTimeline+        "soft primary revocation should reject post-revocation signatures"+        "signing key is revoked"+        (verifyTimelinePackets keyring payload sigAfter)++testSignerTimelineHardPrimaryRevocation :: Assertion+testSignerTimelineHardPrimaryRevocation = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    let payload = "hard primary revocation timeline payload"+        keyCreated = _timestamp signer+        sigBeforeTime = addTimestampSeconds keyCreated 10+        revocationTime = addTimestampSeconds keyCreated 20+    sigBefore <-+        signBinaryMessageWithRSAAt+            signer+            signingKey+            sigBeforeTime+            payload+    revocation <-+        signKeyRevocationWithReasonAt+            signer+            signingKey+            revocationTime+            KeyMaterialCompromised+    let keyring =+            mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]+    assertSingleFailureContainsTimeline+        "hard primary revocation should reject even pre-revocation signatures"+        "signing key is revoked"+        (verifyTimelinePackets keyring payload sigBefore)++testSignerTimelineNoReasonPrimaryRevocation :: Assertion+testSignerTimelineNoReasonPrimaryRevocation = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    let payload = "no-reason primary revocation timeline payload"+        keyCreated = _timestamp signer+        sigBeforeTime = addTimestampSeconds keyCreated 10+        revocationTime = addTimestampSeconds keyCreated 20+    sigBefore <-+        signBinaryMessageWithRSAAt+            signer+            signingKey+            sigBeforeTime+            payload+    revocation <-+        signKeyRevocationWithReasonAt+            signer+            signingKey+            revocationTime+            NoReason+    let keyring =+            mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]+    assertSingleFailureContainsTimeline+        "no-reason primary revocation should reject even pre-revocation signatures"+        "signing key is revoked"+        (verifyTimelinePackets keyring payload sigBefore)++testSignerTimelineUnknownReasonPrimaryRevocation :: Assertion+testSignerTimelineUnknownReasonPrimaryRevocation = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    let payload = "unknown-reason primary revocation timeline payload"+        keyCreated = _timestamp signer+        sigBeforeTime = addTimestampSeconds keyCreated 10+        revocationTime = addTimestampSeconds keyCreated 20+    sigBefore <-+        signBinaryMessageWithRSAAt+            signer+            signingKey+            sigBeforeTime+            payload+    revocation <-+        signKeyRevocationWithReasonAt+            signer+            signingKey+            revocationTime+            (RCoOther 100)+    let keyring =+            mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]+    assertSingleFailureContainsTimeline+        "unknown-reason primary revocation should reject even pre-revocation signatures"+        "signing key is revoked"+        (verifyTimelinePackets keyring payload sigBefore)++testSignerTimelineNonCompromisePrimaryRevocationIsHistorical+    :: Assertion+testSignerTimelineNonCompromisePrimaryRevocationIsHistorical = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    let payload = "non-compromise primary revocation timeline payload"+        keyCreated = _timestamp signer+        sigBeforeTime = addTimestampSeconds keyCreated 10+        revocationTime = addTimestampSeconds keyCreated 20+        sigAfterTime = addTimestampSeconds keyCreated 30+    sigBefore <-+        signBinaryMessageWithRSAAt+            signer+            signingKey+            sigBeforeTime+            payload+    revocation <-+        signKeyRevocationWithReasonAt+            signer+            signingKey+            revocationTime+            UserIdInfoNoLongerValid+    sigAfter <-+        signBinaryMessageWithRSAAt signer signingKey sigAfterTime payload+    let keyring =+            mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]+    assertSingleSignerFingerprint+        "non-compromise primary revocation should preserve pre-revocation signatures"+        (fingerprint signer)+        (verifyTimelinePackets keyring payload sigBefore)+    assertSingleFailureContainsTimeline+        "non-compromise primary revocation should reject post-revocation signatures"+        "signing key is revoked"+        (verifyTimelinePackets keyring payload sigAfter)++testSignerTimelineTemporaryPrimaryRevocationExpires :: Assertion+testSignerTimelineTemporaryPrimaryRevocationExpires = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    let payload = "temporary primary revocation expiry timeline payload"+        keyCreated = _timestamp signer+        sigBeforeTime = addTimestampSeconds keyCreated 10+        revocationTime = addTimestampSeconds keyCreated 20+        sigDuringTime = addTimestampSeconds keyCreated 25+        sigAfterTime = addTimestampSeconds keyCreated 35+    sigBefore <-+        signBinaryMessageWithRSAAt+            signer+            signingKey+            sigBeforeTime+            payload+    revocation <-+        signKeyRevocationWithReasonAndExtrasAt+            signer+            signingKey+            revocationTime+            KeySuperseded+            [SigSubPacket False (SigExpirationTime 10)]+    sigDuring <-+        signBinaryMessageWithRSAAt+            signer+            signingKey+            sigDuringTime+            payload+    sigAfter <-+        signBinaryMessageWithRSAAt signer signingKey sigAfterTime payload+    let keyring =+            mkTestKeyring [TKUnknown (signer, Nothing) [revocation] [] [] []]+    assertSingleSignerFingerprint+        "temporary primary revocation should preserve pre-revocation signatures"+        (fingerprint signer)+        (verifyTimelinePackets keyring payload sigBefore)+    assertSingleFailureContainsTimeline+        "temporary primary revocation should reject signatures while revocation is effective"+        "signing key is revoked"+        (verifyTimelinePackets keyring payload sigDuring)+    assertSingleSignerFingerprint+        "temporary primary revocation should allow signatures after revocation expiration"+        (fingerprint signer)+        (verifyTimelinePackets keyring payload sigAfter)++testSignerTimelineSubkeyRevocation :: Assertion+testSignerTimelineSubkeyRevocation = do+    (primarySigner, primarySigningKey) <- loadUnencryptedRsaSigner+    (subkeySigner, subkeySigningKey) <-+        loadDeterministicEd25519Signer+    let payload = "subkey revocation timeline payload"+        keyCreated = _timestamp primarySigner+        bindingTime = addTimestampSeconds keyCreated 10+        sigBeforeTime = addTimestampSeconds keyCreated 20+        revocationTime = addTimestampSeconds keyCreated 30+        sigAfterTime = addTimestampSeconds keyCreated 40+        subkeyPacket = PublicSubkeyPkt subkeySigner+    bindingSig <-+        signSubkeyBindingWithRSAAt+            primarySigner+            subkeySigner+            primarySigningKey+            bindingTime+    sigBefore <-+        signBinaryMessageWithEd25519At+            subkeySigner+            subkeySigningKey+            sigBeforeTime+            payload+    revocationSig <-+        signSubkeyRevocationWithRSAAt+            primarySigner+            subkeySigner+            primarySigningKey+            revocationTime+    sigAfter <-+        signBinaryMessageWithEd25519At+            subkeySigner+            subkeySigningKey+            sigAfterTime+            payload+    let keyring =+            mkTestKeyring+                [ TKUnknown+                    (primarySigner, Nothing)+                    []+                    []+                    []+                    [(subkeyPacket, [bindingSig, revocationSig])]+                ]+    assertSingleSignerFingerprint+        "subkey revocation should preserve pre-revocation signatures"+        (fingerprint subkeySigner)+        (verifyTimelinePackets keyring payload sigBefore)+    assertSingleFailureContainsTimeline+        "subkey revocation should reject post-revocation signatures"+        "signing key was not valid at the signature creation time"+        (verifyTimelinePackets keyring payload sigAfter)++testSignMessageConvenience :: Assertion+testSignMessageConvenience = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    signerV4 <- expectV4PKPayload "RSA v4 convenience signer" signer+    signedResult <-+        signMessage+            (mkRSASignerV4 signerV4 signingKey)+            "message-api convenience signing payload"+    signedMessage <-+        case signedResult of+            Left err ->+                assertFailure+                    ("message signing convenience API failed: " ++ show err)+                    >> pure mempty+            Right bs -> pure bs+    case parsePkts signedMessage of+        [LiteralDataPkt {}, SignaturePkt _] -> pure ()+        _ ->+            assertFailure+                "convenience signing output should contain literal data and one signature packet"++testTypedVerifySurfaceMatchesLegacy :: Assertion+testTypedVerifySurfaceMatchesLegacy = do+    kr <- loadKeyring "pubring.gpg"+    signedMessage <- readFixtureLazy "uncompressed-ops-rsa.gpg"+    let typedResults =+            verifyMessage+                defaultVerificationOptions+                    { verificationPolicy = VerifyInformational+                    , verificationMode = VerificationStreaming+                    }+                kr+                signedMessage+        strictResults =+            verifyMessage+                defaultVerificationOptions+                    { verificationPolicy = VerifyStrict+                    , verificationMode = VerificationStreaming+                    }+                kr+                signedMessage+        normalizeTyped+            :: Either VerificationError Verification -> Either Bool Fingerprint+        normalizeTyped (Left _) = Left False+        normalizeTyped (Right v) = Right (fingerprint (_verificationSigner v))+    assertEqual+        "strict verification should collapse informational failures"+        ( map+            normalizeTyped+            (either (pure . Left) (Right <$>) (sequence typedResults))+        )+        (map normalizeTyped strictResults)+    assertBool+        "informational verification should emit at least one result for known-good fixture"+        (not (null (map normalizeTyped typedResults)))++testVerifyMessageStrictRejectsTamper :: Assertion+testVerifyMessageStrictRejectsTamper = do+    kr <- loadKeyring "pubring.gpg"+    packets <- loadAndDecompressPkts "uncompressed-ops-rsa.gpg"+    let tamperedPackets = map tamperLiteral packets+        strictOptions =+            defaultVerificationOptions+                { verificationPolicy = VerifyStrict+                , verificationMode = VerificationStreaming+                }+    case verifyMessagePackets strictOptions kr tamperedPackets of+        [Left _] -> pure ()+        _ ->+            assertFailure+                "strict typed verification should fail on tampered payload"+  where+    tamperLiteral (LiteralDataPkt dt fn ts payload) =+        LiteralDataPkt dt fn ts (BL.snoc payload 0)+    tamperLiteral pkt = pkt++testVerifySignedMessageConvenience :: Assertion+testVerifySignedMessageConvenience = do+    kr <- loadKeyring "pubring.gpg"+    signedMessage <- readFixtureLazy "uncompressed-ops-rsa.gpg"+    strictResult <-+        pure+            ( verifySignedMessage+                defaultVerificationOptions+                    { verificationPolicy = VerifyStrict+                    , verificationMode = VerificationStreaming+                    }+                kr+                signedMessage+            )+    case strictResult of+        [Left _] ->+            assertFailure+                "verifySignedMessage should succeed for known-good fixture"+        verifications ->+            assertBool+                "verifySignedMessage should emit at least one verification"+                (not (null verifications))++testVerifyV4EdDSASignatureWithEd25519KeyAlgorithm :: Assertion+testVerifyV4EdDSASignatureWithEd25519KeyAlgorithm = do+    (signer, signingKey) <- loadDeterministicEd25519Signer+    let signerWithEd25519Pka = setPKAlgorithm PKA.Ed25519 signer+    signerV4 <-+        expectV4PKPayload+            "Ed25519 v4 signer with Ed25519 key algorithm"+            signerWithEd25519Pka+    let payload = "v4 eddsa signature with Ed25519 key algorithm"+        state =+            emptyPSC {lastLD = LiteralDataPkt BinaryData BL.empty 0 payload}+        keyring =+            mkTestKeyring+                [TKUnknown (signerWithEd25519Pka, Nothing) [] [] [] []]+    signedResult <-+        signMessageWith+            (mkEd25519SignerV4 signerV4 signingKey)+            (mkClearPayload payload)+    signaturePkt <-+        case signedResult of+            Left err ->+                assertFailure ("Ed25519 message signing failed: " ++ show err)+                    >> fail "expected signed Ed25519 payload"+            Right signedMessage ->+                case parsePkts signedMessage of+                    [ LiteralDataPkt {}+                        , sig@(SignaturePkt (SigV4 BinarySig PKA.Ed25519 SHA512 _ _ _ _))+                        ] ->+                            pure sig+                    other ->+                        assertFailure+                            ( "Expected [LiteralDataPkt, Ed25519 SigV4] for Ed25519-key-algorithm verification test, got "+                                ++ show other+                            )+                            >> fail "unexpected Ed25519-key-algorithm signature shape"+    case verifySigWith+        defaultVerificationPolicy+        (verifyAgainstKeyring keyring)+        signaturePkt+        state+        Nothing of+        Left err ->+            assertFailure+                ( "Ed25519 SigV4 verification with Ed25519 key algorithm failed: "+                    ++ renderVerificationError err+                )+        Right _ -> pure ()
tests/Tests/Serialization.hs view
@@ -2,955 +2,1167 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).--{-# LANGUAGE OverloadedStrings #-}--module Tests.Serialization (serializationTests) where--import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)-import Codec.Encryption.OpenPGP.Internal (emptyPSC, point2MBS)-import Codec.Encryption.OpenPGP.KeyringParser (parseTKsWithWireRep)-import Codec.Encryption.OpenPGP.Policy-  ( signatureV6SaltSizeForHashAlgorithm-  )-import Codec.Encryption.OpenPGP.Serialize (parsePkts, parsePktsWithWireRep)-import Codec.Encryption.OpenPGP.Signatures-  ( VerificationError(..)-  , verifySigWith-  )-import Codec.Encryption.OpenPGP.Types-import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA-import Control.Applicative ((<|>))-import Control.Monad (forM_)-import Crypto.Number.Serialize (os2ip)-import Data.Binary (Get, get, put)-import Data.Binary.Put (putByteString, putWord16be, putWord32be, putWord8, runPut)-import Data.Bits (xor)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Crypto.PubKey.ECC.Types as ECCT-import qualified Crypto.PubKey.ECC.ECDSA as ECDSA-import Data.Conduit.Serialization.Binary (conduitGet)-import qualified Data.Conduit as DC-import qualified Data.Conduit.Binary as CB-import qualified Data.Conduit.List as CL-import qualified Data.List.NonEmpty as NE-import Data.List.NonEmpty (NonEmpty(..))-import Data.Maybe (listToMaybe)-import qualified Data.Set as Set-import Data.Word (Word8)-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, assertFailure, testCase)-import Tests.Common-  ( armorPayload-  , loadArmor-  , readFixturePayload-  , runGet-  )--serializationTests :: TestTree-serializationTests =-  testGroup-    "Serialization"-    [ testGroup-        "Serialization group"-        [ testCase-            "000001-006.public_key"-            (testSerialization "000001-006.public_key")-        , testCase-            "issuer-fingerprint-rejects-unknown-version"-            testIssuerFingerprintRejectsUnknownVersion-        , testCase-            "v6-ed25519-public-key-serializes-fixed-length"-            testV6Ed25519PublicKeySerializesFixedLength-        , testCase-            "v4-ed25519-public-key-parses-native-fixed-length"-            testV4Ed25519PublicKeyParsesNativeFixedLength-        , testCase-            "v4-x25519-public-subkey-parses-native-fixed-length"-            testV4X25519PublicSubkeyParsesNativeFixedLength-        , testCase-            "v6-signature-issuer-fingerprint-version-mismatch"-            testV6SignatureIssuerFingerprintVersionMismatch-        , testCase "000002-013.user_id" (testSerialization "000002-013.user_id")-        , testCase "000003-002.sig" (testSerialization "000003-002.sig")-        , testCase-            "000004-012.ring_trust"-            (testSerialization "000004-012.ring_trust")-        , testCase "000005-002.sig" (testSerialization "000005-002.sig")-        , testCase-            "000006-012.ring_trust"-            (testSerialization "000006-012.ring_trust")-        , testCase "000007-002.sig" (testSerialization "000007-002.sig")-        , testCase-            "000008-012.ring_trust"-            (testSerialization "000008-012.ring_trust")-        , testCase "000009-002.sig" (testSerialization "000009-002.sig")-        , testCase-            "000010-012.ring_trust"-            (testSerialization "000010-012.ring_trust")-        , testCase "000011-002.sig" (testSerialization "000011-002.sig")-        , testCase-            "000012-012.ring_trust"-            (testSerialization "000012-012.ring_trust")-        , testCase-            "000013-014.public_subkey"-            (testSerialization "000013-014.public_subkey")-        , testCase "000014-002.sig" (testSerialization "000014-002.sig")-        , testCase-            "000015-012.ring_trust"-            (testSerialization "000015-012.ring_trust")-        , testCase-            "000016-006.public_key"-            (testSerialization "000016-006.public_key")-        , testCase "000017-002.sig" (testSerialization "000017-002.sig")-        , testCase-            "000018-012.ring_trust"-            (testSerialization "000018-012.ring_trust")-        , testCase "000019-013.user_id" (testSerialization "000019-013.user_id")-        , testCase "000020-002.sig" (testSerialization "000020-002.sig")-        , testCase-            "000021-012.ring_trust"-            (testSerialization "000021-012.ring_trust")-        , testCase "000022-002.sig" (testSerialization "000022-002.sig")-        , testCase-            "000023-012.ring_trust"-            (testSerialization "000023-012.ring_trust")-        , testCase-            "000024-014.public_subkey"-            (testSerialization "000024-014.public_subkey")-        , testCase "000025-002.sig" (testSerialization "000025-002.sig")-        , testCase-            "000026-012.ring_trust"-            (testSerialization "000026-012.ring_trust")-        , testCase-            "000027-006.public_key"-            (testSerialization "000027-006.public_key")-        , testCase "000028-002.sig" (testSerialization "000028-002.sig")-        , testCase-            "000029-012.ring_trust"-            (testSerialization "000029-012.ring_trust")-        , testCase "000030-013.user_id" (testSerialization "000030-013.user_id")-        , testCase "000031-002.sig" (testSerialization "000031-002.sig")-        , testCase-            "000032-012.ring_trust"-            (testSerialization "000032-012.ring_trust")-        , testCase "000033-002.sig" (testSerialization "000033-002.sig")-        , testCase-            "000034-012.ring_trust"-            (testSerialization "000034-012.ring_trust")-        , testCase-            "000035-006.public_key"-            (testSerialization "000035-006.public_key")-        , testCase "000036-013.user_id" (testSerialization "000036-013.user_id")-        , testCase "000037-002.sig" (testSerialization "000037-002.sig")-        , testCase-            "000038-012.ring_trust"-            (testSerialization "000038-012.ring_trust")-        , testCase "000039-002.sig" (testSerialization "000039-002.sig")-        , testCase-            "000040-012.ring_trust"-            (testSerialization "000040-012.ring_trust")-        , testCase-            "000041-017.attribute"-            (testSerialization "000041-017.attribute")-        , testCase "000042-002.sig" (testSerialization "000042-002.sig")-        , testCase-            "000043-012.ring_trust"-            (testSerialization "000043-012.ring_trust")-        , testCase-            "000044-014.public_subkey"-            (testSerialization "000044-014.public_subkey")-        , testCase "000045-002.sig" (testSerialization "000045-002.sig")-        , testCase-            "000046-012.ring_trust"-            (testSerialization "000046-012.ring_trust")-        , testCase-            "000047-005.secret_key"-            (testSerialization "000047-005.secret_key")-        , testCase "000048-013.user_id" (testSerialization "000048-013.user_id")-        , testCase "000049-002.sig" (testSerialization "000049-002.sig")-        , testCase-            "000050-012.ring_trust"-            (testSerialization "000050-012.ring_trust")-        , testCase-            "000051-007.secret_subkey"-            (testSerialization "000051-007.secret_subkey")-        , testCase "000052-002.sig" (testSerialization "000052-002.sig")-        , testCase-            "000053-012.ring_trust"-            (testSerialization "000053-012.ring_trust")-        , testCase-            "000054-005.secret_key"-            (testSerialization "000054-005.secret_key")-        , testCase "000055-002.sig" (testSerialization "000055-002.sig")-        , testCase-            "000056-012.ring_trust"-            (testSerialization "000056-012.ring_trust")-        , testCase "000057-013.user_id" (testSerialization "000057-013.user_id")-        , testCase "000058-002.sig" (testSerialization "000058-002.sig")-        , testCase-            "000059-012.ring_trust"-            (testSerialization "000059-012.ring_trust")-        , testCase-            "000060-007.secret_subkey"-            (testSerialization "000060-007.secret_subkey")-        , testCase "000061-002.sig" (testSerialization "000061-002.sig")-        , testCase-            "000062-012.ring_trust"-            (testSerialization "000062-012.ring_trust")-        , testCase-            "000063-005.secret_key"-            (testSerialization "000063-005.secret_key")-        , testCase "000064-002.sig" (testSerialization "000064-002.sig")-        , testCase-            "000065-012.ring_trust"-            (testSerialization "000065-012.ring_trust")-        , testCase "000066-013.user_id" (testSerialization "000066-013.user_id")-        , testCase "000067-002.sig" (testSerialization "000067-002.sig")-        , testCase-            "000068-012.ring_trust"-            (testSerialization "000068-012.ring_trust")-        , testCase-            "000069-005.secret_key"-            (testSerialization "000069-005.secret_key")-        , testCase "000070-013.user_id" (testSerialization "000070-013.user_id")-        , testCase "000071-002.sig" (testSerialization "000071-002.sig")-        , testCase-            "000072-012.ring_trust"-            (testSerialization "000072-012.ring_trust")-        , testCase-            "000073-017.attribute"-            (testSerialization "000073-017.attribute")-        , testCase "000074-002.sig" (testSerialization "000074-002.sig")-        , testCase-            "000075-012.ring_trust"-            (testSerialization "000075-012.ring_trust")-        , testCase-            "000076-007.secret_subkey"-            (testSerialization "000076-007.secret_subkey")-        , testCase "000077-002.sig" (testSerialization "000077-002.sig")-        , testCase-            "000078-012.ring_trust"-            (testSerialization "000078-012.ring_trust")-        , testCase "pubring.gpg" (testSerialization "pubring.gpg")-        , testCase "secring.gpg" (testSerialization "secring.gpg")-        , testCase "compressedsig.gpg" (testSerialization "compressedsig.gpg")-        , testCase-            "compressedsig-zlib.gpg"-            (testSerialization "compressedsig-zlib.gpg")-        , testCase-            "compressedsig-bzip2.gpg"-            (testSerialization "compressedsig-bzip2.gpg")-        , testCase "onepass_sig" (testSerialization "onepass_sig")-        , testCase-            "uncompressed-ops-dsa.gpg"-            (testSerialization "uncompressed-ops-dsa.gpg")-        , testCase-            "uncompressed-ops-rsa.gpg"-            (testSerialization "uncompressed-ops-rsa.gpg")-        , testCase "simple.seckey" (testSerialization "simple.seckey")-        , testCase "v3-genericcert.sig" (testSerialization "v3-genericcert.sig")-        , testCase "sigs-with-regexes" (testSerialization "sigs-with-regexes")-        , testCase-            "gnu-dummy-s2k-101-secret-key.gpg"-            (testSerialization "gnu-dummy-s2k-101-secret-key.gpg")-        , testCase "anibal-ed25519.gpg" (testSerialization "anibal-ed25519.gpg")-        , testCase "nist_p-256_key.gpg" (testSerialization "nist_p-256_key.gpg")-        , testCase-            "nist_p-256_secretkey.gpg"-            (testSerialization "nist_p-256_secretkey.gpg")-        , testCase "v6-secret.pgp.aa" (testSerialization "v6-secret.pgp.aa")-        , testCase-            "sample-eddsa.pubkey"-            (testSerialization "sample-eddsa.pubkey")-        , testCase "should not serialize point at infinity" testPointAtInfinitySerialization-        , testCase-            "should reject mismatched EC coordinate widths"-            testPointSerializationRejectsMismatchedCoordinateWidths-        ]-    , testGroup-        "TKUnknown Serialization group"-        [ testCase "pubring.gpg TKUnknown serialization" (testTKSerialization "pubring.gpg")-        , testCase "secring.gpg TKUnknown serialization" (testTKSerialization "secring.gpg")-        ]-    , testGroup-        "Argon2 S2K group"-        [ testCase "Argon2 SKESK packet roundtrip" testArgon2S2KPacketRoundTrip-        ]-    , testGroup-        "RFC9580 SEIPD v2 group"-        [ testCase "SEIPD v2 packet roundtrip" testSEIPDv2PacketRoundTrip-        , testCase-            "SEIPD v2 rejects invalid chunk size"-            testSEIPDv2RejectInvalidChunkSize-        , testCase-            "PKESKv6 parsing does not fall back to legacy parser"-            testPKESKv6ParsesAsV6WithoutLegacyFallback-        , testCase-            "PKESKv6 rejects invalid recipient key version"-            testPKESKv6RejectsInvalidRecipientIdentifierVersion-        , testCase-            "PKESKv6 rejects recipient length/version mismatches"-            testPKESKv6RejectsRecipientIdentifierLengthVersionMismatch-        , testCase-            "legacy RSA PKESK rejects extra MPIs"-            testLegacyPKESKRSARejectsExtraMPI-        , testCase-            "legacy ECDH PKESK rejects wrong MPI count"-            testLegacyPKESKECDHRejectsWrongMPICount-        , testCase-            "legacy X25519 PKESK rejects wrong MPI count"-            testLegacyPKESKX25519RejectsWrongMPICount-        , testCase-            "legacy unencrypted secret key rejects checksum mismatch"-            testLegacyUnencryptedSecretKeyRejectsChecksumMismatch-        , testCase-            "legacy secret key rejects unsupported symmetric algorithm IV sizing"-            testLegacySecretKeyRejectsUnsupportedSymmetricAlgorithmIVSizing-        , testCase-            "legacy X25519 PKESK parses RFC9580 v3 octet layout"-            testLegacyPKESKX25519ParsesRFC9580V3OctetLayout-        , testCase "SigV6 rejects invalid salt size" testSigV6RejectsInvalidSaltSize-        , testCase "OPS6 rejects invalid salt size" testOPS6RejectsInvalidSaltSize-        , testCase "OPS3 rejects invalid nested-flag octet" testOPS3RejectsInvalidNestedFlagOctet-        , testCase "OPS6 rejects invalid nested-flag octet" testOPS6RejectsInvalidNestedFlagOctet-        , testCase-            "ECDH pubkey rejects reserved KDF length 0"-            testECDHPubkeyRejectsReservedKDFLengthZero-        , testCase-            "ECDH pubkey rejects reserved KDF length 255"-            testECDHPubkeyRejectsReservedKDFLength255-        , testCase-            "ECDH pubkey encodes fixed KDF length trailer"-            testECDHPubkeyEncodesFixedKDFLength-        , testCase-            "empty key-flags subpacket encodes explicit zero octet"-            testKeyFlagsSubpacketEncodesEmptySetWithZeroOctet-        , testCase-            "v6-secret fixture SigV6 semantics"-            testV6SecretFixtureSignatureSemantics-        , testCase-            "v6-secret fixture derives eight-octet key-id from fingerprint prefix"-            testV6SecretFixtureDerivesEightOctetKeyID-        ]-    ]--testSerialization :: FilePath -> Assertion-testSerialization fpr = do-  bs <- readFixturePayload fpr-  let firstpass = runGet get bs-  case fmap unBlock firstpass of-    Left _ -> assertFailure $ "First pass failed on " ++ fpr-    Right [] ->-      assertFailure $ "First pass of " ++ fpr ++ " decoded to nothing."-    Right packs -> do-      let roundtrip = runPut $ put (Block packs)-      let secondpass = runGet (get :: Get (Block Pkt)) roundtrip-      if fmap unBlock secondpass == Right []-        then assertFailure $ "Second pass of " ++ fpr ++ " decoded to nothing."-        else assertEqual ("for " ++ fpr) firstpass secondpass--testTKSerialization :: FilePath -> Assertion-testTKSerialization fpr = do-  bs <- readFixturePayload fpr-  let pkts = parsePktsWithWireRep (wireRepRef bs) bs-      tksWithWireRep = parseTKsWithWireRep True pkts-  if null tksWithWireRep-    then assertFailure $ "TKUnknown serialization test: " ++ fpr ++ " parsed to no TKs"-    else forM_ tksWithWireRep (testTKRoundtrip fpr)--testTKRoundtrip :: FilePath -> TKWithWireRep -> Assertion-testTKRoundtrip fpr tk = do-  let packets = _tkPackets tk-      encoded = runPut (put (Block (map _pktValue packets)))-  case runGet (get :: Get (Block Pkt)) encoded of-    Left err -> assertFailure $ "TKUnknown " ++ fpr ++ " packet re-parse failed: " ++ err-    Right reparsedBlock ->-      assertEqual-        ("TKUnknown packet re-serialization roundtrip for " ++ fpr)-        (Block (map _pktValue packets))-        reparsedBlock-  case toStructuredTKWithWireRep tk of-    Left err -> assertFailure $ "TKUnknown structured conversion failed for " ++ fpr ++ ": " ++ show err-    Right structured ->-      case canonicalizeTKStructuredWithWireRep structured of-        Left err -> assertFailure $ "TKUnknown canonical conversion failed for " ++ fpr ++ ": " ++ show err-        Right _canonical -> pure ()--testArgon2S2KPacketRoundTrip :: Assertion-testArgon2S2KPacketRoundTrip = do-  let s2k = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15-      pkt = SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 AES128 s2k Nothing))-      encoded = runPut (put pkt)-  assertEqual-    "Argon2 S2K SKESK packet roundtrip"-    (Right pkt)-    (runGet (get :: Get Pkt) encoded)---testIssuerFingerprintRejectsUnknownVersion :: Assertion-testIssuerFingerprintRejectsUnknownVersion = do-  let encoded =-        runPut $ do-          putWord8 34-          putWord8 33-          putWord8 5-          putByteString (B.replicate 32 0)-  case runGet (get :: Get SigSubPacket) encoded of-    Left _ -> pure ()-    Right _ -> assertFailure "issuer fingerprint subpacket version 5 should be rejected"--testV6Ed25519PublicKeySerializesFixedLength :: Assertion-testV6Ed25519PublicKeySerializesFixedLength = do-  let pkp =-        PKPayload-          V6-          (ThirtyTwoBitTimeStamp 0)-          0-          EdDSA-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint 1)))-      encoded = runPut (put (PublicKeyPkt pkp))-  assertEqual-    "v6 Ed25519 public key serialization uses fixed-length octet strings"-    44-    (BL.length encoded)--testV4Ed25519PublicKeyParsesNativeFixedLength :: Assertion-testV4Ed25519PublicKeyParsesNativeFixedLength = do-  let raw = B.pack [0x01 .. 0x20]-      encoded =-        runPut $ do-          putWord8 0xc6-          putWord8 38-          putWord8 4-          putWord32be 0-          putWord8 (fromIntegral (fromFVal PKA.Ed25519))-          putByteString raw-  case runGet (get :: Get Pkt) encoded of-    Right (PublicKeyPkt (PKPayload V4 (ThirtyTwoBitTimeStamp 0) _ PKA.Ed25519 (EdDSAPubKey Ed25519 (NativeEPoint (EPoint x))))) ->-      assertEqual "v4 Ed25519 fixed-length key material parsed as native point" (os2ip raw) x-    other ->-      assertFailure-        ("Expected v4 Ed25519 fixed-length public key parse, got " ++ show other)--testV4X25519PublicSubkeyParsesNativeFixedLength :: Assertion-testV4X25519PublicSubkeyParsesNativeFixedLength = do-  let raw = B.pack [0x01 .. 0x20]-      encoded =-        runPut $ do-          putWord8 0xce-          putWord8 38-          putWord8 4-          putWord32be 0-          putWord8 (fromIntegral (fromFVal PKA.X25519))-          putByteString raw-  case runGet (get :: Get Pkt) encoded of-    Right (PublicSubkeyPkt (PKPayload V4 (ThirtyTwoBitTimeStamp 0) _ PKA.X25519 (EdDSAPubKey Ed25519 (NativeEPoint (EPoint x))))) ->-      assertEqual "v4 X25519 fixed-length key material parsed as native point" (os2ip raw) x-    other ->-      assertFailure-        ("Expected v4 X25519 fixed-length public subkey parse, got " ++ show other)--testV6SignatureIssuerFingerprintVersionMismatch :: Assertion-testV6SignatureIssuerFingerprintVersionMismatch = do-  let signer =-        PKPayload-          V6-          (ThirtyTwoBitTimeStamp 0)-          0-          EdDSA-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint 1)))-      sig =-        SignaturePkt-          (SigV6-             BinarySig-             EdDSA-             SHA512-             (SignatureSalt (BL.replicate 32 0))-             [SigSubPacket False (IssuerFingerprint IssuerFingerprintV4 (fingerprint signer))]-             []-             0-             (NE.fromList [MPI 0, MPI 0]))-      verifier _ _ _ = Right (Verification signer (case sig of SignaturePkt sp -> sp; _ -> error "impossible") [])-  case verifySigWith verifier sig emptyPSC Nothing of-    Left IssuerFingerprintSubpacketMismatch -> pure ()-    Left err -> assertFailure ("unexpected verification error: " ++ show err)-    Right _ -> assertFailure "v6 signature with issuer fingerprint version 4 should be rejected"--testPointAtInfinitySerialization :: Assertion-testPointAtInfinitySerialization =-  assertEqual "point at infinity should not serialize" Nothing (point2MBS ECCT.PointO)--testPointSerializationRejectsMismatchedCoordinateWidths :: Assertion-testPointSerializationRejectsMismatchedCoordinateWidths =-  assertEqual-    "point serialization should reject mismatched coordinate widths"-    Nothing-    (point2MBS (ECCT.Point 1 256))--testSEIPDv2PacketRoundTrip :: Assertion-testSEIPDv2PacketRoundTrip = do-  let salt = Salt (B.pack [0x00 .. 0x1f])-      pkt = SymEncIntegrityProtectedDataPkt (SEIPD2 AES256 OCB 16 salt "\x01\x02\x03\x04")-      encoded = runPut (put pkt)-  assertEqual-    "SEIPD v2 packet roundtrip"-    (Right pkt)-    (runGet (get :: Get Pkt) encoded)--testSEIPDv2RejectInvalidChunkSize :: Assertion-testSEIPDv2RejectInvalidChunkSize = do-  let encoded =-        runPut $ do-          putWord8 0xd2-          putWord8 37-          putWord8 2-          putWord8 7-          putWord8 2-          putWord8 17-          putByteString (B.replicate 32 0)-          putWord8 0-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> return ()-    other ->-      assertFailure-        ("SEIPD v2 parser should reject chunk sizes larger than 16, got " ++-         show other)--testPKESKv6ParsesAsV6WithoutLegacyFallback :: Assertion-testPKESKv6ParsesAsV6WithoutLegacyFallback = do-  let recipientKeyIdentifier = BL.pack (0x04 : replicate 20 0)-      esk = "\x00\x00"-      encoded =-        runPut $ do-          putWord8 0xc1-          putWord8 26-          putWord8 6-          putWord8 21-          putByteString (BL.toStrict recipientKeyIdentifier)-          putWord8 1-          putByteString (BL.toStrict esk)-  case runGet (get :: Get Pkt) encoded of-    Right (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka parsedEsk))) -> do-      assertEqual "PKESKv6 recipient key identifier" recipientKeyIdentifier rid-      assertEqual "PKESKv6 algorithm" RSA pka-      assertEqual "PKESKv6 ESK payload" esk parsedEsk-    other ->-      assertFailure ("Expected PKESKPkt (PKESK6 ...) parse result, got " ++ show other)--testPKESKv6RejectsInvalidRecipientIdentifierVersion :: Assertion-testPKESKv6RejectsInvalidRecipientIdentifierVersion = do-  let recipientKeyIdentifier = BL.pack (0x05 : replicate 20 0)-      encoded =-        runPut $ do-          putWord8 0xc1-          putWord8 24-          putWord8 6-          putWord8 21-          putByteString (BL.toStrict recipientKeyIdentifier)-          putWord8 1-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> pure ()-    other ->-      assertFailure-        ("Expected malformed PKESKv6 key version to produce BrokenPacketPkt, got " ++-         show other)--testPKESKv6RejectsRecipientIdentifierLengthVersionMismatch :: Assertion-testPKESKv6RejectsRecipientIdentifierLengthVersionMismatch = do-  let recipientKeyIdentifier = BL.pack (0x04 : replicate 32 0)-      encoded =-        runPut $ do-          putWord8 0xc1-          putWord8 36-          putWord8 6-          putWord8 33-          putByteString (BL.toStrict recipientKeyIdentifier)-          putWord8 1-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> pure ()-    other ->-      assertFailure-        ("Expected malformed PKESKv6 recipient length/version mismatch to produce BrokenPacketPkt, got " ++-         show other)--testLegacyPKESKRSARejectsExtraMPI :: Assertion-testLegacyPKESKRSARejectsExtraMPI = do-  let encoded =-        runPut $ do-          putWord8 0xc1-          putWord8 16-          putWord8 3-          putByteString (B.replicate 8 0)-          putWord8 1-          put (MPI 1)-          put (MPI 2)-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> pure ()-    other ->-      assertFailure-        ("Expected malformed legacy RSA PKESK to produce BrokenPacketPkt, got " ++-         show other)--testLegacyPKESKECDHRejectsWrongMPICount :: Assertion-testLegacyPKESKECDHRejectsWrongMPICount = do-  let encoded =-        runPut $ do-          putWord8 0xc1-          putWord8 13-          putWord8 3-          putByteString (B.replicate 8 0)-          putWord8 18-          put (MPI 1)-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> pure ()-    other ->-      assertFailure-        ("Expected malformed legacy ECDH PKESK to produce BrokenPacketPkt, got " ++-         show other)--testLegacyPKESKX25519RejectsWrongMPICount :: Assertion-testLegacyPKESKX25519RejectsWrongMPICount = do-  let encoded =-        runPut $ do-          putWord8 0xc1-          putWord8 13-          putWord8 3-          putByteString (B.replicate 8 0)-          putWord8 (fromIntegral (fromFVal X25519))-          put (MPI 1)-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> pure ()-    other ->-      assertFailure-        ("Expected malformed legacy X25519 PKESK to produce BrokenPacketPkt, got " ++-         show other)--testLegacyUnencryptedSecretKeyRejectsChecksumMismatch :: Assertion-testLegacyUnencryptedSecretKeyRejectsChecksumMismatch = do-  secretPackets <--    DC.runConduitRes $-    CB.sourceFile "tests/data/unencrypted.seckey" DC..| conduitGet get DC..| CL.consume-  pkt <--    case secretPackets of-      (SecretKeyPkt pkp (SUUnencrypted sk checksum):_) ->-        pure (SecretKeyPkt pkp (SUUnencrypted sk (checksum `xor` 1)))-      (SecretKeyPkt _ _ :_) ->-        assertFailure "unencrypted.seckey did not begin with an unencrypted secret key packet" >>-        fail "expected unencrypted secret key packet"-      _ ->-        assertFailure "unencrypted.seckey did not begin with a secret key packet" >>-        fail "expected secret key packet"-  let encoded = runPut (put pkt)-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> pure ()-    other ->-      assertFailure-        ("Expected unencrypted secret key checksum mismatch to produce BrokenPacketPkt, got " ++-         show other)--testLegacySecretKeyRejectsUnsupportedSymmetricAlgorithmIVSizing :: Assertion-testLegacySecretKeyRejectsUnsupportedSymmetricAlgorithmIVSizing = do-  let pkt =-        SecretKeyPkt-          (PKPayload V4 0 0 RSA (UnknownPKey BL.empty))-          (SUSSHA1-             (OtherSA 0xfe)-             (IteratedSalted SHA256 (Salt8 "12345678") (IterationCount 65536))-             (IV (B.replicate 8 0))-             BL.empty)-      encoded = runPut (put pkt)-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> pure ()-    other ->-      assertFailure-        ("Expected legacy secret key with unsupported symmetric algorithm to produce BrokenPacketPkt, got " ++-         show other)--testLegacyPKESKX25519ParsesRFC9580V3OctetLayout :: Assertion-testLegacyPKESKX25519ParsesRFC9580V3OctetLayout = do-  let ephemeral = B.pack [0x01 .. 0x20]-      wrappedWithAlgo = B.singleton (fromIntegral (fromFVal AES128)) <> B.replicate 24 0x5a-      encoded =-        runPut $ do-          putWord8 0xc1-          putWord8 (fromIntegral (1 + 8 + 1 + B.length ephemeral + 1 + B.length wrappedWithAlgo))-          putWord8 3-          putByteString (B.replicate 8 0)-          putWord8 (fromIntegral (fromFVal X25519))-          putByteString ephemeral-          putWord8 (fromIntegral (B.length wrappedWithAlgo))-          putByteString wrappedWithAlgo-  case runGet (get :: Get Pkt) encoded of-    Right (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 3 _ X25519 (ephMPI :| [eskMPI])))) -> do-      assertEqual "legacy X25519 v3 octet-layout ephemeral parse" (MPI (os2ip ephemeral)) ephMPI-      assertEqual-        "legacy X25519 v3 octet-layout wrapped parse"-        (MPI (os2ip wrappedWithAlgo))-        eskMPI-    other ->-      assertFailure-        ("Expected legacy X25519 PKESK v3 octet-layout parse success, got " ++ show other)--testSigV6RejectsInvalidSaltSize :: Assertion-testSigV6RejectsInvalidSaltSize = do-  let encoded =-        runPut $ do-          putWord8 0xc2-          putWord8 45-          putWord8 6-          putWord8 0-          putWord8 1-          putWord8 8-          putWord32be 0-          putWord32be 0-          putWord16be 0-          putWord8 32-          putByteString (B.replicate 32 0)-          putWord16be 0-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> return ()-    other ->-      assertFailure-        ("Expected invalid SigV6 salt size to produce BrokenPacketPkt, got " ++-         show other)--testOPS6RejectsInvalidSaltSize :: Assertion-testOPS6RejectsInvalidSaltSize = do-  let encoded =-        runPut $ do-          putWord8 0xc4-          putWord8 69-          putWord8 6-          putWord8 0-          putWord8 10-          putWord8 22-          putWord8 31-          putByteString (B.replicate 31 0)-          putByteString (B.replicate 32 0)-          putWord8 0-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> return ()-    other ->-      assertFailure-        ("Expected invalid OPS6 salt size to produce BrokenPacketPkt, got " ++-         show other)--testOPS3RejectsInvalidNestedFlagOctet :: Assertion-testOPS3RejectsInvalidNestedFlagOctet = do-  let encoded =-        runPut $ do-          putWord8 0xc4-          putWord8 13-          putWord8 3-          putWord8 0-          putWord8 8-          putWord8 1-          putByteString (B.replicate 8 0)-          putWord8 2-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> pure ()-    other ->-      assertFailure-        ("Expected invalid OPS3 nested-flag octet to produce BrokenPacketPkt, got " ++-         show other)--testOPS6RejectsInvalidNestedFlagOctet :: Assertion-testOPS6RejectsInvalidNestedFlagOctet = do-  let encoded =-        runPut $ do-          putWord8 0xc4-          putWord8 70-          putWord8 6-          putWord8 0-          putWord8 8-          putWord8 1-          putWord8 32-          putByteString (B.replicate 32 0)-          putByteString (B.replicate 32 0)-          putWord8 2-  case runGet (get :: Get Pkt) encoded of-    Right BrokenPacketPkt {} -> pure ()-    other ->-      assertFailure-        ("Expected invalid OPS6 nested-flag octet to produce BrokenPacketPkt, got " ++-         show other)--mkECDHBoundaryTestPacket :: Pkt-mkECDHBoundaryTestPacket =-  PublicKeyPkt-    (PKPayload-       V4-       0-       0-       ECDH-       (ECDHPubKey-          (ECDSAPubKey-             (ECDSA_PublicKey-                (ECDSA.PublicKey (ECCT.getCurveByName ECCT.SEC_p256r1) (ECCT.Point 1 2))))-          SHA256-          AES128))--setStrictByteAt :: Int -> Word8 -> B.ByteString -> Maybe B.ByteString-setStrictByteAt idx w bs-  | idx < 0 || idx >= B.length bs = Nothing-  | otherwise =-      let (prefix, rest) = B.splitAt idx bs-       in case B.uncons rest of-            Nothing -> Nothing-            Just (_, suffix) -> Just (prefix <> B.singleton w <> suffix)--testECDHPubkeyRejectsReservedKDFLengthZero :: Assertion-testECDHPubkeyRejectsReservedKDFLengthZero = do-  let encoded = BL.toStrict (runPut (put mkECDHBoundaryTestPacket))-  mutated <--    maybe-      (assertFailure "failed to locate ECDH KDF length byte for zero-length rejection test" >> fail "unreachable")-      pure-      (setStrictByteAt (B.length encoded - 4) 0x00 encoded)-  case runGet (get :: Get Pkt) (BL.fromStrict mutated) of-    Right BrokenPacketPkt {} -> pure ()-    other ->-      assertFailure-        ("Expected ECDH KDF length 0 to produce BrokenPacketPkt, got " ++ show other)--testECDHPubkeyRejectsReservedKDFLength255 :: Assertion-testECDHPubkeyRejectsReservedKDFLength255 = do-  let encoded = BL.toStrict (runPut (put mkECDHBoundaryTestPacket))-  mutated <--    maybe-      (assertFailure "failed to locate ECDH KDF length byte for 0xff rejection test" >> fail "unreachable")-      pure-      (setStrictByteAt (B.length encoded - 4) 0xff encoded)-  case runGet (get :: Get Pkt) (BL.fromStrict mutated) of-    Right BrokenPacketPkt {} -> pure ()-    other ->-      assertFailure-        ("Expected ECDH KDF length 255 to produce BrokenPacketPkt, got " ++ show other)--testECDHPubkeyEncodesFixedKDFLength :: Assertion-testECDHPubkeyEncodesFixedKDFLength = do-  let encoded = BL.toStrict (runPut (put mkECDHBoundaryTestPacket))-      trailer = B.drop (B.length encoded - 4) encoded-  assertEqual-    "ECDH public-key encoding should emit fixed KDF trailer [3,1,hash,sym]"-    (B.pack [0x03, 0x01, fromFVal SHA256, fromFVal AES128])-    trailer--testKeyFlagsSubpacketEncodesEmptySetWithZeroOctet :: Assertion-testKeyFlagsSubpacketEncodesEmptySetWithZeroOctet = do-  let encoded = runPut (put (SigSubPacket False (KeyFlags Set.empty)))-  assertEqual-    "empty key-flags subpacket should encode an explicit zero flags octet"-    [2, 27, 0]-    (BL.unpack encoded)-  case runGet (get :: Get SigSubPacket) encoded of-    Right (SigSubPacket False (KeyFlags flags)) ->-      assertEqual-        "empty key-flags subpacket should decode back to an empty flag set"-        Set.empty-        flags-    other ->-      assertFailure-        ("Expected empty key-flags subpacket roundtrip, got " ++ show other)--expectedV6SaltSizeForTest :: HashAlgorithm -> Maybe Int-expectedV6SaltSizeForTest =-  fmap fromIntegral . signatureV6SaltSizeForHashAlgorithm--signatureHasIssuerFingerprintV6 :: Fingerprint -> SignaturePayload -> Bool-signatureHasIssuerFingerprintV6 expectedFp (SigV6 _ _ _ _ hashed unhashed _ _) =-  expectedFp `elem`-  [ ifp-  | SigSubPacket _ (IssuerFingerprint IssuerFingerprintV6 ifp) <- hashed ++ unhashed-  ]-signatureHasIssuerFingerprintV6 _ _ = False--testV6SecretFixtureSignatureSemantics :: Assertion-testV6SecretFixtureSignatureSemantics = do-  armors <- loadArmor "v6-secret.pgp.aa"-  payload <--    case armors of-      (a:_) -> pure (armorPayload a)-      [] ->-        assertFailure "v6-secret.pgp.aa should contain one armored payload" >>-        fail "expected one armored payload"-  let packets = parsePkts payload-      primaryV6Key =-        listToMaybe-          [ pkp-          | SecretKeyPkt pkp _ <- packets-          , _keyVersion pkp == V6-          ] <|>-        listToMaybe-          [ pkp-          | PublicKeyPkt pkp <- packets-          , _keyVersion pkp == V6-          ]-      signatures =-        [ (sig, ha, salt)-        | SignaturePkt sig@(SigV6 _ _ ha salt _ _ _ _) <- packets-        ]-  pkp <--    case primaryV6Key of-      Nothing ->-        assertFailure "v6-secret.pgp.aa should contain a primary v6 key packet" >>-        fail "expected primary v6 key packet"-      Just k -> pure k-  assertBool-    "v6-secret.pgp.aa should contain at least one SigV6 packet"-    (not (null signatures))-  mapM_-    (\(_, ha, salt) ->-       case expectedV6SaltSizeForTest ha of-         Nothing ->-           assertFailure ("SigV6 in v6-secret.pgp.aa uses unsupported salt hash algorithm: " ++ show ha)-         Just expected ->-           assertEqual-             "SigV6 salt size in v6-secret.pgp.aa should match hash algorithm"-             expected-             (fromIntegral (BL.length (unSignatureSalt salt))))-    signatures-  assertBool-    "v6-secret.pgp.aa should include at least one IssuerFingerprint v6 matching the primary key"-    (any (\(sig, _, _) -> signatureHasIssuerFingerprintV6 (fingerprint pkp) sig) signatures)--testV6SecretFixtureDerivesEightOctetKeyID :: Assertion-testV6SecretFixtureDerivesEightOctetKeyID = do-  armors <- loadArmor "v6-secret.pgp.aa"-  payload <--    case armors of-      (a:_) -> pure (armorPayload a)-      [] ->-        assertFailure "v6-secret.pgp.aa should contain one armored payload" >>-        fail "expected one armored payload"-  let packets = parsePkts payload-      primaryV6Key =-        listToMaybe-          [ pkp-          | SecretKeyPkt pkp _ <- packets-          , _keyVersion pkp == V6-          ] <|>-        listToMaybe-          [ pkp-          | PublicKeyPkt pkp <- packets-          , _keyVersion pkp == V6-          ]-  pkp <--    case primaryV6Key of-      Nothing ->-        assertFailure "v6-secret.pgp.aa should contain a primary v6 key packet" >>-        fail "expected primary v6 key packet"-      Just k -> pure k-  derivedKeyId <--    case eightOctetKeyID pkp of-      Left err ->-        assertFailure ("Expected v6 eight-octet key-id derivation to succeed: " ++ err) >>-        fail "expected v6 eight-octet key-id"-      Right keyId -> pure keyId-  let expectedKeyId = EightOctetKeyId (BL.take 8 (unFingerprint (fingerprint pkp)))-  assertEqual-    "v6 eight-octet key-id should be the high-order 64 bits of the fingerprint"-    expectedKeyId-    derivedKeyId+{-# LANGUAGE OverloadedStrings #-}++module Tests.Serialization (serializationTests) where++import Control.Applicative ((<|>))+import Control.Monad (forM_)+import Crypto.Number.Serialize (os2ip)+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.ECC.Types as ECCT+import Data.Binary (Get, get, put)+import Data.Binary.Put+    ( putByteString+    , putWord16be+    , putWord32be+    , putWord8+    , runPut+    )+import Data.Bits (xor)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import 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.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Maybe (listToMaybe)+import qualified Data.Set as Set+import Data.Word (Word8)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit+    ( Assertion+    , assertBool+    , assertEqual+    , assertFailure+    , testCase+    )++import Codec.Encryption.OpenPGP.Fingerprint+    ( eightOctetKeyID+    , fingerprint+    )+import Codec.Encryption.OpenPGP.Internal (emptyPSC, point2MBS)+import Codec.Encryption.OpenPGP.KeyringParser+    ( parseTKsWithWireRep+    )+import Codec.Encryption.OpenPGP.Policy+    ( defaultVerificationPolicy+    , signatureV6SaltSizeForHashAlgorithm+    )+import Codec.Encryption.OpenPGP.Serialize+    ( parsePkts+    , parsePktsWithWireRep+    )+import Codec.Encryption.OpenPGP.Signatures+    ( VerificationError (..)+    , verifySigWith+    )+import Codec.Encryption.OpenPGP.Types+import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA+import Tests.Common+    ( armorPayload+    , loadArmor+    , readFixturePayload+    , runGet+    )++serializationTests :: TestTree+serializationTests =+    testGroup+        "Serialization"+        [ testGroup+            "Serialization group"+            [ testCase+                "000001-006.public_key"+                (testSerialization "000001-006.public_key")+            , testCase+                "issuer-fingerprint-rejects-unknown-version"+                testIssuerFingerprintRejectsUnknownVersion+            , testCase+                "v6-ed25519-public-key-serializes-fixed-length"+                testV6Ed25519PublicKeySerializesFixedLength+            , testCase+                "v4-ed25519-public-key-parses-native-fixed-length"+                testV4Ed25519PublicKeyParsesNativeFixedLength+            , testCase+                "v4-x25519-public-subkey-parses-native-fixed-length"+                testV4X25519PublicSubkeyParsesNativeFixedLength+            , testCase+                "v6-signature-issuer-fingerprint-version-mismatch"+                testV6SignatureIssuerFingerprintVersionMismatch+            , testCase+                "000002-013.user_id"+                (testSerialization "000002-013.user_id")+            , testCase "000003-002.sig" (testSerialization "000003-002.sig")+            , testCase+                "000004-012.ring_trust"+                (testSerialization "000004-012.ring_trust")+            , testCase "000005-002.sig" (testSerialization "000005-002.sig")+            , testCase+                "000006-012.ring_trust"+                (testSerialization "000006-012.ring_trust")+            , testCase "000007-002.sig" (testSerialization "000007-002.sig")+            , testCase+                "000008-012.ring_trust"+                (testSerialization "000008-012.ring_trust")+            , testCase "000009-002.sig" (testSerialization "000009-002.sig")+            , testCase+                "000010-012.ring_trust"+                (testSerialization "000010-012.ring_trust")+            , testCase "000011-002.sig" (testSerialization "000011-002.sig")+            , testCase+                "000012-012.ring_trust"+                (testSerialization "000012-012.ring_trust")+            , testCase+                "000013-014.public_subkey"+                (testSerialization "000013-014.public_subkey")+            , testCase "000014-002.sig" (testSerialization "000014-002.sig")+            , testCase+                "000015-012.ring_trust"+                (testSerialization "000015-012.ring_trust")+            , testCase+                "000016-006.public_key"+                (testSerialization "000016-006.public_key")+            , testCase "000017-002.sig" (testSerialization "000017-002.sig")+            , testCase+                "000018-012.ring_trust"+                (testSerialization "000018-012.ring_trust")+            , testCase+                "000019-013.user_id"+                (testSerialization "000019-013.user_id")+            , testCase "000020-002.sig" (testSerialization "000020-002.sig")+            , testCase+                "000021-012.ring_trust"+                (testSerialization "000021-012.ring_trust")+            , testCase "000022-002.sig" (testSerialization "000022-002.sig")+            , testCase+                "000023-012.ring_trust"+                (testSerialization "000023-012.ring_trust")+            , testCase+                "000024-014.public_subkey"+                (testSerialization "000024-014.public_subkey")+            , testCase "000025-002.sig" (testSerialization "000025-002.sig")+            , testCase+                "000026-012.ring_trust"+                (testSerialization "000026-012.ring_trust")+            , testCase+                "000027-006.public_key"+                (testSerialization "000027-006.public_key")+            , testCase "000028-002.sig" (testSerialization "000028-002.sig")+            , testCase+                "000029-012.ring_trust"+                (testSerialization "000029-012.ring_trust")+            , testCase+                "000030-013.user_id"+                (testSerialization "000030-013.user_id")+            , testCase "000031-002.sig" (testSerialization "000031-002.sig")+            , testCase+                "000032-012.ring_trust"+                (testSerialization "000032-012.ring_trust")+            , testCase "000033-002.sig" (testSerialization "000033-002.sig")+            , testCase+                "000034-012.ring_trust"+                (testSerialization "000034-012.ring_trust")+            , testCase+                "000035-006.public_key"+                (testSerialization "000035-006.public_key")+            , testCase+                "000036-013.user_id"+                (testSerialization "000036-013.user_id")+            , testCase "000037-002.sig" (testSerialization "000037-002.sig")+            , testCase+                "000038-012.ring_trust"+                (testSerialization "000038-012.ring_trust")+            , testCase "000039-002.sig" (testSerialization "000039-002.sig")+            , testCase+                "000040-012.ring_trust"+                (testSerialization "000040-012.ring_trust")+            , testCase+                "000041-017.attribute"+                (testSerialization "000041-017.attribute")+            , testCase "000042-002.sig" (testSerialization "000042-002.sig")+            , testCase+                "000043-012.ring_trust"+                (testSerialization "000043-012.ring_trust")+            , testCase+                "000044-014.public_subkey"+                (testSerialization "000044-014.public_subkey")+            , testCase "000045-002.sig" (testSerialization "000045-002.sig")+            , testCase+                "000046-012.ring_trust"+                (testSerialization "000046-012.ring_trust")+            , testCase+                "000047-005.secret_key"+                (testSerialization "000047-005.secret_key")+            , testCase+                "000048-013.user_id"+                (testSerialization "000048-013.user_id")+            , testCase "000049-002.sig" (testSerialization "000049-002.sig")+            , testCase+                "000050-012.ring_trust"+                (testSerialization "000050-012.ring_trust")+            , testCase+                "000051-007.secret_subkey"+                (testSerialization "000051-007.secret_subkey")+            , testCase "000052-002.sig" (testSerialization "000052-002.sig")+            , testCase+                "000053-012.ring_trust"+                (testSerialization "000053-012.ring_trust")+            , testCase+                "000054-005.secret_key"+                (testSerialization "000054-005.secret_key")+            , testCase "000055-002.sig" (testSerialization "000055-002.sig")+            , testCase+                "000056-012.ring_trust"+                (testSerialization "000056-012.ring_trust")+            , testCase+                "000057-013.user_id"+                (testSerialization "000057-013.user_id")+            , testCase "000058-002.sig" (testSerialization "000058-002.sig")+            , testCase+                "000059-012.ring_trust"+                (testSerialization "000059-012.ring_trust")+            , testCase+                "000060-007.secret_subkey"+                (testSerialization "000060-007.secret_subkey")+            , testCase "000061-002.sig" (testSerialization "000061-002.sig")+            , testCase+                "000062-012.ring_trust"+                (testSerialization "000062-012.ring_trust")+            , testCase+                "000063-005.secret_key"+                (testSerialization "000063-005.secret_key")+            , testCase "000064-002.sig" (testSerialization "000064-002.sig")+            , testCase+                "000065-012.ring_trust"+                (testSerialization "000065-012.ring_trust")+            , testCase+                "000066-013.user_id"+                (testSerialization "000066-013.user_id")+            , testCase "000067-002.sig" (testSerialization "000067-002.sig")+            , testCase+                "000068-012.ring_trust"+                (testSerialization "000068-012.ring_trust")+            , testCase+                "000069-005.secret_key"+                (testSerialization "000069-005.secret_key")+            , testCase+                "000070-013.user_id"+                (testSerialization "000070-013.user_id")+            , testCase "000071-002.sig" (testSerialization "000071-002.sig")+            , testCase+                "000072-012.ring_trust"+                (testSerialization "000072-012.ring_trust")+            , testCase+                "000073-017.attribute"+                (testSerialization "000073-017.attribute")+            , testCase "000074-002.sig" (testSerialization "000074-002.sig")+            , testCase+                "000075-012.ring_trust"+                (testSerialization "000075-012.ring_trust")+            , testCase+                "000076-007.secret_subkey"+                (testSerialization "000076-007.secret_subkey")+            , testCase "000077-002.sig" (testSerialization "000077-002.sig")+            , testCase+                "000078-012.ring_trust"+                (testSerialization "000078-012.ring_trust")+            , testCase "pubring.gpg" (testSerialization "pubring.gpg")+            , testCase "secring.gpg" (testSerialization "secring.gpg")+            , testCase+                "compressedsig.gpg"+                (testSerialization "compressedsig.gpg")+            , testCase+                "compressedsig-zlib.gpg"+                (testSerialization "compressedsig-zlib.gpg")+            , testCase+                "compressedsig-bzip2.gpg"+                (testSerialization "compressedsig-bzip2.gpg")+            , testCase "onepass_sig" (testSerialization "onepass_sig")+            , testCase+                "uncompressed-ops-dsa.gpg"+                (testSerialization "uncompressed-ops-dsa.gpg")+            , testCase+                "uncompressed-ops-rsa.gpg"+                (testSerialization "uncompressed-ops-rsa.gpg")+            , testCase "simple.seckey" (testSerialization "simple.seckey")+            , testCase+                "v3-genericcert.sig"+                (testSerialization "v3-genericcert.sig")+            , testCase+                "sigs-with-regexes"+                (testSerialization "sigs-with-regexes")+            , testCase+                "gnu-dummy-s2k-101-secret-key.gpg"+                (testSerialization "gnu-dummy-s2k-101-secret-key.gpg")+            , testCase+                "anibal-ed25519.gpg"+                (testSerialization "anibal-ed25519.gpg")+            , testCase+                "nist_p-256_key.gpg"+                (testSerialization "nist_p-256_key.gpg")+            , testCase+                "nist_p-256_secretkey.gpg"+                (testSerialization "nist_p-256_secretkey.gpg")+            , testCase+                "v6-secret.pgp.aa"+                (testSerialization "v6-secret.pgp.aa")+            , testCase+                "sample-eddsa.pubkey"+                (testSerialization "sample-eddsa.pubkey")+            , testCase+                "should not serialize point at infinity"+                testPointAtInfinitySerialization+            , testCase+                "should reject mismatched EC coordinate widths"+                testPointSerializationRejectsMismatchedCoordinateWidths+            ]+        , testGroup+            "TKUnknown Serialization group"+            [ testCase+                "pubring.gpg TKUnknown serialization"+                (testTKSerialization "pubring.gpg")+            , testCase+                "secring.gpg TKUnknown serialization"+                (testTKSerialization "secring.gpg")+            ]+        , testGroup+            "Argon2 S2K group"+            [ testCase+                "Argon2 SKESK packet roundtrip"+                testArgon2S2KPacketRoundTrip+            ]+        , testGroup+            "RFC9580 SEIPD v2 group"+            [ testCase "SEIPD v2 packet roundtrip" testSEIPDv2PacketRoundTrip+            , testCase+                "SEIPD v2 rejects invalid chunk size"+                testSEIPDv2RejectInvalidChunkSize+            , testCase+                "PKESKv6 parsing does not fall back to legacy parser"+                testPKESKv6ParsesAsV6WithoutLegacyFallback+            , testCase+                "PKESKv6 rejects invalid recipient key version"+                testPKESKv6RejectsInvalidRecipientIdentifierVersion+            , testCase+                "PKESKv6 rejects recipient length/version mismatches"+                testPKESKv6RejectsRecipientIdentifierLengthVersionMismatch+            , testCase+                "legacy RSA PKESK rejects extra MPIs"+                testLegacyPKESKRSARejectsExtraMPI+            , testCase+                "legacy ECDH PKESK rejects wrong MPI count"+                testLegacyPKESKECDHRejectsWrongMPICount+            , testCase+                "legacy X25519 PKESK rejects wrong MPI count"+                testLegacyPKESKX25519RejectsWrongMPICount+            , testCase+                "legacy unencrypted secret key rejects checksum mismatch"+                testLegacyUnencryptedSecretKeyRejectsChecksumMismatch+            , testCase+                "legacy secret key rejects unsupported symmetric algorithm IV sizing"+                testLegacySecretKeyRejectsUnsupportedSymmetricAlgorithmIVSizing+            , testCase+                "legacy X25519 PKESK parses RFC9580 v3 octet layout"+                testLegacyPKESKX25519ParsesRFC9580V3OctetLayout+            , testCase+                "SigV6 rejects invalid salt size"+                testSigV6RejectsInvalidSaltSize+            , testCase+                "OPS6 rejects invalid salt size"+                testOPS6RejectsInvalidSaltSize+            , testCase+                "OPS3 rejects invalid nested-flag octet"+                testOPS3RejectsInvalidNestedFlagOctet+            , testCase+                "OPS6 rejects invalid nested-flag octet"+                testOPS6RejectsInvalidNestedFlagOctet+            , testCase+                "ECDH pubkey rejects reserved KDF length 0"+                testECDHPubkeyRejectsReservedKDFLengthZero+            , testCase+                "ECDH pubkey rejects reserved KDF length 255"+                testECDHPubkeyRejectsReservedKDFLength255+            , testCase+                "ECDH pubkey encodes fixed KDF length trailer"+                testECDHPubkeyEncodesFixedKDFLength+            , testCase+                "empty key-flags subpacket encodes explicit zero octet"+                testKeyFlagsSubpacketEncodesEmptySetWithZeroOctet+            , testCase+                "v6-secret fixture SigV6 semantics"+                testV6SecretFixtureSignatureSemantics+            , testCase+                "v6-secret fixture derives eight-octet key-id from fingerprint prefix"+                testV6SecretFixtureDerivesEightOctetKeyID+            ]+        ]++testSerialization :: FilePath -> Assertion+testSerialization fpr = do+    bs <- readFixturePayload fpr+    let firstpass = runGet get bs+    case fmap unBlock firstpass of+        Left _ -> assertFailure $ "First pass failed on " ++ fpr+        Right [] ->+            assertFailure $ "First pass of " ++ fpr ++ " decoded to nothing."+        Right packs -> do+            let roundtrip = runPut $ put (Block packs)+            let secondpass = runGet (get :: Get (Block Pkt)) roundtrip+            if fmap unBlock secondpass == Right []+                then+                    assertFailure $+                        "Second pass of " ++ fpr ++ " decoded to nothing."+                else assertEqual ("for " ++ fpr) firstpass secondpass++testTKSerialization :: FilePath -> Assertion+testTKSerialization fpr = do+    bs <- readFixturePayload fpr+    let pkts = parsePktsWithWireRep (wireRepRef bs) bs+        tksWithWireRep = parseTKsWithWireRep True pkts+    if null tksWithWireRep+        then+            assertFailure $+                "TKUnknown serialization test: " ++ fpr ++ " parsed to no TKs"+        else forM_ tksWithWireRep (testTKRoundtrip fpr)++testTKRoundtrip :: FilePath -> TKWithWireRep -> Assertion+testTKRoundtrip fpr tk = do+    let packets = _tkPackets tk+        encoded = runPut (put (Block (map _pktValue packets)))+    case runGet (get :: Get (Block Pkt)) encoded of+        Left err ->+            assertFailure $+                "TKUnknown " ++ fpr ++ " packet re-parse failed: " ++ err+        Right reparsedBlock ->+            assertEqual+                ("TKUnknown packet re-serialization roundtrip for " ++ fpr)+                (Block (map _pktValue packets))+                reparsedBlock+    case toStructuredTKWithWireRep tk of+        Left err ->+            assertFailure $+                "TKUnknown structured conversion failed for "+                    ++ fpr+                    ++ ": "+                    ++ show err+        Right structured ->+            case canonicalizeTKStructuredWithWireRep structured of+                Left err ->+                    assertFailure $+                        "TKUnknown canonical conversion failed for "+                            ++ fpr+                            ++ ": "+                            ++ show err+                Right _canonical -> pure ()++testArgon2S2KPacketRoundTrip :: Assertion+testArgon2S2KPacketRoundTrip = do+    let s2k = Argon2 (Salt16 (B.pack [0x00 .. 0x0f])) 1 4 15+        pkt =+            SKESKPkt+                (SKESKPayloadV4Packet (SKESKPayloadV4 AES128 s2k Nothing))+        encoded = runPut (put pkt)+    assertEqual+        "Argon2 S2K SKESK packet roundtrip"+        (Right pkt)+        (runGet (get :: Get Pkt) encoded)++testIssuerFingerprintRejectsUnknownVersion :: Assertion+testIssuerFingerprintRejectsUnknownVersion = do+    let encoded =+            runPut $ do+                putWord8 34+                putWord8 33+                putWord8 5+                putByteString (B.replicate 32 0)+    case runGet (get :: Get SigSubPacket) encoded of+        Left _ -> pure ()+        Right _ ->+            assertFailure+                "issuer fingerprint subpacket version 5 should be rejected"++testV6Ed25519PublicKeySerializesFixedLength :: Assertion+testV6Ed25519PublicKeySerializesFixedLength = do+    let pkp =+            PKPayload+                V6+                (ThirtyTwoBitTimeStamp 0)+                0+                EdDSA+                (EdDSAPubKey EdSigningCurve25519 (NativeEPoint (EPoint 1)))+        encoded = runPut (put (PublicKeyPkt pkp))+    assertEqual+        "v6 Ed25519 public key serialization uses fixed-length octet strings"+        44+        (BL.length encoded)++testV4Ed25519PublicKeyParsesNativeFixedLength :: Assertion+testV4Ed25519PublicKeyParsesNativeFixedLength = do+    let raw = B.pack [0x01 .. 0x20]+        encoded =+            runPut $ do+                putWord8 0xc6+                putWord8 38+                putWord8 4+                putWord32be 0+                putWord8 (fromIntegral (fromFVal PKA.Ed25519))+                putByteString raw+    case runGet (get :: Get Pkt) encoded of+        Right+            ( PublicKeyPkt+                    ( PKPayload+                            V4+                            (ThirtyTwoBitTimeStamp 0)+                            _+                            PKA.Ed25519+                            (EdDSAPubKey EdSigningCurve25519 (NativeEPoint (EPoint x)))+                        )+                ) ->+                assertEqual+                    "v4 Ed25519 fixed-length key material parsed as native point"+                    (os2ip raw)+                    x+        other ->+            assertFailure+                ( "Expected v4 Ed25519 fixed-length public key parse, got "+                    ++ show other+                )++testV4X25519PublicSubkeyParsesNativeFixedLength :: Assertion+testV4X25519PublicSubkeyParsesNativeFixedLength = do+    let raw = B.pack [0x01 .. 0x20]+        encoded =+            runPut $ do+                putWord8 0xce+                putWord8 38+                putWord8 4+                putWord32be 0+                putWord8 (fromIntegral (fromFVal PKA.X25519))+                putByteString raw+    case runGet (get :: Get Pkt) encoded of+        Right+            ( PublicSubkeyPkt+                    ( PKPayload+                            V4+                            (ThirtyTwoBitTimeStamp 0)+                            _+                            PKA.X25519+                            (EdDSAPubKey EdSigningCurve25519 (NativeEPoint (EPoint x)))+                        )+                ) ->+                assertEqual+                    "v4 X25519 fixed-length key material parsed as native point"+                    (os2ip raw)+                    x+        other ->+            assertFailure+                ( "Expected v4 X25519 fixed-length public subkey parse, got "+                    ++ show other+                )++testV6SignatureIssuerFingerprintVersionMismatch :: Assertion+testV6SignatureIssuerFingerprintVersionMismatch = do+    let signer =+            PKPayload+                V6+                (ThirtyTwoBitTimeStamp 0)+                0+                EdDSA+                (EdDSAPubKey EdSigningCurve25519 (NativeEPoint (EPoint 1)))+        sig =+            SignaturePkt+                ( SigV6+                    BinarySig+                    EdDSA+                    SHA512+                    (SignatureSalt (BL.replicate 32 0))+                    [ SigSubPacket+                        False+                        (IssuerFingerprint IssuerFingerprintV4 (fingerprint signer))+                    ]+                    []+                    0+                    (NE.fromList [MPI 0, MPI 0])+                )+        verifier _ _ _ =+            Right+                ( Verification+                    signer+                    (case sig of SignaturePkt sp -> sp; _ -> error "impossible")+                    []+                )+    case verifySigWith+        defaultVerificationPolicy+        verifier+        sig+        emptyPSC+        Nothing of+        Left IssuerFingerprintSubpacketMismatch -> pure ()+        Left err -> assertFailure ("unexpected verification error: " ++ show err)+        Right _ ->+            assertFailure+                "v6 signature with issuer fingerprint version 4 should be rejected"++testPointAtInfinitySerialization :: Assertion+testPointAtInfinitySerialization =+    assertEqual+        "point at infinity should not serialize"+        Nothing+        (point2MBS ECCT.PointO)++testPointSerializationRejectsMismatchedCoordinateWidths+    :: Assertion+testPointSerializationRejectsMismatchedCoordinateWidths =+    assertEqual+        "point serialization should reject mismatched coordinate widths"+        Nothing+        (point2MBS (ECCT.Point 1 256))++testSEIPDv2PacketRoundTrip :: Assertion+testSEIPDv2PacketRoundTrip = do+    let salt = Salt (B.pack [0x00 .. 0x1f])+        pkt =+            SymEncIntegrityProtectedDataPkt+                (SEIPD2 AES256 OCB 16 salt "\x01\x02\x03\x04")+        encoded = runPut (put pkt)+    assertEqual+        "SEIPD v2 packet roundtrip"+        (Right pkt)+        (runGet (get :: Get Pkt) encoded)++testSEIPDv2RejectInvalidChunkSize :: Assertion+testSEIPDv2RejectInvalidChunkSize = do+    let encoded =+            runPut $ do+                putWord8 0xd2+                putWord8 37+                putWord8 2+                putWord8 7+                putWord8 2+                putWord8 17+                putByteString (B.replicate 32 0)+                putWord8 0+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> return ()+        other ->+            assertFailure+                ( "SEIPD v2 parser should reject chunk sizes larger than 16, got "+                    ++ show other+                )++testPKESKv6ParsesAsV6WithoutLegacyFallback :: Assertion+testPKESKv6ParsesAsV6WithoutLegacyFallback = do+    let recipientKeyIdentifier = BL.pack (0x04 : replicate 20 0)+        esk = "\x00\x00"+        encoded =+            runPut $ do+                putWord8 0xc1+                putWord8 26+                putWord8 6+                putWord8 21+                putByteString (BL.toStrict recipientKeyIdentifier)+                putWord8 1+                putByteString (BL.toStrict esk)+    case runGet (get :: Get Pkt) encoded of+        Right+            ( PKESKPkt+                    (PKESKPayloadV6Packet (PKESKPayloadV6 rid pka parsedEsk))+                ) -> do+                assertEqual+                    "PKESKv6 recipient key identifier"+                    recipientKeyIdentifier+                    rid+                assertEqual "PKESKv6 algorithm" RSA pka+                assertEqual "PKESKv6 ESK payload" esk parsedEsk+        other ->+            assertFailure+                ("Expected PKESKPkt (PKESK6 ...) parse result, got " ++ show other)++testPKESKv6RejectsInvalidRecipientIdentifierVersion :: Assertion+testPKESKv6RejectsInvalidRecipientIdentifierVersion = do+    let recipientKeyIdentifier = BL.pack (0x05 : replicate 20 0)+        encoded =+            runPut $ do+                putWord8 0xc1+                putWord8 24+                putWord8 6+                putWord8 21+                putByteString (BL.toStrict recipientKeyIdentifier)+                putWord8 1+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> pure ()+        other ->+            assertFailure+                ( "Expected malformed PKESKv6 key version to produce BrokenPacketPkt, got "+                    ++ show other+                )++testPKESKv6RejectsRecipientIdentifierLengthVersionMismatch+    :: Assertion+testPKESKv6RejectsRecipientIdentifierLengthVersionMismatch = do+    let recipientKeyIdentifier = BL.pack (0x04 : replicate 32 0)+        encoded =+            runPut $ do+                putWord8 0xc1+                putWord8 36+                putWord8 6+                putWord8 33+                putByteString (BL.toStrict recipientKeyIdentifier)+                putWord8 1+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> pure ()+        other ->+            assertFailure+                ( "Expected malformed PKESKv6 recipient length/version mismatch to produce BrokenPacketPkt, got "+                    ++ show other+                )++testLegacyPKESKRSARejectsExtraMPI :: Assertion+testLegacyPKESKRSARejectsExtraMPI = do+    let encoded =+            runPut $ do+                putWord8 0xc1+                putWord8 16+                putWord8 3+                putByteString (B.replicate 8 0)+                putWord8 1+                put (MPI 1)+                put (MPI 2)+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> pure ()+        other ->+            assertFailure+                ( "Expected malformed legacy RSA PKESK to produce BrokenPacketPkt, got "+                    ++ show other+                )++testLegacyPKESKECDHRejectsWrongMPICount :: Assertion+testLegacyPKESKECDHRejectsWrongMPICount = do+    let encoded =+            runPut $ do+                putWord8 0xc1+                putWord8 13+                putWord8 3+                putByteString (B.replicate 8 0)+                putWord8 18+                put (MPI 1)+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> pure ()+        other ->+            assertFailure+                ( "Expected malformed legacy ECDH PKESK to produce BrokenPacketPkt, got "+                    ++ show other+                )++testLegacyPKESKX25519RejectsWrongMPICount :: Assertion+testLegacyPKESKX25519RejectsWrongMPICount = do+    let encoded =+            runPut $ do+                putWord8 0xc1+                putWord8 13+                putWord8 3+                putByteString (B.replicate 8 0)+                putWord8 (fromIntegral (fromFVal X25519))+                put (MPI 1)+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> pure ()+        other ->+            assertFailure+                ( "Expected malformed legacy X25519 PKESK to produce BrokenPacketPkt, got "+                    ++ show other+                )++testLegacyUnencryptedSecretKeyRejectsChecksumMismatch+    :: Assertion+testLegacyUnencryptedSecretKeyRejectsChecksumMismatch = do+    secretPackets <-+        DC.runConduitRes $+            CB.sourceFile "tests/data/unencrypted.seckey"+                DC..| conduitGet get+                DC..| CL.consume+    pkt <-+        case secretPackets of+            (SecretKeyPkt pkp (SUUnencrypted sk checksum) : _) ->+                pure (SecretKeyPkt pkp (SUUnencrypted sk (checksum `xor` 1)))+            (SecretKeyPkt _ _ : _) ->+                assertFailure+                    "unencrypted.seckey did not begin with an unencrypted secret key packet"+                    >> fail "expected unencrypted secret key packet"+            _ ->+                assertFailure+                    "unencrypted.seckey did not begin with a secret key packet"+                    >> fail "expected secret key packet"+    let encoded = runPut (put pkt)+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> pure ()+        other ->+            assertFailure+                ( "Expected unencrypted secret key checksum mismatch to produce BrokenPacketPkt, got "+                    ++ show other+                )++testLegacySecretKeyRejectsUnsupportedSymmetricAlgorithmIVSizing+    :: Assertion+testLegacySecretKeyRejectsUnsupportedSymmetricAlgorithmIVSizing = do+    let pkt =+            SecretKeyPkt+                (PKPayload V4 0 0 RSA (UnknownPKey BL.empty))+                ( SUSSHA1+                    (OtherSA 0xfe)+                    (IteratedSalted SHA256 (Salt8 "12345678") (IterationCount 65536))+                    (IV (B.replicate 8 0))+                    BL.empty+                )+        encoded = runPut (put pkt)+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> pure ()+        other ->+            assertFailure+                ( "Expected legacy secret key with unsupported symmetric algorithm to produce BrokenPacketPkt, got "+                    ++ show other+                )++testLegacyPKESKX25519ParsesRFC9580V3OctetLayout :: Assertion+testLegacyPKESKX25519ParsesRFC9580V3OctetLayout = do+    let ephemeral = B.pack [0x01 .. 0x20]+        wrappedWithAlgo =+            B.singleton (fromIntegral (fromFVal AES128))+                <> B.replicate 24 0x5a+        encoded =+            runPut $ do+                putWord8 0xc1+                putWord8+                    ( fromIntegral+                        (1 + 8 + 1 + B.length ephemeral + 1 + B.length wrappedWithAlgo)+                    )+                putWord8 3+                putByteString (B.replicate 8 0)+                putWord8 (fromIntegral (fromFVal X25519))+                putByteString ephemeral+                putWord8 (fromIntegral (B.length wrappedWithAlgo))+                putByteString wrappedWithAlgo+    case runGet (get :: Get Pkt) encoded of+        Right+            ( PKESKPkt+                    ( PKESKPayloadV3Packet+                            (PKESKPayloadV3 3 _ X25519 (ephMPI :| [eskMPI]))+                        )+                ) -> do+                assertEqual+                    "legacy X25519 v3 octet-layout ephemeral parse"+                    (MPI (os2ip ephemeral))+                    ephMPI+                assertEqual+                    "legacy X25519 v3 octet-layout wrapped parse"+                    (MPI (os2ip wrappedWithAlgo))+                    eskMPI+        other ->+            assertFailure+                ( "Expected legacy X25519 PKESK v3 octet-layout parse success, got "+                    ++ show other+                )++testSigV6RejectsInvalidSaltSize :: Assertion+testSigV6RejectsInvalidSaltSize = do+    let encoded =+            runPut $ do+                putWord8 0xc2+                putWord8 45+                putWord8 6+                putWord8 0+                putWord8 1+                putWord8 8+                putWord32be 0+                putWord32be 0+                putWord16be 0+                putWord8 32+                putByteString (B.replicate 32 0)+                putWord16be 0+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> return ()+        other ->+            assertFailure+                ( "Expected invalid SigV6 salt size to produce BrokenPacketPkt, got "+                    ++ show other+                )++testOPS6RejectsInvalidSaltSize :: Assertion+testOPS6RejectsInvalidSaltSize = do+    let encoded =+            runPut $ do+                putWord8 0xc4+                putWord8 69+                putWord8 6+                putWord8 0+                putWord8 10+                putWord8 22+                putWord8 31+                putByteString (B.replicate 31 0)+                putByteString (B.replicate 32 0)+                putWord8 0+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> return ()+        other ->+            assertFailure+                ( "Expected invalid OPS6 salt size to produce BrokenPacketPkt, got "+                    ++ show other+                )++testOPS3RejectsInvalidNestedFlagOctet :: Assertion+testOPS3RejectsInvalidNestedFlagOctet = do+    let encoded =+            runPut $ do+                putWord8 0xc4+                putWord8 13+                putWord8 3+                putWord8 0+                putWord8 8+                putWord8 1+                putByteString (B.replicate 8 0)+                putWord8 2+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> pure ()+        other ->+            assertFailure+                ( "Expected invalid OPS3 nested-flag octet to produce BrokenPacketPkt, got "+                    ++ show other+                )++testOPS6RejectsInvalidNestedFlagOctet :: Assertion+testOPS6RejectsInvalidNestedFlagOctet = do+    let encoded =+            runPut $ do+                putWord8 0xc4+                putWord8 70+                putWord8 6+                putWord8 0+                putWord8 8+                putWord8 1+                putWord8 32+                putByteString (B.replicate 32 0)+                putByteString (B.replicate 32 0)+                putWord8 2+    case runGet (get :: Get Pkt) encoded of+        Right BrokenPacketPkt {} -> pure ()+        other ->+            assertFailure+                ( "Expected invalid OPS6 nested-flag octet to produce BrokenPacketPkt, got "+                    ++ show other+                )++mkECDHBoundaryTestPacket :: Pkt+mkECDHBoundaryTestPacket =+    PublicKeyPkt+        ( PKPayload+            V4+            0+            0+            ECDH+            ( ECDHPubKey+                ( ECDSAPubKey+                    ( ECDSA_PublicKey+                        ( ECDSA.PublicKey+                            (ECCT.getCurveByName ECCT.SEC_p256r1)+                            (ECCT.Point 1 2)+                        )+                    )+                )+                SHA256+                AES128+            )+        )++setStrictByteAt+    :: Int -> Word8 -> B.ByteString -> Maybe B.ByteString+setStrictByteAt idx w bs+    | idx < 0 || idx >= B.length bs = Nothing+    | otherwise =+        let (prefix, rest) = B.splitAt idx bs+         in case B.uncons rest of+                Nothing -> Nothing+                Just (_, suffix) -> Just (prefix <> B.singleton w <> suffix)++testECDHPubkeyRejectsReservedKDFLengthZero :: Assertion+testECDHPubkeyRejectsReservedKDFLengthZero = do+    let encoded = BL.toStrict (runPut (put mkECDHBoundaryTestPacket))+    mutated <-+        maybe+            ( assertFailure+                "failed to locate ECDH KDF length byte for zero-length rejection test"+                >> fail "unreachable"+            )+            pure+            (setStrictByteAt (B.length encoded - 4) 0x00 encoded)+    case runGet (get :: Get Pkt) (BL.fromStrict mutated) of+        Right BrokenPacketPkt {} -> pure ()+        other ->+            assertFailure+                ( "Expected ECDH KDF length 0 to produce BrokenPacketPkt, got "+                    ++ show other+                )++testECDHPubkeyRejectsReservedKDFLength255 :: Assertion+testECDHPubkeyRejectsReservedKDFLength255 = do+    let encoded = BL.toStrict (runPut (put mkECDHBoundaryTestPacket))+    mutated <-+        maybe+            ( assertFailure+                "failed to locate ECDH KDF length byte for 0xff rejection test"+                >> fail "unreachable"+            )+            pure+            (setStrictByteAt (B.length encoded - 4) 0xff encoded)+    case runGet (get :: Get Pkt) (BL.fromStrict mutated) of+        Right BrokenPacketPkt {} -> pure ()+        other ->+            assertFailure+                ( "Expected ECDH KDF length 255 to produce BrokenPacketPkt, got "+                    ++ show other+                )++testECDHPubkeyEncodesFixedKDFLength :: Assertion+testECDHPubkeyEncodesFixedKDFLength = do+    let encoded = BL.toStrict (runPut (put mkECDHBoundaryTestPacket))+        trailer = B.drop (B.length encoded - 4) encoded+    assertEqual+        "ECDH public-key encoding should emit fixed KDF trailer [3,1,hash,sym]"+        (B.pack [0x03, 0x01, fromFVal SHA256, fromFVal AES128])+        trailer++testKeyFlagsSubpacketEncodesEmptySetWithZeroOctet :: Assertion+testKeyFlagsSubpacketEncodesEmptySetWithZeroOctet = do+    let encoded = runPut (put (SigSubPacket False (KeyFlags Set.empty)))+    assertEqual+        "empty key-flags subpacket should encode an explicit zero flags octet"+        [2, 27, 0]+        (BL.unpack encoded)+    case runGet (get :: Get SigSubPacket) encoded of+        Right (SigSubPacket False (KeyFlags flags)) ->+            assertEqual+                "empty key-flags subpacket should decode back to an empty flag set"+                Set.empty+                flags+        other ->+            assertFailure+                ( "Expected empty key-flags subpacket roundtrip, got "+                    ++ show other+                )++expectedV6SaltSizeForTest :: HashAlgorithm -> Maybe Int+expectedV6SaltSizeForTest =+    fmap fromIntegral . signatureV6SaltSizeForHashAlgorithm++signatureHasIssuerFingerprintV6+    :: Fingerprint -> SignaturePayload -> Bool+signatureHasIssuerFingerprintV6 expectedFp (SigV6 _ _ _ _ hashed unhashed _ _) =+    expectedFp+        `elem` [ ifp+               | SigSubPacket _ (IssuerFingerprint IssuerFingerprintV6 ifp) <-+                    hashed ++ unhashed+               ]+signatureHasIssuerFingerprintV6 _ _ = False++testV6SecretFixtureSignatureSemantics :: Assertion+testV6SecretFixtureSignatureSemantics = do+    armors <- loadArmor "v6-secret.pgp.aa"+    payload <-+        case armors of+            (a : _) -> pure (armorPayload a)+            [] ->+                assertFailure+                    "v6-secret.pgp.aa should contain one armored payload"+                    >> fail "expected one armored payload"+    let packets = parsePkts payload+        primaryV6Key =+            listToMaybe+                [ pkp+                | SecretKeyPkt pkp _ <- packets+                , _keyVersion pkp == V6+                ]+                <|> listToMaybe+                    [ pkp+                    | PublicKeyPkt pkp <- packets+                    , _keyVersion pkp == V6+                    ]+        signatures =+            [ (sig, ha, salt)+            | SignaturePkt sig@(SigV6 _ _ ha salt _ _ _ _) <- packets+            ]+    pkp <-+        case primaryV6Key of+            Nothing ->+                assertFailure+                    "v6-secret.pgp.aa should contain a primary v6 key packet"+                    >> fail "expected primary v6 key packet"+            Just k -> pure k+    assertBool+        "v6-secret.pgp.aa should contain at least one SigV6 packet"+        (not (null signatures))+    mapM_+        ( \(_, ha, salt) ->+            case expectedV6SaltSizeForTest ha of+                Nothing ->+                    assertFailure+                        ( "SigV6 in v6-secret.pgp.aa uses unsupported salt hash algorithm: "+                            ++ show ha+                        )+                Just expected ->+                    assertEqual+                        "SigV6 salt size in v6-secret.pgp.aa should match hash algorithm"+                        expected+                        (fromIntegral (BL.length (unSignatureSalt salt)))+        )+        signatures+    assertBool+        "v6-secret.pgp.aa should include at least one IssuerFingerprint v6 matching the primary key"+        ( any+            ( \(sig, _, _) -> signatureHasIssuerFingerprintV6 (fingerprint pkp) sig+            )+            signatures+        )++testV6SecretFixtureDerivesEightOctetKeyID :: Assertion+testV6SecretFixtureDerivesEightOctetKeyID = do+    armors <- loadArmor "v6-secret.pgp.aa"+    payload <-+        case armors of+            (a : _) -> pure (armorPayload a)+            [] ->+                assertFailure+                    "v6-secret.pgp.aa should contain one armored payload"+                    >> fail "expected one armored payload"+    let packets = parsePkts payload+        primaryV6Key =+            listToMaybe+                [ pkp+                | SecretKeyPkt pkp _ <- packets+                , _keyVersion pkp == V6+                ]+                <|> listToMaybe+                    [ pkp+                    | PublicKeyPkt pkp <- packets+                    , _keyVersion pkp == V6+                    ]+    pkp <-+        case primaryV6Key of+            Nothing ->+                assertFailure+                    "v6-secret.pgp.aa should contain a primary v6 key packet"+                    >> fail "expected primary v6 key packet"+            Just k -> pure k+    derivedKeyId <-+        case eightOctetKeyID pkp of+            Left err ->+                assertFailure+                    ("Expected v6 eight-octet key-id derivation to succeed: " ++ err)+                    >> fail "expected v6 eight-octet key-id"+            Right keyId -> pure keyId+    let expectedKeyId = EightOctetKeyId (BL.take 8 (unFingerprint (fingerprint pkp)))+    assertEqual+        "v6 eight-octet key-id should be the high-order 64 bits of the fingerprint"+        expectedKeyId+        derivedKeyId
tests/Tests/Utilities.hs view
@@ -2,1354 +2,1622 @@ -- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).--{-# LANGUAGE OverloadedStrings #-}--module Tests.Utilities (utilityTests) where--import Codec.Encryption.OpenPGP.Fingerprint (fingerprint)-import Codec.Encryption.OpenPGP.KeyInfo (pkalgoAbbrev)-import Codec.Encryption.OpenPGP.KeyringParser-  ( parsePublicTKs-  , parseSecretTKs-  , parseTKsEither-  , parseTKs-  , parseTKsWithWireRep-  , parseUnknownTKs-  )-import Codec.Encryption.OpenPGP.Serialize-  ( PktParseError(..)-  , WireRepInput(..)-  , conduitParsePktsWithWireRep-  , dearmorIfAsciiArmored-  , dearmorIfAsciiArmoredLenient-  , looksLikeAsciiArmor-  , parsePkts-  , parsePktsEither-  , parsePktsWithWireRep-  , wireRepRefFromInput-  )-import Codec.Encryption.OpenPGP.Types-import Crypto.Number.Serialize (os2ip)-import Data.Binary (get)-import Data.Binary.Get (Get)-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.OpenPGP.Keyring-  ( AuthSecretSubkeyRejectionReason(..)-  , AuthSecretSubkeyUID(..)-  , AuthSecretSubkeysAtReport(..)-  , authSecretSubkeysAt-  , authSecretSubkeysAtReport-  , authSecretSubkeyPrimaryUID-  , authSecretSubkeyRejectedReason-  , authSecretSubkeyUIDs-  , authSecretSubkeyValue-  , conduitToSomeTKsDroppingEither-  , conduitToAuthSecretSubkeysAt-  , conduitToAuthSecretSubkeysAtReport-  , conduitToSomeTKsEither-  , conduitToPublicTKs-  , conduitToSecretTKs-  , conduitToTKs-  , conduitToTKsWithWireRep-  , conduitToUnknownTKs-  )-import Data.Conduit.Serialization.Binary (conduitGet)-import Data.Either (lefts, rights)-import Data.List (isInfixOf, nub, sortOn)-import Data.List.NonEmpty (NonEmpty(..))-import Data.Maybe (catMaybes)-import qualified Data.Set as Set-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, assertFailure, testCase)-import Tests.Common-  ( addTimestampSeconds-  , loadAndDecompressPkts-  , loadUnencryptedRsaSigner-  , loadV6UnencryptedSecretKeyFixtureForProperty-  , readFixtureLazy-  , readFixturePackets-  , runGet-  , setKeyTimestamp-  , signCertificationAt-  , signSubkeyBindingWithRSAExtrasAt-  , signSubkeyRevocationWithRSAAt-  , timestampToUTCTime-  )---utilityTests :: TestTree-utilityTests =-  testGroup-    "Utility function group"-    [ testCase "pubring as packets" (testParsePktsUtil "pubring.gpg")-    , testCase-        "pubring parsePktsEither equals parsePkts on valid input"-        (testParsePktsEitherUtil "pubring.gpg")-    , testCase-        "parsePktsEither reports truncation errors"-        (testParsePktsEitherFailureUtil "pubring.gpg")-    , testCase-            "parseUnknownTKs drops disallowed primary-key signature context (v4)"-            testParseTKsDropsDisallowedPrimaryKeySigContextV4-    , testCase-            "parseUnknownTKs drops disallowed primary-key signature context (v6)"-            testParseTKsDropsDisallowedPrimaryKeySigContextV6-    , testCase-            "parseUnknownTKs accepts allowed primary-key signature context (v6)"-            testParseTKsAcceptsAllowedPrimaryKeySigContextV6-    , testCase "pubring as TKs" (testParseTKsUtil "pubring.gpg")-    , testCase-        "pubring as typed TKs"-        (testParseTKsTypedUtil "pubring.gpg")-    , testCase-        "pubring parseTKsEither preserves typed parse outcomes"-        (testParseTKsEitherUtil "pubring.gpg")-    , testCase-        "typed TKUnknown conduit partitioning"-        (testConduitToTKsTypedUtil "pubring.gpg")-    , testCase-        "typed TK conduit either reports values without silent drops on valid input"-        (testConduitToSomeTKsEitherUtil "pubring.gpg")-    , testCase-        "typed TK dropping conduit either preserves valid typed results"-        (testConduitToSomeTKsDroppingEitherUtil "pubring.gpg")-    , testCase-        "auth-capable secret-subkey conduit filters revoked/expired/auth flags"-        testConduitToAuthSecretSubkeysAtFiltersByValidityAndAuth-    , testCase-        "auth-capable secret-subkey conduit tracks primary UID over time"-        testConduitToAuthSecretSubkeysAtTracksPrimaryUIDOverTime-    , testCase-        "auth-capable secret-subkey report includes typed rejection reasons"-        testAuthSecretSubkeysAtReportIncludesRejectionReasons-    , testCase-        "pkalgoAbbrev handles RFC9580-era pubkey algorithms"-        testPKAlgoAbbrevRFC9580-    , testCase-        "EightOctetKeyId Show/Read roundtrip uses hex form"-        testEightOctetKeyIdReadShowRoundtrip-    , testCase-        "PktWithWireRep Ord uses raw bytes for tie-breakers"-        testPktWithWireRepOrdUsesRawBytes-    , testCase-        "pubring as packets with provenance"-        (testParsePktsWithWireRepUtil "pubring.gpg")-    , testCase-        "pubring as TKs with provenance"-        (testParseTKsWithWireRepUtil "pubring.gpg")-    , testCase-        "wire provenance tracks original ASCII armor"-        testWireRepRefTracksArmorProvenance-    , testCase-        "dearmorIfAsciiArmored rejects multi-block armored inputs"-        testDearmorRejectsMultipleBlocks-    , testCase-        "dearmorIfAsciiArmoredLenient accepts BOM-prefixed armor"-        testDearmorLenientAcceptsBomPrefixedArmor-    , testCase-        "looksLikeAsciiArmor centralizes armor prefix detection"-        testLooksLikeAsciiArmor-    , testCase-        "wireRepRefFromInput surfaces malformed armored decode errors"-        testWireRepRefRejectsMalformedArmoredInput-    , testCase-        "tksFromWireRep matches any source in TKUnknown provenance list"-        testTksFromWireRepMatchesAnySource-    , testCase-        "TKWithWireRep Semigroup preserves structured provenance"-        testSemigroupTKWithWireRepPreservesStructuredRefs-    , testCase-        "canonicalizeTKWithWireRep matches manual wire-byte ordering"-        testCanonicalizeTKWithWireRepMatchesManualWireOrdering-    , testCase-        "canonicalizeTKWithWireRep reports missing packet refs"-        testCanonicalizeTKWithWireRepReportsMissingRef-    , testCase-        "KeyPkt wrappers preserve packet kind/role round-trips"-        testKeyPktWrappersRoundTrip-    , testCase-        "TK public/secret conversion and projection round-trip"-        testTKTypedRoundTripAndPublicView-    , testCase-        "uat.gpg embeds expected image data from uat.jpg"-        testUatImageFixture-    ]--testPKAlgoAbbrevRFC9580 :: Assertion-testPKAlgoAbbrevRFC9580 = do-  assertEqual "X25519 abbreviation" "x25" (pkalgoAbbrev (toFVal 25))-  assertEqual "X448 abbreviation" "x448" (pkalgoAbbrev (toFVal 26))-  assertEqual "Ed25519 abbreviation" "e25" (pkalgoAbbrev (toFVal 27))-  assertEqual "Ed448 abbreviation" "e448" (pkalgoAbbrev (toFVal 28))--testEightOctetKeyIdReadShowRoundtrip :: Assertion-testEightOctetKeyIdReadShowRoundtrip = do-  let eoki = EightOctetKeyId (BL.pack [0x01, 0x23, 0x45, 0x67, 0x89, 0xab, 0xcd, 0xef])-  assertEqual "show prints canonical uppercase hex" "0123456789ABCDEF" (show eoki)-  assertEqual "read . show roundtrip" eoki (read (show eoki))--testUatImageFixture :: Assertion-testUatImageFixture = do-  expectedImage <- readFixtureLazy "uat.jpg"-  packets <- loadAndDecompressPkts "uat.gpg"-  let images =-        [ imageData-        | UserAttributePkt uas <- packets-        , ImageAttribute _ imageData <- uas-        ]-  assertBool "uat.gpg should contain a user-attribute image packet" (not (null images))-  assertBool-    "uat.gpg should embed the uat.jpg payload"-    (expectedImage `elem` images)--testParsePktsUtil :: FilePath -> Assertion-testParsePktsUtil fn = do-  cp <- readFixturePackets fn-  pp <- parsePkts `fmap` readFixtureLazy fn-  assertEqual-    "parsePkts utility function gives same results as conduit pipeline"-    cp-    pp--testParsePktsEitherUtil :: FilePath -> Assertion-testParsePktsEitherUtil fn = do-  lbs <- readFixtureLazy fn-  assertEqual-    "parsePktsEither matches parsePkts on valid input"-    (Right (parsePkts lbs))-    (parsePktsEither lbs)--testParsePktsEitherFailureUtil :: FilePath -> Assertion-testParsePktsEitherFailureUtil fn = do-  lbs <- readFixtureLazy fn-  let truncated = BL.take (BL.length lbs - 1) lbs-  case parsePktsEither truncated of-    Left (PktParseError off msg) -> do-      assertBool "parsePktsEither reports non-empty parse error messages" (not (null msg))-      assertBool "parsePktsEither reports an in-range failure offset" (off >= 0 && off <= BL.length truncated)-      assertBool-        "legacy parsePkts still returns a parsed prefix on malformed input"-        (length (parsePkts truncated) <= length (parsePkts lbs))-    Right _ ->-      assertFailure "parsePktsEither should fail when input is truncated"--testParseTKsUtil :: FilePath -> Assertion-testParseTKsUtil fn = do-  lbs <- readFixtureLazy fn-  cp <--    DC.runConduitRes $-    CB.sourceLbs lbs DC..| conduitGet get DC..| conduitToUnknownTKs DC..| CL.consume-  let pt = parseUnknownTKs True . parsePkts $ lbs-  assertEqual-    "parsePkts utility function gives same results as conduit pipeline"-    cp-    pt--testParseTKsTypedUtil :: FilePath -> Assertion-testParseTKsTypedUtil fn = do-  lbs <- readFixtureLazy fn-  let packets = parsePkts lbs-      plain = parseUnknownTKs True packets-      typed = parseTKs True packets-      typedPublic = parsePublicTKs True packets-      typedSecret = parseSecretTKs True packets-  assertEqual-    "parseTKs round-trips to the same untyped TKUnknown semantics"-    plain-    (map someTKToUnknown typed)-  assertEqual-    "public + secret typed partitions preserve full typed parse count"-    (length typed)-    (length typedPublic + length typedSecret)--testParseTKsEitherUtil :: FilePath -> Assertion-testParseTKsEitherUtil fn = do-  lbs <- readFixtureLazy fn-  let packets = parsePkts lbs-      typed = parseTKs True packets-      typedEither = parseTKsEither True packets-  assertEqual-    "parseTKsEither right results should match parseTKs"-    typed-    (rights typedEither)-  assertBool-    "parseTKsEither should have no conversion failures for canonical pubring fixture"-    (null (lefts typedEither))--testConduitToTKsTypedUtil :: FilePath -> Assertion-testConduitToTKsTypedUtil fn = do-  lbs <- readFixtureLazy fn-  allTyped <--    DC.runConduitRes $-    CB.sourceLbs lbs DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume-  publicTyped <--    DC.runConduitRes $-    CB.sourceLbs lbs DC..| conduitGet get DC..| conduitToPublicTKs DC..| CL.consume-  secretTyped <--    DC.runConduitRes $-    CB.sourceLbs lbs DC..| conduitGet get DC..| conduitToSecretTKs DC..| CL.consume-  assertEqual-    "typed conduit round-trips to parseUnknownTKs semantics"-    (parseUnknownTKs True (parsePkts lbs))-    (map someTKToUnknown allTyped)-  assertEqual-    "typed conduit public + secret partitions preserve full count"-    (length allTyped)-    (length publicTyped + length secretTyped)--testConduitToSomeTKsEitherUtil :: FilePath -> Assertion-testConduitToSomeTKsEitherUtil fn = do-  lbs <- readFixtureLazy fn-  results <--    DC.runConduitRes $-    CB.sourceLbs lbs DC..| conduitGet get DC..| conduitToSomeTKsEither DC..| CL.consume-  let typedFromEither = catMaybes (rights results)-  assertBool-    "conduitToSomeTKsEither should not report failures for canonical pubring fixture"-    (null (lefts results))-  assertEqual-    "conduitToSomeTKsEither right values should match conduitToTKs semantics"-    (parseTKs True (parsePkts lbs))-    typedFromEither--testConduitToSomeTKsDroppingEitherUtil :: FilePath -> Assertion-testConduitToSomeTKsDroppingEitherUtil fn = do-  lbs <- readFixtureLazy fn-  results <--    DC.runConduitRes $-    CB.sourceLbs lbs DC..| conduitGet get DC..| conduitToSomeTKsDroppingEither DC..| CL.consume-  let typedFromEither = catMaybes (rights results)-  assertBool-    "conduitToSomeTKsDroppingEither should not report failures for canonical pubring fixture"-    (null (lefts results))-  assertEqual-    "conduitToSomeTKsDroppingEither right values should match tolerant parseTKs semantics"-    (parseTKs False (parsePkts lbs))-    typedFromEither--testConduitToAuthSecretSubkeysAtFiltersByValidityAndAuth :: Assertion-testConduitToAuthSecretSubkeysAtFiltersByValidityAndAuth = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  let baseTime = _timestamp signer-      beforeTime = timestampToUTCTime (addTimestampSeconds baseTime 18)-      afterTime = timestampToUTCTime (addTimestampSeconds baseTime 24)-      uidText = "auth-subkeys@example.org"-      uid = UserId uidText-      secretAddendum = SUUnencrypted (RSAPrivateKey (RSA_PrivateKey signingKey)) 0-      authSubkey = setKeyTimestamp (addTimestampSeconds baseTime 1) signer-      expiringAuthSubkey = setKeyTimestamp (addTimestampSeconds baseTime 2) signer-      signingOnlySubkey = setKeyTimestamp (addTimestampSeconds baseTime 3) signer--  uidCertification <--    signCertificationAt-      signer-      signingKey-      uid-      (addTimestampSeconds baseTime 8)-      [SigSubPacket False (PrimaryUserId True)]-  authBinding <--    signSubkeyBindingWithRSAExtrasAt-      signer-      authSubkey-      signingKey-      (addTimestampSeconds baseTime 10)-      [SigSubPacket False (KeyFlags (Set.fromList [AuthKey]))]-  expiringAuthBinding <--    signSubkeyBindingWithRSAExtrasAt-      signer-      expiringAuthSubkey-      signingKey-      (addTimestampSeconds baseTime 10)-      [ SigSubPacket False (KeyFlags (Set.fromList [AuthKey]))-      , SigSubPacket False (KeyExpirationTime 20)-      ]-  signingOnlyBinding <--    signSubkeyBindingWithRSAExtrasAt-      signer-      signingOnlySubkey-      signingKey-      (addTimestampSeconds baseTime 10)-      [SigSubPacket False (KeyFlags (Set.fromList [SignDataKey]))]-  authRevocation <--    signSubkeyRevocationWithRSAAt-      signer-      authSubkey-      signingKey-      (addTimestampSeconds baseTime 22)--  let tk =-        TKUnknown-          (signer, Just secretAddendum)-          []-          [(uidText, [uidCertification])]-          []-          [ (SecretSubkeyPkt authSubkey secretAddendum, [authBinding, authRevocation])-          , (SecretSubkeyPkt expiringAuthSubkey secretAddendum, [expiringAuthBinding])-          , (SecretSubkeyPkt signingOnlySubkey secretAddendum, [signingOnlyBinding])-          ]-  typedSecret <--    case fromUnknownToTK tk of-      Right (SomeSecretTK typed) -> pure typed-      Right (SomePublicTK _) ->-        assertFailure "expected secret typed TKUnknown for auth subkey test fixture" >> fail "unreachable"-      Left err ->-        assertFailure ("fromUnknownToTK failed for auth subkey test fixture: " ++ err) >> fail "unreachable"--  selectedBefore <--    DC.runConduitRes $-    CL.sourceList [typedSecret] DC..| conduitToAuthSecretSubkeysAt beforeTime DC..| CL.consume-  assertEqual-    "pure authSecretSubkeysAt helper and conduit output should match"-    (authSecretSubkeysAt beforeTime typedSecret)-    selectedBefore-  assertEqual-    "before revocation/expiry, conduit should keep only auth-capable secret subkeys"-    2-    (length selectedBefore)-  let selectedBeforeFps =-        Set.fromList-          (map (fingerprint . keyPktPKPayload . authSecretSubkeyValue) selectedBefore)-  assertEqual-    "selected auth-capable subkeys should match expected fingerprints"-    (Set.fromList [fingerprint authSubkey, fingerprint expiringAuthSubkey])-    selectedBeforeFps-  mapM_-    (\selection -> do-       assertEqual "selected auth subkey should retain active primary UID context" (Just uidText) (authSecretSubkeyPrimaryUID selection)-       assertEqual-         "selected auth subkey should expose UID context with primary marker"-         [AuthSecretSubkeyUID uidText True]-         (authSecretSubkeyUIDs selection))-    selectedBefore--  selectedAfter <--    DC.runConduitRes $-    CL.sourceList [typedSecret] DC..| conduitToAuthSecretSubkeysAt afterTime DC..| CL.consume-  assertEqual-    "after revocation/expiry, conduit should drop revoked/expired auth subkeys"-    []-    selectedAfter--testConduitToAuthSecretSubkeysAtTracksPrimaryUIDOverTime :: Assertion-testConduitToAuthSecretSubkeysAtTracksPrimaryUIDOverTime = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  let baseTime = _timestamp signer-      beforeTime = timestampToUTCTime (addTimestampSeconds baseTime 15)-      afterTime = timestampToUTCTime (addTimestampSeconds baseTime 25)-      uidA = UserId "uid-a@example.org"-      UserId uidAText = uidA-      uidB = UserId "uid-b@example.org"-      UserId uidBText = uidB-      secretAddendum = SUUnencrypted (RSAPrivateKey (RSA_PrivateKey signingKey)) 0-      authSubkey = setKeyTimestamp (addTimestampSeconds baseTime 1) signer--  uidACert <--    signCertificationAt-      signer-      signingKey-      uidA-      (addTimestampSeconds baseTime 10)-      [SigSubPacket False (PrimaryUserId True)]-  uidBCert <--    signCertificationAt-      signer-      signingKey-      uidB-      (addTimestampSeconds baseTime 20)-      [SigSubPacket False (PrimaryUserId True)]-  authBinding <--    signSubkeyBindingWithRSAExtrasAt-      signer-      authSubkey-      signingKey-      (addTimestampSeconds baseTime 11)-      [SigSubPacket False (KeyFlags (Set.fromList [AuthKey]))]--  let tk =-        TKUnknown-          (signer, Just secretAddendum)-          []-          [(uidAText, [uidACert]), (uidBText, [uidBCert])]-          []-          [(SecretSubkeyPkt authSubkey secretAddendum, [authBinding])]-  typedSecret <--    case fromUnknownToTK tk of-      Right (SomeSecretTK typed) -> pure typed-      Right (SomePublicTK _) ->-        assertFailure "expected secret typed TKUnknown for primary-uid test fixture" >> fail "unreachable"-      Left err ->-        assertFailure ("fromUnknownToTK failed for primary-uid test fixture: " ++ err) >> fail "unreachable"--  beforeSelections <--    DC.runConduitRes $-    CL.sourceList [typedSecret] DC..| conduitToAuthSecretSubkeysAt beforeTime DC..| CL.consume-  beforeSelection <--    case beforeSelections of-      [selection] -> pure selection-      other ->-        assertFailure ("expected one auth-capable subkey selection before primary-uid rollover, got " ++ show (length other)) >>-        fail "unreachable"-  assertEqual-    "earlier primary UID should be selected before newer self-certification"-    (Just uidAText)-    (authSecretSubkeyPrimaryUID beforeSelection)-  assertEqual-    "UID context should include only active UIDs before uid-b certification exists"-    [(uidAText, True)]-    (map (\u -> (authSecretSubkeyUIDValue u, authSecretSubkeyUIDIsPrimary u)) (authSecretSubkeyUIDs beforeSelection))--  afterSelections <--    DC.runConduitRes $-    CL.sourceList [typedSecret] DC..| conduitToAuthSecretSubkeysAt afterTime DC..| CL.consume-  afterSelection <--    case afterSelections of-      [selection] -> pure selection-      other ->-        assertFailure ("expected one auth-capable subkey selection after primary-uid rollover, got " ++ show (length other)) >>-        fail "unreachable"-  assertEqual-    "newer primary UID self-certification should win after rollover"-    (Just uidBText)-    (authSecretSubkeyPrimaryUID afterSelection)-  assertEqual-    "UID context should mark uid-b as primary after rollover"-    [(uidAText, False), (uidBText, True)]-    (map (\u -> (authSecretSubkeyUIDValue u, authSecretSubkeyUIDIsPrimary u)) (authSecretSubkeyUIDs afterSelection))--testAuthSecretSubkeysAtReportIncludesRejectionReasons :: Assertion-testAuthSecretSubkeysAtReportIncludesRejectionReasons = do-  (signer, signingKey) <- loadUnencryptedRsaSigner-  let baseTime = _timestamp signer-      beforeTime = timestampToUTCTime (addTimestampSeconds baseTime 18)-      afterTime = timestampToUTCTime (addTimestampSeconds baseTime 24)-      uidText = "auth-subkeys@example.org"-      uid = UserId uidText-      secretAddendum = SUUnencrypted (RSAPrivateKey (RSA_PrivateKey signingKey)) 0-      authSubkey = setKeyTimestamp (addTimestampSeconds baseTime 1) signer-      expiringAuthSubkey = setKeyTimestamp (addTimestampSeconds baseTime 2) signer-      signingOnlySubkey = setKeyTimestamp (addTimestampSeconds baseTime 3) signer--  uidCertification <--    signCertificationAt-      signer-      signingKey-      uid-      (addTimestampSeconds baseTime 8)-      [SigSubPacket False (PrimaryUserId True)]-  authBinding <--    signSubkeyBindingWithRSAExtrasAt-      signer-      authSubkey-      signingKey-      (addTimestampSeconds baseTime 10)-      [SigSubPacket False (KeyFlags (Set.fromList [AuthKey]))]-  expiringAuthBinding <--    signSubkeyBindingWithRSAExtrasAt-      signer-      expiringAuthSubkey-      signingKey-      (addTimestampSeconds baseTime 10)-      [ SigSubPacket False (KeyFlags (Set.fromList [AuthKey]))-      , SigSubPacket False (KeyExpirationTime 20)-      ]-  signingOnlyBinding <--    signSubkeyBindingWithRSAExtrasAt-      signer-      signingOnlySubkey-      signingKey-      (addTimestampSeconds baseTime 10)-      [SigSubPacket False (KeyFlags (Set.fromList [SignDataKey]))]-  authRevocation <--    signSubkeyRevocationWithRSAAt-      signer-      authSubkey-      signingKey-      (addTimestampSeconds baseTime 22)--  let tk =-        TKUnknown-          (signer, Just secretAddendum)-          []-          [(uidText, [uidCertification])]-          []-          [ (SecretSubkeyPkt authSubkey secretAddendum, [authBinding, authRevocation])-          , (SecretSubkeyPkt expiringAuthSubkey secretAddendum, [expiringAuthBinding])-          , (SecretSubkeyPkt signingOnlySubkey secretAddendum, [signingOnlyBinding])-          ]-  typedSecret <--    case fromUnknownToTK tk of-      Right (SomeSecretTK typed) -> pure typed-      Right (SomePublicTK _) ->-        assertFailure "expected secret typed TKUnknown for auth subkey rejection test fixture" >> fail "unreachable"-      Left err ->-        assertFailure ("fromUnknownToTK failed for auth subkey rejection test fixture: " ++ err) >> fail "unreachable"--  let beforeReport = authSecretSubkeysAtReport beforeTime typedSecret-  assertEqual-    "report accepted list should match authSecretSubkeysAt before revocation/expiry"-    (authSecretSubkeysAt beforeTime typedSecret)-    (authSecretSubkeysAccepted beforeReport)-  assertEqual-    "before revocation/expiry, only signing-only subkey should be rejected"-    [AuthSecretSubkeyMissingAuthCapability]-    (map authSecretSubkeyRejectedReason (authSecretSubkeysRejected beforeReport))--  afterReportsViaConduit <--    DC.runConduitRes $-    CL.sourceList [typedSecret] DC..| conduitToAuthSecretSubkeysAtReport afterTime DC..| CL.consume-  afterReport <--    case afterReportsViaConduit of-      [singleReport] -> pure singleReport-      other ->-        assertFailure ("expected one report from conduitToAuthSecretSubkeysAtReport, got " ++ show (length other)) >>-        fail "unreachable"-  assertEqual-    "after revocation/expiry, no accepted auth subkeys should remain"-    []-    (authSecretSubkeysAccepted afterReport)-  assertEqual-    "after revocation/expiry, rejected reasons should report invalid-time and missing-auth cases for still-visible candidates"-    [ AuthSecretSubkeySubkeyInvalidAtTime-    , AuthSecretSubkeyMissingAuthCapability-    ]-    (map authSecretSubkeyRejectedReason (authSecretSubkeysRejected afterReport))--testPktWithWireRepOrdUsesRawBytes :: Assertion-testPktWithWireRepOrdUsesRawBytes = do-  let src = wireRepRef "src"-      pktA =-        PktWithWireRep-          src-          (ByteRange 0 1)-          "a"-          0-          (OtherPacketPkt 42 "a")-      pktB =-        PktWithWireRep-          src-          (ByteRange 1 1)-          "b"-          1-          (BrokenPacketPkt "broken" 42 "b")-  assertEqual-    "base packet ordering can tie on tag-only fallback"-    EQ-    (compare (_pktValue pktA) (_pktValue pktB))-  assertEqual-    "PktWithWireRep ordering should break ties using packet bytes"-    LT-    (compare pktA pktB)--testParsePktsWithWireRepUtil :: FilePath -> Assertion-testParsePktsWithWireRepUtil fn = do-  let fpath = "tests/data/" ++ fn-  lbs <- BL.readFile fpath-  let WireRepInput-        { wireRepInputRef = src-        , wireRepInputPayload = srcBytes-        } =-        either-          (const-             WireRepInput-               { wireRepInputRef = wireRepRef lbs-               , wireRepInputPayload = lbs-               })-          id-          (wireRepRefFromInput Nothing lbs)-      parsed = parsePktsWithWireRep src srcBytes-      chunkedInput = chunkStrict 7 (BL.toStrict lbs)-  conduitParsed <--    DC.runConduitRes $-    CB.sourceLbs lbs DC..| conduitParsePktsWithWireRep Nothing DC..| CL.consume-  conduitParsedChunked <--    DC.runConduitRes $-    CL.sourceList chunkedInput DC..| conduitParsePktsWithWireRep Nothing DC..| CL.consume-  assertEqual-    "provenance-aware parsePkts preserves packet semantics"-    (parsePkts lbs)-    (map _pktValue parsed)-  assertEqual-    "conduit and pure provenance-aware packet parsing agree"-    parsed-    conduitParsed-  assertEqual-    "conduit parser handles packets split across chunk boundaries"-    parsed-    conduitParsedChunked-  assertEqual-    "packetsFromWireRep returns all packets for the originating bytestream"-    parsed-    (packetsFromWireRep src parsed)-  mapM_ (assertPktProvenance src srcBytes) parsed-  where-    chunkStrict n bs-      | B.null bs = []-      | otherwise =-          let (prefix, suffix) = B.splitAt n bs-           in prefix : chunkStrict n suffix--testParseTKsWithWireRepUtil :: FilePath -> Assertion-testParseTKsWithWireRepUtil fn = do-  let fpath = "tests/data/" ++ fn-  lbs <- BL.readFile fpath-  let WireRepInput-        { wireRepInputRef = src-        , wireRepInputPayload = srcBytes-        } =-        either-          (const-             WireRepInput-               { wireRepInputRef = wireRepRef lbs-               , wireRepInputPayload = lbs-               })-          id-          (wireRepRefFromInput Nothing lbs)-      packets = parsePktsWithWireRep src srcBytes-      parsed = parseTKsWithWireRep True packets-      plain = parseUnknownTKs True (map _pktValue packets)-  conduitParsed <--    DC.runConduitRes $ CL.sourceList packets DC..| conduitToTKsWithWireRep DC..| CL.consume-  assertEqual-    "provenance-aware parseUnknownTKs preserves TKUnknown semantics"-    plain-    (map _tkValue parsed)-  assertEqual-    "conduit and pure provenance-aware TKUnknown parsing agree"-    parsed-    conduitParsed-  assertEqual-    "tksFromWireRep returns all TKs for the originating bytestream"-    parsed-    (tksFromWireRep src parsed)-  mapM_ (assertTKProvenance src parsed) parsed--assertPktProvenance :: WireRepRef -> BL.ByteString -> PktWithWireRep -> Assertion-assertPktProvenance src srcBytes pkt = do-  assertEqual-    "packet raw bytes round-trip back to the same packet"-    (Right (_pktValue pkt))-    (runGet (get :: Get Pkt) (_pktRaw pkt))-  assertEqual-    "packet source reference is preserved"-    src-    (wireRepOfPkt pkt)-  let ByteRange offset len = _pktRange pkt-  assertEqual-    "packet raw bytes match the source bytestream slice"-    (_pktRaw pkt)-    (BL.take len (BL.drop offset srcBytes))--assertTKProvenance :: WireRepRef -> [TKWithWireRep] -> TKWithWireRep -> Assertion-assertTKProvenance src allTks tk = do-  assertBool "TKUnknown source reference list includes originating source" (src `elem` _tkWireRepRefs tk)-  assertEqual "TKUnknown source reference is preserved" src (wireRepOfTK tk)-  assertEqual-    "TKUnknown packet references reconstruct the semantic TKUnknown packet sequence"-    (flattenTK (_tkValue tk))-    (map _pktValue (packetRefsOfTK tk))-  assertEqual-    "TKUnknown source span matches the span of its packet references"-    (spanByteRanges (map _pktRange (packetRefsOfTK tk)))-    (_tkWireRepRange tk)-  mapM_-    (\pkt ->-       assertBool-         "packet backlink resolves to containing TKUnknown"-         (tk `elem` tksContainingPacket pkt allTks))-    (packetRefsOfTK tk)-  case toStructuredTKWithWireRep tk of-    Left err ->-      assertFailure ("toStructuredTKWithWireRep failed: " ++ err)-    Right structured -> do-      assertEqual-        "structured provenance retains semantic primary key"-        (_tkuKey (_tkValue tk))-        (_tkStructuredPrimaryKey structured)-      assertEqual-        "structured provenance retains packet source reference list"-        (_tkWireRepRefs tk)-        (_tkStructuredWireRepRefs structured)-      resolved <- resolveStructuredPacketRefs structured-      assertEqual-        "structured provenance resolves packet refs in TKUnknown packet order"-        (map _pktValue (packetRefsOfTK tk))-        (map _pktValue resolved)-      assertEqual-        "structured provenance keeps stable packet ref ids"-        (map packetRefIdOf (packetRefsOfTK tk))-        (map packetRefIdOf resolved)--resolveStructuredPacketRefs :: TKStructuredWithWireRep -> IO [PktWithWireRep]-resolveStructuredPacketRefs structured = do-  let collectSigRefs = map _signatureWithWireRefRef-      uidRefs =-        concatMap-          (\uid -> _uidWithWireRefsRef uid : collectSigRefs (_uidWithWireRefsSignatures uid))-          (_tkStructuredUIDs structured)-      uatRefs =-        concatMap-          (\uat -> _uatWithWireRefsRef uat : collectSigRefs (_uatWithWireRefsSignatures uat))-          (_tkStructuredUAts structured)-      subRefs =-        concatMap-          (\sub ->-             _subkeyWithWireRefsRef sub : collectSigRefs (_subkeyWithWireRefsSignatures sub))-          (_tkStructuredSubkeys structured)-      refIds =-        _tkStructuredPrimaryKeyRef structured :-        collectSigRefs (_tkStructuredDirectSignatures structured) ++ uidRefs ++ uatRefs ++ subRefs-  mapM-    (\refId ->-       case lookupPacketRef structured refId of-         Nothing ->-           assertFailure-             ("lookupPacketRef failed for ref id " ++ show refId)-         Just pkt -> pure pkt)-    refIds--testCanonicalizeTKWithWireRepMatchesManualWireOrdering :: Assertion-testCanonicalizeTKWithWireRepMatchesManualWireOrdering = do-  lbs <- readFixtureLazy "pubring.gpg"-  let src = wireRepRef lbs-      parsed = parseTKsWithWireRep True (parsePktsWithWireRep src lbs)-  case parsed of-    (tk:_) ->-      case toStructuredTKWithWireRep tk of-        Left err ->-          assertFailure ("toStructuredTKWithWireRep failed: " ++ err)-        Right structured -> do-          let shuffled =-                structured-                  { _tkStructuredDirectSignatures =-                      reverse (_tkStructuredDirectSignatures structured)-                  , _tkStructuredUIDs =-                      reverse-                        (map-                           (\uid ->-                              uid-                                { _uidWithWireRefsSignatures =-                                    reverse (_uidWithWireRefsSignatures uid)-                                })-                           (_tkStructuredUIDs structured))-                  , _tkStructuredUAts =-                      reverse-                        (map-                           (\uat ->-                              uat-                                { _uatWithWireRefsSignatures =-                                    reverse (_uatWithWireRefsSignatures uat)-                                })-                           (_tkStructuredUAts structured))-                  , _tkStructuredSubkeys =-                      reverse-                        (map-                           (\sub ->-                              sub-                                { _subkeyWithWireRefsSignatures =-                                    reverse (_subkeyWithWireRefsSignatures sub)-                                })-                           (_tkStructuredSubkeys structured))-                  }-          expected <--            case manualCanonicalizeStructured shuffled of-              Left err ->-                assertFailure ("manual canonicalization failed: " ++ err) >> fail "manual canonicalization failed"-              Right x -> pure x-          got <--            case canonicalizeTKStructuredWithWireRep shuffled of-              Left err ->-                assertFailure ("canonicalizeTKStructuredWithWireRep failed: " ++ show err) >>-                fail "canonicalizeTKStructuredWithWireRep failed"-              Right x -> pure x-          assertEqual-            "canonicalizeTKStructuredWithWireRep matches manual wire-byte ordering"-            expected-            got-          wrapped <--            case canonicalizeTKWithWireRep tk of-              Left err ->-                assertFailure ("canonicalizeTKWithWireRep failed: " ++ show err) >>-                fail "canonicalizeTKWithWireRep failed"-              Right x -> pure x-          structuredCanonical <--            case canonicalizeTKStructuredWithWireRep structured of-              Left err ->-                assertFailure ("canonicalizeTKStructuredWithWireRep failed: " ++ show err) >>-                fail "canonicalizeTKStructuredWithWireRep failed"-              Right x -> pure x-          assertEqual-            "canonicalizeTKWithWireRep delegates to structured canonicalization"-            structuredCanonical-            wrapped-    [] ->-      assertFailure "pubring.gpg should parse to at least one provenance-aware TKUnknown"-  where-    manualCanonicalizeStructured :: TKStructuredWithWireRep -> Either String TKUnknown-    manualCanonicalizeStructured structured = do-      direct <- sortSigs (_tkStructuredDirectSignatures structured)-      uids <--        sortByRef _uidWithWireRefsRef =<<-        mapM-          (\uid -> do-             sigs <- sortSigs (_uidWithWireRefsSignatures uid)-             Right (uid, sigs))-          (_tkStructuredUIDs structured)-      uats <--        sortByRef _uatWithWireRefsRef =<<-        mapM-          (\uat -> do-             sigs <- sortSigs (_uatWithWireRefsSignatures uat)-             Right (uat, sigs))-          (_tkStructuredUAts structured)-      subs <--        sortByRef _subkeyWithWireRefsRef =<<-        mapM-          (\sub -> do-             sigs <- sortSigs (_subkeyWithWireRefsSignatures sub)-             Right (sub, sigs))-          (_tkStructuredSubkeys structured)-      Right $-        TKUnknown-          { _tkuKey = _tkStructuredPrimaryKey structured-          , _tkuRevs = map _signatureWithWireRefValue direct-          , _tkuUIDs =-              map-                (\(uid, sigs) ->-                   (_uidWithWireRefsValue uid, map _signatureWithWireRefValue sigs))-                uids-          , _tkuUAts =-              map-                (\(uat, sigs) ->-                   (_uatWithWireRefsValue uat, map _signatureWithWireRefValue sigs))-                uats-          , _tkuSubs =-              map-                (\(sub, sigs) ->-                   (_subkeyWithWireRefsValue sub, map _signatureWithWireRefValue sigs))-                subs-          }-      where-        wireBytes refId =-          maybe-            (Left ("lookupPacketRef failed for ref id " ++ show refId))-            (Right . _pktRaw)-            (lookupPacketRef structured refId)--        sortSigs sigs = do-          keyed <--            mapM-              (\sig -> do-                 raw <- wireBytes (_signatureWithWireRefRef sig)-                 Right ((raw, _signatureWithWireRefRef sig), sig))-              sigs-          Right (map snd (sortOn fst keyed))--        sortByRef refAccessor items = do-          keyed <--            mapM-              (\(x, sigs) -> do-                 raw <- wireBytes (refAccessor x)-                 Right ((raw, refAccessor x), (x, sigs)))-              items-          Right (map snd (sortOn fst keyed))--testCanonicalizeTKWithWireRepReportsMissingRef :: Assertion-testCanonicalizeTKWithWireRepReportsMissingRef = do-  lbs <- readFixtureLazy "pubring.gpg"-  let src = wireRepRef lbs-      parsed = parseTKsWithWireRep True (parsePktsWithWireRep src lbs)-  case parsed of-    (tk:_) ->-      case toStructuredTKWithWireRep tk of-        Left err ->-          assertFailure ("toStructuredTKWithWireRep failed: " ++ err)-        Right structured -> do-          let badRef = PacketRefId src 999999-              brokenWithBadRef =-                case _tkStructuredDirectSignatures structured of-                  (sig:rest) ->-                    Just-                      structured-                        { _tkStructuredDirectSignatures =-                            sig {_signatureWithWireRefRef = badRef} : rest-                        }-                  [] ->-                    case _tkStructuredUIDs structured of-                      (uid:restUIDs) ->-                        Just-                          structured-                            { _tkStructuredUIDs =-                                uid {_uidWithWireRefsRef = badRef} : restUIDs-                            }-                      [] ->-                        case _tkStructuredUAts structured of-                          (uat:restUATs) ->-                            Just-                              structured-                                { _tkStructuredUAts =-                                    uat {_uatWithWireRefsRef = badRef} : restUATs-                                }-                          [] ->-                            case _tkStructuredSubkeys structured of-                              (sub:restSubs) ->-                                Just-                                  structured-                                    { _tkStructuredSubkeys =-                                        sub {_subkeyWithWireRefsRef = badRef} : restSubs-                                    }-                              [] -> Nothing-          case brokenWithBadRef of-            Nothing ->-              assertFailure-                "pubring.gpg first TKUnknown unexpectedly has no direct signatures, UIDs, UATs, or subkeys"-            Just broken ->-              case canonicalizeTKStructuredWithWireRep broken of-                Left (CanonicalizeMissingPacketRef ref) ->-                  assertEqual "missing ref error should include unresolved ref id" badRef ref-                Left err ->-                  assertFailure ("Expected CanonicalizeMissingPacketRef, got " ++ show err)-                Right _ ->-                  assertFailure "Expected canonicalization to fail on missing packet ref"-    [] ->-      assertFailure "pubring.gpg should parse to at least one provenance-aware TKUnknown"--testWireRepRefTracksArmorProvenance :: Assertion-testWireRepRefTracksArmorProvenance = do-  armored <- readFixtureLazy "v6-secret.pgp.aa"-  case wireRepRefFromInput Nothing armored of-    Left err -> assertFailure ("wireRepRefFromInput failed on armored input: " ++ err)-    Right WireRepInput-      { wireRepInputRef = src-      , wireRepInputPayload = payload-      } -> do-      assertBool-        "wireRepRefFromInput should mark ASCII-armored input as originally armored"-        (_wireRepWasOriginallyArmored src)-      assertBool-        "dearmored payload should parse into packets"-        (not (null (parsePktsWithWireRep src payload)))--testDearmorRejectsMultipleBlocks :: Assertion-testDearmorRejectsMultipleBlocks = do-  armored <- readFixtureLazy "v6-secret.pgp.aa"-  case dearmorIfAsciiArmored (armored <> "\n" <> armored) of-    Left err ->-      assertBool-        "multi-block rejection error should mention expected single block"-        ("expected exactly one" `isInfixOf` err)-    Right _ ->-      assertFailure "dearmorIfAsciiArmored unexpectedly accepted multi-block armor input"--testDearmorLenientAcceptsBomPrefixedArmor :: Assertion-testDearmorLenientAcceptsBomPrefixedArmor = do-  armored <- readFixtureLazy "v6-secret.pgp.aa"-  let bomPrefixed = BL.pack [0xef, 0xbb, 0xbf] <> armored-  case dearmorIfAsciiArmored bomPrefixed of-    Right (False, _) -> pure ()-    Right (True, _) ->-      assertFailure-        "strict dearmorIfAsciiArmored unexpectedly treated BOM-prefixed input as armored"-    Left err ->-      assertFailure ("strict dearmorIfAsciiArmored failed unexpectedly: " ++ err)-  case dearmorIfAsciiArmoredLenient bomPrefixed of-    Left err ->-      assertFailure ("lenient dearmor should decode BOM-prefixed armor: " ++ err)-    Right (wasArmored, payload) -> do-      assertBool "lenient dearmor should report armored input" wasArmored-      assertBool "lenient dearmor payload should parse as packets" (not (null (parsePkts payload)))--testLooksLikeAsciiArmor :: Assertion-testLooksLikeAsciiArmor = do-  let armoredPrefix = "\n\t  -----BEGIN PGP MESSAGE-----\nYWJj\n"-      partialPrefix = "-----BEGIN PG"-      binaryPrefix = BL.pack [0x99, 0x01, 0x02, 0x03]-  assertBool-    "looksLikeAsciiArmor accepts canonical armored headers with leading whitespace"-    (looksLikeAsciiArmor armoredPrefix)-  assertBool-    "looksLikeAsciiArmor rejects partial armored headers"-    (not (looksLikeAsciiArmor partialPrefix))-  assertBool-    "looksLikeAsciiArmor rejects binary packet prefixes"-    (not (looksLikeAsciiArmor binaryPrefix))--testWireRepRefRejectsMalformedArmoredInput :: Assertion-testWireRepRefRejectsMalformedArmoredInput = do-  let malformed =-        "-----BEGIN PGP MESSAGE-----\n" <>-        "not base64 and no checksum\n" <>-        "-----END PGP MESSAGE-----\n"-  case wireRepRefFromInput Nothing malformed of-    Left _ -> pure ()-    Right _ ->-      assertFailure-        "wireRepRefFromInput unexpectedly accepted malformed ASCII-armored input"--testTksFromWireRepMatchesAnySource :: Assertion-testTksFromWireRepMatchesAnySource = do-  lbs <- readFixtureLazy "pubring.gpg"-  let srcA = wireRepRef lbs-      srcB = namedWireRepRef "synthetic-merge-source" lbs-      parsed = parseTKsWithWireRep True (parsePktsWithWireRep srcA lbs)-  case parsed of-    (tk:_) -> do-      let multiSourceTk = tk { _tkWireRepRefs = srcA :| [srcB] }-      assertBool-        "tksFromWireRep matches TKs whose source list contains the queried source"-        (multiSourceTk `elem` tksFromWireRep srcA [multiSourceTk])-      assertBool-        "tksFromWireRep can match secondary provenance sources"-        (multiSourceTk `elem` tksFromWireRep srcB [multiSourceTk])-    [] ->-      assertFailure "pubring.gpg should parse to at least one provenance-aware TKUnknown"--testSemigroupTKWithWireRepPreservesStructuredRefs :: Assertion-testSemigroupTKWithWireRepPreservesStructuredRefs = do-  lbs <- readFixtureLazy "pubring.gpg"-  let srcA = wireRepRef lbs-      srcB = namedWireRepRef "synthetic-merge-source" lbs-      parsed = parseTKsWithWireRep True (parsePktsWithWireRep srcA lbs)-  case parsed of-    (tk:_) -> do-      let remappedPackets = map (\pkt -> pkt { _pktWireRepRef = srcB }) (packetRefsOfTK tk)-          tkFromSecondSource =-            TKWithWireRep-              (srcB :| [])-              (spanByteRanges (map _pktRange remappedPackets))-              remappedPackets-              (_tkValue tk)-          merged = tk <> tkFromSecondSource-          mergedRefIds = map packetRefIdOf (packetRefsOfTK merged)-      assertEqual-        "Semigroup preserves TKUnknown semantic merge behavior"-        (_tkValue tk <> _tkValue tkFromSecondSource)-        (_tkValue merged)-      assertBool-        "Semigroup merged provenance references include both sources"-        (srcA `elem` wireRepsOfTK merged && srcB `elem` wireRepsOfTK merged)-      assertEqual-        "Semigroup result packet refs match merged TKUnknown packet sequence"-        (flattenTK (_tkValue merged))-        (map _pktValue (packetRefsOfTK merged))-      assertEqual-        "Semigroup result keeps packet refs unique by source-aware PacketRefId"-        (length mergedRefIds)-        (length (nub mergedRefIds))-      case toStructuredTKWithWireRep merged of-        Left err ->-          assertFailure ("toStructuredTKWithWireRep failed for Semigroup result: " ++ err)-        Right structured -> do-          resolved <- resolveStructuredPacketRefs structured-          assertEqual-            "Semigroup result structured refs resolve in packet order"-            (map _pktValue (packetRefsOfTK merged))-            (map _pktValue resolved)-    [] ->-      assertFailure "pubring.gpg should parse to at least one provenance-aware TKUnknown"--testKeyPktWrappersRoundTrip :: Assertion-testKeyPktWrappersRoundTrip = do-  fixture <- loadV6UnencryptedSecretKeyFixtureForProperty-  case fixture of-    Left err ->-      assertFailure err-    Right (pkp, ska, _) -> do-      let publicPrimaryPkt = PublicKeyPkt pkp-          publicSubkeyPkt = PublicSubkeyPkt pkp-          secretPrimaryPkt = SecretKeyPkt pkp ska-          secretSubkeyPkt = SecretSubkeyPkt pkp ska-      assertEqual-        "mkPrimaryKeyPkt preserves public primary packets"-        publicPrimaryPkt-        (someKeyPktToPkt (mkPrimaryKeyPkt pkp Nothing))-      assertEqual-        "mkPrimaryKeyPkt preserves secret primary packets"-        secretPrimaryPkt-        (someKeyPktToPkt (mkPrimaryKeyPkt pkp (Just ska)))-      assertEqual-        "mkSubkeyKeyPkt preserves public subkey packets"-        publicSubkeyPkt-        (someKeyPktToPkt (mkSubkeyKeyPkt pkp Nothing))-      assertEqual-        "mkSubkeyKeyPkt preserves secret subkey packets"-        secretSubkeyPkt-        (someKeyPktToPkt (mkSubkeyKeyPkt pkp (Just ska)))-      case pktToPublicKeyPkt publicPrimaryPkt of-        Nothing ->-          assertFailure "pktToPublicKeyPkt should accept PublicKeyPkt"-        Just keyPkt -> do-          assertEqual "public primary role is preserved" KeyPktPrimary (keyPktRole keyPkt)-          assertEqual "public primary TKUnknown key view is preserved" (pkp, Nothing) (keyPktTKKey keyPkt)-          assertEqual "public primary round-trips through KeyPkt" publicPrimaryPkt (keyPktToPkt keyPkt)-      case pktToPublicKeyPkt publicSubkeyPkt of-        Nothing ->-          assertFailure "pktToPublicKeyPkt should accept PublicSubkeyPkt"-        Just keyPkt ->-          assertEqual "public subkey role is preserved" KeyPktSubkey (keyPktRole keyPkt)-      case pktToSecretKeyPkt secretPrimaryPkt of-        Nothing ->-          assertFailure "pktToSecretKeyPkt should accept SecretKeyPkt"-        Just keyPkt -> do-          assertEqual "secret primary role is preserved" KeyPktPrimary (keyPktRole keyPkt)-          assertEqual "secret primary TKUnknown key view is preserved" (pkp, Just ska) (keyPktTKKey keyPkt)-          assertEqual "secret primary round-trips through KeyPkt" secretPrimaryPkt (keyPktToPkt keyPkt)-          assertEqual-            "secret primary public view downgrades to PublicKeyPkt"-            publicPrimaryPkt-            (keyPktToPkt (keyPktToPublicView keyPkt))-      case pktToSecretKeyPkt secretSubkeyPkt of-        Nothing ->-          assertFailure "pktToSecretKeyPkt should accept SecretSubkeyPkt"-        Just keyPkt -> do-          assertEqual "secret subkey role is preserved" KeyPktSubkey (keyPktRole keyPkt)-          assertEqual-            "secret subkey public view downgrades to PublicSubkeyPkt"-            publicSubkeyPkt-            (keyPktToPkt (keyPktToPublicView keyPkt))-      case pktToSomeKeyPktEither (UserIdPkt "not a key packet") of-        Left (NotAKeyPacket pkt) ->-          assertEqual "non-key coercion error reports the original packet" (UserIdPkt "not a key packet") pkt-        other ->-          assertFailure ("Expected NotAKeyPacket error, got " ++ show other)--testTKTypedRoundTripAndPublicView :: Assertion-testTKTypedRoundTripAndPublicView = do-  pubringBytes <- readFixtureLazy "pubring.gpg"-  let publicParsed = parseUnknownTKs True (parsePkts pubringBytes)-  publicTk <--    case publicParsed of-      (tk:_) -> pure tk-      [] -> assertFailure "pubring.gpg should parse to at least one TKUnknown" >> fail "unreachable"-  publicTyped <--    case fromUnknownToTK publicTk of-      Left err -> assertFailure ("fromUnknownToTK failed for public TKUnknown: " ++ err) >> fail "unreachable"-      Right typed@(SomePublicTK _) -> pure typed-      Right (SomeSecretTK _) ->-        assertFailure "fromUnknownToTK should classify pubring primary key as public" >> fail "unreachable"-  assertEqual-    "public typed TKUnknown round-trips back to untyped TKUnknown"-    publicTk-    (someTKToUnknown publicTyped)--  armored <- readFixtureLazy "v6-secret.pgp.aa"-  secretTk <- do-    payload <--      case dearmorIfAsciiArmored armored of-        Left err ->-          assertFailure ("failed to decode v6-secret fixture: " ++ err) >> fail "unreachable"-        Right (_, bs) -> pure bs-    case parseUnknownTKs True (parsePkts payload) of-      (tk:_) -> pure tk-      [] -> assertFailure "v6-secret.pgp.aa should parse to at least one TKUnknown" >> fail "unreachable"-  secretTyped <--    case fromUnknownToTK secretTk of-      Left err -> assertFailure ("fromUnknownToTK failed for secret TKUnknown: " ++ err) >> fail "unreachable"-      Right (SomeSecretTK typed) -> pure typed-      Right (SomePublicTK _) ->-        assertFailure "fromUnknownToTK should classify v6 secret primary key as secret" >> fail "unreachable"-  let secretRoundTrip = tkToUnknown secretTyped-  assertEqual-    "secret typed TKUnknown round-trips back to untyped TKUnknown"-    secretTk-    secretRoundTrip-  let projectedPublic = tkToUnknown (publicViewTK secretTyped)-      expectedPublic =-        secretTk-          { _tkuKey = (\(pkp, _) -> (pkp, Nothing)) (_tkuKey secretTk)-          , _tkuSubs = map (\(pkt, sigs) -> (publicKeyPacketOf pkt, sigs)) (_tkuSubs secretTk)-          }-  assertEqual-    "publicViewTK drops secret material from primary/subkeys"-    expectedPublic-    projectedPublic--flattenTK :: TKUnknown -> [Pkt]-flattenTK tk =-  [someKeyPktToPkt (mkPrimaryKeyPkt pkp mska)] ++-  map SignaturePkt (_tkuRevs tk) ++ concatMap flattenUID (_tkuUIDs tk) ++-  concatMap flattenUAt (_tkuUAts tk) ++ concatMap flattenSub (_tkuSubs tk)-  where-    (pkp, mska) = _tkuKey tk-    flattenUID (uid, sigs) = UserIdPkt uid : map SignaturePkt sigs-    flattenUAt (uat, sigs) = UserAttributePkt uat : map SignaturePkt sigs-    flattenSub (pkt, sigs) = pkt : map SignaturePkt sigs--testParseTKsDropsDisallowedPrimaryKeySigContextV4 :: Assertion-testParseTKsDropsDisallowedPrimaryKeySigContextV4 = do-  let pkp =-        PKPayload-          V4-          (ThirtyTwoBitTimeStamp 0)-          0-          EdDSA-          (EdDSAPubKey Ed25519 (PrefixedNativeEPoint (EPoint (os2ip (B.cons 0x40 (B.replicate 32 0x01))))))-      invalidSig = SigV4 GenericCert RSA SHA512 [] [] 0 (MPI 0 :| [])-  case parseUnknownTKs True [PublicKeyPkt pkp, SignaturePkt invalidSig] of-    [tk] ->-      assertEqual-        "parseUnknownTKs True should drop GenericCert as a primary-key signature in v4"-        []-        (_tkuRevs tk)-    other ->-      assertFailure ("Expected one TKUnknown when dropping invalid v4 signature context, got " ++ show other)--testParseTKsDropsDisallowedPrimaryKeySigContextV6 :: Assertion-testParseTKsDropsDisallowedPrimaryKeySigContextV6 = do-  let pkp =-        PKPayload-          V6-          (ThirtyTwoBitTimeStamp 0)-          0-          EdDSA-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint 1)))-      invalidSig =-        SigV6-          GenericCert-          EdDSA-          SHA512-          (SignatureSalt (BL.replicate 32 0x01))-          []-          []-          0-          (MPI 0 :| [])-  case parseUnknownTKs True [PublicKeyPkt pkp, SignaturePkt invalidSig] of-    [tk] ->-      assertEqual-        "parseUnknownTKs True should drop GenericCert as a primary-key signature in v6"-        []-        (_tkuRevs tk)-    other ->-      assertFailure ("Expected one TKUnknown when dropping invalid v6 signature context, got " ++ show other)--testParseTKsAcceptsAllowedPrimaryKeySigContextV6 :: Assertion-testParseTKsAcceptsAllowedPrimaryKeySigContextV6 = do-  let pkp =-        PKPayload-          V6-          (ThirtyTwoBitTimeStamp 0)-          0-          EdDSA-          (EdDSAPubKey Ed25519 (NativeEPoint (EPoint 1)))-      allowedSig =-        SigV6-          KeyRevocationSig-          EdDSA-          SHA512-          (SignatureSalt (BL.replicate 32 0x02))-          []-          []-          0-          (MPI 0 :| [])-  case parseUnknownTKs True [PublicKeyPkt pkp, SignaturePkt allowedSig] of-    [tk] ->-      assertBool-        "parseUnknownTKs True should keep allowed v6 key-revocation signatures on primary keys"-        (not (null (_tkuRevs tk)))-    other ->-      assertFailure-        ("Expected one TKUnknown with a retained v6 revocation signature, got " ++ show other)+{-# LANGUAGE OverloadedStrings #-}++module Tests.Utilities (utilityTests) where++import Control.Error.Util (hush)+import Control.Monad (join)+import Crypto.Number.Serialize (os2ip)+import Data.Binary (get)+import Data.Binary.Get (Get)+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.Either (lefts, rights)+import Data.List (isInfixOf, nub, sortOn)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (catMaybes)+import qualified Data.Set as Set+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit+    ( Assertion+    , assertBool+    , assertEqual+    , assertFailure+    , testCase+    )++import Codec.Encryption.OpenPGP.Fingerprint (fingerprint)+import Codec.Encryption.OpenPGP.KeyInfo (pkalgoAbbrev)+import Codec.Encryption.OpenPGP.KeyringParser+    ( parsePublicTKs+    , parseSecretTKs+    , parseTKs+    , parseTKsEither+    , parseTKsWithWireRep+    , parseUnknownTKs+    )+import Codec.Encryption.OpenPGP.Serialize+    ( PktParseError (..)+    , WireRepInput (..)+    , conduitParsePktsWithWireRep+    , dearmorIfAsciiArmored+    , dearmorIfAsciiArmoredLenient+    , looksLikeAsciiArmor+    , parsePkts+    , parsePktsEither+    , parsePktsWithWireRep+    , wireRepRefFromInput+    )+import Codec.Encryption.OpenPGP.Types+import Data.Conduit.OpenPGP.Keyring+    ( AuthSecretSubkeyRejectionReason (..)+    , AuthSecretSubkeyUID (..)+    , AuthSecretSubkeysAtReport (..)+    , authSecretSubkeyPrimaryUID+    , authSecretSubkeyRejectedReason+    , authSecretSubkeyUIDs+    , authSecretSubkeyValue+    , authSecretSubkeysAt+    , authSecretSubkeysAtReport+    , conduitDropErrorsAndNothings+    , conduitToAuthSecretSubkeysAt+    , conduitToAuthSecretSubkeysAtReport+    , conduitToSomeTKsDroppingEither+    , conduitToSomeTKsEither+    , conduitToTKsEither+    , conduitToTKsWithWireRepEither+    )+import Tests.Common+    ( addTimestampSeconds+    , loadAndDecompressPkts+    , loadUnencryptedRsaSigner+    , loadV6UnencryptedSecretKeyFixtureForProperty+    , readFixtureLazy+    , readFixturePackets+    , runGet+    , setKeyTimestamp+    , signCertificationAt+    , signSubkeyBindingWithRSAExtrasAt+    , signSubkeyRevocationWithRSAAt+    , timestampToUTCTime+    )++utilityTests :: TestTree+utilityTests =+    testGroup+        "Utility function group"+        [ testCase "pubring as packets" (testParsePktsUtil "pubring.gpg")+        , testCase+            "pubring parsePktsEither equals parsePkts on valid input"+            (testParsePktsEitherUtil "pubring.gpg")+        , testCase+            "parsePktsEither reports truncation errors"+            (testParsePktsEitherFailureUtil "pubring.gpg")+        , testCase+            "parseUnknownTKs drops disallowed primary-key signature context (v4)"+            testParseTKsDropsDisallowedPrimaryKeySigContextV4+        , testCase+            "parseUnknownTKs drops disallowed primary-key signature context (v6)"+            testParseTKsDropsDisallowedPrimaryKeySigContextV6+        , testCase+            "parseUnknownTKs accepts allowed primary-key signature context (v6)"+            testParseTKsAcceptsAllowedPrimaryKeySigContextV6+        , testCase "pubring as TKs" (testParseTKsUtil "pubring.gpg")+        , testCase+            "pubring as typed TKs"+            (testParseTKsTypedUtil "pubring.gpg")+        , testCase+            "pubring parseTKsEither preserves typed parse outcomes"+            (testParseTKsEitherUtil "pubring.gpg")+        , testCase+            "typed TKUnknown conduit partitioning"+            (testConduitToTKsTypedUtil "pubring.gpg")+        , testCase+            "typed TK conduit either reports values without silent drops on valid input"+            (testConduitToSomeTKsEitherUtil "pubring.gpg")+        , testCase+            "typed TK dropping conduit either preserves valid typed results"+            (testConduitToSomeTKsDroppingEitherUtil "pubring.gpg")+        , testCase+            "auth-capable secret-subkey conduit filters revoked/expired/auth flags"+            testConduitToAuthSecretSubkeysAtFiltersByValidityAndAuth+        , testCase+            "auth-capable secret-subkey conduit tracks primary UID over time"+            testConduitToAuthSecretSubkeysAtTracksPrimaryUIDOverTime+        , testCase+            "auth-capable secret-subkey report includes typed rejection reasons"+            testAuthSecretSubkeysAtReportIncludesRejectionReasons+        , testCase+            "pkalgoAbbrev handles RFC9580-era pubkey algorithms"+            testPKAlgoAbbrevRFC9580+        , testCase+            "EightOctetKeyId Show/Read roundtrip uses hex form"+            testEightOctetKeyIdReadShowRoundtrip+        , testCase+            "PktWithWireRep Ord uses raw bytes for tie-breakers"+            testPktWithWireRepOrdUsesRawBytes+        , testCase+            "pubring as packets with provenance"+            (testParsePktsWithWireRepUtil "pubring.gpg")+        , testCase+            "pubring as TKs with provenance"+            (testParseTKsWithWireRepUtil "pubring.gpg")+        , testCase+            "wire provenance tracks original ASCII armor"+            testWireRepRefTracksArmorProvenance+        , testCase+            "dearmorIfAsciiArmored rejects multi-block armored inputs"+            testDearmorRejectsMultipleBlocks+        , testCase+            "dearmorIfAsciiArmoredLenient accepts BOM-prefixed armor"+            testDearmorLenientAcceptsBomPrefixedArmor+        , testCase+            "looksLikeAsciiArmor centralizes armor prefix detection"+            testLooksLikeAsciiArmor+        , testCase+            "wireRepRefFromInput surfaces malformed armored decode errors"+            testWireRepRefRejectsMalformedArmoredInput+        , testCase+            "tksFromWireRep matches any source in TKUnknown provenance list"+            testTksFromWireRepMatchesAnySource+        , testCase+            "TKWithWireRep Semigroup preserves structured provenance"+            testSemigroupTKWithWireRepPreservesStructuredRefs+        , testCase+            "canonicalizeTKWithWireRep matches manual wire-byte ordering"+            testCanonicalizeTKWithWireRepMatchesManualWireOrdering+        , testCase+            "canonicalizeTKWithWireRep reports missing packet refs"+            testCanonicalizeTKWithWireRepReportsMissingRef+        , testCase+            "KeyPkt wrappers preserve packet kind/role round-trips"+            testKeyPktWrappersRoundTrip+        , testCase+            "TK public/secret conversion and projection round-trip"+            testTKTypedRoundTripAndPublicView+        , testCase+            "uat.gpg embeds expected image data from uat.jpg"+            testUatImageFixture+        ]++testPKAlgoAbbrevRFC9580 :: Assertion+testPKAlgoAbbrevRFC9580 = do+    assertEqual+        "X25519 abbreviation"+        "x25"+        (pkalgoAbbrev (toFVal 25))+    assertEqual "X448 abbreviation" "x448" (pkalgoAbbrev (toFVal 26))+    assertEqual+        "Ed25519 abbreviation"+        "e25"+        (pkalgoAbbrev (toFVal 27))+    assertEqual+        "Ed448 abbreviation"+        "e448"+        (pkalgoAbbrev (toFVal 28))++testEightOctetKeyIdReadShowRoundtrip :: Assertion+testEightOctetKeyIdReadShowRoundtrip = do+    let eoki =+            EightOctetKeyId+                (BL.pack [0x01, 0x23, 0x45, 0x67, 0x89, 0xab, 0xcd, 0xef])+    assertEqual+        "show prints canonical uppercase hex"+        "0123456789ABCDEF"+        (show eoki)+    assertEqual "read . show roundtrip" eoki (read (show eoki))++testUatImageFixture :: Assertion+testUatImageFixture = do+    expectedImage <- readFixtureLazy "uat.jpg"+    packets <- loadAndDecompressPkts "uat.gpg"+    let images =+            [ imageData+            | UserAttributePkt uas <- packets+            , ImageAttribute _ imageData <- uas+            ]+    assertBool+        "uat.gpg should contain a user-attribute image packet"+        (not (null images))+    assertBool+        "uat.gpg should embed the uat.jpg payload"+        (expectedImage `elem` images)++testParsePktsUtil :: FilePath -> Assertion+testParsePktsUtil fn = do+    cp <- readFixturePackets fn+    pp <- parsePkts `fmap` readFixtureLazy fn+    assertEqual+        "parsePkts utility function gives same results as conduit pipeline"+        cp+        pp++testParsePktsEitherUtil :: FilePath -> Assertion+testParsePktsEitherUtil fn = do+    lbs <- readFixtureLazy fn+    assertEqual+        "parsePktsEither matches parsePkts on valid input"+        (Right (parsePkts lbs))+        (parsePktsEither lbs)++testParsePktsEitherFailureUtil :: FilePath -> Assertion+testParsePktsEitherFailureUtil fn = do+    lbs <- readFixtureLazy fn+    let truncated = BL.take (BL.length lbs - 1) lbs+    case parsePktsEither truncated of+        Left (PktParseError off msg) -> do+            assertBool+                "parsePktsEither reports non-empty parse error messages"+                (not (null msg))+            assertBool+                "parsePktsEither reports an in-range failure offset"+                (off >= 0 && off <= BL.length truncated)+            assertBool+                "legacy parsePkts still returns a parsed prefix on malformed input"+                (length (parsePkts truncated) <= length (parsePkts lbs))+        Right _ ->+            assertFailure+                "parsePktsEither should fail when input is truncated"++testParseTKsUtil :: FilePath -> Assertion+testParseTKsUtil fn = do+    lbs <- readFixtureLazy fn+    cp <-+        DC.runConduitRes $+            CB.sourceLbs lbs+                DC..| conduitGet get+                DC..| conduitToTKsEither+                DC..| conduitDropErrorsAndNothings+                DC..| CL.consume+    let pt = parseUnknownTKs True . parsePkts $ lbs+    assertEqual+        "parsePkts utility function gives same results as conduit pipeline"+        cp+        pt++testParseTKsTypedUtil :: FilePath -> Assertion+testParseTKsTypedUtil fn = do+    lbs <- readFixtureLazy fn+    let packets = parsePkts lbs+        plain = parseUnknownTKs True packets+        typed = parseTKs True packets+        typedPublic = parsePublicTKs True packets+        typedSecret = parseSecretTKs True packets+    assertEqual+        "parseTKs round-trips to the same untyped TKUnknown semantics"+        plain+        (map someTKToUnknown typed)+    assertEqual+        "public + secret typed partitions preserve full typed parse count"+        (length typed)+        (length typedPublic + length typedSecret)++testParseTKsEitherUtil :: FilePath -> Assertion+testParseTKsEitherUtil fn = do+    lbs <- readFixtureLazy fn+    let packets = parsePkts lbs+        typed = parseTKs True packets+        typedEither = parseTKsEither True packets+    assertEqual+        "parseTKsEither right results should match parseTKs"+        typed+        (rights typedEither)+    assertBool+        "parseTKsEither should have no conversion failures for canonical pubring fixture"+        (null (lefts typedEither))++testConduitToTKsTypedUtil :: FilePath -> Assertion+testConduitToTKsTypedUtil fn = do+    lbs <- readFixtureLazy fn+    allTyped <-+        DC.runConduitRes $+            CB.sourceLbs lbs+                DC..| conduitGet get+                DC..| conduitToSomeTKsEither+                DC..| CL.map (join . hush)+                DC..| CL.catMaybes+                DC..| CL.consume+    publicTyped <-+        DC.runConduitRes $+            CB.sourceLbs lbs+                DC..| conduitGet get+                DC..| conduitToSomeTKsEither+                DC..| CL.map (join . hush)+                DC..| CL.map (join . fmap someTKToPublicTK)+                DC..| CL.catMaybes+                DC..| CL.consume+    secretTyped <-+        DC.runConduitRes $+            CB.sourceLbs lbs+                DC..| conduitGet get+                DC..| conduitToSomeTKsEither+                DC..| CL.map (join . hush)+                DC..| CL.map (join . fmap someTKToSecretTK)+                DC..| CL.catMaybes+                DC..| CL.consume+    assertEqual+        "typed conduit round-trips to parseUnknownTKs semantics"+        (parseUnknownTKs True (parsePkts lbs))+        (map someTKToUnknown allTyped)+    assertEqual+        "typed conduit public + secret partitions preserve full count"+        (length allTyped)+        (length publicTyped + length secretTyped)++testConduitToSomeTKsEitherUtil :: FilePath -> Assertion+testConduitToSomeTKsEitherUtil fn = do+    lbs <- readFixtureLazy fn+    results <-+        DC.runConduitRes $+            CB.sourceLbs lbs+                DC..| conduitGet get+                DC..| conduitToSomeTKsEither+                DC..| CL.consume+    let typedFromEither = catMaybes (rights results)+    assertBool+        "conduitToSomeTKsEither should not report failures for canonical pubring fixture"+        (null (lefts results))+    assertEqual+        "conduitToSomeTKsEither right values should match conduitToTKs semantics"+        (parseTKs True (parsePkts lbs))+        typedFromEither++testConduitToSomeTKsDroppingEitherUtil :: FilePath -> Assertion+testConduitToSomeTKsDroppingEitherUtil fn = do+    lbs <- readFixtureLazy fn+    results <-+        DC.runConduitRes $+            CB.sourceLbs lbs+                DC..| conduitGet get+                DC..| conduitToSomeTKsDroppingEither+                DC..| CL.consume+    let typedFromEither = catMaybes (rights results)+    assertBool+        "conduitToSomeTKsDroppingEither should not report failures for canonical pubring fixture"+        (null (lefts results))+    assertEqual+        "conduitToSomeTKsDroppingEither right values should match tolerant parseTKs semantics"+        (parseTKs False (parsePkts lbs))+        typedFromEither++testConduitToAuthSecretSubkeysAtFiltersByValidityAndAuth+    :: Assertion+testConduitToAuthSecretSubkeysAtFiltersByValidityAndAuth = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    let baseTime = _timestamp signer+        beforeTime = timestampToUTCTime (addTimestampSeconds baseTime 18)+        afterTime = timestampToUTCTime (addTimestampSeconds baseTime 24)+        uidText = "auth-subkeys@example.org"+        uid = UserId uidText+        secretAddendum = SUUnencrypted (RSAPrivateKey (RSA_PrivateKey signingKey)) 0+        authSubkey = setKeyTimestamp (addTimestampSeconds baseTime 1) signer+        expiringAuthSubkey = setKeyTimestamp (addTimestampSeconds baseTime 2) signer+        signingOnlySubkey = setKeyTimestamp (addTimestampSeconds baseTime 3) signer++    uidCertification <-+        signCertificationAt+            signer+            signingKey+            uid+            (addTimestampSeconds baseTime 8)+            [SigSubPacket False (PrimaryUserId True)]+    authBinding <-+        signSubkeyBindingWithRSAExtrasAt+            signer+            authSubkey+            signingKey+            (addTimestampSeconds baseTime 10)+            [SigSubPacket False (KeyFlags (Set.fromList [AuthKey]))]+    expiringAuthBinding <-+        signSubkeyBindingWithRSAExtrasAt+            signer+            expiringAuthSubkey+            signingKey+            (addTimestampSeconds baseTime 10)+            [ SigSubPacket False (KeyFlags (Set.fromList [AuthKey]))+            , SigSubPacket False (KeyExpirationTime 20)+            ]+    signingOnlyBinding <-+        signSubkeyBindingWithRSAExtrasAt+            signer+            signingOnlySubkey+            signingKey+            (addTimestampSeconds baseTime 10)+            [SigSubPacket False (KeyFlags (Set.fromList [SignDataKey]))]+    authRevocation <-+        signSubkeyRevocationWithRSAAt+            signer+            authSubkey+            signingKey+            (addTimestampSeconds baseTime 22)++    let tk =+            TKUnknown+                (signer, Just secretAddendum)+                []+                [(uidText, [uidCertification])]+                []+                [+                    ( SecretSubkeyPkt authSubkey secretAddendum+                    , [authBinding, authRevocation]+                    )+                ,+                    ( SecretSubkeyPkt expiringAuthSubkey secretAddendum+                    , [expiringAuthBinding]+                    )+                ,+                    ( SecretSubkeyPkt signingOnlySubkey secretAddendum+                    , [signingOnlyBinding]+                    )+                ]+    typedSecret <-+        case fromUnknownToTK tk of+            Right (SomeSecretTK typed) -> pure typed+            Right (SomePublicTK _) ->+                assertFailure+                    "expected secret typed TKUnknown for auth subkey test fixture"+                    >> fail "unreachable"+            Left err ->+                assertFailure+                    ("fromUnknownToTK failed for auth subkey test fixture: " ++ err)+                    >> fail "unreachable"++    selectedBefore <-+        DC.runConduitRes $+            CL.sourceList [typedSecret]+                DC..| conduitToAuthSecretSubkeysAt beforeTime+                DC..| CL.consume+    assertEqual+        "pure authSecretSubkeysAt helper and conduit output should match"+        (authSecretSubkeysAt beforeTime typedSecret)+        selectedBefore+    assertEqual+        "before revocation/expiry, conduit should keep only auth-capable secret subkeys"+        2+        (length selectedBefore)+    let selectedBeforeFps =+            Set.fromList+                ( map+                    (fingerprint . keyPktPKPayload . authSecretSubkeyValue)+                    selectedBefore+                )+    assertEqual+        "selected auth-capable subkeys should match expected fingerprints"+        ( Set.fromList+            [fingerprint authSubkey, fingerprint expiringAuthSubkey]+        )+        selectedBeforeFps+    mapM_+        ( \selection -> do+            assertEqual+                "selected auth subkey should retain active primary UID context"+                (Just uidText)+                (authSecretSubkeyPrimaryUID selection)+            assertEqual+                "selected auth subkey should expose UID context with primary marker"+                [AuthSecretSubkeyUID uidText True]+                (authSecretSubkeyUIDs selection)+        )+        selectedBefore++    selectedAfter <-+        DC.runConduitRes $+            CL.sourceList [typedSecret]+                DC..| conduitToAuthSecretSubkeysAt afterTime+                DC..| CL.consume+    assertEqual+        "after revocation/expiry, conduit should drop revoked/expired auth subkeys"+        []+        selectedAfter++testConduitToAuthSecretSubkeysAtTracksPrimaryUIDOverTime+    :: Assertion+testConduitToAuthSecretSubkeysAtTracksPrimaryUIDOverTime = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    let baseTime = _timestamp signer+        beforeTime = timestampToUTCTime (addTimestampSeconds baseTime 15)+        afterTime = timestampToUTCTime (addTimestampSeconds baseTime 25)+        uidA = UserId "uid-a@example.org"+        UserId uidAText = uidA+        uidB = UserId "uid-b@example.org"+        UserId uidBText = uidB+        secretAddendum = SUUnencrypted (RSAPrivateKey (RSA_PrivateKey signingKey)) 0+        authSubkey = setKeyTimestamp (addTimestampSeconds baseTime 1) signer++    uidACert <-+        signCertificationAt+            signer+            signingKey+            uidA+            (addTimestampSeconds baseTime 10)+            [SigSubPacket False (PrimaryUserId True)]+    uidBCert <-+        signCertificationAt+            signer+            signingKey+            uidB+            (addTimestampSeconds baseTime 20)+            [SigSubPacket False (PrimaryUserId True)]+    authBinding <-+        signSubkeyBindingWithRSAExtrasAt+            signer+            authSubkey+            signingKey+            (addTimestampSeconds baseTime 11)+            [SigSubPacket False (KeyFlags (Set.fromList [AuthKey]))]++    let tk =+            TKUnknown+                (signer, Just secretAddendum)+                []+                [(uidAText, [uidACert]), (uidBText, [uidBCert])]+                []+                [(SecretSubkeyPkt authSubkey secretAddendum, [authBinding])]+    typedSecret <-+        case fromUnknownToTK tk of+            Right (SomeSecretTK typed) -> pure typed+            Right (SomePublicTK _) ->+                assertFailure+                    "expected secret typed TKUnknown for primary-uid test fixture"+                    >> fail "unreachable"+            Left err ->+                assertFailure+                    ("fromUnknownToTK failed for primary-uid test fixture: " ++ err)+                    >> fail "unreachable"++    beforeSelections <-+        DC.runConduitRes $+            CL.sourceList [typedSecret]+                DC..| conduitToAuthSecretSubkeysAt beforeTime+                DC..| CL.consume+    beforeSelection <-+        case beforeSelections of+            [selection] -> pure selection+            other ->+                assertFailure+                    ( "expected one auth-capable subkey selection before primary-uid rollover, got "+                        ++ show (length other)+                    )+                    >> fail "unreachable"+    assertEqual+        "earlier primary UID should be selected before newer self-certification"+        (Just uidAText)+        (authSecretSubkeyPrimaryUID beforeSelection)+    assertEqual+        "UID context should include only active UIDs before uid-b certification exists"+        [(uidAText, True)]+        ( map+            ( \u -> (authSecretSubkeyUIDValue u, authSecretSubkeyUIDIsPrimary u)+            )+            (authSecretSubkeyUIDs beforeSelection)+        )++    afterSelections <-+        DC.runConduitRes $+            CL.sourceList [typedSecret]+                DC..| conduitToAuthSecretSubkeysAt afterTime+                DC..| CL.consume+    afterSelection <-+        case afterSelections of+            [selection] -> pure selection+            other ->+                assertFailure+                    ( "expected one auth-capable subkey selection after primary-uid rollover, got "+                        ++ show (length other)+                    )+                    >> fail "unreachable"+    assertEqual+        "newer primary UID self-certification should win after rollover"+        (Just uidBText)+        (authSecretSubkeyPrimaryUID afterSelection)+    assertEqual+        "UID context should mark uid-b as primary after rollover"+        [(uidAText, False), (uidBText, True)]+        ( map+            ( \u -> (authSecretSubkeyUIDValue u, authSecretSubkeyUIDIsPrimary u)+            )+            (authSecretSubkeyUIDs afterSelection)+        )++testAuthSecretSubkeysAtReportIncludesRejectionReasons+    :: Assertion+testAuthSecretSubkeysAtReportIncludesRejectionReasons = do+    (signer, signingKey) <- loadUnencryptedRsaSigner+    let baseTime = _timestamp signer+        beforeTime = timestampToUTCTime (addTimestampSeconds baseTime 18)+        afterTime = timestampToUTCTime (addTimestampSeconds baseTime 24)+        uidText = "auth-subkeys@example.org"+        uid = UserId uidText+        secretAddendum = SUUnencrypted (RSAPrivateKey (RSA_PrivateKey signingKey)) 0+        authSubkey = setKeyTimestamp (addTimestampSeconds baseTime 1) signer+        expiringAuthSubkey = setKeyTimestamp (addTimestampSeconds baseTime 2) signer+        signingOnlySubkey = setKeyTimestamp (addTimestampSeconds baseTime 3) signer++    uidCertification <-+        signCertificationAt+            signer+            signingKey+            uid+            (addTimestampSeconds baseTime 8)+            [SigSubPacket False (PrimaryUserId True)]+    authBinding <-+        signSubkeyBindingWithRSAExtrasAt+            signer+            authSubkey+            signingKey+            (addTimestampSeconds baseTime 10)+            [SigSubPacket False (KeyFlags (Set.fromList [AuthKey]))]+    expiringAuthBinding <-+        signSubkeyBindingWithRSAExtrasAt+            signer+            expiringAuthSubkey+            signingKey+            (addTimestampSeconds baseTime 10)+            [ SigSubPacket False (KeyFlags (Set.fromList [AuthKey]))+            , SigSubPacket False (KeyExpirationTime 20)+            ]+    signingOnlyBinding <-+        signSubkeyBindingWithRSAExtrasAt+            signer+            signingOnlySubkey+            signingKey+            (addTimestampSeconds baseTime 10)+            [SigSubPacket False (KeyFlags (Set.fromList [SignDataKey]))]+    authRevocation <-+        signSubkeyRevocationWithRSAAt+            signer+            authSubkey+            signingKey+            (addTimestampSeconds baseTime 22)++    let tk =+            TKUnknown+                (signer, Just secretAddendum)+                []+                [(uidText, [uidCertification])]+                []+                [+                    ( SecretSubkeyPkt authSubkey secretAddendum+                    , [authBinding, authRevocation]+                    )+                ,+                    ( SecretSubkeyPkt expiringAuthSubkey secretAddendum+                    , [expiringAuthBinding]+                    )+                ,+                    ( SecretSubkeyPkt signingOnlySubkey secretAddendum+                    , [signingOnlyBinding]+                    )+                ]+    typedSecret <-+        case fromUnknownToTK tk of+            Right (SomeSecretTK typed) -> pure typed+            Right (SomePublicTK _) ->+                assertFailure+                    "expected secret typed TKUnknown for auth subkey rejection test fixture"+                    >> fail "unreachable"+            Left err ->+                assertFailure+                    ( "fromUnknownToTK failed for auth subkey rejection test fixture: "+                        ++ err+                    )+                    >> fail "unreachable"++    let beforeReport = authSecretSubkeysAtReport beforeTime typedSecret+    assertEqual+        "report accepted list should match authSecretSubkeysAt before revocation/expiry"+        (authSecretSubkeysAt beforeTime typedSecret)+        (authSecretSubkeysAccepted beforeReport)+    assertEqual+        "before revocation/expiry, only signing-only subkey should be rejected"+        [AuthSecretSubkeyMissingAuthCapability]+        ( map+            authSecretSubkeyRejectedReason+            (authSecretSubkeysRejected beforeReport)+        )++    afterReportsViaConduit <-+        DC.runConduitRes $+            CL.sourceList [typedSecret]+                DC..| conduitToAuthSecretSubkeysAtReport afterTime+                DC..| CL.consume+    afterReport <-+        case afterReportsViaConduit of+            [singleReport] -> pure singleReport+            other ->+                assertFailure+                    ( "expected one report from conduitToAuthSecretSubkeysAtReport, got "+                        ++ show (length other)+                    )+                    >> fail "unreachable"+    assertEqual+        "after revocation/expiry, no accepted auth subkeys should remain"+        []+        (authSecretSubkeysAccepted afterReport)+    assertEqual+        "after revocation/expiry, rejected reasons should report invalid-time and missing-auth cases for still-visible candidates"+        [ AuthSecretSubkeySubkeyInvalidAtTime+        , AuthSecretSubkeyMissingAuthCapability+        ]+        ( map+            authSecretSubkeyRejectedReason+            (authSecretSubkeysRejected afterReport)+        )++testPktWithWireRepOrdUsesRawBytes :: Assertion+testPktWithWireRepOrdUsesRawBytes = do+    let src = wireRepRef "src"+        pktA =+            PktWithWireRep+                src+                (ByteRange 0 1)+                "a"+                0+                (OtherPacketPkt 42 "a")+        pktB =+            PktWithWireRep+                src+                (ByteRange 1 1)+                "b"+                1+                (BrokenPacketPkt "broken" 42 "b")+    assertEqual+        "base packet ordering can tie on tag-only fallback"+        EQ+        (compare (_pktValue pktA) (_pktValue pktB))+    assertEqual+        "PktWithWireRep ordering should break ties using packet bytes"+        LT+        (compare pktA pktB)++testParsePktsWithWireRepUtil :: FilePath -> Assertion+testParsePktsWithWireRepUtil fn = do+    let fpath = "tests/data/" ++ fn+    lbs <- BL.readFile fpath+    let WireRepInput+            { wireRepInputRef = src+            , wireRepInputPayload = srcBytes+            } =+                either+                    ( const+                        WireRepInput+                            { wireRepInputRef = wireRepRef lbs+                            , wireRepInputPayload = lbs+                            }+                    )+                    id+                    (wireRepRefFromInput Nothing lbs)+        parsed = parsePktsWithWireRep src srcBytes+        chunkedInput = chunkStrict 7 (BL.toStrict lbs)+    conduitParsed <-+        DC.runConduitRes $+            CB.sourceLbs lbs+                DC..| conduitParsePktsWithWireRep Nothing+                DC..| CL.consume+    conduitParsedChunked <-+        DC.runConduitRes $+            CL.sourceList chunkedInput+                DC..| conduitParsePktsWithWireRep Nothing+                DC..| CL.consume+    assertEqual+        "provenance-aware parsePkts preserves packet semantics"+        (parsePkts lbs)+        (map _pktValue parsed)+    assertEqual+        "conduit and pure provenance-aware packet parsing agree"+        parsed+        conduitParsed+    assertEqual+        "conduit parser handles packets split across chunk boundaries"+        parsed+        conduitParsedChunked+    assertEqual+        "packetsFromWireRep returns all packets for the originating bytestream"+        parsed+        (packetsFromWireRep src parsed)+    mapM_ (assertPktProvenance src srcBytes) parsed+  where+    chunkStrict n bs+        | B.null bs = []+        | otherwise =+            let (prefix, suffix) = B.splitAt n bs+             in prefix : chunkStrict n suffix++testParseTKsWithWireRepUtil :: FilePath -> Assertion+testParseTKsWithWireRepUtil fn = do+    let fpath = "tests/data/" ++ fn+    lbs <- BL.readFile fpath+    let WireRepInput+            { wireRepInputRef = src+            , wireRepInputPayload = srcBytes+            } =+                either+                    ( const+                        WireRepInput+                            { wireRepInputRef = wireRepRef lbs+                            , wireRepInputPayload = lbs+                            }+                    )+                    id+                    (wireRepRefFromInput Nothing lbs)+        packets = parsePktsWithWireRep src srcBytes+        parsed = parseTKsWithWireRep True packets+        plain = parseUnknownTKs True (map _pktValue packets)+    conduitParsed <-+        DC.runConduitRes $+            CL.sourceList packets+                DC..| conduitToTKsWithWireRepEither+                DC..| CL.map (join . hush)+                DC..| CL.catMaybes+                DC..| CL.consume+    assertEqual+        "provenance-aware parseUnknownTKs preserves TKUnknown semantics"+        plain+        (map _tkValue parsed)+    assertEqual+        "conduit and pure provenance-aware TKUnknown parsing agree"+        parsed+        conduitParsed+    assertEqual+        "tksFromWireRep returns all TKs for the originating bytestream"+        parsed+        (tksFromWireRep src parsed)+    mapM_ (assertTKProvenance src parsed) parsed++assertPktProvenance+    :: WireRepRef -> BL.ByteString -> PktWithWireRep -> Assertion+assertPktProvenance src srcBytes pkt = do+    assertEqual+        "packet raw bytes round-trip back to the same packet"+        (Right (_pktValue pkt))+        (runGet (get :: Get Pkt) (_pktRaw pkt))+    assertEqual+        "packet source reference is preserved"+        src+        (wireRepOfPkt pkt)+    let ByteRange offset len = _pktRange pkt+    assertEqual+        "packet raw bytes match the source bytestream slice"+        (_pktRaw pkt)+        (BL.take len (BL.drop offset srcBytes))++assertTKProvenance+    :: WireRepRef -> [TKWithWireRep] -> TKWithWireRep -> Assertion+assertTKProvenance src allTks tk = do+    assertBool+        "TKUnknown source reference list includes originating source"+        (src `elem` _tkWireRepRefs tk)+    assertEqual+        "TKUnknown source reference is preserved"+        src+        (wireRepOfTK tk)+    assertEqual+        "TKUnknown packet references reconstruct the semantic TKUnknown packet sequence"+        (flattenTK (_tkValue tk))+        (map _pktValue (packetRefsOfTK tk))+    assertEqual+        "TKUnknown source span matches the span of its packet references"+        (spanByteRanges (map _pktRange (packetRefsOfTK tk)))+        (_tkWireRepRange tk)+    mapM_+        ( \pkt ->+            assertBool+                "packet backlink resolves to containing TKUnknown"+                (tk `elem` tksContainingPacket pkt allTks)+        )+        (packetRefsOfTK tk)+    case toStructuredTKWithWireRep tk of+        Left err ->+            assertFailure ("toStructuredTKWithWireRep failed: " ++ err)+        Right structured -> do+            assertEqual+                "structured provenance retains semantic primary key"+                (_tkuKey (_tkValue tk))+                (_tkStructuredPrimaryKey structured)+            assertEqual+                "structured provenance retains packet source reference list"+                (_tkWireRepRefs tk)+                (_tkStructuredWireRepRefs structured)+            resolved <- resolveStructuredPacketRefs structured+            assertEqual+                "structured provenance resolves packet refs in TKUnknown packet order"+                (map _pktValue (packetRefsOfTK tk))+                (map _pktValue resolved)+            assertEqual+                "structured provenance keeps stable packet ref ids"+                (map packetRefIdOf (packetRefsOfTK tk))+                (map packetRefIdOf resolved)++resolveStructuredPacketRefs+    :: TKStructuredWithWireRep -> IO [PktWithWireRep]+resolveStructuredPacketRefs structured = do+    let collectSigRefs = map _signatureWithWireRefRef+        uidRefs =+            concatMap+                ( \uid ->+                    _uidWithWireRefsRef uid+                        : collectSigRefs (_uidWithWireRefsSignatures uid)+                )+                (_tkStructuredUIDs structured)+        uatRefs =+            concatMap+                ( \uat ->+                    _uatWithWireRefsRef uat+                        : collectSigRefs (_uatWithWireRefsSignatures uat)+                )+                (_tkStructuredUAts structured)+        subRefs =+            concatMap+                ( \sub ->+                    _subkeyWithWireRefsRef sub+                        : collectSigRefs (_subkeyWithWireRefsSignatures sub)+                )+                (_tkStructuredSubkeys structured)+        refIds =+            _tkStructuredPrimaryKeyRef structured+                : collectSigRefs (_tkStructuredDirectSignatures structured)+                ++ uidRefs+                ++ uatRefs+                ++ subRefs+    mapM+        ( \refId ->+            case lookupPacketRef structured refId of+                Nothing ->+                    assertFailure+                        ("lookupPacketRef failed for ref id " ++ show refId)+                Just pkt -> pure pkt+        )+        refIds++testCanonicalizeTKWithWireRepMatchesManualWireOrdering+    :: Assertion+testCanonicalizeTKWithWireRepMatchesManualWireOrdering = do+    lbs <- readFixtureLazy "pubring.gpg"+    let src = wireRepRef lbs+        parsed = parseTKsWithWireRep True (parsePktsWithWireRep src lbs)+    case parsed of+        (tk : _) ->+            case toStructuredTKWithWireRep tk of+                Left err ->+                    assertFailure ("toStructuredTKWithWireRep failed: " ++ err)+                Right structured -> do+                    let shuffled =+                            structured+                                { _tkStructuredDirectSignatures =+                                    reverse (_tkStructuredDirectSignatures structured)+                                , _tkStructuredUIDs =+                                    reverse+                                        ( map+                                            ( \uid ->+                                                uid+                                                    { _uidWithWireRefsSignatures =+                                                        reverse (_uidWithWireRefsSignatures uid)+                                                    }+                                            )+                                            (_tkStructuredUIDs structured)+                                        )+                                , _tkStructuredUAts =+                                    reverse+                                        ( map+                                            ( \uat ->+                                                uat+                                                    { _uatWithWireRefsSignatures =+                                                        reverse (_uatWithWireRefsSignatures uat)+                                                    }+                                            )+                                            (_tkStructuredUAts structured)+                                        )+                                , _tkStructuredSubkeys =+                                    reverse+                                        ( map+                                            ( \sub ->+                                                sub+                                                    { _subkeyWithWireRefsSignatures =+                                                        reverse (_subkeyWithWireRefsSignatures sub)+                                                    }+                                            )+                                            (_tkStructuredSubkeys structured)+                                        )+                                }+                    expected <-+                        case manualCanonicalizeStructured shuffled of+                            Left err ->+                                assertFailure ("manual canonicalization failed: " ++ err)+                                    >> fail "manual canonicalization failed"+                            Right x -> pure x+                    got <-+                        case canonicalizeTKStructuredWithWireRep shuffled of+                            Left err ->+                                assertFailure+                                    ("canonicalizeTKStructuredWithWireRep failed: " ++ show err)+                                    >> fail "canonicalizeTKStructuredWithWireRep failed"+                            Right x -> pure x+                    assertEqual+                        "canonicalizeTKStructuredWithWireRep matches manual wire-byte ordering"+                        expected+                        got+                    wrapped <-+                        case canonicalizeTKWithWireRep tk of+                            Left err ->+                                assertFailure ("canonicalizeTKWithWireRep failed: " ++ show err)+                                    >> fail "canonicalizeTKWithWireRep failed"+                            Right x -> pure x+                    structuredCanonical <-+                        case canonicalizeTKStructuredWithWireRep structured of+                            Left err ->+                                assertFailure+                                    ("canonicalizeTKStructuredWithWireRep failed: " ++ show err)+                                    >> fail "canonicalizeTKStructuredWithWireRep failed"+                            Right x -> pure x+                    assertEqual+                        "canonicalizeTKWithWireRep delegates to structured canonicalization"+                        structuredCanonical+                        wrapped+        [] ->+            assertFailure+                "pubring.gpg should parse to at least one provenance-aware TKUnknown"+  where+    manualCanonicalizeStructured+        :: TKStructuredWithWireRep -> Either String TKUnknown+    manualCanonicalizeStructured structured = do+        direct <- sortSigs (_tkStructuredDirectSignatures structured)+        uids <-+            sortByRef _uidWithWireRefsRef+                =<< mapM+                    ( \uid -> do+                        sigs <- sortSigs (_uidWithWireRefsSignatures uid)+                        Right (uid, sigs)+                    )+                    (_tkStructuredUIDs structured)+        uats <-+            sortByRef _uatWithWireRefsRef+                =<< mapM+                    ( \uat -> do+                        sigs <- sortSigs (_uatWithWireRefsSignatures uat)+                        Right (uat, sigs)+                    )+                    (_tkStructuredUAts structured)+        subs <-+            sortByRef _subkeyWithWireRefsRef+                =<< mapM+                    ( \sub -> do+                        sigs <- sortSigs (_subkeyWithWireRefsSignatures sub)+                        Right (sub, sigs)+                    )+                    (_tkStructuredSubkeys structured)+        Right $+            TKUnknown+                { _tkuKey = _tkStructuredPrimaryKey structured+                , _tkuRevs = map _signatureWithWireRefValue direct+                , _tkuUIDs =+                    map+                        ( \(uid, sigs) ->+                            (_uidWithWireRefsValue uid, map _signatureWithWireRefValue sigs)+                        )+                        uids+                , _tkuUAts =+                    map+                        ( \(uat, sigs) ->+                            (_uatWithWireRefsValue uat, map _signatureWithWireRefValue sigs)+                        )+                        uats+                , _tkuSubs =+                    map+                        ( \(sub, sigs) ->+                            ( _subkeyWithWireRefsValue sub+                            , map _signatureWithWireRefValue sigs+                            )+                        )+                        subs+                }+      where+        wireBytes refId =+            maybe+                (Left ("lookupPacketRef failed for ref id " ++ show refId))+                (Right . _pktRaw)+                (lookupPacketRef structured refId)++        sortSigs sigs = do+            keyed <-+                mapM+                    ( \sig -> do+                        raw <- wireBytes (_signatureWithWireRefRef sig)+                        Right ((raw, _signatureWithWireRefRef sig), sig)+                    )+                    sigs+            Right (map snd (sortOn fst keyed))++        sortByRef refAccessor items = do+            keyed <-+                mapM+                    ( \(x, sigs) -> do+                        raw <- wireBytes (refAccessor x)+                        Right ((raw, refAccessor x), (x, sigs))+                    )+                    items+            Right (map snd (sortOn fst keyed))++testCanonicalizeTKWithWireRepReportsMissingRef :: Assertion+testCanonicalizeTKWithWireRepReportsMissingRef = do+    lbs <- readFixtureLazy "pubring.gpg"+    let src = wireRepRef lbs+        parsed = parseTKsWithWireRep True (parsePktsWithWireRep src lbs)+    case parsed of+        (tk : _) ->+            case toStructuredTKWithWireRep tk of+                Left err ->+                    assertFailure ("toStructuredTKWithWireRep failed: " ++ err)+                Right structured -> do+                    let badRef = PacketRefId src 999999+                        brokenWithBadRef =+                            case _tkStructuredDirectSignatures structured of+                                (sig : rest) ->+                                    Just+                                        structured+                                            { _tkStructuredDirectSignatures =+                                                sig {_signatureWithWireRefRef = badRef} : rest+                                            }+                                [] ->+                                    case _tkStructuredUIDs structured of+                                        (uid : restUIDs) ->+                                            Just+                                                structured+                                                    { _tkStructuredUIDs =+                                                        uid {_uidWithWireRefsRef = badRef} : restUIDs+                                                    }+                                        [] ->+                                            case _tkStructuredUAts structured of+                                                (uat : restUATs) ->+                                                    Just+                                                        structured+                                                            { _tkStructuredUAts =+                                                                uat {_uatWithWireRefsRef = badRef} : restUATs+                                                            }+                                                [] ->+                                                    case _tkStructuredSubkeys structured of+                                                        (sub : restSubs) ->+                                                            Just+                                                                structured+                                                                    { _tkStructuredSubkeys =+                                                                        sub {_subkeyWithWireRefsRef = badRef} : restSubs+                                                                    }+                                                        [] -> Nothing+                    case brokenWithBadRef of+                        Nothing ->+                            assertFailure+                                "pubring.gpg first TKUnknown unexpectedly has no direct signatures, UIDs, UATs, or subkeys"+                        Just broken ->+                            case canonicalizeTKStructuredWithWireRep broken of+                                Left (CanonicalizeMissingPacketRef ref) ->+                                    assertEqual+                                        "missing ref error should include unresolved ref id"+                                        badRef+                                        ref+                                Left err ->+                                    assertFailure+                                        ("Expected CanonicalizeMissingPacketRef, got " ++ show err)+                                Right _ ->+                                    assertFailure+                                        "Expected canonicalization to fail on missing packet ref"+        [] ->+            assertFailure+                "pubring.gpg should parse to at least one provenance-aware TKUnknown"++testWireRepRefTracksArmorProvenance :: Assertion+testWireRepRefTracksArmorProvenance = do+    armored <- readFixtureLazy "v6-secret.pgp.aa"+    case wireRepRefFromInput Nothing armored of+        Left err ->+            assertFailure+                ("wireRepRefFromInput failed on armored input: " ++ err)+        Right+            WireRepInput+                { wireRepInputRef = src+                , wireRepInputPayload = payload+                } -> do+                assertBool+                    "wireRepRefFromInput should mark ASCII-armored input as originally armored"+                    (_wireRepWasOriginallyArmored src)+                assertBool+                    "dearmored payload should parse into packets"+                    (not (null (parsePktsWithWireRep src payload)))++testDearmorRejectsMultipleBlocks :: Assertion+testDearmorRejectsMultipleBlocks = do+    armored <- readFixtureLazy "v6-secret.pgp.aa"+    case dearmorIfAsciiArmored (armored <> "\n" <> armored) of+        Left err ->+            assertBool+                "multi-block rejection error should mention expected single block"+                ("expected exactly one" `isInfixOf` err)+        Right _ ->+            assertFailure+                "dearmorIfAsciiArmored unexpectedly accepted multi-block armor input"++testDearmorLenientAcceptsBomPrefixedArmor :: Assertion+testDearmorLenientAcceptsBomPrefixedArmor = do+    armored <- readFixtureLazy "v6-secret.pgp.aa"+    let bomPrefixed = BL.pack [0xef, 0xbb, 0xbf] <> armored+    case dearmorIfAsciiArmored bomPrefixed of+        Right (False, _) -> pure ()+        Right (True, _) ->+            assertFailure+                "strict dearmorIfAsciiArmored unexpectedly treated BOM-prefixed input as armored"+        Left err ->+            assertFailure+                ("strict dearmorIfAsciiArmored failed unexpectedly: " ++ err)+    case dearmorIfAsciiArmoredLenient bomPrefixed of+        Left err ->+            assertFailure+                ("lenient dearmor should decode BOM-prefixed armor: " ++ err)+        Right (wasArmored, payload) -> do+            assertBool+                "lenient dearmor should report armored input"+                wasArmored+            assertBool+                "lenient dearmor payload should parse as packets"+                (not (null (parsePkts payload)))++testLooksLikeAsciiArmor :: Assertion+testLooksLikeAsciiArmor = do+    let armoredPrefix = "\n\t  -----BEGIN PGP MESSAGE-----\nYWJj\n"+        partialPrefix = "-----BEGIN PG"+        binaryPrefix = BL.pack [0x99, 0x01, 0x02, 0x03]+    assertBool+        "looksLikeAsciiArmor accepts canonical armored headers with leading whitespace"+        (looksLikeAsciiArmor armoredPrefix)+    assertBool+        "looksLikeAsciiArmor rejects partial armored headers"+        (not (looksLikeAsciiArmor partialPrefix))+    assertBool+        "looksLikeAsciiArmor rejects binary packet prefixes"+        (not (looksLikeAsciiArmor binaryPrefix))++testWireRepRefRejectsMalformedArmoredInput :: Assertion+testWireRepRefRejectsMalformedArmoredInput = do+    let malformed =+            "-----BEGIN PGP MESSAGE-----\n"+                <> "not base64 and no checksum\n"+                <> "-----END PGP MESSAGE-----\n"+    case wireRepRefFromInput Nothing malformed of+        Left _ -> pure ()+        Right _ ->+            assertFailure+                "wireRepRefFromInput unexpectedly accepted malformed ASCII-armored input"++testTksFromWireRepMatchesAnySource :: Assertion+testTksFromWireRepMatchesAnySource = do+    lbs <- readFixtureLazy "pubring.gpg"+    let srcA = wireRepRef lbs+        srcB = namedWireRepRef "synthetic-merge-source" lbs+        parsed = parseTKsWithWireRep True (parsePktsWithWireRep srcA lbs)+    case parsed of+        (tk : _) -> do+            let multiSourceTk = tk {_tkWireRepRefs = srcA :| [srcB]}+            assertBool+                "tksFromWireRep matches TKs whose source list contains the queried source"+                (multiSourceTk `elem` tksFromWireRep srcA [multiSourceTk])+            assertBool+                "tksFromWireRep can match secondary provenance sources"+                (multiSourceTk `elem` tksFromWireRep srcB [multiSourceTk])+        [] ->+            assertFailure+                "pubring.gpg should parse to at least one provenance-aware TKUnknown"++testSemigroupTKWithWireRepPreservesStructuredRefs :: Assertion+testSemigroupTKWithWireRepPreservesStructuredRefs = do+    lbs <- readFixtureLazy "pubring.gpg"+    let srcA = wireRepRef lbs+        srcB = namedWireRepRef "synthetic-merge-source" lbs+        parsed = parseTKsWithWireRep True (parsePktsWithWireRep srcA lbs)+    case parsed of+        (tk : _) -> do+            let remappedPackets = map (\pkt -> pkt {_pktWireRepRef = srcB}) (packetRefsOfTK tk)+                tkFromSecondSource =+                    TKWithWireRep+                        (srcB :| [])+                        (spanByteRanges (map _pktRange remappedPackets))+                        remappedPackets+                        (_tkValue tk)+                merged = tk <> tkFromSecondSource+                mergedRefIds = map packetRefIdOf (packetRefsOfTK merged)+            assertEqual+                "Semigroup preserves TKUnknown semantic merge behavior"+                (_tkValue tk <> _tkValue tkFromSecondSource)+                (_tkValue merged)+            assertBool+                "Semigroup merged provenance references include both sources"+                ( srcA `elem` wireRepsOfTK merged+                    && srcB `elem` wireRepsOfTK merged+                )+            assertEqual+                "Semigroup result packet refs match merged TKUnknown packet sequence"+                (flattenTK (_tkValue merged))+                (map _pktValue (packetRefsOfTK merged))+            assertEqual+                "Semigroup result keeps packet refs unique by source-aware PacketRefId"+                (length mergedRefIds)+                (length (nub mergedRefIds))+            case toStructuredTKWithWireRep merged of+                Left err ->+                    assertFailure+                        ("toStructuredTKWithWireRep failed for Semigroup result: " ++ err)+                Right structured -> do+                    resolved <- resolveStructuredPacketRefs structured+                    assertEqual+                        "Semigroup result structured refs resolve in packet order"+                        (map _pktValue (packetRefsOfTK merged))+                        (map _pktValue resolved)+        [] ->+            assertFailure+                "pubring.gpg should parse to at least one provenance-aware TKUnknown"++testKeyPktWrappersRoundTrip :: Assertion+testKeyPktWrappersRoundTrip = do+    fixture <- loadV6UnencryptedSecretKeyFixtureForProperty+    case fixture of+        Left err ->+            assertFailure err+        Right (pkp, ska, _) -> do+            let publicPrimaryPkt = PublicKeyPkt pkp+                publicSubkeyPkt = PublicSubkeyPkt pkp+                secretPrimaryPkt = SecretKeyPkt pkp ska+                secretSubkeyPkt = SecretSubkeyPkt pkp ska+            assertEqual+                "mkPrimaryKeyPkt preserves public primary packets"+                publicPrimaryPkt+                (someKeyPktToPkt (mkPrimaryKeyPkt pkp Nothing))+            assertEqual+                "mkPrimaryKeyPkt preserves secret primary packets"+                secretPrimaryPkt+                (someKeyPktToPkt (mkPrimaryKeyPkt pkp (Just ska)))+            assertEqual+                "mkSubkeyKeyPkt preserves public subkey packets"+                publicSubkeyPkt+                (someKeyPktToPkt (mkSubkeyKeyPkt pkp Nothing))+            assertEqual+                "mkSubkeyKeyPkt preserves secret subkey packets"+                secretSubkeyPkt+                (someKeyPktToPkt (mkSubkeyKeyPkt pkp (Just ska)))+            case pktToPublicKeyPkt publicPrimaryPkt of+                Nothing ->+                    assertFailure "pktToPublicKeyPkt should accept PublicKeyPkt"+                Just keyPkt -> do+                    assertEqual+                        "public primary role is preserved"+                        KeyPktPrimary+                        (keyPktRole keyPkt)+                    assertEqual+                        "public primary TKUnknown key view is preserved"+                        (pkp, Nothing)+                        (keyPktTKKey keyPkt)+                    assertEqual+                        "public primary round-trips through KeyPkt"+                        publicPrimaryPkt+                        (keyPktToPkt keyPkt)+            case pktToPublicKeyPkt publicSubkeyPkt of+                Nothing ->+                    assertFailure "pktToPublicKeyPkt should accept PublicSubkeyPkt"+                Just keyPkt ->+                    assertEqual+                        "public subkey role is preserved"+                        KeyPktSubkey+                        (keyPktRole keyPkt)+            case pktToSecretKeyPkt secretPrimaryPkt of+                Nothing ->+                    assertFailure "pktToSecretKeyPkt should accept SecretKeyPkt"+                Just keyPkt -> do+                    assertEqual+                        "secret primary role is preserved"+                        KeyPktPrimary+                        (keyPktRole keyPkt)+                    assertEqual+                        "secret primary TKUnknown key view is preserved"+                        (pkp, Just ska)+                        (keyPktTKKey keyPkt)+                    assertEqual+                        "secret primary round-trips through KeyPkt"+                        secretPrimaryPkt+                        (keyPktToPkt keyPkt)+                    assertEqual+                        "secret primary public view downgrades to PublicKeyPkt"+                        publicPrimaryPkt+                        (keyPktToPkt (keyPktToPublicView keyPkt))+            case pktToSecretKeyPkt secretSubkeyPkt of+                Nothing ->+                    assertFailure "pktToSecretKeyPkt should accept SecretSubkeyPkt"+                Just keyPkt -> do+                    assertEqual+                        "secret subkey role is preserved"+                        KeyPktSubkey+                        (keyPktRole keyPkt)+                    assertEqual+                        "secret subkey public view downgrades to PublicSubkeyPkt"+                        publicSubkeyPkt+                        (keyPktToPkt (keyPktToPublicView keyPkt))+            case pktToSomeKeyPktEither (UserIdPkt "not a key packet") of+                Left (NotAKeyPacket pkt) ->+                    assertEqual+                        "non-key coercion error reports the original packet"+                        (UserIdPkt "not a key packet")+                        pkt+                other ->+                    assertFailure+                        ("Expected NotAKeyPacket error, got " ++ show other)++testTKTypedRoundTripAndPublicView :: Assertion+testTKTypedRoundTripAndPublicView = do+    pubringBytes <- readFixtureLazy "pubring.gpg"+    let publicParsed = parseUnknownTKs True (parsePkts pubringBytes)+    publicTk <-+        case publicParsed of+            (tk : _) -> pure tk+            [] ->+                assertFailure+                    "pubring.gpg should parse to at least one TKUnknown"+                    >> fail "unreachable"+    publicTyped <-+        case fromUnknownToTK publicTk of+            Left err ->+                assertFailure+                    ("fromUnknownToTK failed for public TKUnknown: " ++ err)+                    >> fail "unreachable"+            Right typed@(SomePublicTK _) -> pure typed+            Right (SomeSecretTK _) ->+                assertFailure+                    "fromUnknownToTK should classify pubring primary key as public"+                    >> fail "unreachable"+    assertEqual+        "public typed TKUnknown round-trips back to untyped TKUnknown"+        publicTk+        (someTKToUnknown publicTyped)++    armored <- readFixtureLazy "v6-secret.pgp.aa"+    secretTk <- do+        payload <-+            case dearmorIfAsciiArmored armored of+                Left err ->+                    assertFailure ("failed to decode v6-secret fixture: " ++ err)+                        >> fail "unreachable"+                Right (_, bs) -> pure bs+        case parseUnknownTKs True (parsePkts payload) of+            (tk : _) -> pure tk+            [] ->+                assertFailure+                    "v6-secret.pgp.aa should parse to at least one TKUnknown"+                    >> fail "unreachable"+    secretTyped <-+        case fromUnknownToTK secretTk of+            Left err ->+                assertFailure+                    ("fromUnknownToTK failed for secret TKUnknown: " ++ err)+                    >> fail "unreachable"+            Right (SomeSecretTK typed) -> pure typed+            Right (SomePublicTK _) ->+                assertFailure+                    "fromUnknownToTK should classify v6 secret primary key as secret"+                    >> fail "unreachable"+    let secretRoundTrip = tkToUnknown secretTyped+    assertEqual+        "secret typed TKUnknown round-trips back to untyped TKUnknown"+        secretTk+        secretRoundTrip+    let projectedPublic = tkToUnknown (publicViewTK secretTyped)+        expectedPublic =+            secretTk+                { _tkuKey = (\(pkp, _) -> (pkp, Nothing)) (_tkuKey secretTk)+                , _tkuSubs =+                    map+                        (\(pkt, sigs) -> (publicKeyPacketOf pkt, sigs))+                        (_tkuSubs secretTk)+                }+    assertEqual+        "publicViewTK drops secret material from primary/subkeys"+        expectedPublic+        projectedPublic++flattenTK :: TKUnknown -> [Pkt]+flattenTK tk =+    [someKeyPktToPkt (mkPrimaryKeyPkt pkp mska)]+        ++ map SignaturePkt (_tkuRevs tk)+        ++ concatMap flattenUID (_tkuUIDs tk)+        ++ concatMap flattenUAt (_tkuUAts tk)+        ++ concatMap flattenSub (_tkuSubs tk)+  where+    (pkp, mska) = _tkuKey tk+    flattenUID (uid, sigs) = UserIdPkt uid : map SignaturePkt sigs+    flattenUAt (uat, sigs) = UserAttributePkt uat : map SignaturePkt sigs+    flattenSub (pkt, sigs) = pkt : map SignaturePkt sigs++testParseTKsDropsDisallowedPrimaryKeySigContextV4 :: Assertion+testParseTKsDropsDisallowedPrimaryKeySigContextV4 = do+    let pkp =+            PKPayload+                V4+                (ThirtyTwoBitTimeStamp 0)+                0+                EdDSA+                ( EdDSAPubKey+                    EdSigningCurve25519+                    ( PrefixedNativeEPoint+                        (EPoint (os2ip (B.cons 0x40 (B.replicate 32 0x01))))+                    )+                )+        invalidSig = SigV4 GenericCert RSA SHA512 [] [] 0 (MPI 0 :| [])+    case parseUnknownTKs True [PublicKeyPkt pkp, SignaturePkt invalidSig] of+        [tk] ->+            assertEqual+                "parseUnknownTKs True should drop GenericCert as a primary-key signature in v4"+                []+                (_tkuRevs tk)+        other ->+            assertFailure+                ( "Expected one TKUnknown when dropping invalid v4 signature context, got "+                    ++ show other+                )++testParseTKsDropsDisallowedPrimaryKeySigContextV6 :: Assertion+testParseTKsDropsDisallowedPrimaryKeySigContextV6 = do+    let pkp =+            PKPayload+                V6+                (ThirtyTwoBitTimeStamp 0)+                0+                EdDSA+                (EdDSAPubKey EdSigningCurve25519 (NativeEPoint (EPoint 1)))+        invalidSig =+            SigV6+                GenericCert+                EdDSA+                SHA512+                (SignatureSalt (BL.replicate 32 0x01))+                []+                []+                0+                (MPI 0 :| [])+    case parseUnknownTKs True [PublicKeyPkt pkp, SignaturePkt invalidSig] of+        [tk] ->+            assertEqual+                "parseUnknownTKs True should drop GenericCert as a primary-key signature in v6"+                []+                (_tkuRevs tk)+        other ->+            assertFailure+                ( "Expected one TKUnknown when dropping invalid v6 signature context, got "+                    ++ show other+                )++testParseTKsAcceptsAllowedPrimaryKeySigContextV6 :: Assertion+testParseTKsAcceptsAllowedPrimaryKeySigContextV6 = do+    let pkp =+            PKPayload+                V6+                (ThirtyTwoBitTimeStamp 0)+                0+                EdDSA+                (EdDSAPubKey EdSigningCurve25519 (NativeEPoint (EPoint 1)))+        allowedSig =+            SigV6+                KeyRevocationSig+                EdDSA+                SHA512+                (SignatureSalt (BL.replicate 32 0x02))+                []+                []+                0+                (MPI 0 :| [])+    case parseUnknownTKs True [PublicKeyPkt pkp, SignaturePkt allowedSig] of+        [tk] ->+            assertBool+                "parseUnknownTKs True should keep allowed v6 key-revocation signatures on primary keys"+                (not (null (_tkuRevs tk)))+        other ->+            assertFailure+                ( "Expected one TKUnknown with a retained v6 revocation signature, got "+                    ++ show other+                )