diff options
author | Joey Hess <joey@kitenet.net> | 2013-04-02 15:51:58 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-04-02 15:51:58 -0400 |
commit | 0367b5e8318b47d0cb86610034d63919d174ff3a (patch) | |
tree | 5f66facb98c69a384c22b0a45f343e0f0a7335a2 /Assistant | |
parent | aafd1419d1310b0e45f5a055e7bfa913c974d519 (diff) |
avoid queueing uploads to remotes that already have the content
Diffstat (limited to 'Assistant')
-rw-r--r-- | Assistant/TransferQueue.hs | 24 |
1 files changed, 16 insertions, 8 deletions
diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index 5974c70d1..5f68ba628 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -32,6 +32,7 @@ import Annex.Wanted import Control.Concurrent.STM import qualified Data.Map as M +import qualified Data.Set as S type Reason = String @@ -58,6 +59,7 @@ queueTransfersMatching matching reason schedule k f direction | otherwise = go where go = do + rs <- liftAnnex . selectremotes =<< syncDataRemotes <$> getDaemonStatus let matchingrs = filter (matching . Remote.uuid) rs @@ -67,15 +69,21 @@ queueTransfersMatching matching reason schedule k f direction enqueue reason schedule (gentransfer r) (stubInfo f r) selectremotes rs {- Queue downloads from all remotes that - - have the key, with the cheapest ones first. - - More expensive ones will only be tried if - - downloading from a cheap one fails. -} + - have the key. The list of remotes is ordered with + - cheapest first. More expensive ones will only be tried + - if downloading from a cheap one fails. -} | direction == Download = do - uuids <- Remote.keyLocations k - return $ filter (\r -> uuid r `elem` uuids) rs - {- Upload to all remotes that want the content. -} - | otherwise = filterM (wantSend True f . Remote.uuid) $ - filter (not . Remote.readonly) rs + s <- locs + return $ filter (inset s) rs + {- Upload to all remotes that want the content and don't + - already have it. -} + | otherwise = do + s <- locs + filterM (wantSend True f . Remote.uuid) $ + filter (\r -> not (inset s r || Remote.readonly r)) rs + where + locs = S.fromList <$> Remote.keyLocations k + inset s r = S.member (Remote.uuid r) s gentransfer r = Transfer { transferDirection = direction , transferKey = k |