hOpenPGP 3.0.0 → 3.0.1

raw patch · 13 files changed

+1014/−102 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/Encrypt.hs +173/−5
• Codec/Encryption/OpenPGP/KeyringParser.hs +14/−17
• Codec/Encryption/OpenPGP/SecretKey.hs +27/−0
• Codec/Encryption/OpenPGP/Serialize.hs +166/−24
• Codec/Encryption/OpenPGP/Types/Internal/TK.hs +58/−9
• Data/Conduit/OpenPGP/Keyring.hs +63/−16
• bench/mark.hs +22/−9
• hOpenPGP.cabal +2/−2
• tests/Tests/Common.hs +1/−2
• tests/Tests/Encryption.hs +161/−1
• tests/Tests/Keys.hs +95/−0
• tests/Tests/MessageAndArmor.hs +98/−4
• tests/Tests/Utilities.hs +134/−13

@@ -26,9 +26,15 @@   , recipientEncryptionTargetsReportFromTKAtTimestamp   , recipientEncryptionTargetsReportFromTK   , recipientEncryptionTargetFromTKAtTimestamp+  , recipientEncryptionTargetFromTKAtTimestampWithPolicy   , recipientEncryptionTargetsFromTKAtTimestamp   , recipientEncryptionTargetFromTK+  , recipientEncryptionTargetFromTKWithPolicy   , recipientEncryptionTargetsFromTK+  , RecipientTargetSelectionPolicy(..)+  , PassphraseSKESKVersionPolicy(..)+  , PassphraseEncryptRequest(..)+  , encryptPassphraseWithPolicy   , PKESKVersionPolicy(..)   , RecipientPKESKVersionStrategy(..)   , RecipientPKESKVersionStrategyW(..)@@ -113,6 +119,7 @@   , messageSEIPDv2SymmetricAlgorithms   , messageDefaultAEADAlgorithm   , messageDefaultChunkSize+  , messageSEIPDv2SaltOctets   , defaultPKESKVersionPolicy   ) import Codec.Encryption.OpenPGP.Expirations@@ -129,10 +136,11 @@ 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, mapMaybe)+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import Data.Ord (comparing) import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)@@ -365,16 +373,49 @@   -> TKUnknown   -> Either RecipientCapabilityError RecipientEncryptionTarget recipientEncryptionTargetFromTKAtTimestamp timestamp tk =-  case recipientEncryptionTargetsAccepted (recipientEncryptionTargetsReportFromTKAtTimestamp timestamp tk) of-    (target:_) -> Right target-    [] -> Left RecipientCapabilityNoEncryptableKeyMaterialInTK+  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 =-  recipientEncryptionTargetFromTKAtTimestamp+  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@@ -583,6 +624,36 @@     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@@ -793,6 +864,63 @@     }   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@@ -2052,6 +2180,46 @@  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

@@ -47,13 +47,15 @@   , brokenWithWireRep  -- * Utilities   , parseUnknownTKs-  , parseTKs-  , parsePublicTKs-  , parseSecretTKs-  , parseTKsWithWireRep-  ) where+ , 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@@ -375,25 +377,20 @@   where     notTrustPacket = not . isTrustPkt +parseTKsEither :: Bool -> [Pkt] -> [Either TKConversionError SomeTK]+parseTKsEither intolerant =+  map fromUnknownToTKEither . parseUnknownTKs intolerant+ parseTKs :: Bool -> [Pkt] -> [SomeTK]-parseTKs intolerant =-  mapMaybe (either (const Nothing) Just . fromUnknownToTK) . parseUnknownTKs intolerant+parseTKs intolerant packets = rights (parseTKsEither intolerant packets)  parsePublicTKs :: Bool -> [Pkt] -> [TK 'PublicTK] parsePublicTKs intolerant packets =-  mapMaybe-    (\case-       SomePublicTK tk -> Just tk-       SomeSecretTK _ -> Nothing)-    (parseTKs intolerant packets)+  mapMaybe someTKToPublicTK (parseTKs intolerant packets)  parseSecretTKs :: Bool -> [Pkt] -> [TK 'SecretTK] parseSecretTKs intolerant packets =-  mapMaybe-    (\case-       SomeSecretTK tk -> Just tk-       SomePublicTK _ -> Nothing)-    (parseTKs intolerant packets)+  mapMaybe someTKToSecretTK (parseTKs intolerant packets)  anyTKWithWireRep :: Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep) anyTKWithWireRep True = publicTKWithWireRep True <|> secretTKWithWireRep True

