annex.numcopies works

Backend.hs

@@ -15,8 +15,9 @@
 
 module Backend (
 	storeFileKey,
-	removeKey,
 	retrieveKeyFile,
+	removeKey,
+	hasKey,
 	lookupFile
 ) where
 
@@ -77,6 +78,18 @@ retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest
 removeKey :: Backend -> Key -> Annex Bool
 removeKey backend key = (B.removeKey backend)  key
 
+{- Checks if any backend has a key. -}
+hasKey :: Key -> Annex Bool
+hasKey key = do
+	b <- backendList
+	hasKey' b key
+hasKey' [] key = return False
+hasKey' (b:bs) key = do
+	has <- (B.hasKey b) key
+	if (has)
+		then return True
+		else hasKey' bs key
+
 {- Looks up the key and backend corresponding to an annexed file,
  - by examining what the file symlinks to. -}
 lookupFile :: FilePath -> IO (Maybe (Key, Backend))

Backend/File.hs

@@ -15,6 +15,8 @@ import qualified Remotes
 import qualified GitRepo as Git
 import Utility
 import Core
+import qualified Annex
+import UUID
 
 backend = Backend {
 	name = "file",
@@ -49,6 +51,9 @@ checkKeyFile k = inAnnex backend k
 copyKeyFile :: Key -> FilePath -> Annex (Bool)
 copyKeyFile key file = do
 	remotes <- Remotes.withKey key
+	if (0 == length remotes)
+		then cantfind
+		else return ()
 	trycopy remotes remotes
 	where
 		trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++
@@ -68,6 +73,14 @@ copyKeyFile key file = do
 							liftIO $ hPutStrLn stderr (show err)
 							trycopy full rs
 				                Right succ -> return True
+		cantfind = do
+			g <- Annex.gitRepo
+			uuids <- liftIO $ keyLocations g key
+			error $ "no available git remotes have: " ++
+				(keyFile key) ++ (uuidlist uuids)
+		uuidlist [] = ""
+		uuidlist uuids = "\nIt has been seen before in these repositories:\n" ++
+				prettyPrintUUIDs uuids
 
 {- Tries to copy a file from a remote, exception on error. -}
 copyFromRemote :: Git.Repo -> Key -> FilePath -> IO ()

Commands.hs

@@ -8,6 +8,7 @@ import System.Posix.Files
 import System.Directory
 import Data.String.Utils
 import List
+import IO
 import qualified GitRepo as Git
 import qualified Annex
 import Utility
@@ -18,6 +19,7 @@ import UUID
 import LocationLog
 import Types
 import Core
+import qualified Remotes
 
 options :: [OptDescr (String -> Annex ())]
 options =
@@ -138,7 +140,7 @@ wantCmd file = do error "not implemented" -- TODO
 {- Indicates a file is not wanted. -}
 dropCmd :: FilePath -> Annex ()
 dropCmd file = notinBackend file err $ \(key, backend) -> do
-	-- TODO only remove if enough copies are present elsewhere
+	requireEnoughCopies key
 	success <- Backend.removeKey backend key
 	if (success)
 		then do
@@ -181,3 +183,40 @@ inBackend file yes no = do
 		Just v -> yes v
 		Nothing -> no
 notinBackend file yes no = inBackend file no yes
+
+{- Checks remotes to verify that enough copies of a key exist to allow
+ - for a key to be safely removed (with no data loss), and fails with an
+ - error if not. -}
+requireEnoughCopies :: Key -> Annex ()
+requireEnoughCopies key = do
+	g <- Annex.gitRepo
+	let numcopies = read $ Git.configGet g config "1"
+	remotes <- Remotes.withKey key
+	if (numcopies > length remotes)
+		then error $ "I only know about " ++ (show $ length remotes) ++ 
+			" out of " ++ (show numcopies) ++ 
+			" necessary copies of: " ++ (keyFile key) ++
+			unsafe
+		else findcopies numcopies remotes []
+	where
+		findcopies 0 _ _ = return () -- success, enough copies found
+		findcopies _ [] bad = die bad
+		findcopies n (r:rs) bad = do
+			result <- liftIO $ try $ haskey r
+			case (result) of
+				Right True -> findcopies (n-1) rs bad
+				Left _ -> findcopies n rs (r:bad)
+		haskey r = do
+			-- To check if a remote has a key, construct a new
+			-- Annex monad and query its backend.
+			a <- Annex.new r
+			(result, _) <- Annex.run a (Backend.hasKey key)
+			return result
+		die bad =
+			error $ "I failed to find enough other copies of: " ++
+				(keyFile key) ++ "\n" ++
+				"I was unable to access these remotes: " ++
+				(Remotes.list bad) ++ unsafe
+		unsafe = "\n  -- According to the " ++ config ++
+			" setting, it is not safe to remove it!"
+		config = "annex.numcopies"

Remotes.hs

@@ -40,15 +40,7 @@ withKey key = do
 			mayberemotes <- mapM tryGitConfigRead allremotes
 			let allremotes' = catMaybes mayberemotes
 			remotes' <- reposByUUID allremotes' uuids
-			if (0 == length remotes')
+			return remotes'
-				then err uuids
-				else return remotes'
-		err uuids = 
-			error $ "no available git remotes have: " ++
-				(keyFile key) ++ (uuidlist uuids)
-		uuidlist [] = ""
-		uuidlist uuids = "\nIt has been seen before in these repositories:\n" ++
-				prettyPrintUUIDs uuids
 
 {- Cost Ordered list of remotes. -}
 remotesByCost :: Annex [Git.Repo]

TODO

@@ -1,6 +1,9 @@
 * bug when annexing files while in a subdir of a git repo
 * bug when specifying absolute path to files when annexing
 
+* need to include backend name as part of the key, because currently
+  if two backends have overlapping key spaces, it can confuse things
+
 * --push/--pull/--want
 
 * how to handle git mv file?