replace (Key, Backend) with Key

Only fsck and reinject and the test suite used the Backend, and they can
look it up as needed from the Key. This simplifies the code and also speeds
it up.

There is a small behavior change here. Before, all commands would warn when
acting on an annexed file with an unknown backend. Now, only fsck and
reinject show that warning.

Annex/View.hs

@@ -348,7 +348,7 @@ applyView' mkviewedfile getfilemetadata view = do
 			void clean
   where
 	genviewedfiles = viewedFiles view mkviewedfile -- enables memoization
-	go uh hasher f (Just (k, _)) = do
+	go uh hasher f (Just k) = do
 		metadata <- getCurrentMetaData k
 		let metadata' = getfilemetadata f `unionMetaData` metadata
 		forM_ (genviewedfiles f metadata') $ \fv -> do

Assistant/Threads/TransferScanner.hs

@@ -151,7 +151,7 @@ expensiveScan urlrenderer rs = unless onlyweb $ batch <~> do
 	enqueue f (r, t) =
 		queueTransferWhenSmall "expensive scan found missing object"
 			(Just f) t r
-	findtransfers f unwanted (key, _) = do
+	findtransfers f unwanted key = do
 		{- The syncable remotes may have changed since this
 		 - scan began. -}
 		syncrs <- syncDataRemotes <$> getDaemonStatus

Assistant/Threads/Watcher.hs

@@ -271,7 +271,7 @@ onAddSymlink :: Bool -> Handler
 onAddSymlink isdirect file filestatus = unlessIgnored file $ do
 	linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file)
 	kv <- liftAnnex (Backend.lookupFile file)
-	onAddSymlink' linktarget (fmap fst kv) isdirect file filestatus
+	onAddSymlink' linktarget kv isdirect file filestatus
 
 onAddSymlink' :: Maybe String -> Maybe Key -> Bool -> Handler
 onAddSymlink' linktarget mk isdirect file filestatus = go mk

Backend.hs

