avoid unnecessary transfer scans when syncing a disconnected remote

Found a very cheap way to determine when a disconnected remote has
diverged, and has new content that needs to be transferred: Piggyback on
the git-annex branch update, which already checks for divergence.

However, this does not check if new content has appeared locally while
disconnected, that should be transferred to the remote.

Also, this does not handle cases where the two git repos are in sync,
but their content syncing has not caught up yet.

This code could have its efficiency improved:

* When multiple remotes are synced, if any one has diverged, they're
  all queued for transfer scans.
* The transfer scanner could be told whether the remote has new content,
  the local repo has new content, or both, and could optimise its scan
  accordingly.

4 files changed, 25 insertions, 13 deletions

diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index 8e7f45a4a..a832efada 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -90,10 +90,10 @@ getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha
  - called before data is read from it. Runs only once per git-annex run.
  -}
 update :: Annex ()
-update = runUpdateOnce $ updateTo =<< siblingBranches
+update = runUpdateOnce $ void $ updateTo =<< siblingBranches
 
 {- Forces an update even if one has already been run. -}
-forceUpdate :: Annex ()
+forceUpdate :: Annex Bool
 forceUpdate = updateTo =<< siblingBranches
 
 {- Merges the specified Refs into the index, if they have any changes not
@@ -111,8 +111,10 @@ forceUpdate = updateTo =<< siblingBranches
  -
  - The branch is fast-forwarded if possible, otherwise a merge commit is
  - made.
+ -
+ - Returns True if any refs were merged in, False otherwise.
  -}
-updateTo :: [(Git.Ref, Git.Branch)] -> Annex ()
+updateTo :: [(Git.Ref, Git.Branch)] -> Annex Bool
 updateTo pairs = do
 	-- ensure branch exists, and get its current ref
 	branchref <- getBranch
@@ -139,6 +141,7 @@ updateTo pairs = do
 				else commitBranch branchref merge_desc
 					(nub $ fullname:refs)
 			invalidateCache
+	return $ not $ null refs
 	where
 		isnewer (r, _) = inRepo $ Git.Branch.changed fullname r
 
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index aa990df34..4a0d271a3 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -238,7 +238,8 @@ updateAlertMap dstatus a = notifyAlert dstatus `after` modifyDaemonStatus_ dstat
 	where
 		go s = s { alertMap = a (alertMap s) }
 
-{- Displays an alert while performing an activity.
+{- Displays an alert while performing an activity that returns True on
+ - success.
  -
  - The alert is left visible afterwards, as filler.
  - Old filler is pruned, to prevent the map growing too large. -}
@@ -247,6 +248,7 @@ alertWhile dstatus alert a = alertWhile' dstatus alert $ do
 	r <- a
 	return $ (r, r)
 
+{- Like alertWhile, but allows the activity to return a value too. -}
 alertWhile' :: DaemonStatusHandle -> Alert -> IO (Bool, a) -> IO a
 alertWhile' dstatus alert a = do
 	let alert' = alert { alertClass = Activity }
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index 11d33a54f..b0f3890ee 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -27,21 +27,27 @@ import qualified Data.Map as M
 {- Syncs with remotes that may have been disconnected for a while.
  - 
  - After getting git in sync, queues a scan for file transfers.
+ - To avoid doing that expensive scan unnecessarily, it's only run
+ - if the git-annex branches of the remotes have diverged from the
+ - local git-annex branch.
  -}
 syncRemotes :: ThreadName -> ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> [Remote] -> IO ()
 syncRemotes _ _ _ _ [] = noop
-syncRemotes threadname st dstatus scanremotes rs = do
-	void $ alertWhile dstatus (syncAlert rs) $ do
+syncRemotes threadname st dstatus scanremotes rs = void $
+	alertWhile dstatus (syncAlert rs) $ do
 		sync =<< runThreadState st (inRepo Git.Branch.current)
-	addScanRemotes scanremotes rs
 	where
 		sync (Just branch) = do
-			manualPull st (Just branch) rs
+			haddiverged <- manualPull st (Just branch) rs
+			when haddiverged $
+				addScanRemotes scanremotes rs	
 			now <- getCurrentTime	
 			pushToRemotes threadname now st Nothing rs
 		{- No local branch exists yet, but we can try pulling. -}
 		sync Nothing = do
-			manualPull st Nothing rs
+			haddiverged <- manualPull st Nothing rs
+			when haddiverged $
+				addScanRemotes scanremotes rs	
 			return True
 
 {- Updates the local sync branch, then pushes it to all remotes, in
@@ -85,15 +91,16 @@ pushToRemotes threadname now st mpushmap remotes = do
 
 		retry branch g rs = do
 			debug threadname [ "trying manual pull to resolve failed pushes" ]
-			manualPull st (Just branch) rs
+			void $ manualPull st (Just branch) rs
 			go False (Just branch) g rs
 
 {- Manually pull from remotes and merge their branches. -}
-manualPull :: ThreadState -> (Maybe Git.Ref) -> [Remote] -> IO ()
+manualPull :: ThreadState -> (Maybe Git.Ref) -> [Remote] -> IO Bool
 manualPull st currentbranch remotes = do
 	g <- runThreadState st $ fromRepo id
 	forM_ remotes $ \r ->
 		Git.Command.runBool "fetch" [Param $ Remote.name r] g
-	runThreadState st $ Annex.Branch.forceUpdate
+	haddiverged <- runThreadState st $ Annex.Branch.forceUpdate
 	forM_ remotes $ \r ->
 		runThreadState st $ Command.Sync.mergeRemote r currentbranch
+	return haddiverged
diff --git a/Command/Sync.hs b/Command/Sync.hs
index f40a2f621..023b1b84a 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -172,7 +172,7 @@ pushBranch remote branch g =
 
 mergeAnnex :: CommandStart
 mergeAnnex = do
-	Annex.Branch.forceUpdate
+	void $ Annex.Branch.forceUpdate
 	stop
 
 mergeFrom :: Git.Ref -> Annex Bool