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.

1 files changed, 33 insertions, 60 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