@@ -1,6 +1,6 @@
 {- git-annex key/value backends
  -
- - Copyright 2010,2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -10,6 +10,7 @@ module Backend (
 	orderedList,
 	genKey,
 	lookupFile,
+	getBackend,
 	isAnnexLink,
 	chooseBackend,
 	lookupBackendName,
@@ -74,7 +75,7 @@ genKey' (b:bs) source = do
 		| c == '\n' = '_'
 		| otherwise = c
 
-{- Looks up the key and backend corresponding to an annexed file,
+{- Looks up the key corresponding to an annexed file,
  - by examining what the file links to.
  -
  - In direct mode, there is often no link on disk, in which case
@@ -82,7 +83,7 @@ genKey' (b:bs) source = do
  - on disk still takes precedence over what was committed to git in direct
  - mode.
  -}
-lookupFile :: FilePath -> Annex (Maybe (Key, Backend))
+lookupFile :: FilePath -> Annex (Maybe Key)
 lookupFile file = do
 	mkey <- isAnnexLink file
 	case mkey of
@@ -92,14 +93,15 @@ lookupFile file = do
 			, return Nothing
 			)
   where
-	makeret k = let bname = keyBackendName k in
+	makeret k = return $ Just k
-		case maybeLookupBackendName bname of
+
-			Just backend -> return $ Just (k, backend)
+getBackend :: FilePath -> Key -> Annex (Maybe Backend)
-			Nothing -> do
+getBackend file k = let bname = keyBackendName k in
-				warning $
+	case maybeLookupBackendName bname of
-					"skipping " ++ file ++
+		Just backend -> return $ Just backend
-					" (unknown backend " ++ bname ++ ")"
+		Nothing -> do
-				return Nothing
+			warning $ "skipping " ++ file ++ " (unknown backend " ++ bname ++ ")"
+			return Nothing
 
 {- Looks up the backend that should be used for a file.
  - That can be configured on a per-file basis in the gitattributes file. -}

Command.hs

@@ -70,11 +70,11 @@ stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a)
 stopUnless c a = ifM c ( a , stop )
 
 {- Modifies an action to only act on files that are already annexed,
- - and passes the key and backend on to it. -}
+ - and passes the key on to it. -}
-whenAnnexed :: (FilePath -> (Key, Backend) -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
+whenAnnexed :: (FilePath -> Key -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
 whenAnnexed a file = ifAnnexed file (a file) (return Nothing)
 
-ifAnnexed :: FilePath -> ((Key, Backend) -> Annex a) -> Annex a -> Annex a
+ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a
 ifAnnexed file yes no = maybe no yes =<< Backend.lookupFile file
 
 isBareRepo :: Annex Bool

Command/Add.hs

@@ -73,7 +73,7 @@ start file = ifAnnexed file addpresent add
 				| otherwise -> do
 					showStart "add" file
 					next $ perform file
-	addpresent (key, _) = ifM isDirect
+	addpresent key = ifM isDirect
 		( ifM (goodContent key file) ( stop , add )
 		, fixup key
 		)

Command/AddUrl.hs

@@ -96,7 +96,7 @@ performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform
 performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl
   where
   	quviurl = setDownloader pageurl QuviDownloader
-  	addurl (key, _backend) = next $ cleanup quviurl file key Nothing
+  	addurl key = next $ cleanup quviurl file key Nothing
 	geturl = next $ addUrlFileQuvi relaxed quviurl videourl file
 #endif
 
@@ -130,7 +130,7 @@ perform :: Bool -> URLString -> FilePath -> CommandPerform
 perform relaxed url file = ifAnnexed file addurl geturl
   where
 	geturl = next $ addUrlFile relaxed url file
-	addurl (key, _backend)
+	addurl key
 		| relaxed = do
 			setUrlPresent key url
 			next $ return True

Command/Copy.hs

@@ -30,9 +30,9 @@ seek ps = do
 {- A copy is just a move that does not delete the source file.
  - However, --auto mode avoids unnecessary copies, and avoids getting or
  - sending non-preferred content. -}
-start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
-start to from file (key, backend) = stopUnless shouldCopy $ 
+start to from file key = stopUnless shouldCopy $ 
-	Command.Move.start to from False file (key, backend)
+	Command.Move.start to from False file key
   where
 	shouldCopy = checkAuto (check <||> numCopiesCheck file key (<))
 	check = case to of

Command/Direct.hs

@@ -47,7 +47,7 @@ perform = do
 	void $ liftIO clean
 	next cleanup
   where
-	go = whenAnnexed $ \f (k, _) -> do
+	go = whenAnnexed $ \f k -> do
 		r <- toDirectGen k f
 		case r of
 			Nothing -> noop

Command/Drop.hs

@@ -34,8 +34,8 @@ seek ps = do
 	from <- getOptionField dropFromOption Remote.byNameWithUUID
 	withFilesInGit (whenAnnexed $ start from) ps
 
-start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe Remote -> FilePath -> Key -> CommandStart
-start from file (key, _) = checkDropAuto from file key $ \numcopies ->
+start from file key = checkDropAuto from file key $ \numcopies ->
 	stopUnless (checkAuto $ wantDrop False (Remote.uuid <$> from) (Just key) (Just file)) $
 		case from of
 			Nothing -> startLocal (Just file) numcopies key Nothing

Command/Find.hs

@@ -39,8 +39,8 @@ seek ps = do
 	format <- getFormat
 	withFilesInGit (whenAnnexed $ start format) ps
 
-start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe Utility.Format.Format -> FilePath -> Key -> CommandStart
-start format file (key, _) = do
+start format file key = do
 	-- only files inAnnex are shown, unless the user has requested
 	-- others via a limit
 	whenM (limited <||> inAnnex key) $

Command/Fix.hs

@@ -26,8 +26,8 @@ seek :: CommandSeek
 seek = withFilesInGit $ whenAnnexed start
 
 {- Fixes the symlink to an annexed file. -}
-start :: FilePath -> (Key, Backend) -> CommandStart
+start :: FilePath -> Key -> CommandStart
-start file (key, _) = do
+start file key = do
 	link <- inRepo $ gitAnnexLink file key
 	stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do
 		showStart "fix" file

Command/Fsck.hs

@@ -104,12 +104,16 @@ getIncremental = do
 						resetStartTime
 		return True
 
-start :: Maybe Remote -> Incremental -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart
-start from inc file (key, backend) = do
+start from inc file key = do
-	numcopies <- getFileNumCopies file
+	v <- Backend.getBackend file key
-	case from of
+	case v of
-		Nothing -> go $ perform key file backend numcopies
+		Nothing -> stop
-		Just r -> go $ performRemote key file backend numcopies r
+		Just backend -> do
+			numcopies <- getFileNumCopies file
+			case from of
+				Nothing -> go $ perform key file backend numcopies
+				Just r -> go $ performRemote key file backend numcopies r
   where
 	go = runFsck inc file key
 

Command/Get.hs

@@ -31,8 +31,8 @@ seek ps = do
 		(withFilesInGit $ whenAnnexed $ start from)
 		ps
 
-start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe Remote -> FilePath -> Key -> CommandStart
-start from file (key, _) = start' expensivecheck from key (Just file)
+start from file key = start' expensivecheck from key (Just file)
   where
 	expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file))
 

