run full transfer scan on all remotes at startup

Or when a remote first becomes available after startup.

3 files changed, 39 insertions, 17 deletions

diff --git a/Assistant/ScanRemotes.hs b/Assistant/ScanRemotes.hs
index 637522196..85a29584e 100644
--- a/Assistant/ScanRemotes.hs
+++ b/Assistant/ScanRemotes.hs
@@ -41,9 +41,9 @@ getScanRemote v = atomically $ do
 			return ret
 
 {- Adds new remotes that need scanning to the map. -}
-addScanRemotes :: ScanRemoteMap -> [Remote] -> Bool -> IO ()
-addScanRemotes _ [] _ = noop
-addScanRemotes v rs full = atomically $ do
+addScanRemotes :: ScanRemoteMap -> Bool -> [Remote] -> IO ()
+addScanRemotes _ _ [] = noop
+addScanRemotes v full rs = atomically $ do
 	m <- fromMaybe M.empty <$> tryTakeTMVar v
 	putTMVar v $ M.unionWith merge (M.fromList $ zip rs (map info rs)) m
 	where
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index 6a586e097..35b300f39 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -40,13 +40,13 @@ reconnectRemotes threadname st dstatus scanremotes rs = void $
 	where
 		sync (Just branch) = do
 			diverged <- manualPull st (Just branch) rs
-			addScanRemotes scanremotes rs diverged
+			addScanRemotes scanremotes diverged rs
 			now <- getCurrentTime	
 			pushToRemotes threadname now st Nothing rs
 		{- No local branch exists yet, but we can try pulling. -}
 		sync Nothing = do
 			diverged <- manualPull st Nothing rs
-			addScanRemotes scanremotes rs diverged
+			addScanRemotes scanremotes diverged rs
 			return True
 
 {- Updates the local sync branch, then pushes it to all remotes, in
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index d1d27e480..38b76cfae 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -29,17 +29,36 @@ thisThread = "TransferScanner"
  -}
 transferScannerThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> TransferQueue -> IO ()
 transferScannerThread st dstatus scanremotes transferqueue = do
+	startupScan
 	runEvery (Seconds 2) $ do
 		(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]
+			then expensiveScan st dstatus transferqueue r
 			else failedTransferScan st dstatus transferqueue r
+	where
+		{- All remotes are scanned in full on startup, for multiple
+		 - reasons, including:
+		 -
+		 - * This may be the first run, and there may be remotes
+		 -   already in place, that need to be synced.
+		 - * We may have run before, and scanned a remote, but
+		 -   only been in a subdirectory of the git remote, and so
+		 -   not synced it all.
+		 - * We may have run before, and had transfers queued,
+		 -   and then the system (or us) crashed, and that info was
+		 -   lost.
+		 -
+		 - But not all remotes may be available now. So all
+		 - prior indications that remotes have been scanned
+		 - are first removed.
+		 -}
+		startupScan = do
+			removeDirectoryRecursive
+				=<< runThreadState st (fromRepo transferScannedDir)
+			addScanRemotes scanremotes True
+				=<< knownRemotes <$> getDaemonStatus dstatus
 
 {- This is a cheap scan for failed transfers involving a remote. -}
 failedTransferScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO ()
@@ -77,14 +96,17 @@ failedTransferScan st dstatus transferqueue r = do
 {- This is a expensive scan through the full git work tree.
  - 
  - The scan is blocked when the transfer queue gets too large. -}
-expensiveScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO Bool
+expensiveScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO ()
 expensiveScan st dstatus transferqueue r = do
-	g <- runThreadState st $ fromRepo id
-	files <- LsFiles.inRepo [] g
-	go files
-	runThreadState st $ inRepo $
-		transferScanned $ Remote.uuid r
-	return True
+	liftIO $ debug thisThread ["starting scan of", show r]
+	void $ alertWhile dstatus (scanAlert r) $ do
+		g <- runThreadState st $ fromRepo id
+		files <- LsFiles.inRepo [] g
+		go files
+		runThreadState st $ inRepo $
+			transferScanned $ Remote.uuid r
+		return True
+	liftIO $ debug thisThread ["finished scan of", show r]
 	where
 		go [] = noop
 		go (f:fs) = do