reorg remote key presense checking code

Also, it now checks if a key is inAnnex, ie, cached in .git/annex, not if
it is present in a remote. For the File Backend, these are equivilant, not
so for other backends.

3 files changed, 40 insertions, 32 deletions

diff --git a/Backend/File.hs b/Backend/File.hs
index 3396db3e5..dbd067428 100644
--- a/Backend/File.hs
+++ b/Backend/File.hs
@@ -44,24 +44,15 @@ mustProvide = error "must provide this field"
 dummyStore :: FilePath -> Key -> Annex (Bool)
 dummyStore file key = return True
 
-{- Just check if the .git/annex/ file for the key exists. 
- -
- - But, if running against a remote annex, need to use ssh to do it. -}
+{- Just check if the .git/annex/ file for the key exists. -}
 checkKeyFile :: Key -> Annex Bool
-checkKeyFile k = do
-	g <- Annex.gitRepo
-	if (not $ Git.repoIsUrl g)
-		then inAnnex k
-		else do
-			showNote ("checking " ++ Git.repoDescribe g ++ "...")
-			liftIO $ boolSystem "ssh" [Git.urlHost g,
-				"test -e " ++ (shellEscape $ annexLocation g k)]
+checkKeyFile k = inAnnex k
 
 {- Try to find a copy of the file in one of the remotes,
  - and copy it over to this one. -}
 copyKeyFile :: Key -> FilePath -> Annex (Bool)
 copyKeyFile key file = do
-	remotes <- Remotes.withKey key
+	remotes <- Remotes.keyPossibilities key
 	if (null remotes)
 		then do
 			showNote "not available"
@@ -97,7 +88,6 @@ copyFromRemote r key file = do
 		getlocal = boolSystem "cp" ["-a", location, file]
 		getssh = do
 			liftIO $ putStrLn "" -- make way for scp progress bar
-			-- TODO double-shell-quote path for scp
 			boolSystem "scp" [sshlocation, file]
 		location = annexLocation r key
 		sshlocation = (Git.urlHost r) ++ ":" ++ location
@@ -112,7 +102,7 @@ checkRemoveKey key = do
 		then return True
 		else do
 			g <- Annex.gitRepo
-			remotes <- Remotes.withKey key
+			remotes <- Remotes.keyPossibilities key
 			let numcopies = read $ Git.configGet g config "1"
 			if (numcopies > length remotes)
 				then notEnoughCopies numcopies (length remotes) []
@@ -124,18 +114,11 @@ checkRemoveKey key = do
 				then return True
 				else notEnoughCopies need have bad
 		findcopies need have (r:rs) bad = do
-			all <- Annex.supportedBackends
-			result <- liftIO $ ((try $ remoteHasKey r all)::IO (Either SomeException Bool))
-			case (result) of
+			haskey <- Remotes.inAnnex r key
+			case (haskey) of
 				Right True	-> findcopies need (have+1) rs bad
 				Right False	-> findcopies need have rs bad
 				Left _		-> findcopies need have rs (r:bad)
-		remoteHasKey remote all = do
-			-- To check if a remote has a key, construct a new
-			-- Annex monad and query its backend.
-			a <- Annex.new remote all
-			(result, _) <- Annex.run a (Backend.hasKey key)
-			return result
 		notEnoughCopies need have bad = do
 			unsafe
 			showLongNote $
diff --git a/Core.hs b/Core.hs
index 4941dc26b..da05823bb 100644
--- a/Core.hs
+++ b/Core.hs
@@ -62,11 +62,19 @@ gitAttributes repo = do
 			Git.run repo ["commit", "-m", "git-annex setup", 
 					attributes]
 
-{- Checks if a given key is currently present in the annexLocation -}
+{- Checks if a given key is currently present in the annexLocation.
+ -
+ - This can be run against a remote repository to check the key there. -}
 inAnnex :: Key -> Annex Bool
 inAnnex key = do
 	g <- Annex.gitRepo
-	liftIO $ doesFileExist $ annexLocation g key
+	if (not $ Git.repoIsUrl g)
+		then liftIO $ doesFileExist $ annexLocation g key
+		else do
+			showNote ("checking " ++ Git.repoDescribe g ++ "...")
+			liftIO $ boolSystem "ssh" [Git.urlHost g,
+				"test -e " ++
+				(shellEscape $ annexLocation g key)]
 
 {- Calculates the relative path to use to link a file to a key. -}
 calcGitLink :: FilePath -> Key -> Annex FilePath
diff --git a/Remotes.hs b/Remotes.hs
index f24da2c22..13f66aae2 100644
--- a/Remotes.hs
+++ b/Remotes.hs
@@ -2,8 +2,9 @@
 
 module Remotes (
 	list,
-	withKey,
-	tryGitConfigRead
+	keyPossibilities,
+	tryGitConfigRead,
+	inAnnex
 ) where
 
 import Control.Exception
@@ -18,18 +19,19 @@ import Maybe
 import Types
 import qualified GitRepo as Git
 import qualified Annex
+import qualified Backend
 import LocationLog
 import Locations
 import UUID
-import Core
+import qualified Core
 
 {- Human visible list of remotes. -}
 list :: [Git.Repo] -> String
 list remotes = join ", " $ map Git.repoDescribe remotes 
 
 {- Cost ordered list of remotes that the LocationLog indicate may have a key. -}
-withKey :: Key -> Annex [Git.Repo]
-withKey key = do
+keyPossibilities :: Key -> Annex [Git.Repo]
+keyPossibilities key = do
 	g <- Annex.gitRepo
 	uuids <- liftIO $ keyLocations g key
 	allremotes <- remotesByCost
@@ -50,20 +52,35 @@ withKey key = do
 			let expensive = filter Git.repoIsUrl allremotes
 			doexpensive <- filterM cachedUUID expensive
 			if (not $ null doexpensive)
-				then showNote $ "getting UUIDs for " ++ (list doexpensive) ++ "..."
+				then Core.showNote $ "getting UUIDs for " ++ (list doexpensive) ++ "..."
 				else return ()
 			let todo = cheap ++ doexpensive
 			if (not $ null todo)
 				then do
 					e <- mapM tryGitConfigRead todo
 					Annex.flagChange "remotesread" $ FlagBool True
-					withKey key
+					keyPossibilities key
 				else reposByUUID allremotes uuids
 	where
 		cachedUUID r = do
 			u <- getUUID r
 			return $ null u 
 
+{- Checks if a given remote has the content for a key inAnnex.
+ -
+ - This is done by constructing a new Annex monad using the remote.
+ -
+ - If the remote cannot be accessed, returns a Left error.
+ -}
+inAnnex :: Git.Repo -> Key -> Annex (Either IOException Bool)
+inAnnex remote key = do
+	a <- liftIO $ Annex.new remote []
+	liftIO $ ((try $ check a)::IO (Either IOException Bool))
+	where
+		check a = do
+			(result, _) <- Annex.run a (Core.inAnnex key)
+			return result
+
 {- Cost Ordered list of remotes. -}
 remotesByCost :: Annex [Git.Repo]
 remotesByCost = do