remove unused backend machinery

The only remaining vestiage of backends is different types of keys. These
are still called "backends", mostly to avoid needing to change user interface
and configuration. But everything to do with storing keys in different
backends was gone; instead different types of remotes are used.

In the refactoring, lots of code was moved out of odd corners like
Backend.File, to closer to where it's used, like Command.Drop and
Command.Fsck. Quite a lot of dead code was removed. Several data structures
became simpler, which may result in better runtime efficiency. There should
be no user-visible changes.

1 files changed, 49 insertions, 119 deletions

diff --git a/Backend.hs b/Backend.hs
index b1cd4c8f0..cf976d2b8 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -1,16 +1,4 @@
-{- git-annex key-value storage backends
- -
- - git-annex uses a key-value abstraction layer to allow files contents to be
- - stored in different ways. In theory, any key-value storage system could be
- - used to store the file contents, and git-annex would then retrieve them
- - as needed and put them in `.git/annex/`.
- - 
- - When a file is annexed, a key is generated from its content and/or metadata.
- - This key can later be used to retrieve the file's content (its value). This
- - key generation must be stable for a given file content, name, and size.
- - 
- - Multiple pluggable backends are supported, and more than one can be used
- - to store different files' contents in a given repository.
+{- git-annex key/value backends
  -
  - Copyright 2010 Joey Hess <joey@kitenet.net>
  -
@@ -19,15 +7,10 @@
 
 module Backend (
 	list,
-	storeFileKey,
-	retrieveKeyFile,
-	removeKey,
-	hasKey,
-	fsckKey,
-	upgradableKey,
+	orderedList,
+	genKey,
 	lookupFile,
 	chooseBackends,
-	keyBackend,
 	lookupBackendName,
 	maybeLookupBackendName
 ) where
@@ -36,7 +19,6 @@ import Control.Monad.State (liftIO, when)
 import System.IO.Error (try)
 import System.FilePath
 import System.Posix.Files
-import System.Directory
 
 import Locations
 import qualified Git
@@ -45,12 +27,20 @@ import Types
 import Types.Key
 import qualified Types.Backend as B
 import Messages
-import Content
-import DataUnits
+
+-- When adding a new backend, import it here and add it to the list.
+import qualified Backend.WORM
+import qualified Backend.SHA
+
+list :: [Backend Annex]
+list = concat 
+	[ Backend.WORM.backends
+	, Backend.SHA.backends
+	]
 
 {- List of backends in the order to try them when storing a new key. -}
-list :: Annex [Backend Annex]
-list = do
+orderedList :: Annex [Backend Annex]
+orderedList = do
 	l <- Annex.getState Annex.backends -- list is cached here
 	if not $ null l
 		then return l
@@ -59,92 +49,49 @@ list = do
 			d <- Annex.getState Annex.forcebackend
 			handle d s
 	where
-		parseBackendList l [] = l
-		parseBackendList bs s = map (lookupBackendName bs) $ words s
+		parseBackendList [] = list
+		parseBackendList s = map lookupBackendName $ words s
 		handle Nothing s = return s
 		handle (Just "") s = return s
 		handle (Just name) s = do
-			bs <- Annex.getState Annex.supportedBackends
-			let l' = (lookupBackendName bs name):s
+			let l' = (lookupBackendName name):s
 			Annex.changeState $ \state -> state { Annex.backends = l' }
 			return l'
 		getstandard = do
-			bs <- Annex.getState Annex.supportedBackends
 			g <- Annex.gitRepo
-			return $ parseBackendList bs $
+			return $ parseBackendList $
 				Git.configGet g "annex.backends" ""
 
-{- Looks up a backend in a list. May fail if unknown. -}
-lookupBackendName :: [Backend Annex] -> String -> Backend Annex
-lookupBackendName bs s = maybe unknown id $ maybeLookupBackendName bs s
-	where
-		unknown = error $ "unknown backend " ++ s
-maybeLookupBackendName :: [Backend Annex] -> String -> Maybe (Backend Annex)
-maybeLookupBackendName bs s =
-	if 1 /= length matches
-		then Nothing
-		else Just $ head matches
-	where matches = filter (\b -> s == B.name b) bs
-
-{- Attempts to store a file in one of the backends. -}
-storeFileKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex))
-storeFileKey file trybackend = do
-	bs <- list
+{- Generates a key for a file, trying each backend in turn until one
+ - accepts it. -}
+genKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex))
+genKey file trybackend = do
+	bs <- orderedList
 	let bs' = maybe bs (:bs) trybackend
