hOpenPGP 0.6 → 0.6.1

raw patch · 12 files changed

+195/−160 lines, 12 filesdep ~cereal-conduitdep ~conduitdep ~crypto-pubkeyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: cereal-conduit, conduit, crypto-pubkey

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/Compression.hs +4/−8
• Codec/Encryption/OpenPGP/Fingerprint.hs +4/−4
• Codec/Encryption/OpenPGP/Internal.hs +2/−4
• Codec/Encryption/OpenPGP/Serialize.hs +11/−19
• Codec/Encryption/OpenPGP/SerializeForSigs.hs +2/−2
• Codec/Encryption/OpenPGP/Types.hs +70/−41
• Codec/Encryption/OpenPGP/Verify.hs +5/−5
• Data/Conduit/OpenPGP/Compression.hs +1/−5
• Data/Conduit/OpenPGP/Keyring.hs +57/−47
• Data/Conduit/OpenPGP/Verify.hs +12/−13
• hOpenPGP.cabal +7/−7
• tests/suite.hs +20/−5

@@ -13,7 +13,6 @@ import qualified Codec.Compression.Zlib.Raw as ZlibRaw import Codec.Encryption.OpenPGP.Serialize () import Codec.Encryption.OpenPGP.Types-import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Serialize (get, put)@@ -21,12 +20,11 @@ import Data.Serialize.Put (runPut)  decompressPkt :: Pkt -> [Pkt]-decompressPkt (CompressedDataPkt algo bs') = case (runGet get . B.concat . BL.toChunks) (decompressPkt' algo bs') of+decompressPkt (CompressedDataPkt algo bs) =+    case (runGet get . B.concat . BL.toChunks) (dfunc algo (BL.fromChunks [bs])) of                        Left _ -> []                        Right packs -> unBlock packs     where-        decompressPkt' :: CompressionAlgorithm -> ByteString -> BL.ByteString-	decompressPkt' ca bs = dfunc ca (BL.fromChunks [bs])         dfunc ZIP = ZlibRaw.decompress         dfunc ZLIB = Zlib.decompress         dfunc BZip2 = BZip.decompress@@ -35,12 +33,10 @@  compressPkts :: CompressionAlgorithm -> [Pkt] -> Pkt compressPkts ca packs = do-    let bs' = runPut $ put (Block packs)-    let cbs = B.concat . BL.toChunks $ compressPkts' ca bs'+    let bs = runPut $ put (Block packs)+        cbs = B.concat . BL.toChunks $ cfunc ca (BL.fromChunks [bs])     CompressedDataPkt ca cbs     where-        compressPkts' :: CompressionAlgorithm -> ByteString -> BL.ByteString-        compressPkts' ca bs = cfunc ca (BL.fromChunks [bs])         cfunc ZIP = ZlibRaw.compress         cfunc ZLIB = Zlib.compress         cfunc BZip2 = BZip.compress

@@ -19,10 +19,10 @@ import Codec.Encryption.OpenPGP.Types  eightOctetKeyID :: PKPayload -> EightOctetKeyId-eightOctetKeyID (DeprecatedPubV3 _ _ RSA (RSAPubKey rp)) = (EightOctetKeyId . B.reverse . B.take 4 . B.reverse . integerToBEBS . RSA.public_n) rp-eightOctetKeyID p4@(PubV4 {}) = (EightOctetKeyId . B.drop 12 . unTOF . fingerprint) p4+eightOctetKeyID (PKPayload DeprecatedV3 _ _ RSA (RSAPubKey rp)) = (EightOctetKeyId . B.reverse . B.take 4 . B.reverse . integerToBEBS . RSA.public_n) rp+eightOctetKeyID p4@(PKPayload V4 _ _ _ _) = (EightOctetKeyId . B.drop 12 . unTOF . fingerprint) p4 eightOctetKeyID _ = error "This should never happen."  fingerprint :: PKPayload -> TwentyOctetFingerprint-fingerprint p3@(DeprecatedPubV3 {}) = (TwentyOctetFingerprint . MD5.hash) (runPut $ putPKPforFingerprinting (PublicKeyPkt p3))-fingerprint p4@(PubV4 {}) = (TwentyOctetFingerprint . SHA1.hash) (runPut $ putPKPforFingerprinting (PublicKeyPkt p4))+fingerprint p3@(PKPayload DeprecatedV3 _ _ _ _) = (TwentyOctetFingerprint . MD5.hash) (runPut $ putPKPforFingerprinting (PublicKeyPkt p3))+fingerprint p4@(PKPayload V4 _ _ _ _) = (TwentyOctetFingerprint . SHA1.hash) (runPut $ putPKPforFingerprinting (PublicKeyPkt p4))

@@ -14,15 +14,13 @@  , pubkeyToMPIs ) where -import qualified Crypto.Hash.RIPEMD160 as RIPEMD160-import Crypto.PubKey.HashDescr (HashDescr(..), hashDescrMD5, hashDescrSHA1, hashDescrSHA224, hashDescrSHA256, hashDescrSHA384, hashDescrSHA512)+import Crypto.PubKey.HashDescr (HashDescr(..), hashDescrMD5, hashDescrSHA1, hashDescrSHA224, hashDescrSHA256, hashDescrSHA384, hashDescrSHA512, hashDescrRIPEMD160) import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.RSA as RSA  import Data.Bits (testBit, shiftL, shiftR, (.&.)) import Data.ByteString (ByteString) import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as BC8 import Data.List (find, mapAccumR, unfoldr) import Data.Word (Word8, Word16) @@ -60,7 +58,7 @@  hashDescr :: HashAlgorithm -> HashDescr hashDescr SHA1 = hashDescrSHA1-hashDescr RIPEMD160 = HashDescr (RIPEMD160.hash) (B.append (BC8.pack "\x30\x21\x30\x09\x06\x05\x2b\x24\x03\x02\x01\x05\x00\x04\x14"))+hashDescr RIPEMD160 = hashDescrRIPEMD160 hashDescr SHA256 = hashDescrSHA256 hashDescr SHA384 = hashDescrSHA384 hashDescr SHA512 = hashDescrSHA512

