incremental checksum on download from ssh or p2p

Checksum as content is received from a remote git-annex repository, rather
than doing it in a second pass.

Not tested at all yet, but I imagine it will work!

Not implemented for any special remotes, and also not implemented for
copies from local remotes. It may be that, for local remotes, it will
suffice to use rsync, rely on its checksumming, and simply return Verified.
(It would still make a checksumming pass when cp is used for COW, I guess.)

P2P/Annex.hs

@@ -1,6 +1,6 @@
 {- P2P protocol, Annex implementation
  -
- - Copyright 2016-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2016-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -23,9 +23,11 @@ import P2P.IO
 import Logs.Location
 import Types.NumCopies
 import Utility.Metered
+import Types.Backend (IncrementalVerifier(..))
 
 import Control.Monad.Free
 import Control.Concurrent.STM
+import qualified Data.ByteString as S
 
 -- Full interpreter for Proto, that can receive and send objects.
 runFullProto :: RunState -> P2PConnection -> Proto a -> Annex (Either ProtoFailure a)
@@ -77,7 +79,7 @@ runLocal runst runner a = case a of
 			let runtransfer ti = 
 				Right <$> transfer download' k af Nothing (\p ->
 					logStatusAfter k $ getViaTmp rsp DefaultVerify k af $ \tmp ->
-						storefile (fromRawFilePath tmp) o l getb validitycheck p ti)
+						storefile (fromRawFilePath tmp) o l getb Nothing validitycheck p ti)
 			let fallback = return $ Left $
 				ProtoFailureMessage "transfer already in progress, or unable to take transfer lock"
 			checktransfer runtransfer fallback
@@ -85,10 +87,10 @@ runLocal runst runner a = case a of
 			Left e -> return $ Left $ ProtoFailureException e
 			Right (Left e) -> return $ Left e
 			Right (Right ok) -> runner (next ok)
-	StoreContentTo dest o l getb validitycheck next -> do
+	StoreContentTo dest incrementalverifier o l getb validitycheck next -> do
 		v <- tryNonAsync $ do
 			let runtransfer ti = Right
-				<$> storefile dest o l getb validitycheck nullMeterUpdate ti
+				<$> storefile dest o l getb incrementalverifier validitycheck nullMeterUpdate ti
 			let fallback = return $ Left $
 				ProtoFailureMessage "transfer failed"
 			checktransfer runtransfer fallback
@@ -153,16 +155,41 @@ runLocal runst runner a = case a of
 		-- Transfer logs are updated higher in the stack when
 		-- a client.
 		Client _ -> ta nullMeterUpdate
+	
+	resumefromoffset o incrementalverifier p h
+		| o /= 0 = do
+			p' <- case incrementalverifier of
+				Just iv -> do
+					go iv o
+					return p
+				_ -> return $ offsetMeterUpdate p (toBytesProcessed o)
+			-- Make sure the handle is seeked to the offset.
+			-- (Reading the file probably left it there
+			-- when that was done, but let's be sure.)
+			hSeek h AbsoluteSeek o
+			return p'
+		| otherwise = return p
+	  where
+		go iv n
+			| n == 0 = return ()
+			| n > fromIntegral defaultChunkSize = do
+				updateIncremental iv =<< S.hGet h defaultChunkSize
+				go iv (n - fromIntegral defaultChunkSize)
+			| otherwise = 
+				updateIncremental iv =<< S.hGet h (fromIntegral n)
 
-	storefile dest (Offset o) (Len l) getb validitycheck p ti = do
-		let p' = offsetMeterUpdate p (toBytesProcessed o)
+	storefile dest (Offset o) (Len l) getb incrementalverifier validitycheck p ti = do
 		v <- runner getb
 		case v of
 			Right b -> do
 				liftIO $ withBinaryFile dest ReadWriteMode $ \h -> do
-					when (o /= 0) $
-						hSeek h AbsoluteSeek o
-					meteredWrite p' h b
+					p' <- resumefromoffset o incrementalverifier p h
+					let writechunk = case incrementalverifier of
+						Nothing -> \c -> S.hPut h c
+						Just iv -> \c -> do
+							S.hPut h c
+							updateIncremental iv c
+					meteredWrite p' writechunk b
 				indicatetransferred ti
 
 				rightsize <- do
@@ -170,8 +197,12 @@ runLocal runst runner a = case a of
 					return (toInteger sz == l + o)
 					
 				runner validitycheck >>= \case
-					Right (Just Valid) ->
-						return (rightsize, UnVerified)
+					Right (Just Valid) -> case incrementalverifier of
+						Just iv -> ifM (liftIO (finalizeIncremental iv) <&&> pure rightsize)
+							( return (True, Verified)
+							, return (False, UnVerified)
+							)
+						Nothing -> return (rightsize, UnVerified)
 					Right (Just Invalid) | l == 0 ->
 						-- Special case, for when
 						-- content was not

P2P/IO.hs

@@ -259,7 +259,7 @@ debugMessage conn prefix m = do
 -- connection. False is returned to indicate this problem.
 sendExactly :: Len -> L.ByteString -> Handle -> MeterUpdate -> IO Bool
 sendExactly (Len n) b h p = do
-	sent <- meteredWrite' p h (L.take (fromIntegral n) b)
+	sent <- meteredWrite' p (B.hPut h) (L.take (fromIntegral n) b)
 	return (fromBytesProcessed sent == n)
 
 receiveExactly :: Len -> Handle -> MeterUpdate -> IO L.ByteString

P2P/Protocol.hs

@@ -2,7 +2,7 @@
  -
  - See doc/design/p2p_protocol.mdwn
  -
- - Copyright 2016-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2016-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -18,6 +18,7 @@ import Types (Annex)
 import Types.Key
 import Types.UUID
 import Types.Remote (Verification(..), unVerified)
+import Types.Backend (IncrementalVerifier(..))
 import Utility.AuthToken
 import Utility.Applicative
 import Utility.PartialPrelude
@@ -266,7 +267,7 @@ data LocalF c
 	-- Note: The ByteString may not contain the entire remaining content
 	-- of the key. Only once the temp file size == Len has the whole
 	-- content been transferred.
-	| StoreContentTo FilePath Offset Len (Proto L.ByteString) (Proto (Maybe Validity)) ((Bool, Verification) -> c)
+	| StoreContentTo FilePath (Maybe IncrementalVerifier) Offset Len (Proto L.ByteString) (Proto (Maybe Validity)) ((Bool, Verification) -> c)
 	-- ^ Like StoreContent, but stores the content to a temp file.
 	| SetPresent Key UUID c
 	| CheckContentPresent Key (Bool -> c)
@@ -351,13 +352,13 @@ remove key = do
 	net $ sendMessage (REMOVE key)
 	checkSuccess
 
-get :: FilePath -> Key -> AssociatedFile -> Meter -> MeterUpdate -> Proto (Bool, Verification)
-get dest key af m p = 
+get :: FilePath -> Key -> Maybe IncrementalVerifier -> AssociatedFile -> Meter -> MeterUpdate -> Proto (Bool, Verification)
+get dest key iv af m p = 
 	receiveContent (Just m) p sizer storer $ \offset ->
 		GET offset (ProtoAssociatedFile af) key
   where
 	sizer = fileSize dest
-	storer = storeContentTo dest
+	storer = storeContentTo dest iv
 
 put :: Key -> AssociatedFile -> MeterUpdate -> Proto Bool
 put key af p = do