@@ -9,6 +9,8 @@  module Codec.Encryption.OpenPGP.SecretKey   ( decryptPrivateKey+  , reinterpretUnknownSKeyForPKPayload+  , mkUnencryptedSKAddendum   , encryptPrivateKeyWithPolicyAndSaltAndIV   , encryptPrivateKey   , changePrivateKeyPassphrase@@ -111,6 +113,31 @@   pure (SKAUnencryptedV6 sk) decryptPrivateKeyTyped _ ska@(SKAUnencryptedLegacy {}) _ = Right ska decryptPrivateKeyTyped _ ska@(SKAUnencryptedV6 {}) _ = Right ska++reinterpretUnknownSKeyForPKPayload :: SomePKPayload -> SKey -> Either String SKey+reinterpretUnknownSKeyForPKPayload _ sk@RSAPrivateKey {} = Right sk+reinterpretUnknownSKeyForPKPayload _ sk@DSAPrivateKey {} = Right sk+reinterpretUnknownSKeyForPKPayload _ sk@ElGamalPrivateKey {} = Right sk+reinterpretUnknownSKeyForPKPayload _ sk@ECDHPrivateKey {} = Right sk+reinterpretUnknownSKeyForPKPayload _ sk@ECDSAPrivateKey {} = Right sk+reinterpretUnknownSKeyForPKPayload _ sk@EdDSAPrivateKey {} = Right sk+reinterpretUnknownSKeyForPKPayload _ sk@X25519PrivateKey {} = Right sk+reinterpretUnknownSKeyForPKPayload _ sk@X448PrivateKey {} = Right sk+reinterpretUnknownSKeyForPKPayload pkp (UnknownSKey payload) =+  case runGetOrFail ((,) <$> getSecretKey pkp <*> getRemainingLazyByteString) payload of+    Left (_, _, err) -> Left err+    Right (_, _, (skey, trailing))+      | BL.null trailing -> Right skey+      | otherwise -> Left "decoded secret key material has trailing bytes"++mkUnencryptedSKAddendum :: SomePKPayload -> SKey -> Either String SKAddendum+mkUnencryptedSKAddendum pkp skey = do+  payload <- legacySecretKeyPayload pkp skey+  let checksum =+        case _keyVersion pkp of+          V6 -> 0+          _ -> checksum16 (BL.toStrict payload)+  pure (SUUnencrypted skey checksum)  decryptS2KProtectedPayload ::      SomePKPayload

@@ -18,6 +18,12 @@   , putSKeyForPKPayload   -- * Utilities   , dearmorIfAsciiArmored+  , dearmorIfAsciiArmoredLenient+  , looksLikeAsciiArmor+  , armorPayloadsOfType+  , singleArmorPayloadOfType+  , singleClearSignedBlock+  , recommendedArmorType   , WireRepInput(..)   , wireRepRefFromInput   , PktParseError(..)@@ -95,7 +101,7 @@ 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(..))+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@@ -2767,19 +2773,130 @@           , pktParseErrorMessage = msg           } -armorPayload :: Armor -> ByteString-armorPayload (Armor _ _ bs) = BL.fromStrict (BLC8.toStrict bs)-armorPayload (ClearSigned _ _ inner) = armorPayload inner+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-  | BLC8.isPrefixOf (BLC8.pack "-----BEGIN PGP ") (BLC8.dropWhile (`elem` (" \t\r\n" :: String)) bs) =-      case AA.decodeLazy bs of-        Left err -> Left err-        Right [] -> Left "ASCII armor decode succeeded but returned no blocks"-        Right (a:_) -> Right (True, armorPayload a)+  | 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@@ -2885,19 +3002,13 @@     (advanceBinaryParseState (B.concat (reverse chunksRev)) initialBinaryParseState) finishConduitState mname (ArmoredInput chunksRev) =   let input = BL.fromChunks (reverse chunksRev)-      WireRepInput-        { wireRepInputRef = src-        , wireRepInputPayload = payload-        } =-        either-          (const-             WireRepInput-               { wireRepInputRef = BTypes.mkWireRepRef mname False input-               , wireRepInputPayload = input-               })-          id-          (wireRepRefFromInput mname input)-   in parsePktsWithWireRep src payload+   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@@ -2943,9 +3054,40 @@       | 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-    armorHeader = BLC8.toStrict (BLC8.pack "-----BEGIN PGP ")-    isLeadingArmorWhitespace w = w `elem` map (fromIntegral . fromEnum) (" \t\r\n" :: String)+    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

