assistant: Clear the list of failed transfers when doing a full transfer scan. This prevents repeated retries to download files that are not available, or are not referenced by the current git tree.

This is motivated by a user report that the assistant was repeatedly
retrying transfers of files that had been deleted (in direct mode, so
removing the only copy).

Note that the glacier code retries failed transfers after a while to retry
downloads that have aged long enough to be available. This is ok; if we're
doing a full transfer scan we'll retry on every file that is still in the
git tree.

Also note that this makes the assistant less likely to get every file
referenced by old revs of the git tree. Not something the assistant tries
to ensure anyway, so I feel this is acceptable.

1 files changed, 7 insertions, 4 deletions

diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 5a6871fdb..631310987 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -81,8 +81,7 @@ transferScannerThread urlrenderer = namedThread "TransferScanner" $ do
 {- This is a cheap scan for failed transfers involving a remote. -}
 failedTransferScan :: Remote -> Assistant ()
 failedTransferScan r = do
-	failed <- liftAnnex $ getFailedTransfers (Remote.uuid r)
-	liftAnnex $ mapM_ removeFailedTransfer $ map fst failed
+	failed <- liftAnnex $ clearFailedTransfers (Remote.uuid r)
 	mapM_ retry failed
   where
 	retry (t, info)
@@ -98,7 +97,7 @@ failedTransferScan r = do
 			 - key, so it's not redundantly checked here. -}
 			requeue t info
 	requeue t info = queueTransferWhenSmall "retrying failed transfer" (associatedFile info) t r
-
+	
 {- This is a expensive scan through the full git work tree, finding
  - files to transfer. The scan is blocked when the transfer queue gets
  - too large. 
@@ -118,8 +117,12 @@ expensiveScan :: UrlRenderer -> [Remote] -> Assistant ()
 expensiveScan urlrenderer rs = unless onlyweb $ batch <~> do
 	debug ["starting scan of", show visiblers]
 
+	let us = map Remote.uuid rs
+
+	mapM_ (liftAnnex . clearFailedTransfers) us
+
 	unwantedrs <- liftAnnex $ S.fromList
-		<$> filterM inUnwantedGroup (map Remote.uuid rs)
+		<$> filterM inUnwantedGroup us
 
 	g <- liftAnnex gitRepo
 	(files, cleanup) <- liftIO $ LsFiles.inRepo [] g