From b87dfe5ddfb3686ab0088c09e6e70bd7275a1f16 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 3 Aug 2014 15:35:23 -0400
Subject: roll ChunkedEncryptable into Special and improve interface

Allow disabling progress displays, for eg, rsync.
---
 Command/TestRemote.hs               |   2 +-
 Remote/Bup.hs                       |   7 +-
 Remote/Ddar.hs                      |   7 +-
 Remote/Directory.hs                 |   5 +-
 Remote/Directory/LegacyChunked.hs   |   2 +-
 Remote/External.hs                  |   3 +-
 Remote/Glacier.hs                   |   7 +-
 Remote/Helper/Chunked.hs            |   6 +-
 Remote/Helper/ChunkedEncryptable.hs | 212 ----------------------------------
 Remote/Helper/Special.hs            | 223 +++++++++++++++++++++++++++++++++++-
 Remote/Hook.hs                      |   3 +-
 Remote/S3.hs                        |   3 +-
 Remote/WebDAV.hs                    |   5 +-
 13 files changed, 245 insertions(+), 240 deletions(-)
 delete mode 100644 Remote/Helper/ChunkedEncryptable.hs

diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index 29a2e809c..3f75214a5 100644
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -76,7 +76,7 @@ perform rs ks = do
   where
 	desc r' k = intercalate "; " $ map unwords
 		[ [ "key size", show (keySize k) ]
-		, [ show (chunkConfig (Remote.config r')) ]
+		, [ show (getChunkConfig (Remote.config r')) ]
 		, ["encryption", fromMaybe "none" (M.lookup "encryption" (Remote.config r'))]
 		]
 
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 44ea8c7d8..6a04ad5f7 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -25,7 +25,6 @@ import Config
 import Config.Cost
 import qualified Remote.Helper.Ssh as Ssh
 import Remote.Helper.Special
-import Remote.Helper.ChunkedEncryptable
 import Remote.Helper.Messages
 import Utility.Hash
 import Utility.UserInfo
@@ -74,12 +73,16 @@ gen r u c gc = do
 		, availability = if bupLocal buprepo then LocallyAvailable else GloballyAvailable
 		, readonly = False
 		}
-	return $ Just $ encryptableRemote c
+	return $ Just $ specialRemote' specialcfg c
 		(simplyPrepare $ store this buprepo)
 		(simplyPrepare $ retrieve buprepo)
 		this
   where
 	buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc
+	specialcfg = (specialRemoteCfg c)
+		-- chunking would not improve bup
+		{ chunkConfig = NoChunks
+		}
 
 bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
 bupSetup mu _ c = do
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index bc4755a81..b4c7ac1e6 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -22,7 +22,6 @@ import qualified Git
 import Config
 import Config.Cost
 import Remote.Helper.Special
-import Remote.Helper.ChunkedEncryptable
 import Annex.Ssh
 import Annex.UUID
 
@@ -42,7 +41,7 @@ gen r u c gc = do
 		if ddarLocal ddarrepo
 			then nearlyCheapRemoteCost
 			else expensiveRemoteCost
-	return $ Just $ encryptableRemote c
+	return $ Just $ specialRemote' specialcfg c
 		(simplyPrepare $ store ddarrepo)
 		(simplyPrepare $ retrieve ddarrepo)
 		(this cst)
@@ -71,6 +70,10 @@ gen r u c gc = do
 		, readonly = False
 		}
 	ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc
+	specialcfg = (specialRemoteCfg c)
+		-- chunking would not improve ddar
+		{ chunkConfig = NoChunks
+		}
 
 ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
 ddarSetup mu _ c = do
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 78d30b1a1..db141e01a 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -20,7 +20,6 @@ import Config.Cost
 import Config
 import Utility.FileMode
 import Remote.Helper.Special
-import Remote.Helper.ChunkedEncryptable
 import qualified Remote.Directory.LegacyChunked as Legacy
 import Annex.Content
 import Annex.UUID
@@ -37,8 +36,8 @@ remote = RemoteType {
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = do
 	cst <- remoteCost gc cheapRemoteCost
-	let chunkconfig = chunkConfig c
-	return $ Just $ chunkedEncryptableRemote c
+	let chunkconfig = getChunkConfig c
+	return $ Just $ specialRemote c
 		(prepareStore dir chunkconfig)
 		(retrieve dir chunkconfig)
 		Remote {
diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs
index a19868802..1be885db2 100644
--- a/Remote/Directory/LegacyChunked.hs
+++ b/Remote/Directory/LegacyChunked.hs
@@ -14,7 +14,7 @@ import qualified Data.ByteString as S
 
 import Common.Annex
 import Utility.FileMode
-import Remote.Helper.ChunkedEncryptable
+import Remote.Helper.Special
 import qualified Remote.Helper.Chunked.Legacy as Legacy
 import Annex.Perms
 import Utility.Metered
diff --git a/Remote/External.hs b/Remote/External.hs
index 1c22a589b..c00093402 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -15,7 +15,6 @@ import Types.CleanupActions
 import qualified Git
 import Config
 import Remote.Helper.Special
-import Remote.Helper.ChunkedEncryptable
 import Utility.Metered
 import Logs.Transfer
 import Logs.PreferredContent.Raw
@@ -43,7 +42,7 @@ gen r u c gc = do
 	Annex.addCleanup (RemoteCleanup u) $ stopExternal external
 	cst <- getCost external r gc
 	avail <- getAvailability external r gc
-	return $ Just $ chunkedEncryptableRemote c
+	return $ Just $ specialRemote c
 		(simplyPrepare $ store external)
 		(simplyPrepare $ retrieve external)
 		Remote {
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 592a7db1f..c5bfefa64 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -18,7 +18,6 @@ import qualified Git
 import Config
 import Config.Cost
 import Remote.Helper.Special
-import Remote.Helper.ChunkedEncryptable
 import qualified Remote.Helper.AWS as AWS
 import Creds
 import Utility.Metered
@@ -40,7 +39,7 @@ remote = RemoteType {
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
   where
-	new cst = Just $ encryptableRemote c
+	new cst = Just $ specialRemote' specialcfg c
 		(prepareStore this)
 		(prepareRetrieve this)
 		this
@@ -66,6 +65,10 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 			availability = GloballyAvailable,
 			remotetype = remote
 		}
+	specialcfg = (specialRemoteCfg c)
+		-- Disabled until jobList gets support for chunks.
+		{ chunkConfig = NoChunks
+		}
 
 glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
 glacierSetup mu mcreds c = do
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index a7c43801a..2e9467b2a 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -8,7 +8,7 @@
 module Remote.Helper.Chunked (
 	ChunkSize,
 	ChunkConfig(..),
-	chunkConfig,
+	getChunkConfig,
 	storeChunks,
 	removeChunks,
 	retrieveChunks,
@@ -39,8 +39,8 @@ noChunks :: ChunkConfig -> Bool
 noChunks NoChunks = True
 noChunks _ = False
 
-chunkConfig :: RemoteConfig -> ChunkConfig
-chunkConfig m =
+getChunkConfig :: RemoteConfig -> ChunkConfig
+getChunkConfig m =
 	case M.lookup "chunksize" m of
 		Nothing -> case M.lookup "chunk" m of
 			Nothing -> NoChunks
diff --git a/Remote/Helper/ChunkedEncryptable.hs b/Remote/Helper/ChunkedEncryptable.hs
deleted file mode 100644
index 9c6ba98a2..000000000
--- a/Remote/Helper/ChunkedEncryptable.hs
+++ /dev/null
@@ -1,212 +0,0 @@
-{- Remotes that support both chunking and encryption.
- -
- - Copyright 2014 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-{-# LANGUAGE RankNTypes #-}
-
-module Remote.Helper.ChunkedEncryptable (
-	Preparer,
-	Storer,
-	Retriever,
-	simplyPrepare,
-	ContentSource,
-	checkPrepare,
-	resourcePrepare,
-	fileStorer,
-	byteStorer,
-	fileRetriever,
-	byteRetriever,
-	storeKeyDummy,
-	retreiveKeyFileDummy,
-	chunkedEncryptableRemote,
-	encryptableRemote,
-	module X
-) where
-
-import Common.Annex
-import Types.StoreRetrieve
-import Types.Remote
-import Crypto
-import Config.Cost
-import Utility.Metered
-import Remote.Helper.Chunked as X
-import Remote.Helper.Encryptable as X hiding (encryptableRemote)
-import Annex.Content
-import Annex.Exception
-
-import qualified Data.ByteString.Lazy as L
-import Control.Exception (bracket)
-
--- Use when nothing needs to be done to prepare a helper.
-simplyPrepare :: helper -> Preparer helper
-simplyPrepare helper _ a = a $ Just helper
-
--- Use to run a check when preparing a helper.
-checkPrepare :: (Key -> Annex Bool) -> helper -> Preparer helper
-checkPrepare checker helper k a = ifM (checker k)
-	( a (Just helper)
-	, a Nothing
-	)
-
--- Use to acquire a resource when preparing a helper.
-resourcePrepare :: (Key -> (r -> Annex Bool) -> Annex Bool) -> (r -> helper) -> Preparer helper
-resourcePrepare withr helper k a = withr k $ \r ->
-        a (Just (helper r))
-
--- A Storer that expects to be provided with a file containing
--- the content of the key to store.
-fileStorer :: (Key -> FilePath -> MeterUpdate -> Annex Bool) -> Storer
-fileStorer a k (FileContent f) m = a k f m
-fileStorer a k (ByteContent b) m = withTmp k $ \f -> do
-	liftIO $ L.writeFile f b
-	a k f m
-
--- A Storer that expects to be provided with a L.ByteString of
--- the content to store.
-byteStorer :: (Key -> L.ByteString -> MeterUpdate -> Annex Bool) -> Storer
-byteStorer a k c m = withBytes c $ \b -> a k b m
-
--- A Retriever that writes the content of a Key to a provided file.
--- It is responsible for updating the progress meter as it retrieves data.
-fileRetriever :: (FilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever
-fileRetriever a k m callback = do
-	f <- prepTmp k
-	a f k m
-	callback (FileContent f)
-
--- A Retriever that generates a lazy ByteString containing the Key's
--- content, and passes it to a callback action which will fully consume it
--- before returning.
-byteRetriever :: (Key -> (L.ByteString -> Annex Bool) -> Annex Bool) -> Retriever
-byteRetriever a k _m callback = a k (callback . ByteContent)
-
-{- The base Remote that is provided to chunkedEncryptableRemote
- - needs to have storeKey and retreiveKeyFile methods, but they are
- - never actually used (since chunkedEncryptableRemote replaces
- - them). Here are some dummy ones.
- -}
-storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-storeKeyDummy _ _ _ = return False
-retreiveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
-retreiveKeyFileDummy _ _ _ _ = return False
-
-type RemoteModifier = RemoteConfig -> Preparer Storer -> Preparer Retriever -> Remote -> Remote
-
--- Modifies a base Remote to support both chunking and encryption.
-chunkedEncryptableRemote :: RemoteModifier
-chunkedEncryptableRemote c = chunkedEncryptableRemote' (chunkConfig c) c
-
--- Modifies a base Remote to support encryption, but not chunking.
-encryptableRemote :: RemoteModifier
-encryptableRemote = chunkedEncryptableRemote' NoChunks
-
-chunkedEncryptableRemote' :: ChunkConfig -> RemoteModifier
-chunkedEncryptableRemote' chunkconfig c preparestorer prepareretriever baser = encr
-  where
-	encr = baser
-		{ storeKey = \k _f p -> cip >>= storeKeyGen k p
-		, retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p
-		, retrieveKeyFileCheap = \k d -> cip >>= maybe
-			(retrieveKeyFileCheap baser k d)
-			(\_ -> return False)
-		, removeKey = \k -> cip >>= removeKeyGen k
-		, hasKey = \k -> cip >>= hasKeyGen k
-		, cost = maybe
-			(cost baser)
-			(const $ cost baser + encryptedRemoteCostAdj)
-			(extractCipher c)
-		}
-	cip = cipherKey c
-	gpgopts = getGpgEncParams encr
-
-	safely a = catchNonAsyncAnnex a (\e -> warning (show e) >> return False)
-
-	-- chunk, then encrypt, then feed to the storer
-	storeKeyGen k p enc =
-		safely $ preparestorer k $ safely . go
-	  where
-		go (Just storer) = sendAnnex k rollback $ \src ->
-			metered (Just p) k $ \p' ->
-				storeChunks (uuid baser) chunkconfig k src p'
-					(storechunk enc storer)
-					(hasKey baser)
-		go Nothing = return False
-		rollback = void $ removeKey encr k
-
-	storechunk Nothing storer k content p = storer k content p
-	storechunk (Just (cipher, enck)) storer k content p =
-		withBytes content $ \b ->
-			encrypt gpgopts cipher (feedBytes b) $
-				readBytes $ \encb ->
-					storer (enck k) (ByteContent encb) p
-
-	-- call retriever to get chunks; decrypt them; stream to dest file
-	retrieveKeyFileGen k dest p enc =
-		safely $ prepareretriever k $ safely . go
-	  where
-	  	go (Just retriever) = metered (Just p) k $ \p' ->
-			retrieveChunks retriever (uuid baser) chunkconfig
-				enck k dest p' (sink dest enc)
-		go Nothing = return False
-		enck = maybe id snd enc
-
-	removeKeyGen k enc = removeChunks remover (uuid baser) chunkconfig enck k
-	  where
-		enck = maybe id snd enc
-		remover = removeKey baser
-
-	hasKeyGen k enc = hasKeyChunks checker (uuid baser) chunkconfig enck k
-	  where
-		enck = maybe id snd enc
-		checker = hasKey baser
-
-{- Sink callback for retrieveChunks. Stores the file content into the
- - provided Handle, decrypting it first if necessary.
- - 
- - If the remote did not store the content using chunks, no Handle
- - will be provided, and it's up to us to open the destination file.
- -
- - Note that when neither chunking nor encryption is used, and the remote
- - provides FileContent, that file only needs to be renamed
- - into place. (And it may even already be in the right place..)
- -}
-sink
-	:: FilePath
-	-> Maybe (Cipher, EncKey)
-	-> Maybe Handle
-	-> Maybe MeterUpdate
-	-> ContentSource
-	-> Annex Bool
-sink dest enc mh mp content = do
-	case (enc, mh, content) of
-		(Nothing, Nothing, FileContent f)
-			| f == dest -> noop
-			| otherwise -> liftIO $ moveFile f dest
-		(Just (cipher, _), _, ByteContent b) ->
-			decrypt cipher (feedBytes b) $
-				readBytes write
-		(Just (cipher, _), _, FileContent f) -> do
-			withBytes content $ \b ->
-				decrypt cipher (feedBytes b) $
-					readBytes write
-			liftIO $ nukeFile f
-		(Nothing, _, FileContent f) -> do
-			withBytes content write
-			liftIO $ nukeFile f
-		(Nothing, _, ByteContent b) -> write b
-	return True
-  where
-	write b = case mh of
-		Just h -> liftIO $ b `streamto` h
-		Nothing -> liftIO $ bracket opendest hClose (b `streamto`)
-	streamto b h = case mp of
-		Just p -> meteredWrite p h b
-		Nothing -> L.hPut h b
-	opendest = openBinaryFile dest WriteMode
-
-withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a
-withBytes (ByteContent b) a = a b
-withBytes (FileContent f) a = a =<< liftIO (L.readFile f)
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 7fc421f46..2bcb7d530 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -1,20 +1,51 @@
-{- common functions for special remotes
+{- helpers for special remotes
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Remote.Helper.Special where
-
-import qualified Data.Map as M
+module Remote.Helper.Special (
+	findSpecialRemotes,
+	gitConfigSpecialRemote,
+	Preparer,
+	Storer,
+	Retriever,
+	simplyPrepare,
+	ContentSource,
+	checkPrepare,
+	resourcePrepare,
+	fileStorer,
+	byteStorer,
+	fileRetriever,
+	byteRetriever,
+	storeKeyDummy,
+	retreiveKeyFileDummy,
+	SpecialRemoteCfg(..),
+	specialRemoteCfg,
+	specialRemote,
+	specialRemote',
+	module X
+) where
 
 import Common.Annex
+import Types.StoreRetrieve
 import Types.Remote
+import Crypto
+import Config.Cost
+import Utility.Metered
+import Remote.Helper.Chunked as X
+import Remote.Helper.Encryptable as X hiding (encryptableRemote)
+import Annex.Content
+import Annex.Exception
 import qualified Git
 import qualified Git.Command
 import qualified Git.Construct
 
+import qualified Data.ByteString.Lazy as L
+import Control.Exception (bracket)
+import qualified Data.Map as M
+
 {- Special remotes don't have a configured url, so Git.Repo does not
  - automatically generate remotes for them. This looks for a different
  - configuration key instead.
@@ -38,3 +69,185 @@ gitConfigSpecialRemote u c k v = do
 		[Param "config", Param (configsetting a), Param b]
 	remotename = fromJust (M.lookup "name" c)
 	configsetting s = "remote." ++ remotename ++ "." ++ s
+
+-- Use when nothing needs to be done to prepare a helper.
+simplyPrepare :: helper -> Preparer helper
+simplyPrepare helper _ a = a $ Just helper
+
+-- Use to run a check when preparing a helper.
+checkPrepare :: (Key -> Annex Bool) -> helper -> Preparer helper
+checkPrepare checker helper k a = ifM (checker k)
+	( a (Just helper)
+	, a Nothing
+	)
+
+-- Use to acquire a resource when preparing a helper.
+resourcePrepare :: (Key -> (r -> Annex Bool) -> Annex Bool) -> (r -> helper) -> Preparer helper
+resourcePrepare withr helper k a = withr k $ \r ->
+        a (Just (helper r))
+
+-- A Storer that expects to be provided with a file containing
+-- the content of the key to store.
+fileStorer :: (Key -> FilePath -> MeterUpdate -> Annex Bool) -> Storer
+fileStorer a k (FileContent f) m = a k f m
+fileStorer a k (ByteContent b) m = withTmp k $ \f -> do
+	liftIO $ L.writeFile f b
+	a k f m
+
+-- A Storer that expects to be provided with a L.ByteString of
+-- the content to store.
+byteStorer :: (Key -> L.ByteString -> MeterUpdate -> Annex Bool) -> Storer
+byteStorer a k c m = withBytes c $ \b -> a k b m
+
+-- A Retriever that writes the content of a Key to a provided file.
+-- It is responsible for updating the progress meter as it retrieves data.
+fileRetriever :: (FilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever
+fileRetriever a k m callback = do
+	f <- prepTmp k
+	a f k m
+	callback (FileContent f)
+
+-- A Retriever that generates a lazy ByteString containing the Key's
+-- content, and passes it to a callback action which will fully consume it
+-- before returning.
+byteRetriever :: (Key -> (L.ByteString -> Annex Bool) -> Annex Bool) -> Retriever
+byteRetriever a k _m callback = a k (callback . ByteContent)
+
+{- The base Remote that is provided to specialRemote needs to have
+ - storeKey and retreiveKeyFile methods, but they are never
+ - actually used (since specialRemote replaces them).
+ - Here are some dummy ones.
+ -}
+storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
+storeKeyDummy _ _ _ = return False
+retreiveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+retreiveKeyFileDummy _ _ _ _ = return False
+
+type RemoteModifier = RemoteConfig -> Preparer Storer -> Preparer Retriever -> Remote -> Remote
+
+data SpecialRemoteCfg = SpecialRemoteCfg
+	{ chunkConfig :: ChunkConfig
+	, displayProgress :: Bool
+	}
+
+specialRemoteCfg :: RemoteConfig -> SpecialRemoteCfg
+specialRemoteCfg c = SpecialRemoteCfg (getChunkConfig c) True
+
+-- Modifies a base Remote to support both chunking and encryption,
+-- which special remotes typically should support.
+specialRemote :: RemoteModifier
+specialRemote c = specialRemote' (specialRemoteCfg c) c
+
+specialRemote' :: SpecialRemoteCfg -> RemoteModifier
+specialRemote' cfg c preparestorer prepareretriever baser = encr
+  where
+	encr = baser
+		{ storeKey = \k _f p -> cip >>= storeKeyGen k p
+		, retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p
+		, retrieveKeyFileCheap = \k d -> cip >>= maybe
+			(retrieveKeyFileCheap baser k d)
+			(\_ -> return False)
+		, removeKey = \k -> cip >>= removeKeyGen k
+		, hasKey = \k -> cip >>= hasKeyGen k
+		, cost = maybe
+			(cost baser)
+			(const $ cost baser + encryptedRemoteCostAdj)
+			(extractCipher c)
+		}
+	cip = cipherKey c
+	gpgopts = getGpgEncParams encr
+
+	safely a = catchNonAsyncAnnex a (\e -> warning (show e) >> return False)
+
+	-- chunk, then encrypt, then feed to the storer
+	storeKeyGen k p enc =
+		safely $ preparestorer k $ safely . go
+	  where
+		go (Just storer) = sendAnnex k rollback $ \src ->
+			displayprogress p k $ \p' ->
+				storeChunks (uuid baser) chunkconfig k src p'
+					(storechunk enc storer)
+					(hasKey baser)
+		go Nothing = return False
+		rollback = void $ removeKey encr k
+
+	storechunk Nothing storer k content p = storer k content p
+	storechunk (Just (cipher, enck)) storer k content p =
+		withBytes content $ \b ->
+			encrypt gpgopts cipher (feedBytes b) $
+				readBytes $ \encb ->
+					storer (enck k) (ByteContent encb) p
+
+	-- call retriever to get chunks; decrypt them; stream to dest file
+	retrieveKeyFileGen k dest p enc =
+		safely $ prepareretriever k $ safely . go
+	  where
+	  	go (Just retriever) = displayprogress p k $ \p' ->
+			retrieveChunks retriever (uuid baser) chunkconfig
+				enck k dest p' (sink dest enc)
+		go Nothing = return False
+		enck = maybe id snd enc
+
+	removeKeyGen k enc = removeChunks remover (uuid baser) chunkconfig enck k
+	  where
+		enck = maybe id snd enc
+		remover = removeKey baser
+
+	hasKeyGen k enc = hasKeyChunks checker (uuid baser) chunkconfig enck k
+	  where
+		enck = maybe id snd enc
+		checker = hasKey baser
+
+	chunkconfig = chunkConfig cfg
+
+	displayprogress p k a
+		| displayProgress cfg = metered (Just p) k a
+		| otherwise = a p
+
+{- Sink callback for retrieveChunks. Stores the file content into the
+ - provided Handle, decrypting it first if necessary.
+ - 
+ - If the remote did not store the content using chunks, no Handle
+ - will be provided, and it's up to us to open the destination file.
+ -
+ - Note that when neither chunking nor encryption is used, and the remote
+ - provides FileContent, that file only needs to be renamed
+ - into place. (And it may even already be in the right place..)
+ -}
+sink
+	:: FilePath
+	-> Maybe (Cipher, EncKey)
+	-> Maybe Handle
+	-> Maybe MeterUpdate
+	-> ContentSource
+	-> Annex Bool
+sink dest enc mh mp content = do
+	case (enc, mh, content) of
+		(Nothing, Nothing, FileContent f)
+			| f == dest -> noop
+			| otherwise -> liftIO $ moveFile f dest
+		(Just (cipher, _), _, ByteContent b) ->
+			decrypt cipher (feedBytes b) $
+				readBytes write
+		(Just (cipher, _), _, FileContent f) -> do
+			withBytes content $ \b ->
+				decrypt cipher (feedBytes b) $
+					readBytes write
+			liftIO $ nukeFile f
+		(Nothing, _, FileContent f) -> do
+			withBytes content write
+			liftIO $ nukeFile f
+		(Nothing, _, ByteContent b) -> write b
+	return True
+  where
+	write b = case mh of
+		Just h -> liftIO $ b `streamto` h
+		Nothing -> liftIO $ bracket opendest hClose (b `streamto`)
+	streamto b h = case mp of
+		Just p -> meteredWrite p h b
+		Nothing -> L.hPut h b
+	opendest = openBinaryFile dest WriteMode
+
+withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a
+withBytes (ByteContent b) a = a b
+withBytes (FileContent f) a = a =<< liftIO (L.readFile f)
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 0668e2ca9..efbd9f8ba 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -18,7 +18,6 @@ import Config
 import Config.Cost
 import Annex.UUID
 import Remote.Helper.Special
-import Remote.Helper.ChunkedEncryptable
 import Utility.Env
 
 type Action = String
@@ -35,7 +34,7 @@ remote = RemoteType {
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = do
 	cst <- remoteCost gc expensiveRemoteCost
-	return $ Just $ chunkedEncryptableRemote c
+	return $ Just $ specialRemote c
 		(simplyPrepare $ store hooktype)
 		(simplyPrepare $ retrieve hooktype)
 		Remote {
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 68d8ee4bf..8603757eb 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -25,7 +25,6 @@ import qualified Git
 import Config
 import Config.Cost
 import Remote.Helper.Special
-import Remote.Helper.ChunkedEncryptable
 import qualified Remote.Helper.AWS as AWS
 import Creds
 import Utility.Metered
@@ -45,7 +44,7 @@ remote = RemoteType {
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
   where
-	new cst = Just $ chunkedEncryptableRemote c
+	new cst = Just $ specialRemote c
 		(prepareStore this)
 		(prepareRetrieve this)
 		this
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index d6644cdc7..0bdd38360 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -28,7 +28,6 @@ import Config
 import Config.Cost
 import Remote.Helper.Special
 import Remote.Helper.Encryptable
-import Remote.Helper.Chunked
 import qualified Remote.Helper.Chunked.Legacy as Legacy
 import Crypto
 import Creds
@@ -122,7 +121,7 @@ storeHelper r k baseurl user pass b = catchBoolIO $ do
   where
 	tmpurl = tmpLocation baseurl k
 	keyurl = davLocation baseurl k
-	chunkconfig = chunkConfig $ config r
+	chunkconfig = getChunkConfig $ config r
 	finalizer srcurl desturl = do
 		void $ tryNonAsync (deleteDAV desturl user pass)
 		mkdirRecursiveDAV (urlParent desturl) user pass
@@ -220,7 +219,7 @@ withStoredFiles r k baseurl user pass onerr a = case chunkconfig of
 					else a chunks
   where
 	keyurl = davLocation baseurl k ++ keyFile k
-	chunkconfig = chunkConfig $ config r
+	chunkconfig = getChunkConfig $ config r
 
 davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a
 davAction r unconfigured action = do
-- 
cgit v1.2.3