cost bugfixes

Config.hs

@@ -42,14 +42,17 @@ remoteConfig r key = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex
  - The default cost is 100 for local repositories, and 200 for remote
  - repositories; it can also be configured by remote.<name>.annex-cost
  -}
-remoteCost :: Git.Repo -> Annex Int
-remoteCost r = do
+remoteCost :: Git.Repo -> Int -> Annex Int
+remoteCost r def = do
 	c <- getConfig r "cost" ""
 	if not $ null c
 		then return $ read c
-		else if not $ Git.repoIsUrl r
-			then return 100
-			else return 200
+		else return def
+
+cheapRemoteCost :: Int
+cheapRemoteCost = 100
+expensiveRemoteCost :: Int
+expensiveRemoteCost = 200
 
 {- Checks if a repo should be ignored, based either on annex-ignore
  - setting, or on command-line options. Allows command-line to override

Remote.hs

@@ -75,8 +75,7 @@ genList = do
 			mapM (gen m t) l'
 		gen m t r = do
 			u <- getUUID r
-			cst <- remoteCost r
-			generate t r u cst (M.lookup u m)
+			generate t r u (M.lookup u m)
 
 {- Looks up a remote by name. (Or by UUID.) -}
 byName :: String -> Annex (Remote Annex)

Remote/Directory.hs

@@ -35,9 +35,10 @@ remote = RemoteType {
 	setup = directorySetup
 }
 
-gen :: Git.Repo -> UUID -> Cost -> Maybe (M.Map String String) -> Annex (Remote Annex)
-gen r u cst _ = do
+gen :: Git.Repo -> UUID -> Maybe (M.Map String String) -> Annex (Remote Annex)
+gen r u _ = do
 	dir <- getConfig r "directory" (error "missing directory")
+	cst <- remoteCost r cheapRemoteCost
 	return $ Remote {
 		uuid = u,
 		cost = cst,

Remote/Git.hs

@@ -42,8 +42,8 @@ list = do
 	g <- Annex.gitRepo
 	return $ Git.remotes g
 
-gen :: Git.Repo -> UUID -> Cost -> Maybe (M.Map String String) -> Annex (Remote Annex)
-gen r u cst _ = do
+gen :: Git.Repo -> UUID -> Maybe (M.Map String String) -> Annex (Remote Annex)
+gen r u _ = do
  	{- It's assumed to be cheap to read the config of non-URL remotes,
 	 - so this is done each time git-annex is run. Conversely,
 	 - the config of an URL remote is only read when there is no
@@ -54,6 +54,11 @@ gen r u cst _ = do
 		(False, "") -> tryGitConfigRead r
 		_ -> return r
 
+	let defcst = if not $ Git.repoIsUrl r
+		then cheapRemoteCost
+		else expensiveRemoteCost
+	cst <- remoteCost r' defcst
+
 	return $ Remote {
 		uuid = u,
 		cost = cst,

Remote/S3real.hs

@@ -26,6 +26,7 @@ import qualified Annex
 import UUID
 import Messages
 import Locations
+import Config
 import Remote.Special
 
 remote :: RemoteType Annex
@@ -36,25 +37,28 @@ remote = RemoteType {
 	setup = s3Setup
 }
 
-gen :: Git.Repo -> UUID -> Cost -> Maybe (M.Map String String) -> Annex (Remote Annex)
-gen r u cst c = return this
+gen :: Git.Repo -> UUID -> Maybe (M.Map String String) -> Annex (Remote Annex)
+gen r u c = do
+	cst <- remoteCost r expensiveRemoteCost
+	return $ this cst
 	where
-		this = Remote {
+		this cst = Remote {
 			uuid = u,
 			cost = cst,
 			name = Git.repoDescribe r,
-	 		storeKey = store this,
-			retrieveKeyFile = retrieve this,
-			removeKey = remove this,
-			hasKey = checkPresent this,
+	 		storeKey = store (this cst),
+			retrieveKeyFile = retrieve (this cst),
+			removeKey = remove (this cst),
+			hasKey = checkPresent (this cst),
 			hasKeyCheap = False,
 			config = c
 		}
 
-s3Connection :: M.Map String String -> IO AWSConnection
+s3Connection :: M.Map String String -> Annex AWSConnection
 s3Connection c = do
 	ak <- getEnvKey "AWS_ACCESS_KEY_ID"
 	sk <- getEnvKey "AWS_SECRET_ACCESS_KEY"
+	when (null ak || null sk) $ warning "Set both AWS_ACCESS_KEY_ID and AWS_SECRET_ACCESS_KEY to use S3"
 	return $ AWSConnection host port ak sk
 	where
 		host = fromJust $ (M.lookup "host" c)
@@ -62,7 +66,7 @@ s3Connection c = do
 			case reads s of
 			[(p, _)] -> p
 			_ -> error $ "bad S3 port value: " ++ s
-		getEnvKey s = catch (getEnv s) (error $ "Set " ++ s)
+		getEnvKey s = liftIO $ catch (getEnv s) (const $ return "")
 
 s3Setup :: UUID -> M.Map String String -> Annex (M.Map String String)
 s3Setup u c = do
@@ -75,7 +79,7 @@ s3Setup u c = do
 
 	-- check bucket location to see if the bucket exists, and create it
 	let datacenter = fromJust $ M.lookup "datacenter" fullconfig
-	conn <- liftIO $ s3Connection fullconfig
+	conn <- s3Connection fullconfig
 	showNote "checking bucket"
 	loc <- liftIO $ getBucketLocation conn bucket 
 	case loc of
@@ -105,7 +109,7 @@ s3Action :: Remote Annex -> ((AWSConnection, String) -> Annex a) -> Annex a
 s3Action r a = do
 	when (config r == Nothing) $
 		error $ "Missing configuration for special remote " ++ name r
-	conn <- liftIO $ s3Connection (fromJust $ config r)
+	conn <- s3Connection (fromJust $ config r)
 	let bucket = fromJust $ M.lookup "bucket" $ fromJust $ config r
 	a (conn, bucket)
 

RemoteClass.hs

@@ -15,8 +15,6 @@ import Data.Map as M
 import qualified GitRepo as Git
 import Key
 
-type Cost = Int
-
 {- There are different types of remotes. -}
 data RemoteType a = RemoteType {
 	-- human visible type name
@@ -24,7 +22,7 @@ data RemoteType a = RemoteType {
 	-- enumerates remotes of this type
 	enumerate :: a [Git.Repo],
 	-- generates a remote of this type
-	generate :: Git.Repo -> String -> Cost -> Maybe (M.Map String String) -> a (Remote a),
+	generate :: Git.Repo -> String -> Maybe (M.Map String String) -> a (Remote a),
 	-- initializes or changes a remote
 	setup :: String -> M.Map String String -> a (M.Map String String)
 }
@@ -36,7 +34,7 @@ data Remote a = Remote {
 	-- each Remote has a human visible name
 	name :: String,
 	-- Remotes have a use cost; higher is more expensive
-	cost :: Cost,
+	cost :: Int,
 	-- Transfers a key to the remote.
 	storeKey :: Key -> a Bool,
 	-- retrieves a key's contents to a file
@@ -54,7 +52,7 @@ data Remote a = Remote {
 }
 
 instance Show (Remote a) where
-	show remote = "Remote { uuid =\"" ++ uuid remote ++ "\" }"
+	show remote = "Remote { name =\"" ++ name remote ++ "\" }"
 
 -- two remotes are the same if they have the same uuid
 instance Eq (Remote a) where