@@ -768,7 +768,7 @@  getSecretKey :: PKPayload -> Get SKey getSecretKey pkp-    | pubKeyAlgo pkp `elem` [RSA, RSAEncryptOnly, RSASignOnly] =+    | _pkalgo pkp `elem` [RSA, RSAEncryptOnly, RSASignOnly] =         do MPI d <- get            MPI p <- get            MPI q <- get@@ -777,11 +777,11 @@                dP = 0                dQ = 0                qinv = 0-               pub = (\(RSAPubKey x) -> x) (pubKeyKey pkp)+               pub = (\(RSAPubKey x) -> x) (_pubkey pkp)            return $ RSAPrivateKey (R.PrivateKey pub d p q dP dQ qinv)-    | pubKeyAlgo pkp == DSA = do MPI x <- get-                                 return $ DSAPrivateKey (D.PrivateKey (0,0,0) x)-    | pubKeyAlgo pkp `elem` [ElgamalEncryptOnly,Elgamal] =+    | _pkalgo pkp == DSA = do MPI x <- get+                              return $ DSAPrivateKey (D.PrivateKey (0,0,0) x)+    | _pkalgo pkp `elem` [ElgamalEncryptOnly,Elgamal] =         do MPI x <- get            return $ ElGamalPrivateKey [x] @@ -795,35 +795,27 @@     version <- getWord8     ctime <- getWord32be     if version `elem` [2,3] then-        do v3exp <-  getWord16be+        do v3e <-  getWord16be            pka <- get            pk <- getPubkey pka-           return $ DeprecatedPubV3 ctime v3exp pka pk+           return $! PKPayload DeprecatedV3 ctime v3e pka pk     else         do pka <- get            pk <- getPubkey pka-           return $ PubV4 ctime pka pk+           return $! PKPayload V4 ctime 0 pka pk  putPKPayload :: PKPayload -> Put-putPKPayload (DeprecatedPubV3 ctime v3exp pka pk) = do+putPKPayload (PKPayload DeprecatedV3 ctime v3e pka pk) = do     putWord8 3     putWord32be ctime-    putWord16be v3exp+    putWord16be v3e     put pka     putPubkey pk-putPKPayload (PubV4 ctime pka pk) = do+putPKPayload (PKPayload V4 ctime _ pka pk) = do     putWord8 4     putWord32be ctime     put pka     putPubkey pk--pubKeyAlgo :: PKPayload -> PubKeyAlgorithm-pubKeyAlgo (DeprecatedPubV3 _ _ pka _) = pka-pubKeyAlgo (PubV4 _ pka _) = pka--pubKeyKey :: PKPayload -> PKey-pubKeyKey (DeprecatedPubV3 _ _ _ k) = k-pubKeyKey (PubV4 _ _ k) = k  getSKAddendum :: PKPayload -> Get SKAddendum getSKAddendum pkp = do

@@ -26,8 +26,8 @@ import Codec.Encryption.OpenPGP.Types  putPKPforFingerprinting :: Pkt -> Put-putPKPforFingerprinting (PublicKeyPkt pkp@(DeprecatedPubV3 _ _ _ pk)) = mapM_ putMPIforFingerprinting (pubkeyToMPIs pk)-putPKPforFingerprinting (PublicKeyPkt pkp@(PubV4 {})) = do+putPKPforFingerprinting (PublicKeyPkt (PKPayload DeprecatedV3 _ _ _ pk)) = mapM_ putMPIforFingerprinting (pubkeyToMPIs pk)+putPKPforFingerprinting (PublicKeyPkt pkp@(PKPayload V4 _ _ _ _)) = do     putWord8 0x99     let bs = runPut $ put pkp     putWord16be . fromIntegral $ B.length bs

