c565340adc
In 2013, I wrote "Cryptohash benchmarks 90 to 101% faster than external hashers". Re-benchmarking today, I found cryptonite's sha256 consistently outperformed coreutils by 10% for large files. Tested 10 mb, 100 mb, 1 gb files with both sha256 and sha512. And for smaller files, the external process startup time swamps the hash time. Perhaps cryptonite has improved. Or it could just do better on my current CPU Intel(R) Pentium(R) CPU 4410Y @ 1.50GHz). Anyway, even if cryptonite is slower in some situations, seems likely it would only be marginally slower; it's got the same class of highly optimised C code under the hood as coreutils. The main difference between the two sha256 implementations seems to be how much of the inner loop they unroll.. This commit was sponsored by Henrik Riomar on Patreon.
278 lines
8.4 KiB
Haskell
278 lines
8.4 KiB
Haskell
{- git-annex hashing backends
|
|
-
|
|
- Copyright 2011-2018 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Backend.Hash (
|
|
backends,
|
|
testKeyBackend,
|
|
) where
|
|
|
|
import Annex.Common
|
|
import qualified Annex
|
|
import Types.Key
|
|
import Types.Backend
|
|
import Types.KeySource
|
|
import Utility.Hash
|
|
|
|
import qualified Data.ByteString.Lazy as L
|
|
import Data.Char
|
|
|
|
data Hash
|
|
= MD5Hash
|
|
| SHA1Hash
|
|
| SHA2Hash HashSize
|
|
| SHA3Hash HashSize
|
|
| SkeinHash HashSize
|
|
#if MIN_VERSION_cryptonite(0,23,0)
|
|
| Blake2bHash HashSize
|
|
| Blake2sHash HashSize
|
|
| Blake2spHash HashSize
|
|
#endif
|
|
|
|
{- Order is slightly significant; want SHA256 first, and more general
|
|
- sizes earlier. -}
|
|
hashes :: [Hash]
|
|
hashes = concat
|
|
[ map (SHA2Hash . HashSize) [256, 512, 224, 384]
|
|
, map (SHA3Hash . HashSize) [256, 512, 224, 384]
|
|
, map (SkeinHash . HashSize) [256, 512]
|
|
#if MIN_VERSION_cryptonite(0,23,0)
|
|
, map (Blake2bHash . HashSize) [256, 512, 160, 224, 384]
|
|
, map (Blake2sHash . HashSize) [256, 160, 224]
|
|
, map (Blake2spHash . HashSize) [256, 224]
|
|
#endif
|
|
, [SHA1Hash]
|
|
, [MD5Hash]
|
|
]
|
|
|
|
{- The SHA256E backend is the default, so genBackendE comes first. -}
|
|
backends :: [Backend]
|
|
backends = concatMap (\h -> [genBackendE h, genBackend h]) hashes
|
|
|
|
genBackend :: Hash -> Backend
|
|
genBackend hash = Backend
|
|
{ backendVariety = hashKeyVariety hash (HasExt False)
|
|
, getKey = keyValue hash
|
|
, verifyKeyContent = Just $ checkKeyChecksum hash
|
|
, canUpgradeKey = Just needsUpgrade
|
|
, fastMigrate = Just trivialMigrate
|
|
, isStableKey = const True
|
|
}
|
|
|
|
genBackendE :: Hash -> Backend
|
|
genBackendE hash = (genBackend hash)
|
|
{ backendVariety = hashKeyVariety hash (HasExt True)
|
|
, getKey = keyValueE hash
|
|
}
|
|
|
|
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
|
|
#if MIN_VERSION_cryptonite(0,23,0)
|
|
hashKeyVariety (Blake2bHash size) = Blake2bKey size
|
|
hashKeyVariety (Blake2sHash size) = Blake2sKey size
|
|
hashKeyVariety (Blake2spHash size) = Blake2spKey size
|
|
#endif
|
|
|
|
{- A key is a hash of its contents. -}
|
|
keyValue :: Hash -> KeySource -> Annex (Maybe Key)
|
|
keyValue hash source = do
|
|
let file = contentLocation source
|
|
filesize <- liftIO $ getFileSize file
|
|
s <- hashFile hash file
|
|
return $ Just $ stubKey
|
|
{ keyName = s
|
|
, keyVariety = hashKeyVariety hash (HasExt False)
|
|
, keySize = Just filesize
|
|
}
|
|
|
|
{- Extension preserving keys. -}
|
|
keyValueE :: Hash -> KeySource -> Annex (Maybe Key)
|
|
keyValueE hash source = keyValue hash source >>= maybe (return Nothing) addE
|
|
where
|
|
addE k = return $ Just $ k
|
|
{ keyName = keyName k ++ selectExtension (keyFilename source)
|
|
, keyVariety = hashKeyVariety hash (HasExt True)
|
|
}
|
|
|
|
selectExtension :: FilePath -> String
|
|
selectExtension f
|
|
| null es = ""
|
|
| otherwise = intercalate "." ("":es)
|
|
where
|
|
es = filter (not . null) $ reverse $
|
|
take 2 $ filter (all validInExtension) $
|
|
takeWhile shortenough $
|
|
reverse $ splitc '.' $ takeExtensions f
|
|
shortenough e = length e <= 4 -- long enough for "jpeg"
|
|
|
|
{- A key's checksum is checked during fsck when it's content is present
|
|
- except for in fast mode. -}
|
|
checkKeyChecksum :: Hash -> Key -> FilePath -> Annex Bool
|
|
checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do
|
|
fast <- Annex.getState Annex.fast
|
|
exists <- liftIO $ doesFileExist file
|
|
case (exists, fast) of
|
|
(True, False) -> do
|
|
showAction "checksum"
|
|
check <$> hashFile hash file
|
|
_ -> return True
|
|
where
|
|
expected = keyHash key
|
|
check s
|
|
| s == expected = True
|
|
{- A bug caused checksums to be prefixed with \ in some
|
|
- cases; still accept these as legal now that the bug has been
|
|
- fixed. -}
|
|
| '\\' : s == expected = True
|
|
| otherwise = False
|
|
|
|
hwfault e = do
|
|
warning $ "hardware fault: " ++ show e
|
|
return False
|
|
|
|
keyHash :: Key -> String
|
|
keyHash key = dropExtensions (keyName key)
|
|
|
|
validInExtension :: Char -> Bool
|
|
validInExtension c
|
|
| isAlphaNum c = True
|
|
| c == '.' = True
|
|
| otherwise = False
|
|
|
|
{- Upgrade keys that have the \ prefix on their hash due to a bug, or
|
|
- that contain non-alphanumeric characters in their extension.
|
|
-
|
|
- Also, for a while migrate from eg SHA256E to SHA256 resulted in a SHA256
|
|
- key that contained an extension inside its keyName. Upgrade those
|
|
- keys, removing the extension.
|
|
-}
|
|
needsUpgrade :: Key -> Bool
|
|
needsUpgrade key = or
|
|
[ "\\" `isPrefixOf` keyHash key
|
|
, any (not . validInExtension) (takeExtensions $ keyName key)
|
|
, not (hasExt (keyVariety key)) && keyHash key /= keyName key
|
|
]
|
|
|
|
trivialMigrate :: Key -> Backend -> AssociatedFile -> Maybe Key
|
|
trivialMigrate oldkey newbackend afile
|
|
{- Fast migration from hashE to hash backend. -}
|
|
| migratable && hasExt oldvariety = Just $ oldkey
|
|
{ keyName = keyHash oldkey
|
|
, keyVariety = newvariety
|
|
}
|
|
{- Fast migration from hash to hashE backend. -}
|
|
| migratable && hasExt newvariety = case afile of
|
|
AssociatedFile Nothing -> Nothing
|
|
AssociatedFile (Just file) -> Just $ oldkey
|
|
{ keyName = keyHash oldkey ++ selectExtension file
|
|
, keyVariety = newvariety
|
|
}
|
|
{- Upgrade to fix bad previous migration that created a
|
|
- non-extension preserving key, with an extension
|
|
- in its keyName. -}
|
|
| newvariety == oldvariety && not (hasExt oldvariety) &&
|
|
keyHash oldkey /= keyName oldkey = Just $ oldkey
|
|
{ keyName = keyHash oldkey
|
|
}
|
|
| otherwise = Nothing
|
|
where
|
|
migratable = oldvariety /= newvariety
|
|
&& sameExceptExt oldvariety newvariety
|
|
oldvariety = keyVariety oldkey
|
|
newvariety = backendVariety newbackend
|
|
|
|
hashFile :: Hash -> FilePath -> Annex String
|
|
hashFile hash file = liftIO $ do
|
|
h <- hasher <$> L.readFile file
|
|
-- Force full evaluation so file is read and closed.
|
|
return (length h `seq` h)
|
|
where
|
|
hasher = case hash of
|
|
MD5Hash -> md5Hasher
|
|
SHA1Hash -> sha1Hasher
|
|
SHA2Hash hashsize -> sha2Hasher hashsize
|
|
SHA3Hash hashsize -> sha3Hasher hashsize
|
|
SkeinHash hashsize -> skeinHasher hashsize
|
|
#if MIN_VERSION_cryptonite(0,23,0)
|
|
Blake2bHash hashsize -> blake2bHasher hashsize
|
|
Blake2sHash hashsize -> blake2sHasher hashsize
|
|
Blake2spHash hashsize -> blake2spHasher hashsize
|
|
#endif
|
|
|
|
sha2Hasher :: HashSize -> (L.ByteString -> String)
|
|
sha2Hasher (HashSize hashsize)
|
|
| hashsize == 256 = use sha2_256
|
|
| hashsize == 224 = use sha2_224
|
|
| hashsize == 384 = use sha2_384
|
|
| hashsize == 512 = use sha2_512
|
|
| otherwise = error $ "unsupported SHA size " ++ show hashsize
|
|
where
|
|
use hasher = show . hasher
|
|
|
|
sha3Hasher :: HashSize -> (L.ByteString -> String)
|
|
sha3Hasher (HashSize hashsize)
|
|
| hashsize == 256 = show . sha3_256
|
|
| hashsize == 224 = show . sha3_224
|
|
| hashsize == 384 = show . sha3_384
|
|
| hashsize == 512 = show . sha3_512
|
|
| otherwise = error $ "unsupported SHA3 size " ++ show hashsize
|
|
|
|
skeinHasher :: HashSize -> (L.ByteString -> String)
|
|
skeinHasher (HashSize hashsize)
|
|
| hashsize == 256 = show . skein256
|
|
| hashsize == 512 = show . skein512
|
|
| otherwise = error $ "unsupported SKEIN size " ++ show hashsize
|
|
|
|
#if MIN_VERSION_cryptonite(0,23,0)
|
|
blake2bHasher :: HashSize -> (L.ByteString -> String)
|
|
blake2bHasher (HashSize hashsize)
|
|
| hashsize == 256 = show . blake2b_256
|
|
| hashsize == 512 = show . blake2b_512
|
|
| hashsize == 160 = show . blake2b_160
|
|
| hashsize == 224 = show . blake2b_224
|
|
| hashsize == 384 = show . blake2b_384
|
|
| otherwise = error $ "unsupported BLAKE2B size " ++ show hashsize
|
|
|
|
blake2sHasher :: HashSize -> (L.ByteString -> String)
|
|
blake2sHasher (HashSize hashsize)
|
|
| hashsize == 256 = show . blake2s_256
|
|
| hashsize == 160 = show . blake2s_160
|
|
| hashsize == 224 = show . blake2s_224
|
|
| otherwise = error $ "unsupported BLAKE2S size " ++ show hashsize
|
|
|
|
blake2spHasher :: HashSize -> (L.ByteString -> String)
|
|
blake2spHasher (HashSize hashsize)
|
|
| hashsize == 256 = show . blake2sp_256
|
|
| hashsize == 224 = show . blake2sp_224
|
|
| otherwise = error $ "unsupported BLAKE2SP size " ++ show hashsize
|
|
#endif
|
|
|
|
sha1Hasher :: L.ByteString -> String
|
|
sha1Hasher = show . sha1
|
|
|
|
md5Hasher :: L.ByteString -> String
|
|
md5Hasher = show . md5
|
|
|
|
{- A varient of the SHA256E backend, for testing that needs special keys
|
|
- that cannot collide with legitimate keys in the repository.
|
|
-
|
|
- This is accomplished by appending a special extension to the key,
|
|
- that is not one that selectExtension would select (due to being too
|
|
- long).
|
|
-}
|
|
testKeyBackend :: Backend
|
|
testKeyBackend =
|
|
let b = genBackendE (SHA2Hash (HashSize 256))
|
|
in b { getKey = (fmap addE) <$$> getKey b }
|
|
where
|
|
addE k = k { keyName = keyName k ++ longext }
|
|
longext = ".this-is-a-test-key"
|