Command/ImportFeed.hs

@@ -194,7 +194,7 @@ performDownload relaxed cache todownload = case location todownload of
 				in d </> show n ++ "_" ++ base
 		tryanother = makeunique url (n + 1) file
 		alreadyexists = liftIO $ isJust <$> catchMaybeIO (getSymbolicLinkStatus f)
-		checksameurl (k, _) = ifM (elem url <$> getUrls k)
+		checksameurl k = ifM (elem url <$> getUrls k)
 			( return Nothing
 			, tryanother
 			)

Command/Indirect.hs

@@ -74,7 +74,7 @@ perform = do
 		case r of
 			Just s
 				| isSymbolicLink s -> void $ flip whenAnnexed f $
-					\_ (k, _) -> do
+					\_ k -> do
 						removeInodeCache k
 						removeAssociatedFiles k
 						return Nothing

Command/List.hs

@@ -60,8 +60,8 @@ getList = ifM (Annex.getFlag $ optionName allrepos)
 printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
 printHeader l = liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l
 
-start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> (Key, Backend) -> CommandStart
+start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> Key -> CommandStart
-start l file (key, _) = do
+start l file key = do
 	ls <- S.fromList <$> keyLocations key
 	liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file
 	stop

Command/Log.hs

@@ -64,9 +64,15 @@ seek ps = do
 		Annex.getField (optionName o)
 	use o v = [Param ("--" ++ optionName o), Param v]
 
-start :: M.Map UUID String -> TimeZone -> [CommandParam] -> Bool ->
+start
-	FilePath -> (Key, Backend) -> CommandStart
+	:: M.Map UUID String
-start m zone os gource file (key, _) = do
+	-> TimeZone
+	-> [CommandParam]
+	-> Bool
+	-> FilePath
+	-> Key
+	-> CommandStart
+start m zone os gource file key = do
 	showLog output =<< readLog <$> getLog key os
 	-- getLog produces a zombie; reap it
 	liftIO reapZombies

Command/MetaData.hs

@@ -63,8 +63,8 @@ seek ps = do
 		(withFilesInGit (whenAnnexed $ start now getfield modmeta))
 		ps
 
-start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart
+start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> Key -> CommandStart
-start now f ms file (k, _) = start' (Just file) now f ms k
+start now f ms file = start' (Just file) now f ms
 
 startKeys :: POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart
 startKeys = start' Nothing

Command/Migrate.hs

