check for unused keys on an unwanted remote, and move them off, before deleting it

2 files changed, 33 insertions, 5 deletions

diff --git a/Assistant/DeleteRemote.hs b/Assistant/DeleteRemote.hs
index a23eeaa8e..25dd7720f 100644
--- a/Assistant/DeleteRemote.hs
+++ b/Assistant/DeleteRemote.hs
@@ -14,6 +14,9 @@ import Assistant.Common
 import Assistant.WebApp.Types
 import Assistant.WebApp
 #endif
+import Assistant.TransferQueue
+import Logs.Transfer
+import Logs.Location
 import Assistant.Alert
 import Assistant.DaemonStatus
 import Assistant.Types.UrlRenderer
@@ -21,6 +24,7 @@ import qualified Remote
 import Remote.List
 import qualified Git.Command
 import Logs.Trust
+import qualified Annex
 
 import qualified Data.Text as T
 
@@ -40,8 +44,33 @@ removeRemote uuid = do
 	updateSyncRemotes
 	return remote
 
-{- Called when a remote was marked as unwanted, and is now empty, so can be
- - removed. -}
+{- Called when a Remote is probably empty, to remove it.
+ -
+ - This does one last check for any objects remaining in the Remote,
+ - and if there are any, queues Downloads of them, and defers removing
+ - the remote for later. This is to catch any objects not referred to
+ - in keys in the current branch.
+ -}
+removableRemote :: UrlRenderer -> UUID -> Assistant ()
+removableRemote urlrenderer uuid = do
+	keys <- getkeys
+	if null keys
+		then finishRemovingRemote urlrenderer uuid
+		else do
+			r <- fromMaybe (error "unknown remote")
+				<$> liftAnnex (Remote.remoteFromUUID uuid)
+			mapM_ (queueremaining r) keys
+  where
+  	queueremaining r k = 
+		queueTransferWhenSmall "remaining object in unwanted remote"
+			Nothing (Transfer Download uuid k) r
+	{- Scanning for keys can take a long time; do not tie up
+	 - the Annex monad while doing it, so other threads continue to
+	 - run. -}
+	getkeys = do
+		a <- liftAnnex $ Annex.withCurrentState $ loggedKeysFor uuid
+		liftIO a
+
 finishRemovingRemote :: UrlRenderer -> UUID -> Assistant ()
 finishRemovingRemote urlrenderer uuid = do
 	void $ removeRemote uuid
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 01ea3c22b..46695469e 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -127,9 +127,8 @@ expensiveScan urlrenderer rs = unless onlyweb $ do
 
 	debug ["finished scan of", show visiblers]
 
-	nuke <- asIO1  $ finishRemovingRemote urlrenderer
-	liftIO $ forM_ (S.toList removablers) $
-		void . tryNonAsync . nuke
+	remove <- asIO1 $ removableRemote urlrenderer
+	liftIO $ mapM_ (void . tryNonAsync . remove) $ S.toList removablers
   where
 	onlyweb = all (== webUUID) $ map Remote.uuid rs
 	visiblers = let rs' = filter (not . Remote.readonly) rs