better streaming while encrypting/decrypting

Both the directory and webdav special remotes used to have to buffer
the whole file contents before it could be decrypted, as they read
from chunks. Now the chunks are streamed through gpg with no buffering.

1 files changed, 28 insertions, 34 deletions

diff --git a/Crypto.hs b/Crypto.hs
index 071fb7a25..fe6c6d5cb 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -18,10 +18,11 @@ module Crypto (
 	describeCipher,
 	decryptCipher,		
 	encryptKey,
-	withEncryptedHandle,
-	withDecryptedHandle,
-	withEncryptedContent,
-	withDecryptedContent,
+	feedFile,
+	feedBytes,
+	readBytes,
+	encrypt,
+	decrypt,	
 
 	prop_hmacWithCipher_sane
 ) where
@@ -90,10 +91,9 @@ describeCipher (EncryptedCipher _ (KeyIds ks)) =
 encryptCipher :: Cipher -> KeyIds -> IO StorableCipher
 encryptCipher (Cipher c) (KeyIds ks) = do
 	let ks' = nub $ sort ks -- gpg complains about duplicate recipient keyids
-	encipher <- Gpg.pipeStrict (encrypt++recipients ks') c
+	encipher <- Gpg.pipeStrict ([ Params "--encrypt" ] ++ recipients ks') c
 	return $ EncryptedCipher encipher (KeyIds ks')
  where
-	encrypt = [ Params "--encrypt" ]
 	recipients l = force_recipients :
 		concatMap (\k -> [Param "--recipient", Param k]) l
 	-- Force gpg to only encrypt to the specified
@@ -103,9 +103,7 @@ encryptCipher (Cipher c) (KeyIds ks) = do
 {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
 decryptCipher :: StorableCipher -> IO Cipher
 decryptCipher (SharedCipher t) = return $ Cipher t
-decryptCipher (EncryptedCipher t _) = Cipher <$> Gpg.pipeStrict decrypt t
-  where
-	decrypt = [ Param "--decrypt" ]
+decryptCipher (EncryptedCipher t _) = Cipher <$> Gpg.pipeStrict [ Param "--decrypt" ] t
 
 {- Generates an encrypted form of a Key. The encryption does not need to be
  - reversable, nor does it need to be the same type of encryption used
@@ -118,31 +116,27 @@ encryptKey c k = Key
 	, keyMtime = Nothing -- to avoid leaking data
 	}
 
-{- Runs an action, passing it a handle from which it can 
- - stream encrypted content. -}
-withEncryptedHandle :: Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a
-withEncryptedHandle = Gpg.passphraseHandle [Params "--symmetric --force-mdc"] . cipherPassphrase
-
-{- Runs an action, passing it a handle from which it can
- - stream decrypted content. -}
-withDecryptedHandle :: Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a
-withDecryptedHandle = Gpg.passphraseHandle [Param "--decrypt"] . cipherPassphrase
-
-{- Streams encrypted content to an action. -}
-withEncryptedContent :: Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
-withEncryptedContent = pass withEncryptedHandle
-
-{- Streams decrypted content to an action. -}
-withDecryptedContent :: Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
-withDecryptedContent = pass withDecryptedHandle
-
-pass
-	:: (Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a) 
-	-> Cipher
-	-> IO L.ByteString
-	-> (L.ByteString -> IO a)
-	-> IO a
-pass to n s a = to n s $ a <=< L.hGetContents
+type Feeder = Handle -> IO ()
+type Reader a = Handle -> IO a
+
+feedFile :: FilePath -> Feeder
+feedFile f h = L.hPut h =<< L.readFile f
+
+feedBytes :: L.ByteString -> Feeder
+feedBytes = flip L.hPut
+
+readBytes :: (L.ByteString -> IO a) -> Reader a
+readBytes a h = L.hGetContents h >>= a
+
+{- Runs a Feeder action, that generates content that is encrypted with the
+ - Cipher, and read by the Reader action. -}
+encrypt :: Cipher -> Feeder -> Reader a -> IO a
+encrypt = Gpg.feedRead [Params "--symmetric --force-mdc"] . cipherPassphrase
+
+{- Runs a Feeder action, that generates content that is decrypted with the
+ - Cipher, and read by the Reader action. -}
+decrypt :: Cipher -> Feeder -> Reader a -> IO a
+decrypt = Gpg.feedRead [Param "--decrypt"] . cipherPassphrase
 
 hmacWithCipher :: Cipher -> String -> String
 hmacWithCipher c = hmacWithCipher' (cipherHmac c)