incremental verify for webdav special remote

Sponsored-by: Dartmouth College's DANDI project

diff --git a/CHANGELOG b/CHANGELOG
index 965a751ecc55ae6fcba9248e512786ba2d2a0ea2..4c878844d64b56060822b3ea080cb6df93056927 100644 (file)
--- a/CHANGELOG
+++ b/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
 

diff --git a/Remote/Helper/Http.hs b/Remote/Helper/Http.hs
index 13ef97ef865dd2ab1360019399d4c7f90db94ef4..f22f7d636a77ff123f0cb7cd3f0541baad911b87 100644 (file)
--- a/Remote/Helper/Http.hs
+++ b/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

diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 0001f08879780fe2e857b35998c73ca9730600ab..92f9dc1d648b7f1c65e4e6ea0db7506aa73957a1 100644 (file)
--- a/Remote/WebDAV.hs
+++ b/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
-
-retrieveHelper :: DavLocation -> FilePath -> MeterUpdate -> DAVT IO ()
-retrieveHelper loc d p = do
+               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 -> 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