@@ -25,15 +25,19 @@ def = [notDirect $
 seek :: CommandSeek
 seek = withFilesInGit $ whenAnnexed start
 
-start :: FilePath -> (Key, Backend) -> CommandStart
+start :: FilePath -> Key -> CommandStart
-start file (key, oldbackend) = do
+start file key = do
-	exists <- inAnnex key
+	v <- Backend.getBackend file key
-	newbackend <- choosebackend =<< chooseBackend file
+	case v of
-	if (newbackend /= oldbackend || upgradableKey oldbackend key) && exists
+		Nothing -> stop
-		then do
+		Just oldbackend -> do
-			showStart "migrate" file
+			exists <- inAnnex key
-			next $ perform file key oldbackend newbackend
+			newbackend <- choosebackend =<< chooseBackend file
-		else stop
+			if (newbackend /= oldbackend || upgradableKey oldbackend key) && exists
+				then do
+					showStart "migrate" file
+					next $ perform file key oldbackend newbackend
+				else stop
   where
 	choosebackend Nothing = Prelude.head <$> orderedList
 	choosebackend (Just backend) = return backend

Command/Mirror.hs

@@ -31,8 +31,8 @@ seek ps = do
 		(withFilesInGit $ whenAnnexed $ start to from)
 		ps
 
-start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
-start to from file (key, _backend) = startKey to from (Just file) key
+start to from file key = startKey to from (Just file) key
 
 startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
 startKey to from afile key = do

Command/Move.hs

@@ -33,8 +33,8 @@ seek ps = do
 		(withFilesInGit $ whenAnnexed $ start to from True)
 		ps
 
-start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart
-start to from move file (key, _) = start' to from move (Just file) key
+start to from move file key = start' to from move (Just file) key
 
 startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
 startKey to from move = start' to from move Nothing

Command/ReKey.hs

@@ -29,7 +29,7 @@ start :: (FilePath, String) -> CommandStart
 start (file, keyname) = ifAnnexed file go stop
   where
 	newkey = fromMaybe (error "bad key") $ file2key keyname
-	go (oldkey, _)
+	go oldkey
 		| oldkey == newkey = stop
 		| otherwise = do
 			showStart "rekey" file

Command/Reinject.hs

@@ -12,6 +12,7 @@ import Command
 import Logs.Location
 import Annex.Content
 import qualified Command.Fsck
+import qualified Backend
 
 def :: [Command]
 def = [command "reinject" (paramPair "SRC" "DEST") seek
@@ -33,16 +34,20 @@ start (src:dest:[])
 		next $ whenAnnexed (perform src) dest
 start _ = error "specify a src file and a dest file"
 
-perform :: FilePath -> FilePath -> (Key, Backend) -> CommandPerform
+perform :: FilePath -> FilePath -> Key -> CommandPerform
-perform src _dest (key, backend) =
+perform src dest key = do
 	{- Check the content before accepting it. -}
-	ifM (Command.Fsck.checkKeySizeOr reject key src
+	v <- Backend.getBackend dest key
-		<&&> Command.Fsck.checkBackendOr reject backend key src)
+	case v of
-		( do
+		Nothing -> stop
-			unlessM move $ error "mv failed!"
+		Just backend ->
-			next $ cleanup key
+			ifM (Command.Fsck.checkKeySizeOr reject key src
-		, error "not reinjecting"
+				<&&> Command.Fsck.checkBackendOr reject backend key src)
-		)
+				( do
+					unlessM move $ error "mv failed!"
+					next $ cleanup key
+				, error "not reinjecting"
+				)
   where
 	-- the file might be on a different filesystem,
 	-- so mv is used rather than simply calling

Command/RmUrl.hs

@@ -20,7 +20,7 @@ seek :: CommandSeek
 seek = withPairs start
 
 start :: (FilePath, String) -> CommandStart
-start (file, url) = flip whenAnnexed file $ \_ (key, _) -> do
+start (file, url) = flip whenAnnexed file $ \_ key -> do
 	showStart "rmurl" file
 	next $ next $ cleanup url key
 

Command/Sync.hs

@@ -338,8 +338,8 @@ seekSyncContent rs = do
 		(\v -> void (liftIO (tryPutMVar mvar ())) >> syncFile rs f v)
 		noop
 
-syncFile :: [Remote] -> FilePath -> (Key, Backend) -> Annex ()
+syncFile :: [Remote] -> FilePath -> Key -> Annex ()
-syncFile rs f (k, _) = do
+syncFile rs f k = do
 	locs <- loggedLocations k
 	let (have, lack) = partition (\r -> Remote.uuid r `elem` locs) rs
 

Command/Unannex.hs

@@ -58,8 +58,8 @@ wrapUnannex a = ifM isDirect
 			then void (liftIO cleanup) >> return True
 			else void (liftIO cleanup) >> return False
 
-start :: FilePath -> (Key, Backend) -> CommandStart
+start :: FilePath -> Key -> CommandStart
-start file (key, _) = stopUnless (inAnnex key) $ do
+start file key = stopUnless (inAnnex key) $ do
 	showStart "unannex" file
 	next $ ifM isDirect
 		( performDirect file key

Command/Uninit.hs

@@ -44,7 +44,7 @@ seek ps = do
 
 {- git annex symlinks that are not checked into git could be left by an
  - interrupted add. -}
-startCheckIncomplete :: FilePath -> (Key, Backend) -> CommandStart
+startCheckIncomplete :: FilePath -> Key -> CommandStart
 startCheckIncomplete file _ = error $ unlines
 	[ file ++ " points to annexed content, but is not checked into git."
 	, "Perhaps this was left behind by an interrupted git annex add?"

Command/Unlock.hs

@@ -25,8 +25,8 @@ seek = withFilesInGit $ whenAnnexed start
 
 {- The unlock subcommand replaces the symlink with a copy of the file's
  - content. -}
-start :: FilePath -> (Key, Backend) -> CommandStart
+start :: FilePath -> Key -> CommandStart
-start file (key, _) = do
+start file key = do
 	showStart "unlock" file
 	next $ perform file key
 

Command/Unused.hs

@@ -250,7 +250,7 @@ withKeysReferenced' mdir initial a = do
 		x <- Backend.lookupFile f
 		case x of
 			Nothing -> go v fs
-			Just (k, _) -> do
+			Just k -> do
 				!v' <- a k f v
 				go v' fs
 
@@ -294,7 +294,7 @@ withKeysReferencedInGitRef a ref = do
 	forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a
 	liftIO $ void clean
   where
-	tKey True = fmap fst <$$> Backend.lookupFile . getTopFilePath . DiffTree.file
+	tKey True = Backend.lookupFile . getTopFilePath . DiffTree.file
 	tKey False = fileKey . takeFileName . decodeBS <$$>
 		catFile ref . getTopFilePath . DiffTree.file
 

Command/Whereis.hs

@@ -27,8 +27,8 @@ seek ps = do
 		(withFilesInGit $ whenAnnexed $ start m)
 		ps
 
-start :: M.Map UUID Remote -> FilePath -> (Key, Backend) -> CommandStart
+start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart
-start remotemap file (key, _) = start' remotemap key (Just file)
+start remotemap file key = start' remotemap key (Just file)
 
 startKeys :: M.Map UUID Remote -> Key -> CommandStart
 startKeys remotemap key = start' remotemap key Nothing

Limit.hs

@@ -234,10 +234,10 @@ limitSize vs s = case readSize dataUnits s of
 	Nothing -> Left "bad size"
 	Just sz -> Right $ go sz
   where
-  	go sz _ (MatchingFile fi) = lookupFile fi >>= check fi sz
+  	go sz _ (MatchingFile fi) = lookupFileKey fi >>= check fi sz
 	go sz _ (MatchingKey key) = checkkey sz key
 	checkkey sz key = return $ keySize key `vs` Just sz
-	check _ sz (Just (key, _)) = checkkey sz key
+	check _ sz (Just key) = checkkey sz key
 	check fi sz Nothing = do
 		filesize <- liftIO $ catchMaybeIO $
 			fromIntegral . fileSize
@@ -272,11 +272,8 @@ addTimeLimit s = do
 				liftIO $ exitWith $ ExitFailure 101
 			else return True
 
-lookupFile :: FileInfo -> Annex (Maybe (Key, Backend))
-lookupFile = Backend.lookupFile . relFile
-
 lookupFileKey :: FileInfo -> Annex (Maybe Key)
-lookupFileKey = (fst <$>) <$$> Backend.lookupFile . relFile
+lookupFileKey = Backend.lookupFile . relFile
 
 checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool
 checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a

Test.hs

@@ -712,7 +712,7 @@ test_unused env = intmpclonerepoInDirect env $ do
 			(sort expectedkeys) (sort unusedkeys)
 	findkey f = do
 		r <- Backend.lookupFile f
-		return $ fst $ fromJust r
+		return $ fromJust r
 
 test_describe :: TestEnv -> Assertion
 test_describe env = intmpclonerepo env $ do
@@ -1233,7 +1233,7 @@ test_crypto env = do
 			(c,k) <- annexeval $ do
 				uuid <- Remote.nameToUUID "foo"
 				rs <- Logs.Remote.readRemoteLog
-				Just (k,_) <- Backend.lookupFile annexedfile
+				Just k <- Backend.lookupFile annexedfile
 				return (fromJust $ M.lookup uuid rs, k)
 			let key = if scheme `elem` ["hybrid","pubkey"]
 					then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
@@ -1500,7 +1500,7 @@ checklocationlog f expected = do
 	thisuuid <- annexeval Annex.UUID.getUUID
 	r <- annexeval $ Backend.lookupFile f
 	case r of
-		Just (k, _) -> do
+		Just k -> do
 			uuids <- annexeval $ Remote.keyLocations k
 			assertEqual ("bad content in location log for " ++ f ++ " key " ++ Types.Key.key2file k ++ " uuid " ++ show thisuuid)
 				expected (thisuuid `elem` uuids)
@@ -1508,9 +1508,9 @@ checklocationlog f expected = do
 
 checkbackend :: FilePath -> Types.Backend -> Assertion
 checkbackend file expected = do
-	r <- annexeval $ Backend.lookupFile file
+	b <- annexeval $ maybe (return Nothing) (Backend.getBackend file) 
-	let b = snd $ fromJust r
+		=<< Backend.lookupFile file
-	assertEqual ("backend for " ++ file) expected b
+	assertEqual ("backend for " ++ file) (Just expected) b
 
 inlocationlog :: FilePath -> Assertion
 inlocationlog f = checklocationlog f True