summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-09-17 14:58:43 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-09-17 14:58:43 -0400
commit7a86dc944306af4d0a707631b03ef93941ecc1be (patch)
tree5f5464144b53c92b5403f4f9c8c0e397f36052c9
parent1e37c0c5fc655dc7d6f6c6d2417e7ba79e6395f7 (diff)
cleanup
-rw-r--r--Assistant/Threads/TransferScanner.hs26
-rw-r--r--Logs/Transfer.hs9
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