add support for using hashDirLower in addition to hashDirMixed

Supporting multiple directory hash types will allow converting to a
different one, without a flag day.

gitAnnexLocation now checks which of the possible locations have a file.
This means more statting of files. Several places currently use
gitAnnexLocation and immediately check if the returned file exists;
those need to be optimised.

Annex/Content.hs

@@ -43,12 +43,12 @@ import Annex.Exception
 
 {- Checks if a given key's content is currently present. -}
 inAnnex :: Key -> Annex Bool
-inAnnex = inAnnex' doesFileExist
+inAnnex = inAnnex' $ doesFileExist
 inAnnex' :: (FilePath -> IO a) -> Key -> Annex a
 inAnnex' a key = do
 	whenM (fromRepo Git.repoIsUrl) $
 		error "inAnnex cannot check remote repo"
-	inRepo $ a . gitAnnexLocation key
+	inRepo $ \g -> gitAnnexLocation key g >>= a
 
 {- A safer check; the key's content must not only be present, but
  - is not in the process of being removed. -}
@@ -70,7 +70,7 @@ inAnnexSafe = inAnnex' $ \f -> openForLock f False >>= check
  - it. (If the content is not present, no locking is done.) -}
 lockContent :: Key -> Annex a -> Annex a
 lockContent key a = do
-	file <- fromRepo $ gitAnnexLocation key
+	file <- inRepo $ gitAnnexLocation key
 	bracketIO (openForLock file True >>= lock) unlock a
 	where
 		lock Nothing = return Nothing
@@ -100,9 +100,8 @@ calcGitLink :: FilePath -> Key -> Annex FilePath
 calcGitLink file key = do
 	cwd <- liftIO getCurrentDirectory
 	let absfile = fromMaybe whoops $ absNormPath cwd file
-	top <- fromRepo Git.workTree
-	return $ relPathDirToFile (parentDir absfile) 
-			top </> ".git" </> annexLocation key
+	loc <- inRepo $ gitAnnexLocation key
+	return $ relPathDirToFile (parentDir absfile) loc
 	where
 		whoops = error $ "unable to normalize " ++ file
 
@@ -213,7 +212,7 @@ checkDiskSpace' adjustment key = do
  -}
 moveAnnex :: Key -> FilePath -> Annex ()
 moveAnnex key src = do
-	dest <- fromRepo $ gitAnnexLocation key
+	dest <- inRepo $ gitAnnexLocation key
 	let dir = parentDir dest
 	e <- liftIO $ doesFileExist dest
 	if e
@@ -227,7 +226,7 @@ moveAnnex key src = do
 
 withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
 withObjectLoc key a = do
-	file <- fromRepo $gitAnnexLocation key
+	file <- inRepo $ gitAnnexLocation key
 	let dir = parentDir file
 	a (dir, file)
 
@@ -250,7 +249,7 @@ fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do
  - returns the file it was moved to. -}
 moveBad :: Key -> Annex FilePath
 moveBad key = do
-	src <- fromRepo $ gitAnnexLocation key
+	src <- inRepo $ gitAnnexLocation key
 	bad <- fromRepo gitAnnexBadDir
 	let dest = bad </> takeFileName src
 	liftIO $ do

Backend/SHA.hs

@@ -99,7 +99,7 @@ keyValueE size file = keyValue size file >>= maybe (return Nothing) addE
 checkKeyChecksum :: SHASize -> Key -> Annex Bool
 checkKeyChecksum size key = do
 	fast <- Annex.getState Annex.fast
-	file <- fromRepo $ gitAnnexLocation key
+	file <- inRepo $ gitAnnexLocation key
 	present <- liftIO $ doesFileExist file
 	if not present || fast
 		then return True

Command/Add.hs

@@ -60,7 +60,7 @@ undo file key e = do
 		-- fromAnnex could fail if the file ownership is weird
 		tryharder :: IOException -> Annex ()
 		tryharder _ = do
