From 0367b5e8318b47d0cb86610034d63919d174ff3a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 2 Apr 2013 15:51:58 -0400
Subject: avoid queueing uploads to remotes that already have the content

---
 Assistant/TransferQueue.hs | 24 ++++++++++++++++--------
 debian/changelog           |  1 +
 2 files changed, 17 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
diff --git a/debian/changelog b/debian/changelog
index 2e29c2cee..62c5ac62b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -27,6 +27,7 @@ git-annex (4.20130324) UNRELEASED; urgency=low
   * assistant: Fix bug that could cause direct mode files to be unstaged
     from git.
   * Update working tree files fully atomically.
+  * webapp: Improved transfer queue management.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 25 Mar 2013 10:21:46 -0400
 
-- 
cgit v1.2.3