add KeyVariety type

Where before the "name" of a key and a backend was a string, this makes
it a concrete data type.

This is groundwork for allowing some varieties of keys to be disabled
in file2key, so git-annex won't use them at all.

Benchmarks ran in my big repo:

old git-annex info:

real	0m3.338s
user	0m3.124s
sys	0m0.244s

new git-annex info:

real	0m3.216s
user	0m3.024s
sys	0m0.220s

new git-annex find:

real	0m7.138s
user	0m6.924s
sys	0m0.252s

old git-annex find:

real	0m7.433s
user	0m7.240s
sys	0m0.232s

Surprising result; I'd have expected it to be slower since it now parses
all the key varieties. But, the parser is very simple and perhaps
sharing KeyVarieties uses less memory or something like that.

This commit was supported by the NSF-funded DataLad project.

3 files changed, 37 insertions, 33 deletions

diff --git a/Backend/Hash.hs b/Backend/Hash.hs
index c85047d51..a1640435c 100644
--- a/Backend/Hash.hs
+++ b/Backend/Hash.hs
@@ -1,6 +1,6 @@
 {- git-annex hashing backends
  -
- - Copyright 2011-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2017 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -14,6 +14,7 @@ module Backend.Hash (
 
 import Annex.Common
 import qualified Annex
+import Types.Key
 import Types.Backend
 import Types.KeySource
 import Utility.Hash
@@ -29,17 +30,16 @@ data Hash
 	| SHA2Hash HashSize
 	| SHA3Hash HashSize
 	| SkeinHash HashSize
-type HashSize = Int
 
 {- Order is slightly significant; want SHA256 first, and more general
  - sizes earlier. -}
 hashes :: [Hash]
 hashes = concat 
-	[ map SHA2Hash [256, 512, 224, 384]
+	[ map (SHA2Hash . HashSize) [256, 512, 224, 384]
 #ifdef WITH_CRYPTONITE
-	, map SHA3Hash [256, 512, 224, 384]
+	, map (SHA3Hash . HashSize) [256, 512, 224, 384]
 #endif
-	, map SkeinHash [256, 512]
+	, map (SkeinHash . HashSize) [256, 512]
 	, [SHA1Hash]
 	, [MD5Hash]
 	]
@@ -50,7 +50,7 @@ backends = concatMap (\h -> [genBackendE h, genBackend h]) hashes
 
 genBackend :: Hash -> Backend
 genBackend hash = Backend
-	{ name = hashName hash
+	{ backendVariety = hashKeyVariety hash (HasExt False)
 	, getKey = keyValue hash
 	, verifyKeyContent = Just $ checkKeyChecksum hash
 	, canUpgradeKey = Just needsUpgrade
@@ -60,19 +60,16 @@ genBackend hash = Backend
 
 genBackendE :: Hash -> Backend
 genBackendE hash = (genBackend hash)
-	{ name = hashNameE hash
+	{ backendVariety = hashKeyVariety hash (HasExt True)
 	, getKey = keyValueE hash
 	}
 
-hashName :: Hash -> String
-hashName MD5Hash = "MD5"
-hashName SHA1Hash = "SHA1"
-hashName (SHA2Hash size) = "SHA" ++ show size
-hashName (SHA3Hash size) = "SHA3_" ++ show size
-hashName (SkeinHash size) = "SKEIN" ++ show size
-
-hashNameE :: Hash -> String
-hashNameE hash = hashName hash ++ "E"
+hashKeyVariety :: Hash -> HasExt -> KeyVariety
+hashKeyVariety MD5Hash = MD5Key
+hashKeyVariety SHA1Hash = SHA1Key
+hashKeyVariety (SHA2Hash size) = SHA2Key size
+hashKeyVariety (SHA3Hash size) = SHA3Key size
+hashKeyVariety (SkeinHash size) = SKEINKey size
 
 {- A key is a hash of its contents. -}
 keyValue :: Hash -> KeySource -> Annex (Maybe Key)
@@ -82,7 +79,7 @@ keyValue hash source = do
 	s <- hashFile hash file filesize
 	return $ Just $ stubKey
 		{ keyName = s
-		, keyBackendName = hashName hash
+		, keyVariety = hashKeyVariety hash (HasExt False)
 		, keySize = Just filesize
 		}
 
@@ -92,7 +89,7 @@ keyValueE hash source = keyValue hash source >>= maybe (return Nothing) addE
   where
 	addE k = return $ Just $ k
 		{ keyName = keyName k ++ selectExtension (keyFilename source)
-		, keyBackendName = hashNameE hash
+		, keyVariety = hashKeyVariety hash (HasExt True)
 		}
 
 selectExtension :: FilePath -> String
@@ -149,24 +146,29 @@ needsUpgrade key = "\\" `isPrefixOf` keyHash key ||
 trivialMigrate :: Key -> Backend -> AssociatedFile -> Maybe Key
 trivialMigrate oldkey newbackend afile
 	{- Fast migration from hashE to hash backend. -}
-	| keyBackendName oldkey == name newbackend ++ "E" = Just $ oldkey
+	| migratable && hasExt newvariety = Just $ oldkey
 		{ keyName = keyHash oldkey
-		, keyBackendName = name newbackend
+		, keyVariety = newvariety
 		}
 	{- Fast migration from hash to hashE backend. -}
-	| keyBackendName oldkey ++"E" == name newbackend = case afile of
+	| migratable && hasExt oldvariety = case afile of
 		Nothing -> Nothing
 		Just file -> Just $ oldkey
 			{ keyName = keyHash oldkey ++ selectExtension file
-			, keyBackendName = name newbackend
+			, keyVariety = newvariety
 			}
 	| otherwise = Nothing
+  where
+	migratable = oldvariety /= newvariety 
+		&& sameExceptExt oldvariety newvariety
+	oldvariety = keyVariety oldkey
+	newvariety = backendVariety newbackend
 
 hashFile :: Hash -> FilePath -> Integer -> Annex String
 hashFile hash file filesize = go hash
   where
 	go MD5Hash = use md5Hasher
-	go SHA1Hash = usehasher 1
+	go SHA1Hash = usehasher (HashSize 1)
 	go (SHA2Hash hashsize) = usehasher hashsize
 	go (SHA3Hash hashsize) = use (sha3Hasher hashsize)
 	go (SkeinHash hashsize) = use (skeinHasher hashsize)
@@ -176,10 +178,10 @@ hashFile hash file filesize = go hash
 		-- Force full evaluation so file is read and closed.
 		return (length h `seq` h)
 	
-	usehasher hashsize = case shaHasher hashsize filesize of
+	usehasher hashsize@(HashSize sz) = case shaHasher hashsize filesize of
 		Left sha -> use sha
 		Right (external, internal) -> do
-			v <- liftIO $ externalSHA external hashsize file
+			v <- liftIO $ externalSHA external sz file
 			case v of
 				Right r -> return r
 				Left e -> do
@@ -189,7 +191,7 @@ hashFile hash file filesize = go hash
 					use internal
 
 shaHasher :: HashSize -> Integer -> Either (L.ByteString -> String) (String, L.ByteString -> String)
-shaHasher hashsize filesize
+shaHasher (HashSize hashsize) filesize
 	| hashsize == 1 = use SysConfig.sha1 sha1
 	| hashsize == 256 = use SysConfig.sha256 sha2_256
 	| hashsize == 224 = use SysConfig.sha224 sha2_224
@@ -209,7 +211,7 @@ shaHasher hashsize filesize
 	usehasher hasher = show . hasher
 
 sha3Hasher :: HashSize -> (L.ByteString -> String)
-sha3Hasher hashsize
+sha3Hasher (HashSize hashsize)
 #ifdef WITH_CRYPTONITE
 	| hashsize == 256 = show . sha3_256
 	| hashsize == 224 = show . sha3_224
@@ -219,7 +221,7 @@ sha3Hasher hashsize
 	| otherwise = error $ "unsupported SHA3 size " ++ show hashsize
 
 skeinHasher :: HashSize -> (L.ByteString -> String)
-skeinHasher hashsize 
+skeinHasher (HashSize hashsize)
 	| hashsize == 256 = show . skein256
 	| hashsize == 512 = show . skein512
 	| otherwise = error $ "unsupported SKEIN size " ++ show hashsize
@@ -236,7 +238,7 @@ md5Hasher = show . md5
  -}
 testKeyBackend :: Backend
 testKeyBackend = 
-	let b = genBackendE (SHA2Hash 256)
+	let b = genBackendE (SHA2Hash (HashSize 256))
 	in b { getKey = (fmap addE) <$$> getKey b } 
   where
 	addE k = k { keyName = keyName k ++ longext }
diff --git a/Backend/URL.hs b/Backend/URL.hs
index 92b7a4482..b9d8264d6 100644
--- a/Backend/URL.hs
+++ b/Backend/URL.hs
@@ -11,6 +11,7 @@ module Backend.URL (
 ) where
 
 import Annex.Common
+import Types.Key
 import Types.Backend
 import Backend.Utilities
 
@@ -19,7 +20,7 @@ backends = [backend]
 
 backend :: Backend
 backend = Backend
-	{ name = "URL"
+	{ backendVariety = URLKey
 	, getKey = const $ return Nothing
 	, verifyKeyContent = Nothing
 	, canUpgradeKey = Nothing
@@ -33,6 +34,6 @@ backend = Backend
 fromUrl :: String -> Maybe Integer -> Key
 fromUrl url size = stubKey
 	{ keyName = genKeyName url
-	, keyBackendName = "URL"
+	, keyVariety = URLKey
 	, keySize = size
 	}
diff --git a/Backend/WORM.hs b/Backend/WORM.hs
index 99a853f47..d7220a431 100644
--- a/Backend/WORM.hs
+++ b/Backend/WORM.hs
@@ -8,6 +8,7 @@
 module Backend.WORM (backends) where
 
 import Annex.Common
+import Types.Key
 import Types.Backend
 import Types.KeySource
 import Backend.Utilities
@@ -18,7 +19,7 @@ backends = [backend]
 
 backend :: Backend
 backend = Backend
-	{ name = "WORM"
+	{ backendVariety = WORMKey
 	, getKey = keyValue
 	, verifyKeyContent = Nothing
 	, canUpgradeKey = Nothing
@@ -37,7 +38,7 @@ keyValue source = do
 	relf <- getTopFilePath <$> inRepo (toTopFilePath $ keyFilename source)
 	return $ Just $ stubKey
 		{ keyName = genKeyName relf
-		, keyBackendName = name backend
+		, keyVariety = WORMKey
 		, keySize = Just sz
 		, keyMtime = Just $ modificationTime stat
 		}