diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-09-18 14:24:51 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-09-18 14:24:51 -0400 |
| commit | 9f05d19108f8a35c83c9a5075783b68f203e756f (patch) | |
| tree | ac11c1210dbfe9d6b80f8d73b2241197e67f4611 /Assistant | |
| parent | 3a0cffcfed4e6824b0771ce69f70095a4e3b9917 (diff) | |
avoid sending uploads right back to where the download came from
Just an optimisation.
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Threads/TransferWatcher.hs | 4 | ||||
| -rw-r--r-- | Assistant/TransferQueue.hs | 13 |
2 files changed, 13 insertions, 4 deletions
diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index e62e3db3a..ce0708a91 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -86,7 +86,9 @@ onDel st dstatus transferqueue file _ = case parseTransferFile file of - spreading them out to other reachable remotes. -} case (minfo, transferDirection t) of (Just info, Download) -> runThreadState st $ - queueTransfers Later transferqueue dstatus + queueTransfersMatching + (/= transferUUID t) + Later transferqueue dstatus (transferKey t) (associatedFile info) Upload diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index 21479d04d..1941c23ef 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -11,6 +11,7 @@ module Assistant.TransferQueue ( newTransferQueue, getTransferQueue, queueTransfers, + queueTransfersMatching, queueDeferredDownloads, queueTransfer, queueTransferAt, @@ -57,12 +58,18 @@ stubInfo f r = stubTransferInfo {- Adds transfers to queue for some of the known remotes. -} queueTransfers :: Schedule -> TransferQueue -> DaemonStatusHandle -> Key -> AssociatedFile -> Direction -> Annex () -queueTransfers schedule q dstatus k f direction = do +queueTransfers = queueTransfersMatching (const True) + +{- Adds transfers to queue for some of the known remotes, that match a + - predicate. -} +queueTransfersMatching :: (UUID -> Bool) -> Schedule -> TransferQueue -> DaemonStatusHandle -> Key -> AssociatedFile -> Direction -> Annex () +queueTransfersMatching pred schedule q dstatus k f direction = do rs <- sufficientremotes =<< knownRemotes <$> liftIO (getDaemonStatus dstatus) - if null rs + let matchingrs = filter (pred . Remote.uuid) rs + if null matchingrs then defer - else forM_ rs $ \r -> liftIO $ + else forM_ matchingrs $ \r -> liftIO $ enqueue schedule q dstatus (gentransfer r) (stubInfo f r) where sufficientremotes rs |