groundwork for parameterizing hash depth

Command/Find.hs

@@ -7,6 +7,7 @@
 
 module Command.Find where
 
+import Data.Default
 import qualified Data.Map as M
 
 import Common.Annex
@@ -65,8 +66,8 @@ keyVars key =
 	, ("bytesize", size show)
 	, ("humansize", size $ roughSize storageUnits True)
 	, ("keyname", keyName key)
-	, ("hashdirlower", hashDirLower key)
+	, ("hashdirlower", hashDirLower def key)
-	, ("hashdirmixed", hashDirMixed key)
+	, ("hashdirmixed", hashDirMixed def key)
 	, ("mtime", whenavail show $ keyMtime key)
 	]
   where

Locations.hs

@@ -60,6 +60,7 @@ module Locations (
 	gitAnnexAssistantDefaultDir,
 	isLinkToAnnex,
 	annexHashes,
+	HashLevels(..),
 	hashDirMixed,
 	hashDirLower,
 	preSanitizeKeyName,
@@ -71,6 +72,7 @@ import Data.Bits
 import Data.Word
 import Data.Hash.MD5
 import Data.Char
+import Data.Default
 
 import Common
 import Types
@@ -105,7 +107,7 @@ objectDir = addTrailingPathSeparator $ annexDir </> "objects"
 {- Annexed file's possible locations relative to the .git directory.
  - There are two different possibilities, using different hashes. -}
 annexLocations :: Key -> [FilePath]
-annexLocations key = map (annexLocation key) annexHashes
+annexLocations key = map (annexLocation key) (annexHashes def)
 annexLocation :: Key -> Hasher -> FilePath
 annexLocation key hasher = objectDir </> keyPath key hasher
 
@@ -140,7 +142,7 @@ gitAnnexLocation' key r config crippled
 	{- Non-bare repositories only use hashDirMixed, so
 	 - don't need to do any work to check if the file is
 	 - present. -}
-	| otherwise = return $ inrepo $ annexLocation key hashDirMixed
+	| otherwise = return $ inrepo $ annexLocation key (hashDirMixed def)
   where
 	inrepo d = Git.localGitDir r </> d
 	check locs@(l:_) = fromMaybe l <$> firstM doesFileExist locs
@@ -419,28 +421,35 @@ keyPath key hasher = hasher key </> f </> f
 
 {- All possibile locations to store a key using different directory hashes. -}
 keyPaths :: Key -> [FilePath]
-keyPaths key = map (keyPath key) annexHashes
+keyPaths key = map (keyPath key) (annexHashes def)
 
 {- Two different directory hashes may be used. The mixed case hash
  - came first, and is fine, except for the problem of case-strict
  - filesystems such as Linux VFAT (mounted with shortname=mixed),
  - which do not allow using a directory "XX" when "xx" already exists.
  - To support that, most repositories use the lower case hash for new data. -}
+annexHashes :: HashLevels -> [Hasher]
+annexHashes n = [hashDirLower n, hashDirMixed n]
+
 type Hasher = Key -> FilePath
 
-annexHashes :: [Hasher]
+-- Number of hash levels to use. 2 is the default.
-annexHashes = [hashDirLower, hashDirMixed]
+newtype HashLevels = HashLevels Int
 
-hashDirMixed :: Hasher
+instance Default HashLevels where
-hashDirMixed k = addTrailingPathSeparator $ take 2 dir </> drop 2 dir
+	def = HashLevels 2
+
+hashDirs :: HashLevels -> Int -> String -> FilePath
+hashDirs (HashLevels 1) sz s = addTrailingPathSeparator $ take sz s
+hashDirs _ sz s = addTrailingPathSeparator $ take sz s </> drop sz s
+
+hashDirMixed :: HashLevels -> Hasher
+hashDirMixed n k = hashDirs n 2 $ take 4 $ display_32bits_as_dir =<< [a,b,c,d]
   where
-	dir = take 4 $ display_32bits_as_dir =<< [a,b,c,d]
 	ABCD (a,b,c,d) = md5 $ md5FilePath $ key2file $ nonChunkKey k
 
-hashDirLower :: Hasher
+hashDirLower :: HashLevels -> Hasher
-hashDirLower k = addTrailingPathSeparator $ take 3 dir </> drop 3 dir
+hashDirLower n k = hashDirs n 3 $ take 6 $ md5s $ md5FilePath $ key2file $ nonChunkKey k
-  where
-	dir = take 6 $ md5s $ md5FilePath $ key2file $ nonChunkKey k
 
 {- modified version of display_32bits_as_hex from Data.Hash.MD5
  -   Copyright (C) 2001 Ian Lynagh 

Logs.hs

@@ -10,6 +10,8 @@ module Logs where
 import Common.Annex
 import Types.Key
 
+import Data.Default
+
 {- There are several varieties of log file formats. -}
 data LogVariety
 	= UUIDBasedLog
@@ -88,7 +90,7 @@ differenceLog = "difference.log"
 
 {- The pathname of the location log file for a given key. -}
 locationLogFile :: Key -> String
-locationLogFile key = hashDirLower key ++ keyFile key ++ ".log"
+locationLogFile key = hashDirLower def key ++ keyFile key ++ ".log"
 
 {- Converts a pathname into a key if it's a location log. -}
 locationLogFileKey :: FilePath -> Maybe Key
@@ -102,13 +104,13 @@ locationLogFileKey path
 
 {- The filename of the url log for a given key. -}
 urlLogFile :: Key -> FilePath
-urlLogFile key = hashDirLower key </> keyFile key ++ urlLogExt
+urlLogFile key = hashDirLower def key </> keyFile key ++ urlLogExt
 
 {- Old versions stored the urls elsewhere. -}
 oldurlLogs :: Key -> [FilePath]
 oldurlLogs key =
-	[ "remote/web" </> hashDirLower key </> key2file key ++ ".log"
+	[ "remote/web" </> hashDirLower def key </> key2file key ++ ".log"
-	, "remote/web" </> hashDirLower key </> keyFile key ++ ".log"
+	, "remote/web" </> hashDirLower def key </> keyFile key ++ ".log"
 	]
 
 urlLogExt :: String
@@ -131,7 +133,7 @@ isUrlLog file = urlLogExt `isSuffixOf` file
 
 {- The filename of the remote state log for a given key. -}
 remoteStateLogFile :: Key -> FilePath
-remoteStateLogFile key = hashDirLower key </> keyFile key ++ remoteStateLogExt
+remoteStateLogFile key = hashDirLower def key </> keyFile key ++ remoteStateLogExt
 
 remoteStateLogExt :: String
 remoteStateLogExt = ".log.rmt"
@@ -141,7 +143,7 @@ isRemoteStateLog path = remoteStateLogExt `isSuffixOf` path
 
 {- The filename of the chunk log for a given key. -}
 chunkLogFile :: Key -> FilePath
-chunkLogFile key = hashDirLower key </> keyFile key ++ chunkLogExt
+chunkLogFile key = hashDirLower def key </> keyFile key ++ chunkLogExt
 
 chunkLogFileKey :: FilePath -> Maybe Key
 chunkLogFileKey path
@@ -160,7 +162,7 @@ isChunkLog path = chunkLogExt `isSuffixOf` path
 
 {- The filename of the metadata log for a given key. -}
 metaDataLogFile :: Key -> FilePath
-metaDataLogFile key = hashDirLower key </> keyFile key ++ metaDataLogExt
+metaDataLogFile key = hashDirLower def key </> keyFile key ++ metaDataLogExt
 
 metaDataLogExt :: String
 metaDataLogExt = ".log.met"

Remote/Directory.hs

@@ -15,6 +15,7 @@ module Remote.Directory (
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
+import Data.Default
 
 import Common.Annex
 import Types.Remote
@@ -107,7 +108,7 @@ getLocation d k = do
 
 {- Directory where the file(s) for a key are stored. -}
 storeDir :: FilePath -> Key -> FilePath
-storeDir d k = addTrailingPathSeparator $ d </> hashDirLower k </> keyFile k
+storeDir d k = addTrailingPathSeparator $ d </> hashDirLower def k </> keyFile k
 
 {- Where we store temporary data for a key, in the directory, as it's being
  - written. -}

Remote/External.hs

@@ -28,6 +28,7 @@ import Creds
 import Control.Concurrent.STM
 import System.Log.Logger (debugM)
 import qualified Data.Map as M
+import Data.Default
 
 remote :: RemoteType
 remote = RemoteType {
@@ -184,7 +185,7 @@ handleRequest' lck external req mp responsehandler
 	handleRemoteRequest (PROGRESS bytesprocessed) =
 		maybe noop (\a -> liftIO $ a bytesprocessed) mp
 	handleRemoteRequest (DIRHASH k) = 
-		send $ VALUE $ hashDirMixed k
+		send $ VALUE $ hashDirMixed def k
 	handleRemoteRequest (SETCONFIG setting value) =
 		liftIO $ atomically $ do
 			let v = externalConfig external

Remote/GCrypt.hs

@@ -16,6 +16,7 @@ module Remote.GCrypt (
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as L
 import Control.Exception
+import Data.Default
 
 import Common.Annex
 import Types.Remote
@@ -361,7 +362,7 @@ checkKey r rsyncopts k
 {- Annexed objects are hashed using lower-case directories for max
  - portability. -}
 gCryptLocation :: Remote -> Key -> FilePath
-gCryptLocation r key = Git.repoLocation (repo r) </> objectDir </> keyPath key hashDirLower
+gCryptLocation r key = Git.repoLocation (repo r) </> objectDir </> keyPath key (hashDirLower def)
 
 data AccessMethod = AccessDirect | AccessShell
 

Remote/Hook.hs

@@ -7,8 +7,6 @@
 
 module Remote.Hook (remote) where
 
-import qualified Data.Map as M
-
 import Common.Annex
 import Types.Remote
 import Types.Key
@@ -20,6 +18,9 @@ import Annex.UUID
 import Remote.Helper.Special
 import Utility.Env
 
+import Data.Default
+import qualified Data.Map as M
+
 type Action = String
 type HookName = String
 
@@ -90,7 +91,7 @@ hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
 		]
 	fileenv Nothing = []
 	fileenv (Just file) =  [envvar "FILE" file]
-	hashbits = map takeDirectory $ splitPath $ hashDirMixed k
+	hashbits = map takeDirectory $ splitPath $ hashDirMixed def k
 
 lookupHook :: HookName -> Action -> Annex (Maybe String)
 lookupHook hookname action = do

Remote/Rsync.hs

@@ -38,6 +38,7 @@ import Logs.Transfer
 import Types.Creds
 import Types.Key (isChunkKey)
 
+import Data.Default
 import qualified Data.Map as M
 
 remote :: RemoteType
@@ -212,7 +213,7 @@ remove o k = do
 	 - content could be. Note that the parent directories have
 	 - to also be explicitly included, due to how rsync
 	 - traverses directories. -}
-	includes = concatMap use annexHashes
+	includes = concatMap use (annexHashes def)
 	use h = let dir = h k in
 		[ parentDir dir
 		, dir

Remote/Rsync/RsyncUrl.hs

@@ -14,6 +14,7 @@ import Locations
 import Utility.Rsync
 import Utility.SafeCommand
 
+import Data.Default
 import System.FilePath.Posix
 #ifdef mingw32_HOST_OS
 import Data.String.Utils
@@ -35,7 +36,7 @@ rsyncEscape o u
 	| otherwise = u
 
 rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl]
-rsyncUrls o k = map use annexHashes
+rsyncUrls o k = map use (annexHashes def)
   where
 	use h = rsyncUrl o </> hash h </> rsyncEscape o (f </> f)
 	f = keyFile k

Remote/WebDAV/DavLocation.hs

@@ -17,6 +17,7 @@ import Utility.Url (URLString)
 import System.FilePath.Posix -- for manipulating url paths
 import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT)
 import Control.Monad.IO.Class (MonadIO)
+import Data.Default
 #ifdef mingw32_HOST_OS
 import Data.String.Utils
 #endif
@@ -33,9 +34,9 @@ keyDir :: Key -> DavLocation
 keyDir k = addTrailingPathSeparator $ hashdir </> keyFile k
   where
 #ifndef mingw32_HOST_OS
-	hashdir = hashDirLower k
+	hashdir = hashDirLower def k
 #else
-	hashdir = replace "\\" "/" (hashDirLower k)
+	hashdir = replace "\\" "/" (hashDirLower def k)
 #endif
 
 keyLocation :: Key -> DavLocation

Upgrade/V1.hs

@@ -9,6 +9,7 @@ module Upgrade.V1 where
 
 import System.Posix.Types
 import Data.Char
+import Data.Default
 
 import Common.Annex
 import Types.Key
@@ -228,7 +229,7 @@ logFile1 :: Git.Repo -> Key -> String
 logFile1 repo key = Upgrade.V2.gitStateDir repo ++ keyFile1 key ++ ".log"
 
 logFile2 :: Key -> Git.Repo -> String
-logFile2 = logFile' hashDirLower
+logFile2 = logFile' (hashDirLower def)
 
 logFile' :: (Key -> FilePath) -> Key -> Git.Repo -> String
 logFile' hasher key repo =