webapp: Set locally paired repositories to a lower cost than other network remotes.

6 files changed, 27 insertions, 7 deletions

diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs
index 113018363..8d4e3a1ba 100644
--- a/Assistant/MakeRemote.hs
+++ b/Assistant/MakeRemote.hs
@@ -20,15 +20,17 @@ import qualified Command.InitRemote
 import Logs.UUID
 import Logs.Remote
 import Git.Remote
+import Config
 
 import qualified Data.Text as T
 import qualified Data.Map as M
 
 {- Sets up and begins syncing with a new ssh or rsync remote. -}
-makeSshRemote :: Bool -> SshData -> Assistant Remote
-makeSshRemote forcersync sshdata = do
+makeSshRemote :: Bool -> SshData -> Maybe Int -> Assistant Remote
+makeSshRemote forcersync sshdata mcost = do
 	r <- liftAnnex $
 		addRemote $ maker (sshRepoName sshdata) sshurl
+	liftAnnex $ maybe noop (setRemoteCost r) mcost
 	syncNewRemote r
 	return r
   where
diff --git a/Assistant/Pairing/MakeRemote.hs b/Assistant/Pairing/MakeRemote.hs
index 24a83b43c..e4aab434d 100644
--- a/Assistant/Pairing/MakeRemote.hs
+++ b/Assistant/Pairing/MakeRemote.hs
@@ -12,6 +12,7 @@ import Assistant.Ssh
 import Assistant.Pairing
 import Assistant.Pairing.Network
 import Assistant.MakeRemote
+import Config
 
 import Network.Socket
 import qualified Data.Text as T
@@ -42,7 +43,7 @@ finishedLocalPairing msg keypair = do
 			, "git-annex-shell -c configlist " ++ T.unpack (sshDirectory sshdata)
 			]
 			Nothing
-	void $ makeSshRemote False sshdata
+	void $ makeSshRemote False sshdata (Just semiExpensiveRemoteCost)
 
 {- Mostly a straightforward conversion.  Except:
  -  * Determine the best hostname to use to contact the host.
diff --git a/Config.hs b/Config.hs
index 2eaf17bf8..b732f982f 100644
--- a/Config.hs
+++ b/Config.hs
@@ -12,6 +12,7 @@ import qualified Git
 import qualified Git.Config
 import qualified Git.Command
 import qualified Annex
+import qualified Types.Remote as Remote
 
 type UnqualifiedConfigKey = String
 data ConfigKey = ConfigKey String
@@ -50,10 +51,15 @@ remoteCost c def = case remoteAnnexCostCommand c of
 			readProcess "sh" ["-c", cmd]
 	_ -> return $ fromMaybe def $ remoteAnnexCost c
 
+setRemoteCost :: Remote -> Int -> Annex ()
+setRemoteCost r c = setConfig (remoteConfig (Remote.repo r) "cost") (show c)
+
 cheapRemoteCost :: Int
 cheapRemoteCost = 100
 semiCheapRemoteCost :: Int
 semiCheapRemoteCost = 110
+semiExpensiveRemoteCost :: Int
+semiExpensiveRemoteCost = 175
 expensiveRemoteCost :: Int
 expensiveRemoteCost = 200
 veryExpensiveRemoteCost :: Int
@@ -68,9 +74,10 @@ prop_cost_sane :: Bool
 prop_cost_sane = False `notElem`
 	[ expensiveRemoteCost > 0
 	, cheapRemoteCost < semiCheapRemoteCost
-	, semiCheapRemoteCost < expensiveRemoteCost
+	, semiCheapRemoteCost < semiExpensiveRemoteCost
+	, semiExpensiveRemoteCost < expensiveRemoteCost
 	, cheapRemoteCost + encryptedRemoteCostAdj > semiCheapRemoteCost
-	, cheapRemoteCost + encryptedRemoteCostAdj < expensiveRemoteCost
+	, cheapRemoteCost + encryptedRemoteCostAdj < semiExpensiveRemoteCost
 	, semiCheapRemoteCost + encryptedRemoteCostAdj < expensiveRemoteCost
 	]
 
diff --git a/debian/changelog b/debian/changelog
index 3b2723478..f714ae231 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -50,7 +50,6 @@ git-annex (4.20130228) UNRELEASED; urgency=low
     ssh key does not force a command.
   * assistant: Be smarter about avoiding unncessary transfers.
 
-  * webapp: DTRT when told to create a git repo that already exists.
   * webapp: Work around bug in Warp's slowloris attack prevention code,
     that caused regular browsers to stall when they reuse a connection
     after leaving it idle for 30 seconds.
@@ -60,6 +59,9 @@ git-annex (4.20130228) UNRELEASED; urgency=low
   * webapp: Proceed automatically on from "Configure jabber account"
     to pairing.
   * webapp: Only show up to 10 queued transfers.
+  * webapp: DTRT when told to create a git repo that already exists.
+  * webapp: Set locally paired repositories to a lower cost than other
+    network remotes.
 
   * Run ssh with -T to avoid tty allocation and any login scripts that
     may do undesired things with it.
diff --git a/doc/assistant/release_notes.mdwn b/doc/assistant/release_notes.mdwn
index aa79cd9b7..bdd37cafe 100644
--- a/doc/assistant/release_notes.mdwn
+++ b/doc/assistant/release_notes.mdwn
@@ -1,3 +1,9 @@
+## version 4.20130314
+
+If you have already used the webapp to locally pair two computers,
+you're recommended to configure the cost of each to be 175, so
+it is used in preference to more expensive remotes on the network.
+
 ## version 4.20130227
 
 This release fixes a bug with globbing that broke preferred content expressions.
diff --git a/doc/bugs/smarter_flood_filling.mdwn b/doc/bugs/smarter_flood_filling.mdwn
index a2a4f2ce5..47b6942c7 100644
--- a/doc/bugs/smarter_flood_filling.mdwn
+++ b/doc/bugs/smarter_flood_filling.mdwn
@@ -10,12 +10,14 @@ It occurred to me this morning that there is a simple change that can avoid
 this.
 
 1. Ensure that locally paired computers have a lower cost than network
-   transfer remotes.
+   transfer remotes. (done)
 2. When queuing uploads, queue transfers to the lowest cost remotes first.
    (already done)
 3. Just before starting a transfer, re-check if the transfer is still wanted.
    (done)
 
+> [[done]]
+
 Now, unnecessary transfers to tranfer repos are avoided if it can send
 the file locally instead.