convert bup to new ChunkedEncryptable API (but do not support chunking)

bup already splits files and does rolling deltas, so there is no reason to
use chunking here.

The new API made it easier to add progress support for storeKey, so that's
done. Unfortunately, bup-split still outputs its own progress with -q,
so a little ugly, but not too bad.

Made dropping remove the branch for an object, for two reasons:

1. The new API calls removeKey to roll back a storeKey when the content
   changed unexpectedly.
2. So that testremote will be happy.

Also, fixed a bug that caused a crash when removing the branch for an
object in rollback.

3 files changed, 38 insertions, 62 deletions

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 778832850..06679c4b8 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -1,15 +1,13 @@
 {- Using bup as a remote.
  -
- - 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.Bup (remote) where
 
-import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
-import System.Process
 import Data.ByteString.Lazy.UTF8 (fromString)
 
 import Common.Annex
@@ -26,12 +24,10 @@ import Config
 import Config.Cost
 import qualified Remote.Helper.Ssh as Ssh
 import Remote.Helper.Special
-import Remote.Helper.Encryptable
+import Remote.Helper.ChunkedEncryptable
 import Remote.Helper.Messages
-import Crypto
 import Utility.Hash
 import Utility.UserInfo
-import Annex.Content
 import Annex.UUID
 import Utility.Metered
 
@@ -54,14 +50,14 @@ gen r u c gc = do
 			else expensiveRemoteCost
 	(u', bupr') <- getBupUUID bupr u
 	
-	let new = Remote
+	let this = Remote
 		{ uuid = u'
 		, cost = cst
 		, name = Git.repoDescribe r
-		, storeKey = store new buprepo
-		, retrieveKeyFile = retrieve buprepo
+		, storeKey = storeKeyDummy
+		, retrieveKeyFile = retreiveKeyFileDummy
 		, retrieveKeyFileCheap = retrieveCheap buprepo
-		, removeKey = remove
+		, removeKey = remove buprepo
 		, hasKey = checkPresent r bupr'
 		, hasKeyCheap = bupLocal buprepo
 		, whereisKey = Nothing
@@ -78,9 +74,9 @@ gen r u c gc = do
 		, readonly = False
 		}
 	return $ Just $ encryptableRemote c
-		(storeEncrypted new buprepo)
-		(retrieveEncrypted buprepo)
-		new
+		(simplyPrepare $ store this buprepo)
+		(simplyPrepare $ retrieve buprepo)
+		this
   where
 	buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc
 
@@ -115,72 +111,49 @@ bup command buprepo params = do
 	showOutput -- make way for bup output
 	liftIO $ boolSystem "bup" $ bupParams command buprepo params
 
-pipeBup :: [CommandParam] -> Maybe Handle -> Maybe Handle -> IO Bool
-pipeBup params inh outh = do
-	p <- runProcess "bup" (toCommand params)
-		Nothing Nothing inh outh Nothing
-	ok <- waitForProcess p
-	case ok of
-		ExitSuccess -> return True
-		_ -> return False
-
 bupSplitParams :: Remote -> BupRepo -> Key -> [CommandParam] -> Annex [CommandParam]
 bupSplitParams r buprepo k src = do
 	let os = map Param $ remoteAnnexBupSplitOptions $ gitconfig r
 	showOutput -- make way for bup output
 	return $ bupParams "split" buprepo 
-		(os ++ [Param "-n", Param (bupRef k)] ++ src)
-
-store :: Remote -> BupRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store r buprepo k _f _p = sendAnnex k (rollback k buprepo) $ \src -> do
-	params <- bupSplitParams r buprepo k [File src]
-	liftIO $ boolSystem "bup" params
+		(os ++ [Param "-q", Param "-n", Param (bupRef k)] ++ src)
 
-storeEncrypted :: Remote -> BupRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted r buprepo (cipher, enck) k _p =
-	sendAnnex k (rollback enck buprepo) $ \src -> do
-		params <- bupSplitParams r buprepo enck []
-		liftIO $ catchBoolIO $
-			encrypt (getGpgEncParams r) cipher (feedFile src) $ \h ->
-				pipeBup params (Just h) Nothing
+store :: Remote -> BupRepo -> Storer
+store r buprepo = byteStorer $ \k b p -> do
+	params <- bupSplitParams r buprepo k []
+	let cmd = proc "bup" (toCommand params)
+	liftIO $ withHandle StdinHandle createProcessSuccess cmd $ \h -> do
+		meteredWrite p h b
+		return True
 
-retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
-retrieve buprepo k _f d _p = do
-	let params = bupParams "join" buprepo [Param $ bupRef k]
-	liftIO $ catchBoolIO $ withFile d WriteMode $
-		pipeBup params Nothing . Just
+retrieve :: BupRepo -> Retriever
+retrieve buprepo = fileRetriever $ \d k _p ->
+	liftIO $ withFile d WriteMode $ \h -> do
+		let params = bupParams "join" buprepo [Param $ bupRef k]
+		let p = proc "bup" (toCommand params)
+		(_, _, _, pid) <- createProcess $ p { std_out = UseHandle h }
+		forceSuccessProcess p pid
 
 retrieveCheap :: BupRepo -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
 
-retrieveEncrypted :: BupRepo -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
-retrieveEncrypted buprepo (cipher, enck) _ f _p = liftIO $ catchBoolIO $
-	withHandle StdoutHandle createProcessSuccess p $ \h -> do
-		decrypt cipher (\toh -> L.hPut toh =<< L.hGetContents h) $
-			readBytes $ L.writeFile f
-		return True
-  where
-	params = bupParams "join" buprepo [Param $ bupRef enck]
-	p = proc "bup" $ toCommand params
-
-remove :: Key -> Annex Bool
-remove _ = do
-	warning "content cannot be removed from bup remote"
-	return False
-
 {- Cannot revert having stored a key in bup, but at least the data for the
  - key will be used for deltaing data of other keys stored later.
  -
  - We can, however, remove the git branch that bup created for the key.
  -}
-rollback :: Key -> BupRepo -> Annex ()
-rollback k bupr = go =<< liftIO (bup2GitRemote bupr)
+remove :: BupRepo -> Key -> Annex Bool
+remove buprepo k = do
+	go =<< liftIO (bup2GitRemote buprepo)
+	warning "content cannot be completely removed from bup remote"
+	return True
   where
 	go r
 		| Git.repoIsUrl r = void $ onBupRemote r boolSystem "git" params
-		| otherwise = void $ liftIO $ catchMaybeIO $
-			boolSystem "git" $ Git.Command.gitCommandLine params r
-	params = [ Params "branch -D", Param (bupRef k) ]
+		| otherwise = void $ liftIO $ catchMaybeIO $ do
+			r' <- Git.Config.read r
+			boolSystem "git" $ Git.Command.gitCommandLine params r'
+	params = [ Params "branch -q -D", Param (bupRef k) ]
 
 {- Bup does not provide a way to tell if a given dataset is present
  - in a bup repository. One way it to check if the git repository has
diff --git a/debian/changelog b/debian/changelog
index 4c6eac663..ca6059f43 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -18,6 +18,9 @@ git-annex (5.20140718) UNRELEASED; urgency=medium
   * Display exception message when a transfer fails due to an exception.
   * WebDAV: Dropped support for DAV before 0.6.1.
   * testremote: New command to test uploads/downloads to a remote.
+  * Dropping an object from a bup special remote now deletes the git branch
+    for the object, although of course the object's content cannot be deleted
+    due to the nature of bup.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 21 Jul 2014 14:41:26 -0400
 
diff --git a/doc/design/assistant/progressbars.mdwn b/doc/design/assistant/progressbars.mdwn
index 50f424508..7de70452d 100644
--- a/doc/design/assistant/progressbars.mdwn
+++ b/doc/design/assistant/progressbars.mdwn
@@ -14,7 +14,7 @@ This is one of those potentially hidden but time consuming problems.
   could use inotify. **done**
 * When easily available, remotes call the MeterUpdate callback as downloads
   progress. **done**
-* S3 TODO  
+* S3: TODO  
   While it has a download progress bar, `getObject` probably buffers the whole
   download in memory before returning. Leaving the progress bar to only
   display progress for writing the file out of memory. Fixing this would
@@ -32,7 +32,7 @@ the MeterUpdate callback as the upload progresses.
 * webdav: **done**
 * S3: **done**
 * glacier: **done**
-* bup: TODO
+* bup: **done**
 * hook: Would require the hook interface to somehow do this, which seems
   too complicated. So skipping.