add incremental hashing interface to Backend

As yet unused.

Backend.External could perhaps implement it too, although that would
involve sending chunks of data to it via a pipe or something, so likely
to be slow.

Backend/External.hs

@@ -67,6 +67,7 @@ makeBackend' ebname@(ExternalBackendName bname) hasext (Right p) = do
 				-- bump if progress handling is later added.
 				nullMeterUpdate
 			else Nothing
+		, verifyKeyContentIncrementally = Nothing
 		, canUpgradeKey = Nothing
 		, fastMigrate = Nothing
 		, isStableKey = const isstable
@@ -80,6 +81,7 @@ unavailBackend (ExternalBackendName bname) hasext =
 		{ backendVariety = ExternalKey bname hasext
 		, genKey = Nothing
 		, verifyKeyContent = Nothing
+		, verifyKeyContentIncrementally = Nothing
 		, canUpgradeKey = Nothing
 		, fastMigrate = Nothing
 		, isStableKey = const False

Backend/Hash.hs

@@ -1,6 +1,6 @@
 {- git-annex hashing backends
  -
- - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -28,6 +28,7 @@ import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString.Lazy as L
 import Control.DeepSeq
 import Control.Exception (evaluate)
+import Control.Concurrent.MVar
 
 data Hash
 	= MD5Hash
@@ -75,6 +76,7 @@ genBackend hash = Backend
 	{ backendVariety = hashKeyVariety hash (HasExt False)
 	, genKey = Just (keyValue hash)
 	, verifyKeyContent = Just $ checkKeyChecksum hash
+	, verifyKeyContentIncrementally = Just $ checkKeyChecksumIncremental hash
 	, canUpgradeKey = Just needsUpgrade
 	, fastMigrate = Just trivialMigrate
 	, isStableKey = const True
@@ -116,8 +118,6 @@ keyValueE hash source meterupdate =
 	keyValue hash source meterupdate
 		>>= addE source (const $ hashKeyVariety hash (HasExt True))
 
-{- A key's checksum is checked during fsck when it's content is present
- - except for in fast mode. -}
 checkKeyChecksum :: Hash -> Key -> RawFilePath -> Annex Bool
 checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do
 	fast <- Annex.getState Annex.fast
@@ -125,22 +125,29 @@ checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do
 	case (exists, fast) of
 		(True, False) -> do
 			showAction "checksum"
-			check <$> hashFile hash file nullMeterUpdate
+			sameCheckSum key 
+				<$> hashFile hash file nullMeterUpdate
 		_ -> return True
   where
-	expected = decodeBS (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
 
+sameCheckSum :: Key -> String -> Bool
+sameCheckSum key 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
+  where
+	expected = decodeBS (keyHash key)
+
+checkKeyChecksumIncremental :: Hash -> Key -> Annex IncrementalVerifier
+checkKeyChecksumIncremental hash key = liftIO $
+	(\h -> snd h key) (hasher hash)
+
 keyHash :: Key -> S.ByteString
 keyHash = fst . splitKeyNameExtension
 
@@ -195,79 +202,97 @@ trivialMigrate' oldkey newbackend afile maxextlen
 hashFile :: Hash -> RawFilePath -> MeterUpdate -> Annex String
 hashFile hash file meterupdate = 
 	liftIO $ withMeteredFile (fromRawFilePath file) meterupdate $ \b -> do
-		let h = hasher b
+		let h = (fst $ hasher hash) b
 		-- Force full evaluation of hash so whole file is read
 		-- before returning.
 		evaluate (rnf h)
 		return h
-  where
-	hasher = case hash of
-		MD5Hash -> md5Hasher
-		SHA1Hash -> sha1Hasher
-		SHA2Hash hashsize -> sha2Hasher hashsize
-		SHA3Hash hashsize -> sha3Hasher hashsize
-		SkeinHash hashsize -> skeinHasher hashsize
-		Blake2bHash hashsize -> blake2bHasher hashsize
-		Blake2bpHash hashsize -> blake2bpHasher hashsize
-		Blake2sHash hashsize -> blake2sHasher hashsize
-		Blake2spHash hashsize -> blake2spHasher hashsize
 
-sha2Hasher :: HashSize -> (L.ByteString -> String)
+type Hasher = (L.ByteString -> String, Key -> IO IncrementalVerifier)
+
+hasher :: Hash -> 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
+
+mkHasher :: HashAlgorithm h => (L.ByteString -> Digest h) -> Context h -> Hasher
+mkHasher h c = (show . h, mkIncrementalVerifier c)
+
+sha2Hasher :: HashSize -> Hasher
 sha2Hasher (HashSize hashsize)
-	| hashsize == 256 = use sha2_256
+	| hashsize == 256 = mkHasher sha2_256 sha2_256_context
-	| hashsize == 224 = use sha2_224
+	| hashsize == 224 = mkHasher sha2_224 sha2_224_context
-	| hashsize == 384 = use sha2_384
+	| hashsize == 384 = mkHasher sha2_384 sha2_384_context
-	| hashsize == 512 = use sha2_512
+	| hashsize == 512 = mkHasher sha2_512 sha2_512_context
-	| otherwise = error $ "unsupported SHA size " ++ show hashsize
+	| otherwise = error $ "unsupported SHA2 size " ++ show hashsize
-  where
-	use hasher = show . hasher
 
-sha3Hasher :: HashSize -> (L.ByteString -> String)
+sha3Hasher :: HashSize -> Hasher
 sha3Hasher (HashSize hashsize)
-	| hashsize == 256 = show . sha3_256
+	| hashsize == 256 = mkHasher sha3_256 sha3_256_context
-	| hashsize == 224 = show . sha3_224
+	| hashsize == 224 = mkHasher sha3_224 sha3_224_context
-	| hashsize == 384 = show . sha3_384
+	| hashsize == 384 = mkHasher sha3_384 sha3_384_context
-	| hashsize == 512 = show . sha3_512
+	| hashsize == 512 = mkHasher sha3_512 sha3_512_context
 	| otherwise = error $ "unsupported SHA3 size " ++ show hashsize
 
-skeinHasher :: HashSize -> (L.ByteString -> String)
+skeinHasher :: HashSize -> Hasher
 skeinHasher (HashSize hashsize)
-	| hashsize == 256 = show . skein256
+	| hashsize == 256 = mkHasher skein256 skein256_context
-	| hashsize == 512 = show . skein512
+	| hashsize == 512 = mkHasher skein512 skein512_context
 	| otherwise = error $ "unsupported SKEIN size " ++ show hashsize
 
-blake2bHasher :: HashSize -> (L.ByteString -> String)
+blake2bHasher :: HashSize -> Hasher
 blake2bHasher (HashSize hashsize)
-	| hashsize == 256 = show . blake2b_256
+	| hashsize == 256 = mkHasher blake2b_256 blake2b_256_context
-	| hashsize == 512 = show . blake2b_512
+	| hashsize == 512 = mkHasher blake2b_512 blake2b_512_context
-	| hashsize == 160 = show . blake2b_160
+	| hashsize == 160 = mkHasher blake2b_160 blake2b_160_context
-	| hashsize == 224 = show . blake2b_224
+	| hashsize == 224 = mkHasher blake2b_224 blake2b_224_context
-	| hashsize == 384 = show . blake2b_384
+	| hashsize == 384 = mkHasher blake2b_384 blake2b_384_context
 	| otherwise = error $ "unsupported BLAKE2B size " ++ show hashsize
 
-blake2bpHasher :: HashSize -> (L.ByteString -> String)
+blake2bpHasher :: HashSize -> Hasher
 blake2bpHasher (HashSize hashsize)
-	| hashsize == 512 = show . blake2bp_512
+	| hashsize == 512 = mkHasher blake2bp_512 blake2bp_512_context
 	| otherwise = error $ "unsupported BLAKE2BP size " ++ show hashsize
 
-blake2sHasher :: HashSize -> (L.ByteString -> String)
+blake2sHasher :: HashSize -> Hasher
 blake2sHasher (HashSize hashsize)
-	| hashsize == 256 = show . blake2s_256
+	| hashsize == 256 = mkHasher blake2s_256 blake2s_256_context
-	| hashsize == 160 = show . blake2s_160
+	| hashsize == 160 = mkHasher blake2s_160 blake2s_160_context
-	| hashsize == 224 = show . blake2s_224
+	| hashsize == 224 = mkHasher blake2s_224 blake2s_224_context
 	| otherwise = error $ "unsupported BLAKE2S size " ++ show hashsize
 
-blake2spHasher :: HashSize -> (L.ByteString -> String)
+blake2spHasher :: HashSize -> Hasher
 blake2spHasher (HashSize hashsize)
-	| hashsize == 256 = show . blake2sp_256
+	| hashsize == 256 = mkHasher blake2sp_256 blake2sp_256_context
-	| hashsize == 224 = show . blake2sp_224
+	| hashsize == 224 = mkHasher blake2sp_224 blake2sp_224_context
 	| otherwise = error $ "unsupported BLAKE2SP size " ++ show hashsize
 
-sha1Hasher :: L.ByteString -> String
+sha1Hasher :: Hasher
-sha1Hasher = show . sha1
+sha1Hasher = mkHasher sha1 sha1_context
 
-md5Hasher :: L.ByteString -> String
+md5Hasher :: Hasher
-md5Hasher = show . md5
+md5Hasher = mkHasher md5 md5_context
+
+mkIncrementalVerifier :: HashAlgorithm h => Context h -> Key -> IO IncrementalVerifier
+mkIncrementalVerifier ctx key = do
+	v <- newMVar ctx
+	return $ IncrementalVerifier
+		{ updateIncremental = \b -> do
+			ctx' <- takeMVar v
+			let ctx'' = hashUpdate ctx' b
+			evaluate $ rnf ctx''
+			putMVar v ctx''
+		, finalizeIncremental = do
+			ctx' <- takeMVar v
+			let digest = hashFinalize ctx'
+			return $ sameCheckSum key (show digest)
+		}
 
 {- A varient of the SHA256E backend, for testing that needs special keys
  - that cannot collide with legitimate keys in the repository.

Backend/URL.hs

@@ -23,6 +23,7 @@ backend = Backend
 	{ backendVariety = URLKey
 	, genKey = Nothing
 	, verifyKeyContent = Nothing
+	, verifyKeyContentIncrementally = Nothing
 	, canUpgradeKey = Nothing
 	, fastMigrate = Nothing
 	-- The content of an url can change at any time, so URL keys are

Backend/WORM.hs

@@ -26,6 +26,7 @@ backend = Backend
 	{ backendVariety = WORMKey
 	, genKey = Just keyValue
 	, verifyKeyContent = Nothing
+	, verifyKeyContentIncrementally = Nothing
 	, canUpgradeKey = Just needsUpgrade
 	, fastMigrate = Just removeProblemChars
 	, isStableKey = const True

Types/Backend.hs

@@ -2,7 +2,7 @@
  -
  - Most things should not need this, using Types instead
  -
- - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -11,16 +11,21 @@ module Types.Backend where
 
 import Types.Key
 import Types.KeySource
-
 import Utility.Metered
 import Utility.FileSystemEncoding
 
+import Data.ByteString (ByteString)
+
 data BackendA a = Backend
 	{ backendVariety :: KeyVariety
 	, genKey :: Maybe (KeySource -> MeterUpdate -> a Key)
-	-- Verifies the content of a key using a hash. This does not need
+	-- Verifies the content of a key, stored in a file, using a hash.
-	-- to be cryptographically secure.
+	-- This does not need to be cryptographically secure.
 	, verifyKeyContent :: Maybe (Key -> RawFilePath -> a Bool)
+	-- Incrementally verifies the content of a key, using the same
+	-- hash as verifyKeyContent, but with the content provided
+	-- incrementally a peice at a time, until finalized.
+	, verifyKeyContentIncrementally :: Maybe (Key -> a IncrementalVerifier)
 	-- Checks if a key can be upgraded to a better form.
 	, canUpgradeKey :: Maybe (Key -> Bool)
 	-- Checks if there is a fast way to migrate a key to a different
@@ -38,3 +43,11 @@ instance Show (BackendA a) where
 
 instance Eq (BackendA a) where
 	a == b = backendVariety a == backendVariety b
+
+data IncrementalVerifier = IncrementalVerifier
+	{ updateIncremental :: ByteString -> IO ()
+	-- ^ Called repeatedly on each peice of the content.
+	, finalizeIncremental :: IO Bool
+	-- ^ Called once the full content has been sent, returns true
+	-- if the hash verified.
+	}

Utility/Hash.hs

@@ -2,29 +2,57 @@
 
 module Utility.Hash (
 	sha1,
+	sha1_context,
 	sha2_224,
+	sha2_224_context,
 	sha2_256,
+	sha2_256_context,
 	sha2_384,
+	sha2_384_context,
 	sha2_512,
+	sha2_512_context,
 	sha3_224,
+	sha3_224_context,
 	sha3_256,
+	sha3_256_context,
 	sha3_384,
+	sha3_384_context,
 	sha3_512,
+	sha3_512_context,
 	skein256,
+	skein256_context,
 	skein512,
+	skein512_context,
 	blake2s_160,
+	blake2s_160_context,
 	blake2s_224,
+	blake2s_224_context,
 	blake2s_256,
+	blake2s_256_context,
 	blake2sp_224,
+	blake2sp_224_context,
 	blake2sp_256,
+	blake2sp_256_context,
 	blake2b_160,
+	blake2b_160_context,
 	blake2b_224,
+	blake2b_224_context,
 	blake2b_256,
+	blake2b_256_context,
 	blake2b_384,
+	blake2b_384_context,
 	blake2b_512,
+	blake2b_512_context,
 	blake2bp_512,
+	blake2bp_512_context,
 	md5,
+	md5_context,
 	md5s,
+	hashUpdate,
+	hashFinalize,
+	Digest,
+	HashAlgorithm,
+	Context,
 	props_hashes_stable,
 	Mac(..),
 	calcMac,
@@ -35,78 +63,147 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
-import "cryptonite" Crypto.MAC.HMAC
+import "cryptonite" Crypto.MAC.HMAC hiding (Context)
 import "cryptonite" Crypto.Hash
 
 sha1 :: L.ByteString -> Digest SHA1
 sha1 = hashlazy
 
+sha1_context :: Context SHA1
+sha1_context = hashInit
+
 sha2_224 :: L.ByteString -> Digest SHA224
 sha2_224 = hashlazy
 
+sha2_224_context :: Context SHA224
+sha2_224_context = hashInit
+
 sha2_256 :: L.ByteString -> Digest SHA256
 sha2_256 = hashlazy
 
+sha2_256_context :: Context SHA256
+sha2_256_context = hashInit
+
 sha2_384 :: L.ByteString -> Digest SHA384
 sha2_384 = hashlazy
 
+sha2_384_context :: Context SHA384
+sha2_384_context = hashInit
+
 sha2_512 :: L.ByteString -> Digest SHA512
 sha2_512 = hashlazy
 
+sha2_512_context :: Context SHA512
+sha2_512_context = hashInit
+
 sha3_224 :: L.ByteString -> Digest SHA3_224
 sha3_224 = hashlazy
 
+sha3_224_context :: Context SHA3_224
+sha3_224_context = hashInit
+
 sha3_256 :: L.ByteString -> Digest SHA3_256
 sha3_256 = hashlazy
 
+sha3_256_context :: Context SHA3_256
+sha3_256_context = hashInit
+
 sha3_384 :: L.ByteString -> Digest SHA3_384
 sha3_384 = hashlazy
 
+sha3_384_context :: Context SHA3_384
+sha3_384_context = hashInit
+
 sha3_512 :: L.ByteString -> Digest SHA3_512
 sha3_512 = hashlazy
 
+sha3_512_context :: Context SHA3_512
+sha3_512_context = hashInit
+
 skein256 :: L.ByteString -> Digest Skein256_256
 skein256 = hashlazy
 
+skein256_context :: Context Skein256_256
+skein256_context = hashInit
+
 skein512 :: L.ByteString -> Digest Skein512_512
 skein512 = hashlazy
 
+skein512_context :: Context Skein512_512
+skein512_context = hashInit
+
 blake2s_160 :: L.ByteString -> Digest Blake2s_160
 blake2s_160 = hashlazy
 
+blake2s_160_context :: Context Blake2s_160
+blake2s_160_context = hashInit
+
 blake2s_224 :: L.ByteString -> Digest Blake2s_224
 blake2s_224 = hashlazy
 
+blake2s_224_context :: Context Blake2s_224
+blake2s_224_context = hashInit
+
 blake2s_256 :: L.ByteString -> Digest Blake2s_256
 blake2s_256 = hashlazy
 
+blake2s_256_context :: Context Blake2s_256
+blake2s_256_context = hashInit
+
 blake2sp_224 :: L.ByteString -> Digest Blake2sp_224
 blake2sp_224 = hashlazy
 
+blake2sp_224_context :: Context Blake2sp_224
+blake2sp_224_context = hashInit
+
 blake2sp_256 :: L.ByteString -> Digest Blake2sp_256
 blake2sp_256 = hashlazy
 
+blake2sp_256_context :: Context Blake2sp_256
+blake2sp_256_context = hashInit
+
 blake2b_160 :: L.ByteString -> Digest Blake2b_160
 blake2b_160 = hashlazy
 
+blake2b_160_context :: Context Blake2b_160
+blake2b_160_context = hashInit
+
 blake2b_224 :: L.ByteString -> Digest Blake2b_224
 blake2b_224 = hashlazy
 
+blake2b_224_context :: Context Blake2b_224
+blake2b_224_context = hashInit
+
 blake2b_256 :: L.ByteString -> Digest Blake2b_256
 blake2b_256 = hashlazy
 
+blake2b_256_context :: Context Blake2b_256
+blake2b_256_context = hashInit
+
 blake2b_384 :: L.ByteString -> Digest Blake2b_384
 blake2b_384 = hashlazy
 
+blake2b_384_context :: Context Blake2b_384
+blake2b_384_context = hashInit
+
 blake2b_512 :: L.ByteString -> Digest Blake2b_512
 blake2b_512 = hashlazy
 
+blake2b_512_context :: Context Blake2b_512
+blake2b_512_context = hashInit
+
 blake2bp_512 :: L.ByteString -> Digest Blake2bp_512
 blake2bp_512 = hashlazy
 
+blake2bp_512_context :: Context Blake2bp_512
+blake2bp_512_context = hashInit
+
 md5 ::  L.ByteString -> Digest MD5
 md5 = hashlazy
 
+md5_context :: Context MD5
+md5_context = hashInit
+
 md5s ::  S.ByteString -> Digest MD5
 md5s = hash