implement annex.tune.branchhash1

I hope this doesn't impact speed much -- it does have to pull out a value
from Annex state every time it accesses the branch now.

The test case I dropped has never caught any problems that I can remember,
and would have been rather difficult to convert.

1 files changed, 18 insertions, 38 deletions

diff --git a/Logs.hs b/Logs.hs
index b0f330e93..1f8cf9f9c 100644
--- a/Logs.hs
+++ b/Logs.hs
@@ -9,6 +9,7 @@ module Logs where
 
 import Common.Annex
 import Types.Key
+import Annex.DirHashes
 
 {- There are several varieties of log file formats. -}
 data LogVariety
@@ -87,8 +88,8 @@ differenceLog :: FilePath
 differenceLog = "difference.log"
 
 {- The pathname of the location log file for a given key. -}
-locationLogFile :: Key -> String
-locationLogFile key = hashDirLower def key ++ keyFile key ++ ".log"
+locationLogFile :: GitConfig -> Key -> String
+locationLogFile config key = branchHashDir config key </> keyFile key ++ ".log"
 
 {- Converts a pathname into a key if it's a location log. -}
 locationLogFileKey :: FilePath -> Maybe Key
@@ -101,15 +102,17 @@ locationLogFileKey path
 	(base, ext) = splitAt (length file - 4) file
 
 {- The filename of the url log for a given key. -}
-urlLogFile :: Key -> FilePath
-urlLogFile key = hashDirLower def key </> keyFile key ++ urlLogExt
+urlLogFile :: GitConfig -> Key -> FilePath
+urlLogFile config key = branchHashDir config key </> keyFile key ++ urlLogExt
 
 {- Old versions stored the urls elsewhere. -}
-oldurlLogs :: Key -> [FilePath]
-oldurlLogs key =
-	[ "remote/web" </> hashDirLower def key </> key2file key ++ ".log"
-	, "remote/web" </> hashDirLower def key </> keyFile key ++ ".log"
+oldurlLogs :: GitConfig -> Key -> [FilePath]
+oldurlLogs config key =
+	[ "remote/web" </> hdir </> key2file key ++ ".log"
+	, "remote/web" </> hdir </> keyFile key ++ ".log"
 	]
+  where
+	hdir = branchHashDir config key
 
 urlLogExt :: String
 urlLogExt = ".log.web"
@@ -130,8 +133,9 @@ isUrlLog :: FilePath -> Bool
 isUrlLog file = urlLogExt `isSuffixOf` file
 
 {- The filename of the remote state log for a given key. -}
-remoteStateLogFile :: Key -> FilePath
-remoteStateLogFile key = hashDirLower def key </> keyFile key ++ remoteStateLogExt
+remoteStateLogFile :: GitConfig -> Key -> FilePath
+remoteStateLogFile config key = branchHashDir config key 
+	</> keyFile key ++ remoteStateLogExt
 
 remoteStateLogExt :: String
 remoteStateLogExt = ".log.rmt"
@@ -140,8 +144,8 @@ isRemoteStateLog :: FilePath -> Bool
 isRemoteStateLog path = remoteStateLogExt `isSuffixOf` path
 
 {- The filename of the chunk log for a given key. -}
-chunkLogFile :: Key -> FilePath
-chunkLogFile key = hashDirLower def key </> keyFile key ++ chunkLogExt
+chunkLogFile :: GitConfig -> Key -> FilePath
+chunkLogFile config key = branchHashDir config key </> keyFile key ++ chunkLogExt
 
 chunkLogFileKey :: FilePath -> Maybe Key
 chunkLogFileKey path
@@ -159,35 +163,11 @@ isChunkLog :: FilePath -> Bool
 isChunkLog path = chunkLogExt `isSuffixOf` path
 
 {- The filename of the metadata log for a given key. -}
-metaDataLogFile :: Key -> FilePath
-metaDataLogFile key = hashDirLower def key </> keyFile key ++ metaDataLogExt
+metaDataLogFile :: GitConfig -> Key -> FilePath
+metaDataLogFile config key = branchHashDir config key </> keyFile key ++ metaDataLogExt
 
 metaDataLogExt :: String
 metaDataLogExt = ".log.met"
 
 isMetaDataLog :: FilePath -> Bool
 isMetaDataLog path = metaDataLogExt `isSuffixOf` path
-
-prop_logs_sane :: Key -> Bool
-prop_logs_sane dummykey = and
-	[ isNothing (getLogVariety "unknown")
-	, expect gotUUIDBasedLog (getLogVariety uuidLog)
-	, expect gotPresenceLog (getLogVariety $ locationLogFile dummykey)
-	, expect gotPresenceLog (getLogVariety $ urlLogFile dummykey)
-	, expect gotNewUUIDBasedLog (getLogVariety $ remoteStateLogFile dummykey)
-	, expect gotChunkLog (getLogVariety $ chunkLogFile dummykey)
-	, expect gotOtherLog (getLogVariety $ metaDataLogFile dummykey)
-	, expect gotOtherLog (getLogVariety numcopiesLog)
-	]
-  where
-	expect = maybe False
-	gotUUIDBasedLog UUIDBasedLog = True
-	gotUUIDBasedLog _ = False
-	gotNewUUIDBasedLog NewUUIDBasedLog = True
-	gotNewUUIDBasedLog _ = False
-	gotChunkLog (ChunkLog k) = k == dummykey
-	gotChunkLog _ = False
-	gotPresenceLog (PresenceLog k) = k == dummykey
-	gotPresenceLog _ = False
-	gotOtherLog OtherLog = True
-	gotOtherLog _ = False