@@ -19,6 +19,7 @@  , SigType(..)  , ImageHeader(..)  , ImageFormat(..)+ , KeyVersion(..)  , PKPayload(..)  , SKAddendum(..)  , DataType(..)@@ -426,8 +427,16 @@                       | SigVOther Word8 ByteString     deriving (Data, Eq, Show, Typeable) -- FIXME -data PKPayload = DeprecatedPubV3 TimeStamp V3Expiration PubKeyAlgorithm PKey-               | PubV4 TimeStamp PubKeyAlgorithm PKey+data KeyVersion = DeprecatedV3 | V4+    deriving (Data, Eq, Ord, Show, Typeable)++data PKPayload = PKPayload {+      _keyVersion :: KeyVersion+    , _timestamp :: TimeStamp+    , _v3exp :: V3Expiration+    , _pkalgo :: PubKeyAlgorithm+    , _pubkey :: PKey+    }     deriving (Data, Eq, Show, Typeable)  instance Ord PKPayload where@@ -631,10 +640,10 @@     deriving (Show, Eq, Data, Typeable) -- FIXME  data PKESK = PKESK-    { pkeskPacketVersion :: PacketVersion-    , pkeskEightOctetKeyId :: EightOctetKeyId-    , pkeskPubKeyAlgorithm :: PubKeyAlgorithm-    , pkeskMPIs :: [MPI]+    { _pkeskPacketVersion :: PacketVersion+    , _pkeskEightOctetKeyId :: EightOctetKeyId+    , _pkeskPubKeyAlgorithm :: PubKeyAlgorithm+    , _pkeskMPIs :: [MPI]     } deriving (Data, Eq, Show, Typeable) instance Packet PKESK where     data PacketType PKESK = PKESKType@@ -644,7 +653,7 @@     fromPkt (PKESKPkt a b c d) = PKESK a b c d  data Signature = Signature   -- FIXME?-    { signaturePayload :: SignaturePayload+    { _signaturePayload :: SignaturePayload     } deriving (Data, Eq, Show, Typeable) instance Packet Signature where     data PacketType Signature = SignatureType@@ -654,10 +663,10 @@     fromPkt (SignaturePkt a) = Signature a  data SKESK = SKESK-    { skeskPacketVersion :: PacketVersion-    , skeskSymmetricAlgorithm :: SymmetricAlgorithm-    , skeskS2K :: S2K-    , skeskMPIs :: [MPI]+    { _skeskPacketVersion :: PacketVersion+    , _skeskSymmetricAlgorithm :: SymmetricAlgorithm+    , _skeskS2K :: S2K+    , _skeskMPIs :: [MPI]     } deriving (Data, Eq, Show, Typeable) instance Packet SKESK where     data PacketType SKESK = SKESKType@@ -667,12 +676,12 @@     fromPkt (SKESKPkt a b c d) = SKESK a b c d  data OnePassSignature = OnePassSignature-    { onePassSignaturePacketVersion :: PacketVersion-    , onePassSignatureSigType :: SigType-    , onePassSignatureHashAlgorithm :: HashAlgorithm-    , onePassSignaturePubKeyAlgorithm :: PubKeyAlgorithm-    , onePassSignatureEightOctetKeyId :: EightOctetKeyId-    , onePassSignatureNestedFlag :: NestedFlag+    { _onePassSignaturePacketVersion :: PacketVersion+    , _onePassSignatureSigType :: SigType+    , _onePassSignatureHashAlgorithm :: HashAlgorithm+    , _onePassSignaturePubKeyAlgorithm :: PubKeyAlgorithm+    , _onePassSignatureEightOctetKeyId :: EightOctetKeyId+    , _onePassSignatureNestedFlag :: NestedFlag     } deriving (Data, Eq, Show, Typeable) instance Packet OnePassSignature where     data PacketType OnePassSignature = OnePassSignatureType@@ -682,8 +691,8 @@     fromPkt (OnePassSignaturePkt a b c d e f) = OnePassSignature a b c d e f  data SecretKey = SecretKey-    { secretKeyPKPayload :: PKPayload-    , secretKeySKAddendum :: SKAddendum+    { _secretKeyPKPayload :: PKPayload+    , _secretKeySKAddendum :: SKAddendum     } deriving (Data, Eq, Show, Typeable) instance Packet SecretKey where     data PacketType SecretKey = SecretKeyType@@ -693,7 +702,7 @@     fromPkt (SecretKeyPkt a b) = SecretKey a b  data PublicKey = PublicKey-    { publicKeyPKPayload :: PKPayload+    { _publicKeyPKPayload :: PKPayload     } deriving (Data, Eq, Show, Typeable) instance Packet PublicKey where     data PacketType PublicKey = PublicKeyType@@ -703,8 +712,8 @@     fromPkt (PublicKeyPkt a) = PublicKey a  data SecretSubkey = SecretSubkey-    { secretSubkeyPKPayload :: PKPayload-    , secretSubkeySKAddendum :: SKAddendum+    { _secretSubkeyPKPayload :: PKPayload+    , _secretSubkeySKAddendum :: SKAddendum     } deriving (Data, Eq, Show, Typeable) instance Packet SecretSubkey where     data PacketType SecretSubkey = SecretSubkeyType@@ -714,8 +723,8 @@     fromPkt (SecretSubkeyPkt a b) = SecretSubkey a b  data CompressedData = CompressedData-    { compressedDataCompressionAlgorithm :: CompressionAlgorithm-    , compressedDataPayload :: CompressedDataPayload+    { _compressedDataCompressionAlgorithm :: CompressionAlgorithm+    , _compressedDataPayload :: CompressedDataPayload     } deriving (Data, Eq, Show, Typeable) instance Packet CompressedData where     data PacketType CompressedData = CompressedDataType@@ -725,7 +734,7 @@     fromPkt (CompressedDataPkt a b) = CompressedData a b  data SymEncData = SymEncData-    { symEncDataPayload :: ByteString+    { _symEncDataPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet SymEncData where     data PacketType SymEncData = SymEncDataType@@ -735,7 +744,7 @@     fromPkt (SymEncDataPkt a) = SymEncData a  data Marker = Marker-    { markerPayload :: ByteString+    { _markerPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet Marker where     data PacketType Marker = MarkerType@@ -745,10 +754,10 @@     fromPkt (MarkerPkt a) = Marker a  data LiteralData = LiteralData-    { literalDataDataType :: DataType-    , literalDataFileName :: FileName-    , literalDataTimeStamp :: TimeStamp-    , literalDataPayload :: ByteString+    { _literalDataDataType :: DataType+    , _literalDataFileName :: FileName+    , _literalDataTimeStamp :: TimeStamp+    , _literalDataPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet LiteralData where     data PacketType LiteralData = LiteralDataType@@ -758,7 +767,7 @@     fromPkt (LiteralDataPkt a b c d) = LiteralData a b c d  data Trust = Trust-    { trustPayload :: ByteString+    { _trustPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet Trust where     data PacketType Trust = TrustType@@ -768,7 +777,7 @@     fromPkt (TrustPkt a) = Trust a  data UserId = UserId-    { userIdPayload :: String+    { _userIdPayload :: String     } deriving (Data, Eq, Show, Typeable) instance Packet UserId where     data PacketType UserId = UserIdType@@ -778,7 +787,7 @@     fromPkt (UserIdPkt a) = UserId a  data PublicSubkey = PublicSubkey-    { publicSubkeyPKPayload :: PKPayload+    { _publicSubkeyPKPayload :: PKPayload     } deriving (Data, Eq, Show, Typeable) instance Packet PublicSubkey where     data PacketType PublicSubkey = PublicSubkeyType@@ -788,7 +797,7 @@     fromPkt (PublicSubkeyPkt a) = PublicSubkey a  data UserAttribute = UserAttribute-    { userAttributeSubPackets :: [UserAttrSubPacket]+    { _userAttributeSubPackets :: [UserAttrSubPacket]     } deriving (Data, Eq, Show, Typeable) instance Packet UserAttribute where     data PacketType UserAttribute = UserAttributeType@@ -798,8 +807,8 @@     fromPkt (UserAttributePkt a) = UserAttribute a  data SymEncIntegrityProtectedData = SymEncIntegrityProtectedData-    { symEncIntegrityProtectedDataPacketVersion :: PacketVersion-    , symEncIntegrityProtectedDataPayload :: ByteString+    { _symEncIntegrityProtectedDataPacketVersion :: PacketVersion+    , _symEncIntegrityProtectedDataPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet SymEncIntegrityProtectedData where     data PacketType SymEncIntegrityProtectedData = SymEncIntegrityProtectedDataType@@ -809,7 +818,7 @@     fromPkt (SymEncIntegrityProtectedDataPkt a b) = SymEncIntegrityProtectedData a b  data ModificationDetectionCode = ModificationDetectionCode-    { modificationDetectionCodePayload :: ByteString+    { _modificationDetectionCodePayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet ModificationDetectionCode where     data PacketType ModificationDetectionCode = ModificationDetectionCodeType@@ -819,8 +828,8 @@     fromPkt (ModificationDetectionCodePkt a) = ModificationDetectionCode a  data OtherPacket = OtherPacket-    { otherPacketType :: Word8-    , otherPacketPayload :: ByteString+    { _otherPacketType :: Word8+    , _otherPacketPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet OtherPacket where     data PacketType OtherPacket = OtherPacketType@@ -830,8 +839,28 @@     fromPkt (OtherPacketPkt a b) = OtherPacket a b  data Verification = Verification {-      verificationSigner :: PKPayload-    , verificationSignature :: SignaturePayload+      _verificationSigner :: PKPayload+    , _verificationSignature :: SignaturePayload     } +$(makeLenses ''PKESK)+$(makeLenses ''Signature)+$(makeLenses ''SKESK)+$(makeLenses ''OnePassSignature)+$(makeLenses ''SecretKey)+$(makeLenses ''PKPayload)+$(makeLenses ''PublicKey)+$(makeLenses ''SecretSubkey)+$(makeLenses ''CompressedData)+$(makeLenses ''SymEncData)+$(makeLenses ''Marker)+$(makeLenses ''LiteralData)+$(makeLenses ''Trust)+$(makeLenses ''UserId)+$(makeLenses ''PublicSubkey)+$(makeLenses ''UserAttribute)+$(makeLenses ''SymEncIntegrityProtectedData)+$(makeLenses ''ModificationDetectionCode)+$(makeLenses ''OtherPacket) $(makeLenses ''TK)+$(makeLenses ''Verification)

@@ -34,7 +34,7 @@ verifySig :: Keyring -> Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification -- FIXME: check expiration here? verifySig kr sig@(SignaturePkt (SigV4 st _ _ hs _ _ _)) state mt = do     v <- verify kr sig mt (payloadForSig st state)-    _ <- mapM_ (checkIssuer (eightOctetKeyID (verificationSigner v)) . sspPayload) hs+    _ <- mapM_ (checkIssuer (eightOctetKeyID (_verificationSigner v)) . sspPayload) hs     return v     where         checkIssuer :: EightOctetKeyId -> SigSubPacketPayload -> Either String Bool@@ -70,7 +70,7 @@ 	filterRevs :: [(PubKeyAlgorithm, TwentyOctetFingerprint)] -> (SignaturePayload, Verification) -> [Either String SignaturePayload] 	filterRevs vokers spv = case spv of                                      (s@(SigV4 SignatureDirectlyOnAKey _ _ _ _ _ _), _) -> [Right s]-                                     (s@(SigV4 KeyRevocationSig pka _ _ _ _ _), v) -> if any (\(p,f) -> p == pka && f == fingerprint (verificationSigner v)) vokers then [Left "Key revoked"] else [Right s]+                                     (s@(SigV4 KeyRevocationSig pka _ _ _ _ _), v) -> if any (\(p,f) -> p == pka && f == fingerprint (_verificationSigner v)) vokers then [Left "Key revoked"] else [Right s] 				     _ -> []         isKeyRevocation (SigV4 KeyRevocationSig _ _ _ _ _ _) = True         isKeyRevocation _ = False@@ -104,13 +104,13 @@     case rights results of         [] -> Left (concatMap (++"/") (lefts results))         [r] -> do _ <- isSignatureExpired sig mt-	          return (Verification r ((signaturePayload . fromPkt) sig)) -- FIXME: this should also check expiration time and flags of the signing key+	          return (Verification r ((_signaturePayload . fromPkt) sig)) -- FIXME: this should also check expiration time and flags of the signing key         _ -> Left "multiple successes; unexpected condition"     where         subPKP (pack, _, _) = subPKP' pack         subPKP' (PublicSubkeyPkt p) = p         subPKP' (SecretSubkeyPkt p _) = p-        verify' (SignaturePkt s) (pub@(PubV4 _ _ pkey)) ha pl = verify'' (pkaAndMPIs s) ha pub pkey pl+        verify' (SignaturePkt s) (pub@(PKPayload V4 _ _ _ pkey)) ha pl = verify'' (pkaAndMPIs s) ha pub pkey pl         verify' _ _ _ _ = error "This should never happen."         verify'' (DSA,mpis) ha pub (DSAPubKey pkey) bs = verify''' (dsaVerify mpis ha pkey bs) pub         verify'' (RSA,mpis) ha pub (RSAPubKey pkey) bs = verify''' (rsaVerify mpis ha pkey bs) pub@@ -134,7 +134,7 @@ 	pkaAndMPIs _ = error "This should never happen."         isSignatureExpired :: Pkt -> Maybe UTCTime -> Either String Bool         isSignatureExpired s Nothing = return False-        isSignatureExpired s (Just t) = if any (expiredBefore t) ((\(SigV4 _ _ _ h _ _ _) -> h) . signaturePayload . fromPkt $ s) then Left "signature expired" else return True+        isSignatureExpired s (Just t) = if any (expiredBefore t) ((\(SigV4 _ _ _ h _ _ _) -> h) . _signaturePayload . fromPkt $ s) then Left "signature expired" else return True         expiredBefore :: UTCTime -> SigSubPacket -> Bool         expiredBefore ct (SigSubPacket _ (SigExpirationTime et)) = fromEnum ((posixSecondsToUTCTime . toEnum . fromEnum) et `diffUTCTime` ct) < 0         expiredBefore _ _ = False

@@ -12,13 +12,9 @@ import Codec.Encryption.OpenPGP.Types import Data.Conduit import qualified Data.Conduit.List as CL-import qualified Data.Conduit.Util as CU  conduitCompress :: MonadThrow m => CompressionAlgorithm -> Conduit Pkt m Pkt-conduitCompress algo = CU.conduitState [] push (close algo)-    where-        push state input = return $ CU.StateProducing (input : state) []-        close a state = return [compressPkts a state]+conduitCompress algo = CL.consume >>= \ps -> yield (compressPkts algo ps)  conduitDecompress :: MonadThrow m => Conduit Pkt m Pkt conduitDecompress = CL.concatMap decompressPkt

@@ -12,7 +12,6 @@ import qualified Data.ByteString as B import Data.Conduit import qualified Data.Conduit.List as CL-import qualified Data.Conduit.Util as CU import Data.IxSet (empty, insert)  import Codec.Encryption.OpenPGP.Types@@ -27,52 +26,63 @@ conduitToTKsDropping :: MonadResource m => Conduit Pkt m TK conduitToTKsDropping = conduitToTKs' False +fakecmAccum :: Monad m => (a -> (Phase, Maybe TK) -> ((Phase, Maybe TK), [TK])) -> (Phase, Maybe TK) -> Conduit a m TK+fakecmAccum f =+    loop+  where+    loop accum =+        await >>= maybe (finalyield accum) go+      where+        go a = do+            let (accum', bs) = f a accum+            Prelude.mapM_ yield bs+            loop accum'+        finalyield = maybe (return ()) yield . snd+ conduitToTKs' :: MonadResource m => Bool -> Conduit Pkt m TK-conduitToTKs' intolerant = CU.conduitState (MainKey, Nothing) push close+conduitToTKs' intolerant = fakecmAccum push (MainKey, Nothing)     where-        push state input = case (state, input) of-                               ((MainKey, _), PublicKeyPkt pkp) -> return $ CU.StateProducing (Revs, Just (TK pkp Nothing [] [] [] [])) []-                               ((MainKey, _), SecretKeyPkt pkp ska) -> return $ CU.StateProducing (Revs, Just (TK pkp (Just ska) [] [] [] [])) []-                               ((Revs, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt s) -> return $ CU.StateProducing (Revs, Just (TK pkp Nothing (revs ++ [s]) uids uats subs)) []-                               ((Revs, Just (TK pkp Nothing revs _ uats subs)), UserIdPkt u) -> return $ CU.StateProducing (Uids, Just (TK pkp Nothing revs [(u, [])] uats subs)) []-                               ((Uids, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt s) -> return $ CU.StateProducing (Uids, Just (TK pkp Nothing revs (addUidSig s uids) uats subs)) []-                               ((Uids, Just (TK pkp Nothing revs uids uats subs)), UserIdPkt u) -> return $ CU.StateProducing (Uids, Just (TK pkp Nothing revs (uids ++ [(u, [])]) uats subs)) []-                               ((Uids, Just (TK pkp Nothing revs uids _ subs)), UserAttributePkt u) -> return $ CU.StateProducing (UAts, Just (TK pkp Nothing revs uids [(u, [])] subs)) []-                               ((Uids, Just (TK pkp Nothing revs uids uats _)), PublicSubkeyPkt p) -> return $ CU.StateProducing (Subs, Just (TK pkp Nothing revs uids uats [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)])) []-                               ((Uids, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> return $ CU.StateProducing (Revs, Just (TK p Nothing [] [] [] [])) [TK pkp Nothing revs uids uats subs]-                               ((UAts, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt s) -> return $ CU.StateProducing (UAts, Just (TK pkp Nothing revs uids (addUAtSig s uats) subs)) []-                               ((UAts, Just (TK pkp Nothing revs uids uats subs)), UserAttributePkt u) -> return $ CU.StateProducing (UAts, Just (TK pkp Nothing revs uids (uats ++ [(u, [])]) subs)) []-                               ((UAts, Just (TK pkp Nothing revs uids uats subs)), UserIdPkt u) -> return $ CU.StateProducing (Uids, Just (TK pkp Nothing revs (uids ++ [(u, [])]) uats subs)) []-                               ((UAts, Just (TK pkp Nothing revs uids uats _)), PublicSubkeyPkt p) -> return $ CU.StateProducing (Subs, Just (TK pkp Nothing revs uids uats [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)])) []-                               ((UAts, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> return $ CU.StateProducing (Revs, Just (TK p Nothing [] [] [] [])) [TK pkp Nothing revs uids uats subs]-                               ((Subs, Just (TK pkp Nothing revs uids uats subs)), PublicSubkeyPkt p) -> return $ CU.StateProducing (Subs, Just (TK pkp Nothing revs uids uats (subs ++ [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)]))) []-                               ((Subs, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt s) -> case sType s of-                                                                                        SubkeyBindingSig -> return $ CU.StateProducing (Subs, Just (TK pkp Nothing revs uids uats (setBSig s subs))) []-                                                                                        SubkeyRevocationSig -> return $ CU.StateProducing (Subs, Just (TK pkp Nothing revs uids uats (setRSig s subs))) []-                                                                                        _ -> return (dropOrError intolerant state $ "Unexpected subkey sig: " ++ show (fst state) ++ "/" ++ show input)-                               ((Subs, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> return $ CU.StateProducing (Revs, Just (TK p Nothing [] [] [] [])) [TK pkp Nothing revs uids uats subs]-                               ((Revs, Just (TK pkp mska revs uids uats subs)), SignaturePkt s) -> return $ CU.StateProducing (Revs, Just (TK pkp mska (revs ++ [s]) uids uats subs)) []-                               ((Revs, Just (TK pkp mska revs _ uats subs)), UserIdPkt u) -> return $ CU.StateProducing (Uids, Just (TK pkp mska revs [(u, [])] uats subs)) []-                               ((Uids, Just (TK pkp mska revs uids uats subs)), SignaturePkt s) -> return $ CU.StateProducing (Uids, Just (TK pkp mska revs (addUidSig s uids) uats subs)) []-                               ((Uids, Just (TK pkp mska revs uids uats subs)), UserIdPkt u) -> return $ CU.StateProducing (Uids, Just (TK pkp mska revs (uids ++ [(u, [])]) uats subs)) []-                               ((Uids, Just (TK pkp mska revs uids _ subs)), UserAttributePkt u) -> return $ CU.StateProducing (UAts, Just (TK pkp mska revs uids [(u, [])] subs)) []-                               ((Uids, Just (TK pkp mska revs uids uats _)), SecretSubkeyPkt p s) -> return $ CU.StateProducing (Subs, Just (TK pkp mska revs uids uats [(SecretSubkeyPkt p s, SigVOther 0 B.empty, Nothing)])) []-                               ((Uids, Just (TK pkp mska revs uids uats subs)), SecretKeyPkt p s) -> return $ CU.StateProducing (Revs, Just (TK p (Just s) [] [] [] [])) [TK pkp mska revs uids uats subs]-                               ((UAts, Just (TK pkp mska revs uids uats subs)), SignaturePkt s) -> return $ CU.StateProducing (UAts, Just (TK pkp mska revs uids (addUAtSig s uats) subs)) []-                               ((UAts, Just (TK pkp mska revs uids uats subs)), UserAttributePkt u) -> return $ CU.StateProducing (UAts, Just (TK pkp mska revs uids (uats ++ [(u, [])]) subs)) []-                               ((UAts, Just (TK pkp mska revs uids uats subs)), UserIdPkt u) -> return $ CU.StateProducing (Uids, Just (TK pkp mska revs (uids ++ [(u, [])]) uats subs)) []-                               ((UAts, Just (TK pkp mska revs uids uats _)), SecretSubkeyPkt p s) -> return $ CU.StateProducing (Subs, Just (TK pkp mska revs uids uats [(SecretSubkeyPkt p s, SigVOther 0 B.empty, Nothing)])) []-                               ((UAts, Just (TK pkp mska revs uids uats subs)), SecretKeyPkt p s) -> return $ CU.StateProducing (Revs, Just (TK p (Just s) [] [] [] [])) [TK pkp mska revs uids uats subs]-                               ((Subs, Just (TK pkp mska revs uids uats subs)), SecretSubkeyPkt p s) -> return $ CU.StateProducing (Subs, Just (TK pkp mska revs uids uats (subs ++ [(SecretSubkeyPkt p s, SigVOther 0 B.empty, Nothing)]))) []-                               ((Subs, Just (TK pkp mska revs uids uats subs)), SignaturePkt s) -> case sType s of-                                                                                        SubkeyBindingSig -> return $ CU.StateProducing (Subs, Just (TK pkp mska revs uids uats (setBSig s subs))) []-                                                                                        SubkeyRevocationSig -> return $ CU.StateProducing (Subs, Just (TK pkp mska revs uids uats (setRSig s subs))) []-                                                                                        _ -> return (dropOrError intolerant state $ "Unexpected subkey sig: " ++ show (fst state) ++ "/" ++ show input)-                               ((Subs, Just (TK pkp mska revs uids uats subs)), SecretKeyPkt p s) -> return $ CU.StateProducing (Revs, Just (TK p (Just s) [] [] [] [])) [TK pkp mska revs uids uats subs]-                               ((_,_), TrustPkt _) -> return $ CU.StateProducing state []-                               _ -> return (dropOrError intolerant state $ "Unexpected packet: " ++ show (fst state) ++ "/" ++ show input)-        close (_, Nothing) = return []-        close (_, Just tk) = return [tk]+        push i s = case (s, i) of+                       ((MainKey, _), PublicKeyPkt pkp) -> ((Revs, Just (TK pkp Nothing [] [] [] [])), [])+                       ((MainKey, _), SecretKeyPkt pkp ska) -> ((Revs, Just (TK pkp (Just ska) [] [] [] [])), [])+                       ((Revs, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> ((Revs, Just (TK pkp Nothing (revs ++ [sp]) uids uats subs)), [])+                       ((Revs, Just (TK pkp Nothing revs _ uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp Nothing revs [(u, [])] uats subs)), [])+                       ((Uids, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> ((Uids, Just (TK pkp Nothing revs (addUidSig sp uids) uats subs)), [])+                       ((Uids, Just (TK pkp Nothing revs uids uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp Nothing revs (uids ++ [(u, [])]) uats subs)), [])+                       ((Uids, Just (TK pkp Nothing revs uids _ subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp Nothing revs uids [(u, [])] subs)), [])+                       ((Uids, Just (TK pkp Nothing revs uids uats _)), PublicSubkeyPkt p) -> ((Subs, Just (TK pkp Nothing revs uids uats [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)])), [])+                       ((Uids, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> ((Revs, Just (TK p Nothing [] [] [] [])), [TK pkp Nothing revs uids uats subs])+                       ((UAts, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> ((UAts, Just (TK pkp Nothing revs uids (addUAtSig sp uats) subs)), [])+                       ((UAts, Just (TK pkp Nothing revs uids uats subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp Nothing revs uids (uats ++ [(u, [])]) subs)), [])+                       ((UAts, Just (TK pkp Nothing revs uids uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp Nothing revs (uids ++ [(u, [])]) uats subs)), [])+                       ((UAts, Just (TK pkp Nothing revs uids uats _)), PublicSubkeyPkt p) -> ((Subs, Just (TK pkp Nothing revs uids uats [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)])), [])+                       ((UAts, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> ((Revs, Just (TK p Nothing [] [] [] [])), [TK pkp Nothing revs uids uats subs])+                       ((Subs, Just (TK pkp Nothing revs uids uats subs)), PublicSubkeyPkt p) -> ((Subs, Just (TK pkp Nothing revs uids uats (subs ++ [(PublicSubkeyPkt p, SigVOther 0 B.empty, Nothing)]))), [])+                       ((Subs, Just (TK pkp Nothing revs uids uats subs)), SignaturePkt sp) -> case sType sp of+                                                                                SubkeyBindingSig -> ((Subs, Just (TK pkp Nothing revs uids uats (setBSig sp subs))), [])+                                                                                SubkeyRevocationSig -> ((Subs, Just (TK pkp Nothing revs uids uats (setRSig sp subs))), [])+                                                                                _ -> dropOrError intolerant s $ "Unexpected subkey sig: " ++ show (fst s) ++ "/" ++ show i+                       ((Subs, Just (TK pkp Nothing revs uids uats subs)), PublicKeyPkt p) -> ((Revs, Just (TK p Nothing [] [] [] [])), [TK pkp Nothing revs uids uats subs])+                       ((Revs, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> ((Revs, Just (TK pkp mska (revs ++ [sp]) uids uats subs)), [])+                       ((Revs, Just (TK pkp mska revs _ uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp mska revs [(u, [])] uats subs)), [])+                       ((Uids, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> ((Uids, Just (TK pkp mska revs (addUidSig sp uids) uats subs)), [])+                       ((Uids, Just (TK pkp mska revs uids uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp mska revs (uids ++ [(u, [])]) uats subs)), [])+                       ((Uids, Just (TK pkp mska revs uids _ subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp mska revs uids [(u, [])] subs)), [])+                       ((Uids, Just (TK pkp mska revs uids uats _)), SecretSubkeyPkt p ss) -> ((Subs, Just (TK pkp mska revs uids uats [(SecretSubkeyPkt p ss, SigVOther 0 B.empty, Nothing)])), [])+                       ((Uids, Just (TK pkp mska revs uids uats subs)), SecretKeyPkt p sk) -> ((Revs, Just (TK p (Just sk) [] [] [] [])), [TK pkp mska revs uids uats subs])+                       ((UAts, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> ((UAts, Just (TK pkp mska revs uids (addUAtSig sp uats) subs)), [])+                       ((UAts, Just (TK pkp mska revs uids uats subs)), UserAttributePkt u) -> ((UAts, Just (TK pkp mska revs uids (uats ++ [(u, [])]) subs)), [])+                       ((UAts, Just (TK pkp mska revs uids uats subs)), UserIdPkt u) -> ((Uids, Just (TK pkp mska revs (uids ++ [(u, [])]) uats subs)), [])+                       ((UAts, Just (TK pkp mska revs uids uats _)), SecretSubkeyPkt p ss) -> ((Subs, Just (TK pkp mska revs uids uats [(SecretSubkeyPkt p ss, SigVOther 0 B.empty, Nothing)])), [])+                       ((UAts, Just (TK pkp mska revs uids uats subs)), SecretKeyPkt p ss) -> ((Revs, Just (TK p (Just ss) [] [] [] [])), [TK pkp mska revs uids uats subs])+                       ((Subs, Just (TK pkp mska revs uids uats subs)), SecretSubkeyPkt p ss) -> ((Subs, Just (TK pkp mska revs uids uats (subs ++ [(SecretSubkeyPkt p ss, SigVOther 0 B.empty, Nothing)]))), [])+                       ((Subs, Just (TK pkp mska revs uids uats subs)), SignaturePkt sp) -> case sType sp of+                                                                                SubkeyBindingSig -> ((Subs, Just (TK pkp mska revs uids uats (setBSig sp subs))), [])+                                                                                SubkeyRevocationSig -> ((Subs, Just (TK pkp mska revs uids uats (setRSig sp subs))), [])+                                                                                _ -> dropOrError intolerant s $ "Unexpected subkey sig: " ++ show (fst s) ++ "/" ++ show i+                       ((Subs, Just (TK pkp mska revs uids uats subs)), SecretKeyPkt p sk) -> ((Revs, Just (TK p (Just sk) [] [] [] [])), [TK pkp mska revs uids uats subs])+                       ((_,_), TrustPkt _) -> (s, [])+                       _ -> dropOrError intolerant s $ "Unexpected packet: " ++ show (fst s) ++ "/" ++ show i         addUidSig s uids = init uids ++ [(\(u, us) -> (u, us ++ [s])) (last uids)]         addUAtSig s uats = init uats ++ [(\(u, us) -> (u, us ++ [s])) (last uats)]         setBSig s subs = init subs ++ [(\(p, _, r) -> (p, s, r)) (last subs)]@@ -80,9 +90,9 @@         sType (SigV3 st _ _ _ _ _ _) = st         sType (SigV4 st _ _ _ _ _ _) = st         sType _ = error "This should never happen."-        dropOrError :: Bool -> (Phase, Maybe TK) -> String -> CU.ConduitStateResult (Phase, Maybe TK) Pkt TK+        dropOrError :: Bool -> (Phase, Maybe TK) -> String -> ((Phase, Maybe TK), [TK])         dropOrError True _ e = error e-        dropOrError False s _ = CU.StateProducing s []+        dropOrError False s _ = (s, [])  sinkKeyringMap :: MonadResource m => Sink TK m Keyring sinkKeyringMap = CL.fold (flip insert) empty

@@ -8,25 +8,24 @@ ) where  import Data.Conduit-import qualified Data.Conduit.Util as CU import Data.Time.Clock (UTCTime)  import Codec.Encryption.OpenPGP.Internal (PktStreamContext(..), emptyPSC) import Codec.Encryption.OpenPGP.Types import Codec.Encryption.OpenPGP.Verify (verifySig)+import qualified Data.Conduit.List as CL  conduitVerify :: MonadResource m => Keyring -> Maybe UTCTime -> Conduit Pkt m (Either String Verification)-conduitVerify kr mt = CU.conduitState emptyPSC push close+conduitVerify kr mt = CL.concatMapAccum (flip push) emptyPSC     where-        push state ld@(LiteralDataPkt {}) = return $ CU.StateProducing (state { lastLD = ld }) []-        push state uid@(UserIdPkt _) = return $ CU.StateProducing (state { lastUIDorUAt = uid }) []-        push state uat@(UserAttributePkt _) = return $ CU.StateProducing (state { lastUIDorUAt = uat }) []-        push state pk@(PublicKeyPkt _) = return $ CU.StateProducing (state { lastPrimaryKey = pk }) []-        push state pk@(PublicSubkeyPkt _) = return $ CU.StateProducing (state { lastSubkey = pk }) []-        push state sk@(SecretKeyPkt _ _) = return $ CU.StateProducing (state { lastPrimaryKey = sk }) []-        push state sk@(SecretSubkeyPkt _ _) = return $ CU.StateProducing (state { lastSubkey = sk }) []-        push state sig@(SignaturePkt (SigV4 {})) = return $ CU.StateProducing state { lastSig = sig } [verifySig kr sig state mt]-        push state (OnePassSignaturePkt _ _ _ _ _ False) = return $ CU.StateProducing state []-        push state _ = return $ CU.StateProducing state []-        close _ = return []+        push state ld@(LiteralDataPkt {}) = (state { lastLD = ld }, [])+        push state uid@(UserIdPkt _) = (state { lastUIDorUAt = uid }, [])+        push state uat@(UserAttributePkt _) = (state { lastUIDorUAt = uat }, [])+        push state pk@(PublicKeyPkt _) = (state { lastPrimaryKey = pk }, [])+        push state pk@(PublicSubkeyPkt _) = (state { lastSubkey = pk }, [])+        push state sk@(SecretKeyPkt _ _) = (state { lastPrimaryKey = sk }, [])+        push state sk@(SecretSubkeyPkt _ _) = (state { lastSubkey = sk }, [])+        push state sig@(SignaturePkt (SigV4 {})) = (state { lastSig = sig }, [verifySig kr sig state mt])+        push state (OnePassSignaturePkt _ _ _ _ _ False) = (state, [])+        push state _ = (state, [])         normLineEndings = id  -- FIXME

@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             0.6+Version:             0.6.1 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880) Homepage:            http://floss.scru.org/hOpenPGP/@@ -133,10 +133,10 @@                , bytestring                , bzlib                , cereal-               , cereal-conduit        >= 0.6    && < 0.7-               , conduit               >= 0.5    && < 0.6+               , cereal-conduit        >= 0.6    && < 0.8+               , conduit               >= 0.5    && < 1.1                , containers-               , crypto-pubkey         >= 0.1.1+               , crypto-pubkey         >= 0.1.2                , cryptohash                , ixset                 >= 1.0                , lens                  >= 3.0@@ -157,10 +157,10 @@                , bytestring                , bzlib                , cereal-               , cereal-conduit        >= 0.6    && < 0.7-               , conduit               >= 0.5    && < 0.6+               , cereal-conduit+               , conduit                , containers-               , crypto-pubkey         >= 0.1.1+               , crypto-pubkey         >= 0.1.2                , cryptohash                , ixset                 >= 1.0                , lens                  >= 3.0

@@ -15,8 +15,8 @@ import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint) import Codec.Encryption.OpenPGP.Types import Data.Conduit.Cereal (conduitGet)-import Data.Conduit.OpenPGP.Compression (conduitDecompress)-import Data.Conduit.OpenPGP.Keyring (conduitToTKs, sinkKeyringMap)+import Data.Conduit.OpenPGP.Compression (conduitCompress, conduitDecompress)+import Data.Conduit.OpenPGP.Keyring (conduitToTKs, conduitToTKsDropping, sinkKeyringMap) import Data.Conduit.OpenPGP.Verify (conduitVerify)  import qualified Data.ByteString as B@@ -35,7 +35,7 @@     bs <- B.readFile $ "tests/data/" ++ fpr     let firstpass = runGet get bs     case fmap unBlock firstpass of-        Left err -> assertFailure $ "First pass failed on " ++ fpr+        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@@ -64,7 +64,7 @@ testConduitOutputLength :: FilePath -> DC.Conduit B.ByteString (DC.ResourceT IO) b -> Int -> Assertion testConduitOutputLength fpr c target = do     len <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ fpr) DC.$= c DC.$$ counter-    assertEqual ("expected length" ++ show target) target len+    assertEqual ("expected length " ++ show target) target len  testKeyIDandFingerprint :: FilePath -> String -> Assertion testKeyIDandFingerprint fpr kf = do@@ -84,7 +84,7 @@ testVerifyMessage keyring message issuers = do     kr <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ keyring) DC.$= conduitGet get DC.$= conduitToTKs DC.$$ sinkKeyringMap     verification <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ message) DC.$= conduitGet get DC.$= conduitDecompress DC.$= conduitVerify kr Nothing DC.$$ CL.consume-    let verification' = map (fmap (fingerprint . verificationSigner)) verification+    let verification' = map (fmap (fingerprint . _verificationSigner)) verification     assertEqual (keyring ++ " for " ++ message) (map Right issuers) verification'  tests :: [Test]@@ -209,8 +209,23 @@    , testCase "6F87040E" (testVerifyMessage "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"]))    , testCase "6F87040E-cr" (testVerifyMessage "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"]))    , testCase "simple RSA secret key" (testVerifyMessage "pubring.gpg" "simple.seckey" ([fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"]))+   ],+  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")+   ],+  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 "conduitToTKs" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitToTKs) 4)+   , testCase "conduitToTKsDropping" (testConduitOutputLength "pubring.gpg" (cgp DC.=$= conduitToTKsDropping) 4)    ]  ]++cgp :: DC.Conduit B.ByteString (DC.ResourceT IO) Pkt+cgp = conduitGet (get :: Get Pkt)  fp :: String -> TwentyOctetFingerprint fp = read