incremental verify for webdav special remote

Sponsored-by: Dartmouth College's DANDI project

CHANGELOG

@@ -8,10 +8,12 @@ git-annex (8.20210804) UNRELEASED; urgency=medium
   * add: When adding a dotfile, avoid treating its name as an extension.
   * rsync special remote: Stop displaying rsync progress, and use
     git-annex's own progress display.
-  * Special remotes now checksum content while it is being retrieved,
-    instead of in a separate pass at the end. This is supported for all
-    special remotes on Linux (except for web and bittorrent), and for a
-    few on other OSs (directory, bup, ddar, gcrypt, glacier).
+  * Many special remotes now checksum content while it is being retrieved,
+    instead of in a separate pass at the end. This is supported for most
+    special remotes on Linux (except for web, bittorrent, gitlfs, and S3),
+    and for a few on other OSs (directory, webdav, bup, ddar, gcrypt,
+    glacier). Special remotes using chunking or encryption also support
+    it. But exporttree/importtree special remotes do not.
 
  -- Joey Hess <id@joeyh.name>  Tue, 03 Aug 2021 12:22:45 -0400
 

Remote/Helper/Http.hs

@@ -1,6 +1,6 @@
 {- helpers for remotes using http
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -11,6 +11,7 @@ module Remote.Helper.Http where
 
 import Annex.Common
 import Types.StoreRetrieve
+import Types.Backend
 import Remote.Helper.Special
 import Utility.Metered
 
@@ -67,9 +68,9 @@ handlePopper numchunks chunksize meterupdate h sink = do
 	target = toBytesProcessed (numchunks * fromIntegral chunksize)
 
 -- Reads the http body and stores it to the specified file, updating the
--- meter as it goes.
-httpBodyRetriever :: FilePath -> MeterUpdate -> Response BodyReader -> IO ()
-httpBodyRetriever dest meterupdate resp
+-- meter and incremental verifier as it goes.
+httpBodyRetriever :: FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> Response BodyReader -> IO ()
+httpBodyRetriever dest meterupdate iv resp
 	| responseStatus resp /= ok200 = giveup $ show $ responseStatus resp
 	| otherwise = bracket (openBinaryFile dest WriteMode) hClose (go zeroBytesProcessed)
   where
@@ -82,4 +83,5 @@ httpBodyRetriever dest meterupdate resp
 				let sofar' = addBytesProcessed sofar $ S.length b
 				S.hPut h b
 				meterupdate sofar'
+				maybe noop (flip updateIncremental b) iv
 				go sofar' h

Remote/WebDAV.hs

@@ -1,6 +1,6 @@
 {- WebDAV remotes.
  -
- - Copyright 2012-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -28,6 +28,7 @@ import Control.Concurrent.STM hiding (check)
 import Annex.Common
 import Types.Remote
 import Types.Export
+import Types.Backend
 import qualified Git
 import qualified Annex
 import Config
@@ -168,17 +169,20 @@ finalizeStore dav tmp dest = do
 	moveDAV (baseURL dav) tmp dest
 
 retrieve :: DavHandleVar -> ChunkConfig -> Retriever
-retrieve hv cc = fileRetriever $ \d k p ->
+retrieve hv cc = fileRetriever' $ \d k p iv ->
 	withDavHandle hv $ \dav -> case cc of
-		LegacyChunks _ -> retrieveLegacyChunked (fromRawFilePath d) k p dav
-		_ -> liftIO $
-			goDAV dav $ retrieveHelper (keyLocation k) (fromRawFilePath d) p
+		LegacyChunks _ -> do
+			-- Not doing incremental verification for chunks.
+			liftIO $ maybe noop failIncremental iv
+			retrieveLegacyChunked (fromRawFilePath d) k p dav
+		_ -> liftIO $ goDAV dav $
+			retrieveHelper (keyLocation k) (fromRawFilePath d) p iv
 
-retrieveHelper :: DavLocation -> FilePath -> MeterUpdate -> DAVT IO ()
-retrieveHelper loc d p = do
+retrieveHelper :: DavLocation -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> DAVT IO ()
+retrieveHelper loc d p iv = do
 	debugDav $ "retrieve " ++ loc
 	inLocation loc $
-		withContentM $ httpBodyRetriever d p
+		withContentM $ httpBodyRetriever d p iv
 
 remove :: DavHandleVar -> Remover
 remove hv k = withDavHandle hv $ \dav -> liftIO $ goDAV dav $
@@ -217,7 +221,7 @@ storeExportDav hdl f k loc p = case exportLocation loc of
 retrieveExportDav :: DavHandleVar -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
 retrieveExportDav hdl  _k loc d p = case exportLocation loc of
 	Right src -> withDavHandle hdl $ \h -> runExport h $ \_dav ->
-		retrieveHelper src d p
+		retrieveHelper src d p Nothing
 	Left err -> giveup err
 
 checkPresentExportDav :: DavHandleVar -> Remote -> Key -> ExportLocation -> Annex Bool