hOpenPGP 0.8 → 0.9

raw patch · 7 files changed

+274/−32 lines, 7 filesdep +crypto-cipher-typesdep +cryptocipherdep +data-defaultPVP ok

version bump matches the API change (PVP)

Dependencies added: crypto-cipher-types, cryptocipher, data-default, monad-loops, nettle, securemem, transformers

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/CFB.hs +75/−0
• Codec/Encryption/OpenPGP/S2K.hs +32/−5
• Codec/Encryption/OpenPGP/Serialize.hs +5/−6
• Codec/Encryption/OpenPGP/Types.hs +20/−20
• Data/Conduit/OpenPGP/Decrypt.hs +72/−0
• hOpenPGP.cabal +23/−1
• tests/suite.hs +47/−0

@@ -0,0 +1,75 @@+-- CFB.hs: OpenPGP (RFC4880) CFB mode+-- Copyright © 2013 Daniel Kahn Gillmor and Clint Adams+-- This software is released under the terms of the Expat license.+-- (See the LICENSE file).++{-# LANGUAGE ExistentialQuantification #-}++module Codec.Encryption.OpenPGP.CFB (+   decrypt+ , decryptOpenPGPCfb+) where++import Codec.Encryption.OpenPGP.Types+import Crypto.Cipher.Types (makeKey, nullIV, BlockCipher(..), Cipher(..))+import qualified Crypto.Cipher as CC+import qualified Crypto.Nettle.Ciphers as CNC+import qualified Data.ByteString as B+import Data.Maybe (fromJust)+import Data.SecureMem (ToSecureMem)++data BCipher = forall a. (BlockCipher a) => BCipher a++decryptOpenPGPCfb :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString+decryptOpenPGPCfb Plaintext ciphertext _ = return ciphertext+decryptOpenPGPCfb sa ciphertext keydata = do+    bc <- mkBCipher sa keydata+    return $ B.drop (bsize bc + 2) (decrypt1 ciphertext bc `B.append` decrypt2 ciphertext bc) -- FIXME: verify the code+    where+        decrypt1 :: B.ByteString -> BCipher -> B.ByteString+        decrypt1 ct (BCipher cipher) = cdecrypt sa cipher nullIV (B.take (blockSize cipher + 2) ct)+        decrypt2 :: B.ByteString -> BCipher -> B.ByteString+        decrypt2 ct (BCipher cipher) = cdecrypt sa cipher (fromJust (CC.makeIV (B.take (blockSize cipher) (B.drop 2 ct)))) (B.drop (blockSize cipher + 2) ct)++decrypt :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString+decrypt Plaintext ciphertext _ = return ciphertext+decrypt sa ciphertext keydata = do+    bc <- mkBCipher sa keydata+    return $ B.drop (bsize bc + 2) (decrypt' ciphertext bc)  -- FIXME: verify the code+    where+        decrypt' :: B.ByteString -> BCipher -> B.ByteString+        decrypt' ct (BCipher cipher) = cdecrypt sa cipher nullIV ct++bsize :: BCipher -> Int+bsize (BCipher bc) = blockSize bc++cdecrypt :: BlockCipher cipher => SymmetricAlgorithm -> cipher -> CC.IV cipher -> B.ByteString -> B.ByteString+cdecrypt sa+    | sa `elem` [CAST5, Twofish] = paddedCfbDecrypt+    | otherwise = cfbDecrypt++paddedCfbDecrypt :: BlockCipher cipher => cipher -> CC.IV cipher -> B.ByteString -> B.ByteString+paddedCfbDecrypt cipher iv ciphertext = B.take (B.length ciphertext) (cfbDecrypt cipher iv padded)+    where+        padded = ciphertext `B.append` B.pack (replicate (blockSize cipher - (B.length ciphertext `mod` blockSize cipher)) 0)++mkBCipher :: ToSecureMem b => SymmetricAlgorithm -> b -> Either String BCipher+mkBCipher Plaintext = const (fail "this shouldn't have happened") -- FIXME: orphan instance?+mkBCipher IDEA = const (fail "IDEA not yet implemented") -- FIXME: IDEA+mkBCipher ReservedSAFER = const (fail "SAFER not implemented") -- FIXME: or not?+mkBCipher ReservedDES = const (fail "DES not implemented") -- FIXME: or not?+mkBCipher (OtherSA _) = const (fail "Unknown, unimplemented symmetric algorithm")+mkBCipher CAST5 = return . BCipher . (ciph :: ToSecureMem b => b -> CNC.CAST128)+mkBCipher Twofish = return . BCipher . (ciph :: ToSecureMem b => b -> CNC.TWOFISH)+mkBCipher TripleDES = return . BCipher . (ciph :: ToSecureMem b => b -> CC.DES_EDE3)+mkBCipher Blowfish = return . BCipher . (ciph :: ToSecureMem b => b -> CC.Blowfish128)+mkBCipher AES128 = return . BCipher . (ciph :: ToSecureMem b => b -> CC.AES128)+mkBCipher AES192 = return . BCipher . (ciph :: ToSecureMem b => b -> CC.AES192)+mkBCipher AES256 = return . BCipher . (ciph :: ToSecureMem b => b -> CC.AES256)++ciph :: (CC.BlockCipher cipher, ToSecureMem b) => b -> cipher -- FIXME: return an Either String cipher ?+ciph keydata = cipherInit ekey+    where+        ekey = case makeKey keydata of+          Left _ -> error "bad cipher parameters"+          Right key -> key

@@ -5,17 +5,44 @@  module Codec.Encryption.OpenPGP.S2K (   string2Key+  ,skesk2Key ) where  import Codec.Encryption.OpenPGP.Types+import Control.Monad.Loops (untilM_)+import Control.Monad.Trans.State.Lazy (execState, get, put) import qualified Crypto.Hash.SHA1 as SHA1 import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL -string2Key :: Integral a => S2K -> a -> BL.ByteString -> B.ByteString-string2Key (Simple SHA1) ksz bs-    | 20 < ksz = error "FIXME"-    | otherwise = B.take (fromIntegral ksz) . SHA1.hashlazy $ bs+string2Key :: S2K -> Int -> BL.ByteString -> B.ByteString+string2Key (Simple SHA1) ksz bs = B.take (fromIntegral ksz) $ hashpp SHA1.hashlazy ksz bs string2Key (Salted SHA1 salt) ksz bs = string2Key (Simple SHA1) ksz (BL.append (BL.fromChunks [salt]) bs) string2Key (IteratedSalted SHA1 salt cnt) ksz bs = string2Key (Simple SHA1) ksz (BL.take (fromIntegral cnt) . BL.cycle $ BL.append (BL.fromChunks [salt]) bs)-string2Key _ _ _ = error "FIXME"+string2Key _ _ _ = error "FIXME: unimplemented S2K hash"++-- in bytes+keySize :: SymmetricAlgorithm -> Int+keySize Plaintext = 0+keySize IDEA = 16 -- according to https://en.wikipedia.org/wiki/International_Data_Encryption_Algorithm+keySize TripleDES = 24 -- RFC 4880 says 168 bits (derived from 192 bits) but we don't know who does the derivation+keySize CAST5 = 16+keySize Blowfish = 16+keySize ReservedSAFER = undefined+keySize ReservedDES = undefined+keySize AES128 = 16+keySize AES192 = 24+keySize AES256 = 32+keySize Twofish = 32+keySize (OtherSA _) = undefined++skesk2Key :: SKESK -> BL.ByteString -> B.ByteString+skesk2Key (SKESK 4 sa s2k Nothing) pass = string2Key s2k (keySize sa) pass+skesk2Key _ _ = error "FIXME"++hashpp :: (BL.ByteString -> B.ByteString) -> Int -> BL.ByteString -> B.ByteString+hashpp hf keysize pp = snd (execState (hashround `untilM_` bigEnough) (0, B.empty))+    where+        hashround = get >>= \(ctr, bs) -> put (ctr + 1, bs `B.append` hf (nulpad ctr `BL.append` pp))+        nulpad = BL.pack . flip replicate 0+	bigEnough = get >>= \(_, bs) -> return (B.length bs >= keysize)

@@ -23,6 +23,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Word (Word8, Word32)+import Data.Maybe (fromMaybe)  import Codec.Encryption.OpenPGP.Internal (countBits, beBSToInteger, integerToBEBS, pubkeyToMPIs) import Codec.Encryption.OpenPGP.Types@@ -526,10 +527,8 @@                           symalgo <- getWord8                           s2k <- getS2K                           remainder <- remaining-                          mpib <- getBytes remainder-                          case runGet (many getMPI) mpib of-                              Left _ -> return $ SKESKPkt pv (toFVal symalgo) s2k []-                              Right mpis -> return $ SKESKPkt pv (toFVal symalgo) s2k mpis+                          esk <- getByteString remainder+                          return $ SKESKPkt pv (toFVal symalgo) s2k (if B.null esk then Nothing else Just esk)             | t == 4 = do                           pv <- getWord8                           sigtype <- getWord8@@ -649,10 +648,10 @@     let bs = runPut $ put sp     putPacketLength . fromIntegral . B.length $ bs     putByteString bs-putPkt (SKESKPkt pv symalgo s2k mpis) = do+putPkt (SKESKPkt pv symalgo s2k mesk) = do     putWord8 (0xc0 .|. 3)     let bs2k = fromS2K s2k-    let bsk = runPut $ mapM_ put mpis+    let bsk = fromMaybe B.empty mesk     putPacketLength . fromIntegral $ 2 + (B.length bs2k) + (B.length bsk)     putWord8 pv -- should be 4     putWord8 $ fromIntegral . fromFVal $ symalgo

@@ -566,7 +566,7 @@ -- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a data Pkt = PKESKPkt PacketVersion EightOctetKeyId PubKeyAlgorithm [MPI]          | SignaturePkt SignaturePayload-         | SKESKPkt PacketVersion SymmetricAlgorithm S2K [MPI]+         | SKESKPkt PacketVersion SymmetricAlgorithm S2K (Maybe B.ByteString)          | OnePassSignaturePkt PacketVersion SigType HashAlgorithm PubKeyAlgorithm EightOctetKeyId NestedFlag          | SecretKeyPkt PKPayload SKAddendum          | PublicKeyPkt PKPayload@@ -591,7 +591,7 @@     , _pkeskMPIs :: [MPI]     } deriving (Data, Eq, Show, Typeable) instance Packet PKESK where-    data PacketType PKESK = PKESKType+    data PacketType PKESK = PKESKType deriving (Show, Eq)     packetType _ = PKESKType     packetCode _ = 1     toPkt (PKESK a b c d) = PKESKPkt a b c d@@ -601,7 +601,7 @@     { _signaturePayload :: SignaturePayload     } deriving (Data, Eq, Show, Typeable) instance Packet Signature where-    data PacketType Signature = SignatureType+    data PacketType Signature = SignatureType deriving (Show, Eq)     packetType _ = SignatureType     packetCode _ = 2     toPkt (Signature a ) = SignaturePkt a@@ -611,10 +611,10 @@     { _skeskPacketVersion :: PacketVersion     , _skeskSymmetricAlgorithm :: SymmetricAlgorithm     , _skeskS2K :: S2K-    , _skeskMPIs :: [MPI]+    , _skeskESK :: Maybe B.ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet SKESK where-    data PacketType SKESK = SKESKType+    data PacketType SKESK = SKESKType deriving (Show, Eq)     packetType _ = SKESKType     packetCode _ = 3     toPkt (SKESK a b c d) = SKESKPkt a b c d@@ -629,7 +629,7 @@     , _onePassSignatureNestedFlag :: NestedFlag     } deriving (Data, Eq, Show, Typeable) instance Packet OnePassSignature where-    data PacketType OnePassSignature = OnePassSignatureType+    data PacketType OnePassSignature = OnePassSignatureType deriving (Show, Eq)     packetType _ = OnePassSignatureType     packetCode _ = 4     toPkt (OnePassSignature a b c d e f) = OnePassSignaturePkt a b c d e f@@ -640,7 +640,7 @@     , _secretKeySKAddendum :: SKAddendum     } deriving (Data, Eq, Show, Typeable) instance Packet SecretKey where-    data PacketType SecretKey = SecretKeyType+    data PacketType SecretKey = SecretKeyType deriving (Show, Eq)     packetType _ = SecretKeyType     packetCode _ = 5     toPkt (SecretKey a b) = SecretKeyPkt a b@@ -650,7 +650,7 @@     { _publicKeyPKPayload :: PKPayload     } deriving (Data, Eq, Show, Typeable) instance Packet PublicKey where-    data PacketType PublicKey = PublicKeyType+    data PacketType PublicKey = PublicKeyType deriving (Show, Eq)     packetType _ = PublicKeyType     packetCode _ = 6     toPkt (PublicKey a) = PublicKeyPkt a@@ -661,7 +661,7 @@     , _secretSubkeySKAddendum :: SKAddendum     } deriving (Data, Eq, Show, Typeable) instance Packet SecretSubkey where-    data PacketType SecretSubkey = SecretSubkeyType+    data PacketType SecretSubkey = SecretSubkeyType deriving (Show, Eq)     packetType _ = SecretSubkeyType     packetCode _ = 7     toPkt (SecretSubkey a b) = SecretSubkeyPkt a b@@ -672,7 +672,7 @@     , _compressedDataPayload :: CompressedDataPayload     } deriving (Data, Eq, Show, Typeable) instance Packet CompressedData where-    data PacketType CompressedData = CompressedDataType+    data PacketType CompressedData = CompressedDataType deriving (Show, Eq)     packetType _ = CompressedDataType     packetCode _ = 8     toPkt (CompressedData a b) = CompressedDataPkt a b@@ -682,7 +682,7 @@     { _symEncDataPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet SymEncData where-    data PacketType SymEncData = SymEncDataType+    data PacketType SymEncData = SymEncDataType deriving (Show, Eq)     packetType _ = SymEncDataType     packetCode _ = 9     toPkt (SymEncData a) = SymEncDataPkt a@@ -692,7 +692,7 @@     { _markerPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet Marker where-    data PacketType Marker = MarkerType+    data PacketType Marker = MarkerType deriving (Show, Eq)     packetType _ = MarkerType     packetCode _ = 10     toPkt (Marker a) = MarkerPkt a@@ -705,7 +705,7 @@     , _literalDataPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet LiteralData where-    data PacketType LiteralData = LiteralDataType+    data PacketType LiteralData = LiteralDataType deriving (Show, Eq)     packetType _ = LiteralDataType     packetCode _ = 11     toPkt (LiteralData a b c d) = LiteralDataPkt a b c d@@ -715,7 +715,7 @@     { _trustPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet Trust where-    data PacketType Trust = TrustType+    data PacketType Trust = TrustType deriving (Show, Eq)     packetType _ = TrustType     packetCode _ = 12     toPkt (Trust a) = TrustPkt a@@ -725,7 +725,7 @@     { _userIdPayload :: String     } deriving (Data, Eq, Show, Typeable) instance Packet UserId where-    data PacketType UserId = UserIdType+    data PacketType UserId = UserIdType deriving (Show, Eq)     packetType _ = UserIdType     packetCode _ = 13     toPkt (UserId a) = UserIdPkt a@@ -735,7 +735,7 @@     { _publicSubkeyPKPayload :: PKPayload     } deriving (Data, Eq, Show, Typeable) instance Packet PublicSubkey where-    data PacketType PublicSubkey = PublicSubkeyType+    data PacketType PublicSubkey = PublicSubkeyType deriving (Show, Eq)     packetType _ = PublicSubkeyType     packetCode _ = 14     toPkt (PublicSubkey a) = PublicSubkeyPkt a@@ -745,7 +745,7 @@     { _userAttributeSubPackets :: [UserAttrSubPacket]     } deriving (Data, Eq, Show, Typeable) instance Packet UserAttribute where-    data PacketType UserAttribute = UserAttributeType+    data PacketType UserAttribute = UserAttributeType deriving (Show, Eq)     packetType _ = UserAttributeType     packetCode _ = 17     toPkt (UserAttribute a) = UserAttributePkt a@@ -756,7 +756,7 @@     , _symEncIntegrityProtectedDataPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet SymEncIntegrityProtectedData where-    data PacketType SymEncIntegrityProtectedData = SymEncIntegrityProtectedDataType+    data PacketType SymEncIntegrityProtectedData = SymEncIntegrityProtectedDataType deriving (Show, Eq)     packetType _ = SymEncIntegrityProtectedDataType     packetCode _ = 18     toPkt (SymEncIntegrityProtectedData a b) = SymEncIntegrityProtectedDataPkt a b@@ -766,7 +766,7 @@     { _modificationDetectionCodePayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet ModificationDetectionCode where-    data PacketType ModificationDetectionCode = ModificationDetectionCodeType+    data PacketType ModificationDetectionCode = ModificationDetectionCodeType deriving (Show, Eq)     packetType _ = ModificationDetectionCodeType     packetCode _ = 19     toPkt (ModificationDetectionCode a) = ModificationDetectionCodePkt a@@ -777,7 +777,7 @@     , _otherPacketPayload :: ByteString     } deriving (Data, Eq, Show, Typeable) instance Packet OtherPacket where-    data PacketType OtherPacket = OtherPacketType+    data PacketType OtherPacket = OtherPacketType deriving (Show, Eq)     packetType _ = OtherPacketType     packetCode _ = undefined -- FIXME     toPkt (OtherPacket a b) = OtherPacketPkt a b

@@ -0,0 +1,72 @@+-- Decrypt.hs: OpenPGP (RFC4880) recursive packet decryption+-- Copyright © 2013  Clint Adams+-- This software is released under the terms of the Expat license.+-- (See the LICENSE file).++{-# LANGUAGE FlexibleContexts #-}++module Data.Conduit.OpenPGP.Decrypt (+   conduitDecrypt+) where++import Control.Monad.IO.Class (MonadIO(..))+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Conduit+import qualified Data.Conduit.Binary as CB+import Data.Conduit.Cereal (conduitGet)+import Data.Conduit.OpenPGP.Compression (conduitDecompress)+import qualified Data.Conduit.List as CL+import Data.Default (Default, def)+import Data.Maybe (fromJust)+import Data.Serialize (get)++import Codec.Encryption.OpenPGP.S2K (skesk2Key)+import Codec.Encryption.OpenPGP.CFB (decrypt, decryptOpenPGPCfb)+import Codec.Encryption.OpenPGP.Types++data RecursorState = RecursorState {+     _depth    :: Int+  , _lastPKESK :: Maybe PKESK+  , _lastSKESK :: Maybe SKESK+} deriving (Eq, Show)++instance Default RecursorState where+    def = RecursorState 0 Nothing Nothing++type InputCallback m = String -> m BL.ByteString++conduitDecrypt :: (MonadBaseControl IO m, MonadResource m) => InputCallback IO -> Conduit Pkt m Pkt+conduitDecrypt = conduitDecrypt' 0++conduitDecrypt' :: (MonadBaseControl IO m, MonadResource m) => Int -> InputCallback IO -> Conduit Pkt m Pkt+conduitDecrypt' depth cb = CL.concatMapAccumM push def { _depth = depth }  -- FIXME: this depth stuff is convoluted+    where+        push :: (MonadBaseControl IO m, MonadResource m) => Pkt -> RecursorState -> m (RecursorState, [Pkt])+        push i s+            | _depth s > 42 = fail "I think we've been quine-attacked"+	    | otherwise = case i of+                       (SKESKPkt {}) -> return (s { _lastSKESK = Just (fromPkt i) }, [])+                       (SymEncDataPkt bs) -> do d <- decryptSEDP (_depth s) cb (fromJust . _lastSKESK $ s) bs+                                                return (s, d)+                       (SymEncIntegrityProtectedDataPkt _ bs) -> do d <- decryptSEIPDP (_depth s) cb (fromJust . _lastSKESK $ s) bs+                                                                    return (s, d)+                       p -> return (s, [p])++decryptSEDP :: (MonadBaseControl IO m, MonadIO m, MonadThrow m, MonadUnsafeIO m) => Int -> InputCallback IO -> SKESK -> B.ByteString -> m [Pkt]+decryptSEDP depth cb skesk bs = do -- FIXME: this shouldn't pass the whole SKESK+    passphrase <- liftIO $ cb "Input the passphrase I want"+    let key = skesk2Key skesk passphrase+        decrypted = case decryptOpenPGPCfb (_skeskSymmetricAlgorithm skesk) bs key of+                        Left e -> error e+                        Right x -> x+    runResourceT $ CB.sourceLbs (BL.fromStrict decrypted) $= conduitGet get $= conduitDecompress $= conduitDecrypt' depth cb $$ CL.consume++decryptSEIPDP :: (MonadBaseControl IO m, MonadIO m, MonadThrow m, MonadUnsafeIO m) => Int -> InputCallback IO -> SKESK -> B.ByteString -> m [Pkt]+decryptSEIPDP depth cb skesk bs = do -- FIXME: this shouldn't pass the whole SKESK+    passphrase <- liftIO $ cb "Input the passphrase I want"+    let key = skesk2Key skesk passphrase+        decrypted = case decrypt (_skeskSymmetricAlgorithm skesk) bs key of+                        Left e -> error e+                        Right x -> x+    runResourceT $ CB.sourceLbs (BL.fromStrict decrypted) $= conduitGet get $= conduitDecompress $= conduitDecrypt' depth cb $$ CL.consume

@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             0.8+Version:             0.9 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880) Homepage:            http://floss.scru.org/hOpenPGP/@@ -122,8 +122,10 @@                      , Codec.Encryption.OpenPGP.Fingerprint                      , Codec.Encryption.OpenPGP.KeyInfo                      , Codec.Encryption.OpenPGP.S2K+                     , Codec.Encryption.OpenPGP.CFB                      , Codec.Encryption.OpenPGP.Signatures                      , Data.Conduit.OpenPGP.Compression+                     , Data.Conduit.OpenPGP.Decrypt                      , Data.Conduit.OpenPGP.Keyring                      , Data.Conduit.OpenPGP.Keyring.Instances                      , Data.Conduit.OpenPGP.Verify@@ -139,13 +141,20 @@                , conduit               >= 0.5    && < 1.1                , containers                , crypto-pubkey         >= 0.1.4+               , cryptocipher+               , crypto-cipher-types                , cryptohash+               , data-default                , ixset                 >= 1.0                , lens                  >= 3.0+               , monad-loops                , mtl+               , nettle                , openpgp-asciiarmor                 >= 0.1+               , securemem                , split                , time                               >= 1.1+               , transformers                , zlib   default-language: Haskell2010 @@ -163,11 +172,19 @@                , conduit                , containers                , crypto-pubkey         >= 0.1.4+               , cryptocipher+               , crypto-cipher-types                , cryptohash+               , data-default                , ixset                 >= 1.0                , lens                  >= 3.0+               , monad-loops+               , mtl+               , nettle+               , securemem                , split                , time                               >= 1.1+               , transformers                , zlib                , HUnit                , test-framework@@ -179,3 +196,8 @@ source-repository head   type:     git   location: git://git.debian.org/users/clint/hOpenPGP.git++source-repository this+  type:     git+  location: git://git.debian.org/users/clint/hOpenPGP.git+  tag:      v0.9

@@ -16,10 +16,13 @@ import Codec.Encryption.OpenPGP.Types import Data.Conduit.Cereal (conduitGet) import Data.Conduit.OpenPGP.Compression (conduitCompress, conduitDecompress)+import Data.Conduit.OpenPGP.Decrypt (conduitDecrypt) import Data.Conduit.OpenPGP.Keyring (conduitToTKs, conduitToTKsDropping, sinkKeyringMap) import Data.Conduit.OpenPGP.Verify (conduitVerify)+import Codec.Encryption.OpenPGP.Serialize ()  import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL import Data.IxSet ((@=), getOne) import Data.Maybe (isJust) import Data.Serialize (get, put)@@ -87,6 +90,28 @@     let verification' = map (fmap (fingerprint . _verificationSigner)) verification     assertEqual (keyring ++ " for " ++ message) (map Right issuers) verification' +-- This needs a lot of work+testSymmetricEncryption :: FilePath -> FilePath -> B.ByteString -> Assertion+testSymmetricEncryption encfile passfile cleartext = do+  passphrase <- BL.readFile $ "tests/data/" ++ passfile+  -- get parse tree+  pt <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ encfile) DC.$= conduitGet get DC.$$ CL.consume+  -- assert parse tree has exactly two packets: skesk, encdata+  assertEqual "wrong number of packets" 2 (length pt)+  let skesk = fromPkt.head $ pt+      d = fromPkt.last $ pt+  -- FIXME: these assertions don't currently do anything properly,+  -- because haskell notices the _-prefixed accessor invocations below+  -- and the type system chokes before we hit them:+  assertEqual "first packet should be SKESK" SKESKType (packetType skesk)+  assertEqual "second packet should be encrypted data" SymEncIntegrityProtectedDataType (packetType d)+  decrypted <- DC.runResourceT $ CL.sourceList pt DC.$= conduitDecrypt (fakeCallback passphrase) DC.$$ CL.consume+  let payload = _literalDataPayload . fromPkt . head $ decrypted+  assertEqual ("cleartext for " ++ encfile) cleartext payload+      where+          fakeCallback :: BL.ByteString -> String -> IO BL.ByteString+          fakeCallback = const . return+ tests :: [Test] tests = [   testGroup "Serialization group" [@@ -221,6 +246,28 @@    , 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)+   ],+  testGroup "Encrypted data" [+     testCase "Symmetric Encryption simple S2K SHA1 3DES, no MDC" (testSymmetricEncryption "encryption-sym-3des-s2k0.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted S2K SHA1 3DES, no MDC" (testSymmetricEncryption "encryption-sym-3des.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption simple S2K SHA1 3DES" (testSymmetricEncryption "encryption-sym-3des-mdc-s2k0.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted S2K SHA1 3DES" (testSymmetricEncryption "encryption-sym-3des-mdc.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption simple S2K SHA1 CAST5, no MDC" (testSymmetricEncryption "encryption-sym-cast5-s2k0.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted S2K SHA1 CAST5, no MDC" (testSymmetricEncryption "encryption-sym-cast5.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption simple S2K SHA1 CAST5" (testSymmetricEncryption "encryption-sym-cast5-mdc-s2k0.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted S2K SHA1 CAST5" (testSymmetricEncryption "encryption-sym-cast5-mdc.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption simple S2K SHA1 Blowfish, no MDC" (testSymmetricEncryption "encryption-sym-blowfish-s2k0.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted S2K SHA1 Blowfish, no MDC" (testSymmetricEncryption "encryption-sym-blowfish.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption simple S2K SHA1 Blowfish" (testSymmetricEncryption "encryption-sym-blowfish-mdc-s2k0.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted S2K SHA1 Blowfish" (testSymmetricEncryption "encryption-sym-blowfish-mdc.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption simple S2K SHA1 AES128" (testSymmetricEncryption "encryption-sym-aes128-s2k0.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES128" (testSymmetricEncryption "encryption-sym-aes128.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption simple S2K SHA1 AES192" (testSymmetricEncryption "encryption-sym-aes192-s2k0.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES192" (testSymmetricEncryption "encryption-sym-aes192.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption simple S2K SHA1 AES256" (testSymmetricEncryption "encryption-sym-aes256-s2k0.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES256" (testSymmetricEncryption "encryption-sym-aes256.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption simple S2K SHA1 Twofish" (testSymmetricEncryption "encryption-sym-twofish-s2k0.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted S2K SHA1 Twofish" (testSymmetricEncryption "encryption-sym-twofish.gpg" "symmetric-password.txt" "test\n")    ]  ]