keep logs of failed transfers, and requeue them when doing a non-full scan

of a remote

Assistant/Threads/TransferScanner.hs

@@ -30,24 +30,45 @@ thisThread = "TransferScanner"
 transferScannerThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> TransferQueue -> IO ()
 transferScannerThread st dstatus scanremotes transferqueue = do
 	runEvery (Seconds 2) $ do
-		r <- getScanRemote scanremotes
-		liftIO $ debug thisThread ["starting scan of", show r]
-		void $ alertWhile dstatus (scanAlert r) $
-			scan st dstatus transferqueue r
-		liftIO $ debug thisThread ["finished scan of", show r]
+		(r, info) <- getScanRemote scanremotes
+		scanned <- runThreadState st $ inRepo $
+			checkTransferScanned $ Remote.uuid r
+		if not scanned || fullScan info
+			then do
+				liftIO $ debug thisThread ["starting scan of", show r]
+				void $ alertWhile dstatus (scanAlert r) $
+					expensiveScan st dstatus transferqueue r
+				liftIO $ debug thisThread ["finished scan of", show r]
+				runThreadState st $ inRepo $
+					transferScanned $ Remote.uuid r
+			else failedTransferScan st dstatus transferqueue r
 
-{- This is a naive scan through the git work tree.
+{- This is a cheap scan for failed transfers involving a remote. -}
+failedTransferScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO ()
+failedTransferScan st dstatus transferqueue r = do
+	ts <- runThreadState st $ 
+		getFailedTransfers $ Remote.uuid r
+	go ts
+	where
+		go [] = noop
+		go ((t, info):ts) = do
+			queueTransferWhenSmall
+				transferqueue dstatus (associatedFile info) t r
+			void $ runThreadState st $ inRepo $
+				liftIO . tryIO . removeFile . failedTransferFile t
+			go ts
+
+{- This is a expensive scan through the full git work tree.
  - 
  - The scan is blocked when the transfer queue gets too large. -}
-scan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO Bool
-scan st dstatus transferqueue r = do
+expensiveScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO Bool
+expensiveScan st dstatus transferqueue r = do
 	g <- runThreadState st $ fromRepo id
 	files <- LsFiles.inRepo [] g
 	go files
-	inRepo $ transferScanned $ uuid r
 	return True
 	where
-		go [] = return ()
+		go [] = noop
 		go (f:fs) = do
 			v <- runThreadState st $ whenAnnexed check f
 			case v of
@@ -67,8 +88,7 @@ scan st dstatus transferqueue r = do
 					| otherwise = return Nothing
 				
 		u = Remote.uuid r
-		enqueue f t = queueTransferAt smallsize Later transferqueue dstatus (Just f) t r
-		smallsize = 10
+		enqueue f t = queueTransferWhenSmall transferqueue dstatus (Just f) t r
 
 		{- Look directly in remote for the key when it's cheap;
 		 - otherwise rely on the location log. -}