git-annex-10.20260624: Backend/Hash.hs

{- git-annex hashing backends
 -
 - Copyright 2011-2026 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Backend.Hash (
	backends,
	keyHash,
	descChecksum,
	HashType(..),
	cryptographicallySecure,
	hashFile,
	checkKeyChecksum,
	testKeyBackend,
	genTestKey,
) where

import Annex.Common
import qualified Annex
import Backend.Utilities
import Types.Key
import Types.Backend
import Types.KeySource
import Utility.Hash
import Utility.Metered

import qualified Data.ByteString as S
import qualified Data.ByteString.Short as S (toShort, fromShort)
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import Data.Char
import Control.DeepSeq
import Control.Exception (evaluate)

data HashType
	= MD5Hash
	| SHA1Hash
	| SHA2Hash HashSize
	| SHA3Hash HashSize
	| SkeinHash HashSize
	| Blake2bHash HashSize
	| Blake2bpHash HashSize
	| Blake2sHash HashSize
	| Blake2spHash HashSize
#ifdef WITH_BLAKE3
	| Blake3Hash
#endif
#ifdef WITH_XXH3
	| XXH3Hash
#endif

cryptographicallySecure :: HashType -> Bool
cryptographicallySecure (SHA2Hash _) = True
cryptographicallySecure (SHA3Hash _) = True
cryptographicallySecure (SkeinHash _) = True
cryptographicallySecure (Blake2bHash _) = True
cryptographicallySecure (Blake2bpHash _) = True
cryptographicallySecure (Blake2sHash _) = True
cryptographicallySecure (Blake2spHash _) = True
#ifdef WITH_BLAKE3
cryptographicallySecure Blake3Hash = True
#endif
#ifdef WITH_XXH3
cryptographicallySecure XXH3Hash = False
#endif
cryptographicallySecure SHA1Hash = False
cryptographicallySecure MD5Hash = False

{- Order is significant. The first hash is the default one that git-annex
 - uses, and must be cryptographically secure. 
 -
 - Also, want more common sizes earlier than uncommon sizes. -}
hashes :: [HashType]
hashes = concat 
	[ map (SHA2Hash . HashSize) [256, 512, 224, 384]
	, map (SHA3Hash . HashSize) [256, 512, 224, 384]
	, map (SkeinHash . HashSize) [256, 512]
	, map (Blake2bHash . HashSize) [256, 512, 160, 224, 384]
	, map (Blake2bpHash . HashSize) [512]
	, map (Blake2sHash . HashSize) [256, 160, 224]
	, map (Blake2spHash . HashSize) [256, 224]
#ifdef WITH_BLAKE3
	, [Blake3Hash]
#endif
#ifdef WITH_XXH3
	, if xxh3Supported
		then [XXH3Hash]
		else []
#endif
	, [SHA1Hash]
	, [MD5Hash]
	]

{- The SHA256E backend is the default, so genBackendE comes first. -}
backends :: [Backend]
backends = concatMap (\h -> [genBackendE h, genBackend h]) hashes

genBackend :: HashType -> Backend
genBackend hash = Backend
	{ backendVariety = hashKeyVariety hash (HasExt False)
	, genKey = Just (keyValue hash)
	, verifyKeyContent = Just $ checkKeyChecksum sameCheckSum hash
	, verifyKeyContentIncrementally = checkKeyChecksumIncremental hash
	, verifyKeyContentIsFaster = True
	, canUpgradeKey = Just needsUpgrade
	, fastMigrate = Just trivialMigrate
	, isStableKey = const True
	, isCryptographicallySecure = cryptographicallySecure hash
	, isCryptographicallySecureKey = const $ pure $
		cryptographicallySecure hash
	}

genBackendE :: HashType -> Backend
genBackendE hash = (genBackend hash)
	{ backendVariety = hashKeyVariety hash (HasExt True)
	, genKey = Just (keyValueE hash)
	}

hashKeyVariety :: HashType -> HasExt -> KeyVariety
hashKeyVariety MD5Hash he = MD5Key he
hashKeyVariety SHA1Hash he = SHA1Key he
hashKeyVariety (SHA2Hash size) he = SHA2Key size he
hashKeyVariety (SHA3Hash size) he = SHA3Key size he
hashKeyVariety (SkeinHash size) he = SKEINKey size he
hashKeyVariety (Blake2bHash size) he = Blake2bKey size he
hashKeyVariety (Blake2bpHash size) he = Blake2bpKey size he
hashKeyVariety (Blake2sHash size) he = Blake2sKey size he
hashKeyVariety (Blake2spHash size) he = Blake2spKey size he
#ifdef WITH_BLAKE3
hashKeyVariety Blake3Hash he = Blake3Key he
#endif
#ifdef WITH_XXH3
hashKeyVariety XXH3Hash he = XXH3Key he
#endif

{- A key is a hash of its contents. -}
keyValue :: HashType -> KeySource -> MeterUpdate -> Annex Key
keyValue hashtype source meterupdate = do
	let file = contentLocation source
	filesize <- liftIO $ getFileSize file
	hash <- hashFile hashtype file meterupdate
	return $ mkKey $ \k -> k
		{ keyName = S.toShort (hashByteString hash)
		, keyVariety = hashKeyVariety hashtype (HasExt False)
		, keySize = Just filesize
		}

{- Extension preserving keys. -}
keyValueE :: HashType -> KeySource -> MeterUpdate -> Annex Key
keyValueE hash source meterupdate =
	keyValue hash source meterupdate
		>>= addE source (const $ hashKeyVariety hash (HasExt True))

checkKeyChecksum :: (Key -> Hash -> Bool) -> HashType -> Key -> OsPath -> Annex Bool
checkKeyChecksum issame hash key file = catchIOErrorType HardwareFault hwfault $ do
	showAction (UnquotedString descChecksum)
	issame key 
		<$> hashFile hash file nullMeterUpdate
  where
	hwfault e = do
		warning $ UnquotedString $ "hardware fault: " ++ show e
		return False

sameCheckSum :: Key -> Hash -> Bool
sameCheckSum key hash
	| hash == Hash 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. -}
	| otherwise = case S.uncons expected of
		Just (h, t) | h == backslash -> hash == Hash t
		_ -> False
  where
	expected = keyHash key
	backslash = fromIntegral (ord '\\')