@@ -23,6 +23,7 @@ import Codec.Encryption.OpenPGP.Types.Internal.Pkt  import Control.Arrow ((&&&))+import Data.Bifunctor (first) import Control.Lens (makeLenses) import qualified Data.Aeson.TH as ATH import qualified Data.ByteString.Lazy as BL@@ -35,6 +36,7 @@ import Data.Ord (comparing) import Data.Text (Text) import Data.Typeable (Typeable)+import Data.Word (Word8)  -- | Zipper for navigating a list of packets with position context data PacketZipper =@@ -111,6 +113,21 @@ instance Eq SomeTK where   left == right = someTKToUnknown left == someTKToUnknown right +data TKConversionError+  = PublicSubkeyHasPrimaryRole+  | SecretSubkeyHasPrimaryRole+  | ExpectedPublicSubkeyPacket Word8+  | ExpectedSecretSubkeyPacket Word8+  deriving (Eq, Show)++renderTKConversionError :: TKConversionError -> String+renderTKConversionError PublicSubkeyHasPrimaryRole = "public subkey has primary-key role"+renderTKConversionError SecretSubkeyHasPrimaryRole = "secret subkey has primary-key role"+renderTKConversionError (ExpectedPublicSubkeyPacket tagValue) =+  "expected public subkey, got packet tag " ++ show tagValue+renderTKConversionError (ExpectedSecretSubkeyPacket tagValue) =+  "expected secret subkey, got packet tag " ++ show tagValue+ tkToUnknown :: TK k -> TKUnknown tkToUnknown tk =   TKUnknown@@ -125,6 +142,36 @@ someTKToUnknown (SomePublicTK tk) = tkToUnknown tk someTKToUnknown (SomeSecretTK tk) = tkToUnknown tk +mkTKUnknown :: SomePKPayload -> Maybe SKAddendum -> TKUnknown+mkTKUnknown pkp maybeSka =+  TKUnknown+    { _tkuKey = (pkp, maybeSka)+    , _tkuRevs = []+    , _tkuUIDs = []+    , _tkuUAts = []+    , _tkuSubs = []+    }++fromPrimaryKeyPktToTKUnknown :: Pkt -> Either String TKUnknown+fromPrimaryKeyPktToTKUnknown (PublicKeyPkt pkp) =+  Right (mkTKUnknown pkp Nothing)+fromPrimaryKeyPktToTKUnknown (SecretKeyPkt pkp ska) =+  Right (mkTKUnknown pkp (Just ska))+fromPrimaryKeyPktToTKUnknown pkt =+  Left ("expected primary key packet, got packet tag " ++ show (pktTag pkt))++someTKToPublicTK :: SomeTK -> Maybe (TK 'PublicTK)+someTKToPublicTK (SomePublicTK tk) = Just tk+someTKToPublicTK (SomeSecretTK _) = Nothing++someTKToSecretTK :: SomeTK -> Maybe (TK 'SecretTK)+someTKToSecretTK (SomeSecretTK tk) = Just tk+someTKToSecretTK (SomePublicTK _) = Nothing++someTKToPublicViewTK :: SomeTK -> TK 'PublicTK+someTKToPublicViewTK (SomePublicTK tk) = tk+someTKToPublicViewTK (SomeSecretTK tk) = publicViewTK tk+ publicViewTK :: TK 'SecretTK -> TK 'PublicTK publicViewTK tk =   TK@@ -135,8 +182,8 @@     , _tkSubs = map (\(kp, sigs) -> (keyPktToPublicView kp, sigs)) (_tkSubs tk)     } -fromUnknownToTK :: TKUnknown -> Either String SomeTK-fromUnknownToTK tk =+fromUnknownToTKEither :: TKUnknown -> Either TKConversionError SomeTK+fromUnknownToTKEither tk =   case _tkuKey tk of     (pkp, Nothing) -> do       subs <- traverse liftPublicSubkey (_tkuSubs tk)@@ -167,30 +214,33 @@   where     liftPublicSubkey ::          (Pkt, [SignaturePayload])-      -> Either String (KeyPkt 'PublicPkt, [SignaturePayload])+      -> Either TKConversionError (KeyPkt 'PublicPkt, [SignaturePayload])     liftPublicSubkey (pkt, sigs) =       case pktToPublicKeyPkt pkt of         Just keyPkt           | keyPktRole keyPkt == KeyPktSubkey ->               Right (keyPkt, sigs)           | otherwise ->-              Left "public subkey has primary-key role"+              Left PublicSubkeyHasPrimaryRole         Nothing ->-          Left ("expected public subkey, got packet tag " ++ show (pktTag pkt))+          Left (ExpectedPublicSubkeyPacket (pktTag pkt))      liftSecretSubkey ::          (Pkt, [SignaturePayload])-      -> Either String (KeyPkt 'SecretPkt, [SignaturePayload])+      -> Either TKConversionError (KeyPkt 'SecretPkt, [SignaturePayload])     liftSecretSubkey (pkt, sigs) =       case pktToSecretKeyPkt pkt of         Just keyPkt           | keyPktRole keyPkt == KeyPktSubkey ->               Right (keyPkt, sigs)           | otherwise ->-              Left "secret subkey has primary-key role"+              Left SecretSubkeyHasPrimaryRole         Nothing ->-          Left ("expected secret subkey, got packet tag " ++ show (pktTag pkt))+          Left (ExpectedSecretSubkeyPacket (pktTag pkt)) +fromUnknownToTK :: TKUnknown -> Either String SomeTK+fromUnknownToTK = first renderTKConversionError . fromUnknownToTKEither+ data TKWithWireRep =   TKWithWireRep     { _tkWireRepRefs :: WireRepRefs@@ -593,4 +643,3 @@ $(makeLenses ''UATWithWireRefs) $(makeLenses ''SubkeyWithWireRefs) $(makeLenses ''TKStructuredWithWireRep)-

@@ -8,6 +8,10 @@  module Data.Conduit.OpenPGP.Keyring   ( conduitToUnknownTKs+  , TypedTKConduitError(..)+  , conduitToSomeTKsEither+  , conduitToSomeTKsDropping+  , conduitToSomeTKsDroppingEither   , conduitToTKs   , conduitToPublicTKs   , conduitToPublicViewTKs@@ -38,6 +42,7 @@  import Data.Conduit import qualified Data.Conduit.List as CL+import Data.Bifunctor (first) import Data.List (find) import Data.Maybe (maybeToList) import qualified Data.Set as Set@@ -81,44 +86,80 @@   | 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." #-} +-- | Canonical strict typed conduit with explicit parse+conversion error channel.+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." #-}++-- | 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 . fromUnknownToTK)+  CL.mapMaybe (either (const Nothing) Just . fromUnknownToTKEither)+{-# DEPRECATED conduitToTKs "Use conduitToSomeTKsEither and handle Left/Maybe explicitly." #-} +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-    (\stk ->-       case stk of-         SomePublicTK tk -> Just tk-         SomeSecretTK _ -> Nothing)+  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-    (\stk ->-       case stk of-         SomePublicTK tk -> tk-         SomeSecretTK tk -> publicViewTK tk)+  CL.map someTKToPublicViewTK+{-# DEPRECATED conduitToPublicViewTKs "Use conduitToSomeTKsEither and perform explicit projection." #-}  conduitToSecretTKs :: Monad m => ConduitT Pkt (TK 'SecretTK) m () conduitToSecretTKs =   conduitToTKs .|-  CL.mapMaybe-    (\stk ->-       case stk of-         SomeSecretTK tk -> Just tk-         SomePublicTK _ -> Nothing)+  CL.mapMaybe someTKToSecretTK+{-# DEPRECATED conduitToSecretTKs "Use conduitToSomeTKsEither and perform explicit projection/filtering." #-}  data AuthSecretSubkeyUID =   AuthSecretSubkeyUID@@ -345,10 +386,14 @@      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 ()@@ -358,6 +403,7 @@ conduitToTKsWithWireRep =   conduitToTKsWithWireRepEither .|   conduitDropErrorsAndNothings+{-# DEPRECATED conduitToTKsWithWireRep "Use conduitToTKsWithWireRepEither and handle Left/Maybe explicitly." #-}  conduitToTKsWithWireRepEither ::      Monad m@@ -373,6 +419,7 @@ conduitToTKsDroppingWithWireRep =   conduitToTKsDroppingWithWireRepEither .|   conduitDropErrorsAndNothings+{-# DEPRECATED conduitToTKsDroppingWithWireRep "Use conduitToTKsDroppingWithWireRepEither or conduitToTKsWithWireRepEither and handle Left/Maybe explicitly." #-}  conduitToTKsDroppingWithWireRepEither ::      Monad m

@@ -20,17 +20,21 @@   , verifyTKWith   , verifyUnknownTKWith   )-import Codec.Encryption.OpenPGP.Types (wireRepRef)+import Codec.Encryption.OpenPGP.Types+  ( someTKToPublicViewTK+  , wireRepRef+  )  import Data.Binary (get) import Data.Conduit.OpenPGP.Keyring- ( conduitToPublicViewTKs- , conduitToUnknownTKs- , sinkPublicKeyringMap+ ( 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@@ -73,12 +77,17 @@     ]   where     loadKeys fp =-      DC.runConduitRes $-      CB.sourceFile fp DC..| conduitGet get DC..| conduitToUnknownTKs DC..| CL.consume+      fmap+        catMaybes+        (DC.runConduitRes $+         CB.sourceFile fp DC..| conduitGet get DC..| conduitToTKsEither DC..|+         CL.consume)     loadKeyring fp =-      DC.runConduitRes $-      CB.sourceFile fp DC..| conduitGet get DC..| conduitToPublicViewTKs DC..|-      sinkPublicKeyringMap+      fmap+        (sinkFromSomeTKs . rights)+        (DC.runConduitRes $+         CB.sourceFile fp DC..| conduitGet get DC..| conduitToSomeTKsEither DC..|+         CL.consume)     selfVerifyKeys fp =       fmap         (\ks ->@@ -91,3 +100,7 @@              (verifyTKWith (verifySigWith (verifyAgainstKeyring kr)) Nothing)              (IxSet.toList kr))         (loadKeyring fp)+    sinkFromSomeTKs =+      IxSet.fromList .+      map someTKToPublicViewTK .+      catMaybes

@@ -1,6 +1,6 @@ Cabal-version:       3.4 Name:                hOpenPGP-Version:             3.0.0+Version:             3.0.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@@ -331,4 +331,4 @@ source-repository this   type:     git   location: https://salsa.debian.org/clint/hOpenPGP.git-  tag:      v3.0.0+  tag:      v3.0.1

@@ -708,7 +708,7 @@  mkTestKeyring :: [TKUnknown] -> PublicKeyring mkTestKeyring tks =-  let someTKs = [stk | Right stk <- map fromUnknownToTK tks]+  let someTKs = [stk | Right stk <- map fromUnknownToTKEither tks]   in fst (partitionSomeTKs someTKs)  addTimestampSeconds :: ThirtyTwoBitTimeStamp -> Word32 -> ThirtyTwoBitTimeStamp@@ -1535,5 +1535,4 @@       assertFailure ("failed to sign Ed25519 message payload: " ++ renderSignError err) >>       fail "expected Ed25519 message signature"     Right sigPayload -> pure sigPayload- 

@@ -17,11 +17,14 @@   ( PKESKEncryptError(InvalidRecipientIdentifier, InvalidRecipientKeyMaterial, PayloadBuildFailure, RecipientCapabilitySelectionFailure, RecipientKdfFailure, UnsupportedRecipientAlgorithm)   , RecipientCapabilityError(RecipientCapabilityMissingSEIPDv1Support, RecipientCapabilityNoCommonAEADAlgorithms, RecipientCapabilityNoCommonSymmetricAlgorithms, RecipientCapabilityNoEncryptableKeyMaterialInTK)   , RecipientCapabilityNegotiationMode(..)+  , PassphraseSKESKVersionPolicy(..)+  , PassphraseEncryptRequest(..)   , EncryptCompatibilityProfile(..)   , RecipientCapabilities(..)   , RecipientEncryptionTargetRejected(..)   , RecipientEncryptionTargetsReport(..)   , RecipientTargetRejectionReason(..)+  , RecipientTargetSelectionPolicy(..)   , RecipientPKESKVersionStrategy(..)   , RecipientEncryptionTarget(..)   , RecipientPayloadShape(..)@@ -39,8 +42,10 @@   , encryptForRecipients   , encryptForRecipientsLegacy   , encryptForRecipientsWithCapabilityNegotiation+  , encryptPassphraseWithPolicy   , recipientCapabilitiesFromSubpacketPayloads   , recipientEncryptionTargetFromTKAtTimestamp+  , recipientEncryptionTargetFromTKAtTimestampWithPolicy   , recipientEncryptionTargetsFromTKAtTimestamp   , recipientEncryptionTargetsReportFromTKAtTimestamp   , recipientEncryptionTargetFromTK@@ -117,7 +122,10 @@   ) import qualified Data.Conduit.OpenPGP.Decrypt as DCD import Data.Conduit.OpenPGP.Keyring-  ( conduitToTKsDropping+  ( conduitToSomeTKsDropping+  , conduitToSomeTKsDroppingEither+  , conduitToSomeTKsEither+  , conduitToTKsDropping   , conduitToTKsDroppingEither   , conduitToTKsEither   , conduitToUnknownTKs@@ -295,11 +303,23 @@                (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"@@ -555,6 +575,12 @@             "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@@ -635,6 +661,12 @@         , 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         ]@@ -691,6 +723,26 @@     "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.@@ -2579,6 +2631,66 @@             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@@ -4881,6 +4993,54 @@          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

@@ -35,10 +35,13 @@ 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@@ -96,6 +99,7 @@   , loadDeterministicEd25519Signer   , loadKeyring   , loadUnencryptedRsaSigner+  , loadUnencryptedRsaSignerV6   , messageVerificationFixtures   , mkTestKeyring   , readFixturePayload@@ -272,6 +276,18 @@         , 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"@@ -1675,3 +1691,82 @@         (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"

@@ -19,7 +19,14 @@ import Codec.Encryption.OpenPGP.Message import Codec.Encryption.OpenPGP.Policy (signatureV6SaltSizeForHashAlgorithm) import Codec.Encryption.OpenPGP.S2K (renderS2KError, string2Key)-import Codec.Encryption.OpenPGP.Serialize (parsePkts, parsePktsEither)+import Codec.Encryption.OpenPGP.Serialize+  ( armorPayloadsOfType+  , parsePkts+  , parsePktsEither+  , recommendedArmorType+  , singleClearSignedBlock+  , singleArmorPayloadOfType+  ) import Codec.Encryption.OpenPGP.SerializeForSigs (payloadForSig, payloadForSigWith) import Codec.Encryption.OpenPGP.Signatures   ( renderSignError@@ -64,7 +71,7 @@ import qualified Data.ByteString.Lazy as BL import Data.Conduit.OpenPGP.Message (verifyMessage, verifyMessagePackets) import Data.Conduit.OpenPGP.Verify (VerificationMode(..))-import Data.Either (isRight)+import Data.Either (isLeft, isRight) import Data.List (isInfixOf) import qualified Data.List.NonEmpty as NE import Test.Tasty (TestTree, testGroup)@@ -167,6 +174,15 @@             "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@@ -1560,6 +1576,86 @@     "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@@ -1843,5 +1939,3 @@         ("Ed25519 SigV4 verification with Ed25519 key algorithm failed: " ++          renderVerificationError err)     Right _ -> pure ()--

@@ -7,12 +7,12 @@  module Tests.Utilities (utilityTests) where -import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA import Codec.Encryption.OpenPGP.Fingerprint (fingerprint) import Codec.Encryption.OpenPGP.KeyInfo (pkalgoAbbrev) import Codec.Encryption.OpenPGP.KeyringParser   ( parsePublicTKs   , parseSecretTKs+  , parseTKsEither   , parseTKs   , parseTKsWithWireRep   , parseUnknownTKs@@ -21,6 +21,9 @@   ( PktParseError(..)   , WireRepInput(..)   , conduitParsePktsWithWireRep+  , dearmorIfAsciiArmored+  , dearmorIfAsciiArmoredLenient+  , looksLikeAsciiArmor   , parsePkts   , parsePktsEither   , parsePktsWithWireRep@@ -45,8 +48,10 @@   , authSecretSubkeyRejectedReason   , authSecretSubkeyUIDs   , authSecretSubkeyValue+  , conduitToSomeTKsDroppingEither   , conduitToAuthSecretSubkeysAt   , conduitToAuthSecretSubkeysAtReport+  , conduitToSomeTKsEither   , conduitToPublicTKs   , conduitToSecretTKs   , conduitToTKs@@ -54,14 +59,15 @@   , conduitToUnknownTKs   ) import Data.Conduit.Serialization.Binary (conduitGet)-import Data.List (nub, sortOn)+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-  , armorPayload   , loadAndDecompressPkts   , loadUnencryptedRsaSigner   , loadV6UnencryptedSecretKeyFixtureForProperty@@ -101,9 +107,18 @@         "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@@ -131,6 +146,18 @@         "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@@ -240,6 +267,20 @@     (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@@ -261,6 +302,36 @@     (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@@ -963,6 +1034,62 @@         "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"@@ -1111,16 +1238,12 @@    armored <- readFixtureLazy "v6-secret.pgp.aa"   secretTk <- do-    armors <--      case AA.decodeLazy armored of+    payload <-+      case dearmorIfAsciiArmored armored of         Left err ->           assertFailure ("failed to decode v6-secret fixture: " ++ err) >> fail "unreachable"-        Right as -> pure as-    armor <--      case armors of-        (a:_) -> pure a-        [] -> assertFailure "v6-secret.pgp.aa should contain one armored payload" >> fail "unreachable"-    case parseUnknownTKs True (parsePkts (armorPayload armor)) of+        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 <-@@ -1230,5 +1353,3 @@     other ->       assertFailure         ("Expected one TKUnknown with a retained v6 revocation signature, got " ++ show other)--