diff options
author | Joey Hess <joey@kitenet.net> | 2012-09-17 14:58:43 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-09-17 14:58:43 -0400 |
commit | 7a86dc944306af4d0a707631b03ef93941ecc1be (patch) | |
tree | 5f5464144b53c92b5403f4f9c8c0e397f36052c9 | |
parent | 1e37c0c5fc655dc7d6f6c6d2417e7ba79e6395f7 (diff) |
cleanup
-rw-r--r-- | Assistant/Threads/TransferScanner.hs | 26 | ||||
-rw-r--r-- | Logs/Transfer.hs | 9 |
2 files changed, 17 insertions, 18 deletions
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index d8719f027..d3436bd25 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -65,35 +65,25 @@ transferScannerThread st dstatus scanremotes transferqueue = thread $ do {- 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 + failed <- runThreadState st $ getFailedTransfers (Remote.uuid r) + runThreadState st $ mapM_ removeFailedTransfer $ map fst failed + mapM_ retry failed where - go [] = noop - go ((t, info):ts) + retry (t, info) | transferDirection t == Download = do {- Check if the remote still has the key. - If not, relies on the expensiveScan to - get it queued from some other remote. -} - ifM (runThreadState st $ remoteHas r $ transferKey t) - ( requeue t info - , dequeue t - ) - go ts + whenM (runThreadState st $ remoteHas r $ transferKey t) $ + requeue t info | otherwise = do {- The Transferrer checks when uploading - that the remote doesn't already have the - key, so it's not redundantly checked - here. -} requeue t info - go ts - - requeue t info = do - queueTransferWhenSmall - transferqueue dstatus (associatedFile info) t r - dequeue t - dequeue t = void $ runThreadState st $ inRepo $ - liftIO . tryIO . removeFile . failedTransferFile t + requeue t info = queueTransferWhenSmall + transferqueue dstatus (associatedFile info) t r {- This is a expensive scan through the full git work tree, finding - files to download from or upload to any of the remotes. diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index a641c4882..21d2d2c97 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -10,6 +10,7 @@ module Logs.Transfer where import Common.Annex import Annex.Perms import Annex.Exception +import Annex.UUID import qualified Git import Types.Remote import Types.Key @@ -48,6 +49,9 @@ data TransferInfo = TransferInfo } deriving (Show, Eq, Ord) +stubTransferInfo :: TransferInfo +stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing Nothing False + data Direction = Upload | Download deriving (Eq, Ord, Read, Show) @@ -164,6 +168,11 @@ getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles =<< mapM (fromRepo . failedTransferDir u) [Download, Upload] +removeFailedTransfer :: Transfer -> Annex () +removeFailedTransfer t = do + f <- fromRepo $ failedTransferFile t + liftIO $ void $ tryIO $ removeFile f + {- The transfer information file to use for a given Transfer. -} transferFile :: Transfer -> Git.Repo -> FilePath transferFile (Transfer direction u key) r = transferDir direction r |