checkKeyChecksumIncremental :: HashType -> Maybe (Key -> Annex IncrementalVerifier)
checkKeyChecksumIncremental hash = case hashIncremental (hasher hash) of
	Just iv -> Just (liftIO . iv)
	Nothing -> Nothing

keyHash :: Key -> S.ByteString
keyHash = fst . splitKeyNameExtension

{- 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
	[ "\\" `S8.isPrefixOf` keyHash key
	, S.any (not . validInExtension) (snd $ splitKeyNameExtension key)
	, not (hasExt (fromKey keyVariety key)) && keyHash key /= S.fromShort (fromKey keyName key)
	]

trivialMigrate :: Key -> Backend -> AssociatedFile -> Bool -> Annex (Maybe Key)
trivialMigrate oldkey newbackend afile _inannex = do
	c <- Annex.getGitConfig
	return $ trivialMigrate' oldkey newbackend afile
		(annexMaxExtensionLength c)
		(annexMaxExtensions c)

trivialMigrate' :: Key -> Backend -> AssociatedFile -> Maybe Int -> Maybe Int -> Maybe Key
trivialMigrate' oldkey newbackend afile maxextlen maxexts
	{- Fast migration from hashE to hash backend. -}
	| migratable && hasExt oldvariety = Just $ alterKey oldkey $ \d -> d
		{ keyName = S.toShort (keyHash oldkey)
		, keyVariety = newvariety
		}
	{- Fast migration from hash to hashE backend. -}
	| migratable && hasExt newvariety = case afile of
		AssociatedFile Nothing -> Nothing
		AssociatedFile (Just file) -> Just $ alterKey oldkey $ \d -> d
			{ keyName = S.toShort $ keyHash oldkey 
				<> selectExtension maxextlen maxexts 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 /= S.fromShort (fromKey keyName oldkey) = 
			Just $ alterKey oldkey $ \d -> d
				{ keyName = S.toShort (keyHash oldkey)
				}
	| otherwise = Nothing
  where
	migratable = oldvariety /= newvariety 
		&& sameExceptExt oldvariety newvariety
	oldvariety = fromKey keyVariety oldkey
	newvariety = backendVariety newbackend

hashFile :: HashType -> OsPath -> MeterUpdate -> Annex Hash
hashFile hashtype file meterupdate = case hashFileFast o of
	Nothing -> liftIO hashpure
	Just a -> liftIO $ a file >>= \case
		Just h -> return h
		Nothing -> hashpure
  where
	o = hasher hashtype
	hashpure = withMeteredFile file meterupdate $ \b -> do
		let h = (hashPure o) b
		-- Force full evaluation of hash so whole file is read
		-- before returning.
		evaluate (rnf h)
		return h

data Hasher = Hasher
	{ hashPure :: L.ByteString -> Hash
	, hashFileFast :: Maybe (OsPath -> IO (Maybe Hash))
	, hashIncremental :: Maybe (Key -> IO IncrementalVerifier)
	}

hasher :: HashType -> Hasher
hasher MD5Hash = md5Hasher
hasher SHA1Hash = sha1Hasher
hasher (SHA2Hash hashsize) = sha2Hasher hashsize
hasher (SHA3Hash hashsize) = sha3Hasher hashsize
hasher (SkeinHash hashsize) = skeinHasher hashsize
hasher (Blake2bHash hashsize) = blake2bHasher hashsize
hasher (Blake2bpHash hashsize) = blake2bpHasher hashsize
hasher (Blake2sHash hashsize) = blake2sHasher hashsize
hasher (Blake2spHash hashsize) = blake2spHasher hashsize
#ifdef WITH_BLAKE3
hasher Blake3Hash = blake3Hasher
#endif
#ifdef WITH_XXH3
hasher XXH3Hash = xxh3Hasher
#endif

mkHasher :: (L.ByteString -> HashDigest) -> IO IncrementalHasher -> Hasher
mkHasher h i = Hasher
	{ hashPure = digestToHash . h
	, hashFileFast = Nothing
	, hashIncremental = Just $
		mkIncrementalVerifier i descChecksum . sameCheckSum
	}

sha2Hasher :: HashSize -> Hasher
sha2Hasher (HashSize hashsize)
	| hashsize == 256 = mkHasher sha2_256 sha2_256_hasher
	| hashsize == 224 = mkHasher sha2_224 sha2_224_hasher
	| hashsize == 384 = mkHasher sha2_384 sha2_384_hasher
	| hashsize == 512 = mkHasher sha2_512 sha2_512_hasher
	| otherwise = giveup $ "unsupported SHA2 size " ++ show hashsize

sha3Hasher :: HashSize -> Hasher
sha3Hasher (HashSize hashsize)
	| hashsize == 256 = mkHasher sha3_256 sha3_256_hasher
	| hashsize == 224 = mkHasher sha3_224 sha3_224_hasher
	| hashsize == 384 = mkHasher sha3_384 sha3_384_hasher
	| hashsize == 512 = mkHasher sha3_512 sha3_512_hasher
	| otherwise = giveup $ "unsupported SHA3 size " ++ show hashsize

skeinHasher :: HashSize -> Hasher
skeinHasher (HashSize hashsize)
	| hashsize == 256 = mkHasher skein256 skein256_hasher
	| hashsize == 512 = mkHasher skein512 skein512_hasher
	| otherwise = giveup $ "unsupported SKEIN size " ++ show hashsize

blake2bHasher :: HashSize -> Hasher
blake2bHasher (HashSize hashsize)
	| hashsize == 256 = mkHasher blake2b_256 blake2b_256_hasher
	| hashsize == 512 = mkHasher blake2b_512 blake2b_512_hasher
	| hashsize == 160 = mkHasher blake2b_160 blake2b_160_hasher
	| hashsize == 224 = mkHasher blake2b_224 blake2b_224_hasher
	| hashsize == 384 = mkHasher blake2b_384 blake2b_384_hasher
	| otherwise = giveup $ "unsupported BLAKE2B size " ++ show hashsize

blake2bpHasher :: HashSize -> Hasher
blake2bpHasher (HashSize hashsize)
	| hashsize == 512 = mkHasher blake2bp_512 blake2bp_512_hasher
	| otherwise = giveup $ "unsupported BLAKE2BP size " ++ show hashsize

blake2sHasher :: HashSize -> Hasher
blake2sHasher (HashSize hashsize)
	| hashsize == 256 = mkHasher blake2s_256 blake2s_256_hasher
	| hashsize == 160 = mkHasher blake2s_160 blake2s_160_hasher
	| hashsize == 224 = mkHasher blake2s_224 blake2s_224_hasher
	| otherwise = giveup $ "unsupported BLAKE2S size " ++ show hashsize

blake2spHasher :: HashSize -> Hasher
blake2spHasher (HashSize hashsize)
	| hashsize == 256 = mkHasher blake2sp_256 blake2sp_256_hasher
	| hashsize == 224 = mkHasher blake2sp_224 blake2sp_224_hasher
	| otherwise = giveup $ "unsupported BLAKE2SP size " ++ show hashsize

#ifdef WITH_BLAKE3
blake3Hasher :: Hasher
blake3Hasher = Hasher
	{ hashPure = blake3
	, hashFileFast = Just blake3File
	, hashIncremental = Just $
		blake3IncrementalVerifier descChecksum . sameCheckSum
	}
#endif

#ifdef WITH_XXH3
xxh3Hasher :: Hasher
xxh3Hasher = Hasher
	{ hashPure = digestToHash . xxh3
	, hashFileFast = Nothing
	, hashIncremental = xxh3Incremental
	}
#endif

sha1Hasher :: Hasher
sha1Hasher = mkHasher sha1 sha1_hasher

md5Hasher :: Hasher
md5Hasher = mkHasher md5 md5_hasher

descChecksum :: String
descChecksum = "checksum"

{- A variant 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 testKeyHash
	    gk = case genKey b of
		Nothing -> Nothing
		Just f -> Just (\ks p -> addTestE <$> f ks p)
	in b { genKey = gk }

addTestE :: Key -> Key
addTestE k = alterKey k $ \d -> d
	{ keyName = keyName d <> longext
	}
  where
	longext = ".this-is-a-test-key"

testKeyHash :: HashType
testKeyHash = SHA2Hash (HashSize 256)

genTestKey :: L.ByteString -> Key
genTestKey content = addTestE $ mkKey $ \kd -> kd
	{ keyName = S.toShort $ hashByteString $
		(hashPure $ hasher testKeyHash) content
	, keyVariety = backendVariety testKeyBackend
	}