-	storeFileKey' bs' file
-storeFileKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex))
-storeFileKey' [] _ = return Nothing
-storeFileKey' (b:bs) file = maybe nextbackend store =<< (B.getKey b) file
-	where
-		nextbackend = storeFileKey' bs file
-		store key = do
-			stored <- (B.storeFileKey b) file key
-			if (not stored)
-				then nextbackend
-				else return $ Just (key, b)
-
-{- Attempts to retrieve an key from one of the backends, saving it to
- - a specified location. -}
-retrieveKeyFile :: Backend Annex -> Key -> FilePath -> Annex Bool
-retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest
-
-{- Removes a key from a backend. -}
-removeKey :: Backend Annex -> Key -> Maybe Int -> Annex Bool
-removeKey backend key numcopies = (B.removeKey backend) key numcopies
-
-{- Checks if a key is present in its backend. -}
-hasKey :: Key -> Annex Bool
-hasKey key = do
-	backend <- keyBackend key
-	(B.hasKey backend) key
-
-{- Checks a key for problems. -}
-fsckKey :: Backend Annex -> Key -> Maybe FilePath -> Maybe Int -> Annex Bool
-fsckKey backend key file numcopies = do
-	size_ok <- checkKeySize key
-	backend_ok <-(B.fsckKey backend) key file numcopies
-	return $ size_ok && backend_ok
-
-{- Checks if a key is upgradable to a newer representation. -}
-upgradableKey :: Backend Annex -> Key -> Annex Bool
-upgradableKey backend key = (B.upgradableKey backend) key
+	genKey' bs' file
+genKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex))
+genKey' [] _ = return Nothing
+genKey' (b:bs) file = do
+	r <- (B.getKey b) file
+	case r of
+		Nothing -> genKey' bs file
+		Just k -> return $ Just (k, b)
 
 {- Looks up the key and backend corresponding to an annexed file,
  - by examining what the file symlinks to. -}
 lookupFile :: FilePath -> Annex (Maybe (Key, Backend Annex))
 lookupFile file = do
-	bs <- Annex.getState Annex.supportedBackends
 	tl <- liftIO $ try getsymlink
 	case tl of
 		Left _ -> return Nothing
-		Right l -> makekey bs l
+		Right l -> makekey l
 	where
 		getsymlink = do
 			l <- readSymbolicLink file
 			return $ takeFileName l
-		makekey bs l = maybe (return Nothing) (makeret bs l) (fileKey l)
-		makeret bs l k =
-			case maybeLookupBackendName bs bname of
+		makekey l = maybe (return Nothing) (makeret l) (fileKey l)
+		makeret l k =
+			case maybeLookupBackendName bname of
 					Just backend -> return $ Just (k, backend)
 					Nothing -> do
 						when (isLinkToAnnex l) $
@@ -164,37 +111,20 @@ chooseBackends fs = do
 	forced <- Annex.getState Annex.forcebackend
 	if forced /= Nothing
 		then do
-			l <- list
+			l <- orderedList
 			return $ map (\f -> (f, Just $ head l)) fs
 		else do
-			bs <- Annex.getState Annex.supportedBackends
 			pairs <- liftIO $ Git.checkAttr g "annex.backend" fs
-			return $ map (\(f,b) -> (f, maybeLookupBackendName bs b)) pairs
-
-{- Returns the backend to use for a key. -}
-keyBackend :: Key -> Annex (Backend Annex)
-keyBackend key = do
-	bs <- Annex.getState Annex.supportedBackends
-	return $ lookupBackendName bs $ keyBackendName key
+			return $ map (\(f,b) -> (f, maybeLookupBackendName b)) pairs
 
-{- The size of the data for a key is checked against the size encoded in
- - the key's metadata, if available. -}
-checkKeySize :: Key -> Annex Bool
-checkKeySize key = do
-	g <- Annex.gitRepo
-	let file = gitAnnexLocation g key
-	present <- liftIO $ doesFileExist file
-	case (present, keySize key) of
-		(_, Nothing) -> return True
-		(False, _) -> return True
-		(True, Just size) -> do
-			stat <- liftIO $ getFileStatus file
-			let size' = fromIntegral (fileSize stat)
-			if size == size'
-				then return True
-				else do
-					dest <- moveBad key
-					warning $ "Bad file size (" ++
-						compareSizes storageUnits True size size' ++ 
-						"); moved to " ++ dest
-					return False
+{- Looks up a backend by name. May fail if unknown. -}
+lookupBackendName :: String -> Backend Annex
+lookupBackendName s = maybe unknown id $ maybeLookupBackendName s
+	where
+		unknown = error $ "unknown backend " ++ s
+maybeLookupBackendName :: String -> Maybe (Backend Annex)
+maybeLookupBackendName s =
+	if 1 /= length matches
+		then Nothing
+		else Just $ head matches
+	where matches = filter (\b -> s == B.name b) list