From b96b845ffd9dc82f674751e258fd769e266fe494 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 12 Mar 2018 19:18:47 -0400
Subject: [PATCH] fix nested progress meters when using git-annex-shell
 fallback

Caused an ugly blank line when the first progress meter was not used,
but also it may have confused -J display.
---
 Remote/Git.hs        | 32 +++++++++++++++-----------------
 Remote/Helper/P2P.hs |  8 ++++----
 Remote/P2P.hs        |  4 ++--
 3 files changed, 21 insertions(+), 23 deletions(-)

diff --git a/Remote/Git.hs b/Remote/Git.hs
index 12a761fc81..b1a5878f60 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -470,17 +470,16 @@ copyFromRemote' forcersync r (State connpool _) key file dest meterupdate
 						file forwardRetry
 						(\p -> copier object dest (combineMeterUpdate p meterupdate) checksuccess)
 	| Git.repoIsSsh (repo r) = if forcersync
-		then unVerified fallback
+		then unVerified $ fallback meterupdate
 		else P2PHelper.retrieve
-			(Ssh.runProto r connpool False fallback)
+			(\p -> Ssh.runProto r connpool False (fallback p))
 			key file dest meterupdate
 	| otherwise = giveup "copying from non-ssh, non-http remote not supported"
   where
-	fallback = metered (Just meterupdate) key (return Nothing) $ \p ->
-		feedprogressback $ \p' -> do
-			oh <- mkOutputHandlerQuiet
-			Ssh.rsyncHelper oh (Just (combineMeterUpdate p' p))
-				=<< Ssh.rsyncParamsRemote False r Download key dest file
+	fallback p = feedprogressback $ \p' -> do
+		oh <- mkOutputHandlerQuiet
+		Ssh.rsyncHelper oh (Just (combineMeterUpdate p' p))
+			=<< Ssh.rsyncParamsRemote False r Download key dest file
 	{- Feed local rsync's progress info back to the remote,
 	 - by forking a feeder thread that runs
 	 - git-annex-shell transferinfo at the same time
@@ -575,7 +574,7 @@ copyToRemote r (State connpool duc) key file meterupdate
 		)
 	| Git.repoIsSsh (repo r) = commitOnCleanup r $
 		P2PHelper.store
-			(Ssh.runProto r connpool False copyremotefallback)
+			(\p -> Ssh.runProto r connpool False (copyremotefallback p))
 			key file meterupdate
 		
 	| otherwise = giveup "copying to non-ssh repo not supported"
@@ -602,15 +601,14 @@ copyToRemote r (State connpool duc) key file meterupdate
 						Annex.Content.getViaTmp verify key
 							(\dest -> copier object dest p' (liftIO checksuccessio))
 			)
-	copyremotefallback = Annex.Content.sendAnnex key noop $ \object ->
-			metered (Just meterupdate) key (return $ Just object) $ \p -> do
-				-- This is too broad really, but recvkey normally
-				-- verifies content anyway, so avoid complicating
-				-- it with a local sendAnnex check and rollback.
-				unlocked <- isDirect <||> versionSupportsUnlockedPointers
-				oh <- mkOutputHandlerQuiet
-				Ssh.rsyncHelper oh (Just p)
-					=<< Ssh.rsyncParamsRemote unlocked r Upload key object file
+	copyremotefallback p = Annex.Content.sendAnnex key noop $ \object -> do
+		-- This is too broad really, but recvkey normally
+		-- verifies content anyway, so avoid complicating
+		-- it with a local sendAnnex check and rollback.
+		unlocked <- isDirect <||> versionSupportsUnlockedPointers
+		oh <- mkOutputHandlerQuiet
+		Ssh.rsyncHelper oh (Just p)
+			=<< Ssh.rsyncParamsRemote unlocked r Upload key object file
 
 fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)
 fsckOnRemote r params
diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs
index 23d99da511..f609f97d44 100644
--- a/Remote/Helper/P2P.hs
+++ b/Remote/Helper/P2P.hs
@@ -30,17 +30,17 @@ type ProtoConnRunner c = forall a. P2P.Proto a -> ClosableConnection c -> Annex
 -- the pool when done.
 type WithConn a c = (ClosableConnection c -> Annex (ClosableConnection c, a)) -> Annex a
 
-store :: ProtoRunner Bool -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
+store :: (MeterUpdate -> ProtoRunner Bool) -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store runner k af p = do
 	let getsrcfile = fmap fst <$> prepSendAnnex k
 	metered (Just p) k getsrcfile $ \p' -> 
 		fromMaybe False
-			<$> runner (P2P.put k af p')
+			<$> runner p' (P2P.put k af p')
 
-retrieve :: ProtoRunner Bool -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
+retrieve :: (MeterUpdate -> ProtoRunner Bool) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
 retrieve runner k af dest p = unVerified $ 
 	metered (Just p) k (return Nothing) $ \p' -> fromMaybe False 
-		<$> runner (P2P.get dest k af p')
+		<$> runner p (P2P.get dest k af p')
 
 remove :: ProtoRunner Bool -> Key -> Annex Bool
 remove runner k = fromMaybe False <$> runner (P2P.remove k)
diff --git a/Remote/P2P.hs b/Remote/P2P.hs
index f475eed1ca..41b6b21eb7 100644
--- a/Remote/P2P.hs
+++ b/Remote/P2P.hs
@@ -51,8 +51,8 @@ chainGen addr r u c gc = do
 		{ uuid = u
 		, cost = cst
 		, name = Git.repoDescribe r
-		, storeKey = store protorunner
-		, retrieveKeyFile = retrieve protorunner
+		, storeKey = store (const protorunner)
+		, retrieveKeyFile = retrieve (const protorunner)
 		, retrieveKeyFileCheap = \_ _ _ -> return False
 		, removeKey = remove protorunner
 		, lockContent = Just $ lock withconn runProtoConn u