-			src <- fromRepo $ gitAnnexLocation key
+			src <- inRepo $ gitAnnexLocation key
 			liftIO $ moveFile src file
 
 cleanup :: FilePath -> Key -> Bool -> CommandCleanup

Command/Fsck.hs

@@ -87,7 +87,7 @@ verifyLocationLog key desc = do
 	-- Since we're checking that a key's file is present, throw
 	-- in a permission fixup here too.
 	when present $ do
-		f <- fromRepo $ gitAnnexLocation key
+		f <- inRepo $ gitAnnexLocation key
 		liftIO $ do
 			preventWrite f
 			preventWrite (parentDir f)
@@ -118,7 +118,7 @@ verifyLocationLog key desc = do
  - the key's metadata, if available. -}
 checkKeySize :: Key -> Annex Bool
 checkKeySize key = do
-	file <- fromRepo $ gitAnnexLocation key
+	file <- inRepo $ gitAnnexLocation key
 	present <- liftIO $ doesFileExist file
 	case (present, Types.Key.keySize key) of
 		(_, Nothing) -> return True

Command/Migrate.hs

@@ -49,7 +49,7 @@ upgradableKey key = isNothing $ Types.Key.keySize key
  -}
 perform :: FilePath -> Key -> Backend Annex -> CommandPerform
 perform file oldkey newbackend = do
-	src <- fromRepo $ gitAnnexLocation oldkey
+	src <- inRepo $ gitAnnexLocation oldkey
 	tmp <- fromRepo gitAnnexTmpDir
 	let tmpfile = tmp </> takeFileName file
 	cleantmp tmpfile

Command/SendKey.hs

@@ -21,7 +21,7 @@ seek = [withKeys start]
 
 start :: Key -> CommandStart
 start key = do
-	file <- fromRepo $ gitAnnexLocation key
+	file <- inRepo $ gitAnnexLocation key
 	whenM (inAnnex key) $
 		liftIO $ rsyncServerSend file -- does not return
 	warning "requested key is not present"

Command/Unannex.hs

@@ -55,7 +55,7 @@ cleanup file key = do
 	if fast
 		then do
 			-- fast mode: hard link to content in annex
-			src <- fromRepo $ gitAnnexLocation key
+			src <- inRepo $ gitAnnexLocation key
 			liftIO $ do
 				createLink src file
 				allowWrite file

Command/Unlock.hs

@@ -37,7 +37,7 @@ perform dest key = do
 	
 	checkDiskSpace key
 
-	src <- fromRepo $ gitAnnexLocation key
+	src <- inRepo $ gitAnnexLocation key
 	tmpdest <- fromRepo $ gitAnnexTmpLocation key
 	liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
 	showAction "copying"

Locations.hs

