incremental checksum on upload to ssh or p2p

CHANGELOG

@@ -24,8 +24,8 @@ git-annex (8.20210128) UNRELEASED; urgency=medium
   * Include libkqueue.h file needed to build the assistant on BSDs.
   * Tahoe: Avoid verifying hash after download, since tahoe does sufficient
     verification itself.
-  * Checksum as content is received from a remote git-annex repository,
-    rather than doing it in a second pass.
+  * Checksum as content is received from a remote git-annex repository
+    over ssh/p2p protocols, rather than doing it in a second pass.
 
  -- Joey Hess <id@joeyh.name>  Thu, 28 Jan 2021 12:34:32 -0400
 

P2P/Annex.hs

@@ -24,6 +24,7 @@ import Logs.Location
 import Types.NumCopies
 import Utility.Metered
 import Types.Backend (IncrementalVerifier(..))
+import Backend
 
 import Control.Monad.Free
 import Control.Concurrent.STM
@@ -76,10 +77,11 @@ runLocal runst runner a = case a of
 		-- Remote.P2P and Remote.Git.
 		let rsp = RetrievalAllKeysSecure
 		v <- tryNonAsync $ do
+			iv <- startVerifyKeyContentIncrementally DefaultVerify k
 			let runtransfer ti = 
 				Right <$> transfer download' k af Nothing (\p ->
 					logStatusAfter k $ getViaTmp rsp DefaultVerify k af $ \tmp ->
-						storefile (fromRawFilePath tmp) o l getb Nothing validitycheck p ti)
+						storefile (fromRawFilePath tmp) o l getb iv validitycheck p ti)
 			let fallback = return $ Left $
 				ProtoFailureMessage "transfer already in progress, or unable to take transfer lock"
 			checktransfer runtransfer fallback
@@ -87,10 +89,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 incrementalverifier o l getb validitycheck next -> do
+	StoreContentTo dest iv o l getb validitycheck next -> do
 		v <- tryNonAsync $ do
 			let runtransfer ti = Right
-				<$> storefile dest o l getb incrementalverifier validitycheck nullMeterUpdate ti
+				<$> storefile dest o l getb iv validitycheck nullMeterUpdate ti
 			let fallback = return $ Left $
 				ProtoFailureMessage "transfer failed"
 			checktransfer runtransfer fallback

P2P/Protocol.hs

@@ -17,8 +17,9 @@ import qualified Utility.SimpleProtocol as Proto
 import Types (Annex)
 import Types.Key
 import Types.UUID
-import Types.Remote (Verification(..), unVerified)
+import Types.Remote (Verification(..))
 import Types.Backend (IncrementalVerifier(..))
+import Types.Transfer
 import Utility.AuthToken
 import Utility.Applicative
 import Utility.PartialPrelude
@@ -504,10 +505,9 @@ serveAuthed servermode myuuid = void $ serverLoop handler
 			then net $ sendMessage ALREADY_HAVE
 			else do
 				let sizer = tmpContentSize key
-				let storer = \o l b v -> unVerified $
-					storeContent key af o l b v
-				(ok, _v) <- receiveContent Nothing nullMeterUpdate sizer storer PUT_FROM
-				when ok $
+				let storer = storeContent key af
+				v <- receiveContent Nothing nullMeterUpdate sizer storer PUT_FROM
+				when (observeBool v) $
 					local $ setPresent key myuuid
 		return ServerContinue
 
@@ -533,12 +533,13 @@ sendContent key af offset@(Offset n) p = go =<< local (contentSize key)
 		checkSuccess
 
 receiveContent
-	:: Maybe Meter
+	:: Observable t
+	=> Maybe Meter
 	-> MeterUpdate
 	-> Local Len
-	-> (Offset -> Len -> Proto L.ByteString -> Proto (Maybe Validity) -> Local (Bool, Verification))
+	-> (Offset -> Len -> Proto L.ByteString -> Proto (Maybe Validity) -> Local t)
 	-> (Offset -> Message)
-	-> Proto (Bool, Verification)
+	-> Proto t
 receiveContent mm p sizer storer mkmsg = do
 	Len n <- local sizer
 	let p' = offsetMeterUpdate p (toBytesProcessed n)
@@ -558,14 +559,14 @@ receiveContent mm p sizer storer mkmsg = do
 						net $ sendMessage (ERROR "expected VALID or INVALID")
 						return Nothing
 				else return Nothing
-			(ok, v) <- local $ storer offset len
+			v <- local $ storer offset len
 				(net (receiveBytes len p'))
 				validitycheck
-			sendSuccess ok
-			return (ok, v)
+			sendSuccess (observeBool v)
+			return v
 		_ -> do
 			net $ sendMessage (ERROR "expected DATA")
-			return (False, UnVerified)
+			return observeFailure
 
 checkSuccess :: Proto Bool
 checkSuccess = do