@@ -9,7 +9,7 @@ module Locations (
 	keyFile,
 	fileKey,
 	gitAnnexLocation,
-	annexLocation,
+	annexLocations,
 	gitAnnexDir,
 	gitAnnexObjectDir,
 	gitAnnexTmpDir,
@@ -58,17 +58,33 @@ annexDir = addTrailingPathSeparator "annex"
 objectDir :: FilePath
 objectDir = addTrailingPathSeparator $ annexDir </> "objects"
 
-{- Annexed file's location relative to the .git directory. -}
-annexLocation :: Key -> FilePath
-annexLocation key = objectDir </> hashDirMixed key </> f </> f
+{- Annexed file's possible locations relative to the .git directory.
+ - There are two different possibilities, using different hashes;
+ - the first is the default for new content. -}
+annexLocations :: Key -> [FilePath]
+annexLocations key = [using hashDirMixed, using hashDirLower]
 	where
+		using h = objectDir </> h key </> f </> f
 		f = keyFile key
 
-{- Annexed file's absolute location in a repository. -}
-gitAnnexLocation :: Key -> Git.Repo -> FilePath
+{- Annexed file's absolute location in a repository.
+ - Out of the possible annexLocations, returns the one where the file
+ - is actually present. When the file is not present, returns the
+ - one where the file should be put.
+ -}
+gitAnnexLocation :: Key -> Git.Repo -> IO FilePath
 gitAnnexLocation key r
-	| Git.repoIsLocalBare r = Git.workTree r </> annexLocation key
-	| otherwise = Git.workTree r </> ".git" </> annexLocation key
+	| Git.repoIsLocalBare r =
+		go (Git.workTree r) $ annexLocations key
+	| otherwise =
+		go (Git.workTree r </> ".git") $ annexLocations key
+	where
+		go dir locs = fromMaybe (dir </> head locs) <$> check dir locs
+		check _ [] = return Nothing
+		check dir (l:ls) = do
+			let f = dir </> l
+			e <- doesFileExist f
+			if e then return (Just f) else check dir ls
 
 {- The annex directory of a repository. -}
 gitAnnexDir :: Git.Repo -> FilePath
@@ -76,8 +92,7 @@ gitAnnexDir r
 	| Git.repoIsLocalBare r = addTrailingPathSeparator $ Git.workTree r </> annexDir
 	| otherwise = addTrailingPathSeparator $ Git.workTree r </> ".git" </> annexDir
 
-{- The part of the annex directory where file contents are stored.
- -}
+{- The part of the annex directory where file contents are stored. -}
 gitAnnexObjectDir :: Git.Repo -> FilePath
 gitAnnexObjectDir r
 	| Git.repoIsLocalBare r = addTrailingPathSeparator $ Git.workTree r </> objectDir

Remote/Bup.hs

@@ -102,13 +102,13 @@ bupSplitParams r buprepo k src = do
 
 store :: Git.Repo -> BupRepo -> Key -> Annex Bool
 store r buprepo k = do
-	src <- fromRepo $ gitAnnexLocation k
+	src <- inRepo $ gitAnnexLocation k
 	params <- bupSplitParams r buprepo k (File src)
 	liftIO $ boolSystem "bup" params
 
 storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool
 storeEncrypted r buprepo (cipher, enck) k = do
-	src <- fromRepo $ gitAnnexLocation k
+	src <- inRepo $ gitAnnexLocation k
 	params <- bupSplitParams r buprepo enck (Param "-")
 	liftIO $ catchBoolIO $
 		withEncryptedHandle cipher (L.readFile src) $ \h ->

Remote/Directory.hs

@@ -94,12 +94,12 @@ withStoredFile = withCheckedFile doesFileExist
 
 store :: FilePath -> Key -> Annex Bool
 store d k = do
-	src <- fromRepo $ gitAnnexLocation k
+	src <- inRepo $ gitAnnexLocation k
 	liftIO $ catchBoolIO $ storeHelper d k $ copyFileExternal src
 
 storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
 storeEncrypted d (cipher, enck) k = do
-	src <- fromRepo $ gitAnnexLocation k
+	src <- inRepo $ gitAnnexLocation k
 	liftIO $ catchBoolIO $ storeHelper d enck $ encrypt src
 	where
 		encrypt src dest = do

Remote/Git.hs

@@ -134,7 +134,14 @@ inAnnex r key
 	| Git.repoIsUrl r = checkremote
 	| otherwise = checklocal
 	where
-		checkhttp = liftIO $ catchMsgIO $ Url.exists $ keyUrl r key
+		checkhttp = liftIO $ go undefined $ keyUrls r key
+			where
+				go e [] = return $ Left e
+				go _ (u:us) = do
+					res <- catchMsgIO $ Url.exists u
+					case res of
+						Left e -> go e us
+						v -> return v
 		checkremote = do
 			showAction $ "checking " ++ Git.repoDescribe r
 			onRemote r (check, unknown) "inannex" [Param (show key)]
@@ -169,8 +176,10 @@ onLocal r a = do
 		liftIO Git.reap
 		return ret
 
-keyUrl :: Git.Repo -> Key -> String
-keyUrl r key = Git.repoLocation r ++ "/" ++ annexLocation key
+keyUrls :: Git.Repo -> Key -> [String]
+keyUrls r key = map tourl (annexLocations key)
+	where
+		tourl l = Git.repoLocation r ++ "/" ++ l
 
 dropKey :: Git.Repo -> Key -> Annex Bool
 dropKey r key
@@ -185,16 +194,22 @@ copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
 copyFromRemote r key file
 	| not $ Git.repoIsUrl r = do
 		params <- rsyncParams r
-		rsyncOrCopyFile params (gitAnnexLocation key r) file
+		loc <- liftIO $ gitAnnexLocation key r
+		rsyncOrCopyFile params loc file
 	| Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file
-	| Git.repoIsHttp r = liftIO $ Url.download (keyUrl r key) file
+	| Git.repoIsHttp r = liftIO $ downloadurls $ keyUrls r key
 	| otherwise = error "copying from non-ssh, non-http repo not supported"
+	where
+		downloadurls [] = return False
+		downloadurls (u:us) = do
+			ok <- Url.download u file
+			if ok then return ok else downloadurls us
 
 {- Tries to copy a key's content to a remote's annex. -}
 copyToRemote :: Git.Repo -> Key -> Annex Bool
 copyToRemote r key
 	| not $ Git.repoIsUrl r = do
-		keysrc <- fromRepo $ gitAnnexLocation key
+		keysrc <- inRepo $ gitAnnexLocation key
 		params <- rsyncParams r
 		-- run copy from perspective of remote
 		liftIO $ onLocal r $ do
@@ -203,7 +218,7 @@ copyToRemote r key
 			Annex.Content.saveState
 			return ok
 	| Git.repoIsSsh r = do
-		keysrc <- fromRepo $ gitAnnexLocation key
+		keysrc <- inRepo $ gitAnnexLocation key
 		rsyncHelper =<< rsyncParamsRemote r False key keysrc
 	| otherwise = error "copying to non-ssh repo not supported"
 

Remote/Hook.hs

@@ -97,12 +97,12 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h
 
 store :: String -> Key -> Annex Bool
 store h k = do
-	src <- fromRepo $ gitAnnexLocation k
+	src <- inRepo $ gitAnnexLocation k
 	runHook h "store" k (Just src) $ return True
 
 storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool
 storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do
-	src <- fromRepo $ gitAnnexLocation k
+	src <- inRepo $ gitAnnexLocation k
 	liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
 	runHook h "store" enck (Just tmp) $ return True
 

Remote/Rsync.hs

@@ -95,11 +95,11 @@ rsyncKeyDir :: RsyncOpts -> Key -> String
 rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> rsyncEscape o (keyFile k)
 
 store :: RsyncOpts -> Key -> Annex Bool
-store o k = rsyncSend o k =<< fromRepo (gitAnnexLocation k)
+store o k = rsyncSend o k =<< inRepo (gitAnnexLocation k)
 
 storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool
 storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
-	src <- fromRepo $ gitAnnexLocation k
+	src <- inRepo $ gitAnnexLocation k
 	liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
 	rsyncSend o enck tmp
 

Remote/S3real.hs

@@ -112,7 +112,7 @@ s3Setup u c = handlehost $ M.lookup "host" c
 
 store :: Remote Annex -> Key -> Annex Bool
 store r k = s3Action r False $ \(conn, bucket) -> do
-	dest <- fromRepo $ gitAnnexLocation k
+	dest <- inRepo $ gitAnnexLocation k
 	res <- liftIO $ storeHelper (conn, bucket) r k dest
 	s3Bool res
 
@@ -121,7 +121,7 @@ storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) ->
 	-- To get file size of the encrypted content, have to use a temp file.
 	-- (An alternative would be chunking to to a constant size.)
 	withTmp enck $ \tmp -> do
-		f <- fromRepo $ gitAnnexLocation k
+		f <- inRepo $ gitAnnexLocation k
 		liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
 		res <- liftIO $ storeHelper (conn, bucket) r enck tmp
 		s3Bool res