incremental verification for retrieval from all export remotes

Only for export remotes so far, not export/import.

Sponsored-by: Dartmouth College's Datalad project

diff --git a/Annex/Verify.hs b/Annex/Verify.hs
index 9e4deb93ab51b232f27c1af7efd55eaa2ca90615..5703bf41e4505b6cfa8e4002d2b80fb66dc44b42 100644 (file)
--- a/Annex/Verify.hs
+++ b/Annex/Verify.hs
@@ -1,6 +1,6 @@
 {- verification
  -
- - Copyright 2010-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2022 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -17,6 +17,7 @@ module Annex.Verify (
        isVerifiable,
        startVerifyKeyContentIncrementally,
        finishVerifyKeyContentIncrementally,
+       verifyKeyContentIncrementally,
        IncrementalVerifier(..),
        tailVerify,
 ) where
@@ -34,6 +35,7 @@ import Types.WorkerPool
 import Types.Key
 
 import Control.Concurrent.STM
+import Control.Concurrent.Async
 import qualified Data.ByteString as S
 #if WITH_INOTIFY
 import qualified System.INotify as INotify
@@ -186,12 +188,17 @@ finishVerifyKeyContentIncrementally (Just iv) =
                -- Incremental verification was not able to be done.
                Nothing -> return (True, UnVerified)
 
--- | Reads the file as it grows, and feeds it to the incremental verifier.
+verifyKeyContentIncrementally :: VerifyConfig -> Key -> (Maybe IncrementalVerifier -> Annex ()) -> Annex Verification
+verifyKeyContentIncrementally verifyconfig k a = do
+       miv <- startVerifyKeyContentIncrementally verifyconfig k
+       a miv
+       snd <$> finishVerifyKeyContentIncrementally miv
+
+-- | Runs a writer action that retrieves to a file. In another thread,
+-- reads the file as it grows, and feeds it to the incremental verifier.
 -- 
--- The TMVar must start out empty, and be filled once whatever is
--- writing to the file finishes. Once the writer finishes, this returns
--- quickly. It may not feed the entire content of the file to the
--- incremental verifier.
+-- Once the writer finishes, this returns quickly. It may not feed
+-- the entire content of the file to the incremental verifier.
 --
 -- The file does not need to exist yet when this is called. It will wait
 -- for the file to appear before opening it and starting verification.
@@ -223,9 +230,19 @@ finishVerifyKeyContentIncrementally (Just iv) =
 -- and if the disk is slow, the reader may never catch up to the writer,
 -- and the disk cache may never speed up reads. So this should only be
 -- used when there's not a better way to incrementally verify.
-tailVerify :: IncrementalVerifier -> RawFilePath -> TMVar () -> IO ()
+tailVerify :: Maybe IncrementalVerifier -> RawFilePath -> Annex a -> Annex a
+tailVerify (Just iv) f writer = do
+       finished <- liftIO newEmptyTMVarIO
+       t <- liftIO $ async $ tailVerify' iv f finished
+       let finishtail = do
+               liftIO $ atomically $ putTMVar finished ()
+               liftIO (wait t)
+       writer `finally` finishtail
+tailVerify Nothing _ writer = writer
+
+tailVerify' :: IncrementalVerifier -> RawFilePath -> TMVar () -> IO ()
 #if WITH_INOTIFY
-tailVerify iv f finished = 
+tailVerify' iv f finished = 
        tryNonAsync go >>= \case
                Right r -> return r
                Left _ -> unableIncrementalVerifier iv
@@ -312,5 +329,5 @@ tailVerify iv f finished =
 
        chunk = 65536
 #else
-tailVerify iv _ _ = unableIncrementalVerifier iv
+tailVerify' iv _ _ = unableIncrementalVerifier iv
 #endif

diff --git a/Remote/Adb.hs b/Remote/Adb.hs
index 09c2aa219e1ce72e1bd46942bc9b505be798ba1e..477d9ea589ea97962982c13f97be8056ae2ac220 100644 (file)
--- a/Remote/Adb.hs
+++ b/Remote/Adb.hs
@@ -1,6 +1,6 @@
 {- Remote on Android device accessed using adb.
  -
- - Copyright 2018-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2018-2022 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -22,6 +22,7 @@ import Annex.UUID
 import Utility.Metered
 import Types.ProposedAccepted
 import Annex.SpecialRemote.Config
+import Annex.Verify
 
 import qualified Data.Map as M
 import qualified System.FilePath.Posix as Posix
@@ -256,9 +257,10 @@ storeExportM serial adir src _k loc _p =
        dest = androidExportLocation adir loc
 
 retrieveExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
-retrieveExportM serial adir _k loc dest _p = do
-       retrieve' serial src dest
-       return UnVerified
+retrieveExportM serial adir k loc dest _p = 
+       verifyKeyContentIncrementally AlwaysVerify k $ \iv ->
+               tailVerify iv (toRawFilePath dest) $
+                       retrieve' serial src dest
   where
        src = androidExportLocation adir loc
 

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 3164e4d3bf91f74a78478328dfddfb84c80f8d1a..82b28b81bbc4149656543f946447427c06301d4d 100644 (file)
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -36,6 +36,7 @@ import Annex.CopyFile
 import Annex.Content
 import Annex.Perms
 import Annex.UUID
+import Annex.Verify
 import Backend
 import Types.KeySource
 import Types.ProposedAccepted
@@ -317,9 +318,9 @@ storeExportM d cow src _k loc p = do
        go tmp () = void $ fileCopier cow src tmp p Nothing
 
 retrieveExportM :: RawFilePath -> CopyCoWTried -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
-retrieveExportM d cow _k loc dest p = do
-       void $ fileCopier cow src dest p Nothing
-       return UnVerified
+retrieveExportM d cow k loc dest p = 
+       verifyKeyContentIncrementally AlwaysVerify k $ \iv -> 
+               void $ fileCopier cow src dest p iv
   where
        src = fromRawFilePath $ exportPath d loc
 

diff --git a/Remote/External.hs b/Remote/External.hs
index 99dfae52fa6390c05d2b79a6fed0d232fd3aa38c..7eb5a4be66890f1e1851e4ffc02cc1b477624441 100644 (file)
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -1,6 +1,6 @@
 {- External special remote interface.
  -
- - Copyright 2013-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2022 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -37,6 +37,7 @@ import Config.Cost
 import Annex.Content
 import Annex.Url
 import Annex.UUID
+import Annex.Verify
 import Creds
 
 import Control.Concurrent.STM
@@ -292,9 +293,10 @@ storeExportM external f k loc p = either giveup return =<< go
        req sk = TRANSFEREXPORT Upload sk f
 
 retrieveExportM :: External -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
-retrieveExportM external k loc d p = do
-       either giveup return =<< go
-       return UnVerified
+retrieveExportM external k loc dest p = do
+       verifyKeyContentIncrementally AlwaysVerify k $ \iv ->
+               tailVerify iv (toRawFilePath dest) $
+                       either giveup return =<< go
   where
        go = handleRequestExport external loc req k (Just p) $ \resp -> case resp of
                TRANSFER_SUCCESS Download k'
@@ -304,7 +306,7 @@ retrieveExportM external k loc d p = do
                UNSUPPORTED_REQUEST ->
                        result $ Left "TRANSFEREXPORT not implemented by external special remote"
                _ -> Nothing
-       req sk = TRANSFEREXPORT Download sk d
+       req sk = TRANSFEREXPORT Download sk dest
 
 checkPresentExportM :: External -> Key -> ExportLocation -> Annex Bool
 checkPresentExportM external k loc = either giveup id <$> go

diff --git a/Remote/Git.hs b/Remote/Git.hs
index 45e79ee3485c4f2741ba7de3f3250fb255d69d13..db3a56f8f4da4d64b76a8688dae8a7b6f7f3a893 100644 (file)
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -491,14 +491,12 @@ copyFromRemote r st key file dest meterupdate vc = do
 
 copyFromRemote'' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
 copyFromRemote'' repo r st@(State connpool _ _ _ _) key file dest meterupdate vc
-       | Git.repoIsHttp repo = do
-               iv <- startVerifyKeyContentIncrementally vc key
+       | Git.repoIsHttp repo = verifyKeyContentIncrementally vc key $ \iv -> do
                gc <- Annex.getGitConfig
                ok <- Url.withUrlOptionsPromptingCreds $
                        Annex.Content.downloadUrl False key meterupdate iv (keyUrls gc repo r key) dest
                unless ok $
                        giveup "failed to download content"
-               snd <$> finishVerifyKeyContentIncrementally iv
        | not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $ do
                u <- getUUID
                hardlink <- wantHardLink

diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 8f595865db35b63d54956c015ea7214422bed3ca..a18f971b7156a0b7559d2723075216ea920e4dd5 100644 (file)
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -56,8 +56,6 @@ import Git.Types
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
-import Control.Concurrent.STM
-import Control.Concurrent.Async
 
 {- Special remotes don't have a configured url, so Git.Repo does not
  - automatically generate remotes for them. This looks for a different
@@ -117,17 +115,9 @@ byteRetriever a k _m _miv callback = a k (callback . ByteContent)
 -- the action writes to the file, but may not be updated with the entire
 -- content of the file.
 fileRetriever :: (RawFilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever
-fileRetriever a = fileRetriever' $ \f k m miv -> do
+fileRetriever a = fileRetriever' $ \f k m miv -> 
        let retrieve = a f k m
-       case miv of
-               Nothing -> retrieve
-               Just iv -> do
-                       finished <- liftIO newEmptyTMVarIO
-                       t <- liftIO $ async $ tailVerify iv f finished
-                       let finishtail = do
-                               liftIO $ atomically $ putTMVar finished ()
-                               liftIO (wait t)
-                       retrieve `finally` finishtail
+       in tailVerify miv f retrieve
 
 {- A Retriever that writes the content of a Key to a provided file.
  - The action is responsible for updating the progress meter and the 

diff --git a/Remote/HttpAlso.hs b/Remote/HttpAlso.hs
index 0f26af48b25b076ba301eeced3b6943f98139d79..c423ba8fad43020aa98a633f740645755b134c7c 100644 (file)
--- a/Remote/HttpAlso.hs
+++ b/Remote/HttpAlso.hs
@@ -116,14 +116,13 @@ httpAlsoSetup _ (Just u) _ c gc = do
 
 downloadKey :: Maybe URLString -> LearnedLayout -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
 downloadKey baseurl ll key _af dest p vc = do
-       iv <- startVerifyKeyContentIncrementally vc key
-       downloadAction dest p iv key (keyUrlAction baseurl ll key)
-       snd <$> finishVerifyKeyContentIncrementally iv
+       verifyKeyContentIncrementally vc key $ \iv ->
+               downloadAction dest p iv key (keyUrlAction baseurl ll key)
 
 retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
 retriveExportHttpAlso baseurl key loc dest p = do
-       downloadAction dest p Nothing key (exportLocationUrlAction baseurl loc)
-       return UnVerified
+       verifyKeyContentIncrementally AlwaysVerify key $ \iv ->
+               downloadAction dest p iv key (exportLocationUrlAction baseurl loc)
 
 downloadAction :: FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> Key -> ((URLString -> Annex (Either String ())) -> Annex (Either String ())) -> Annex ()
 downloadAction dest p iv key run =

diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 2915671b517cf5151809016085d37acd527b3d17..e2ac08a616f5db3f56e270fccbd986c3d452cb0b 100644 (file)
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -46,6 +46,7 @@ import Annex.DirHashes
 import Utility.Tmp.Dir
 import Utility.SshHost
 import Annex.SpecialRemote.Config
+import Annex.Verify
 
 import qualified Data.Map as M
 
@@ -317,9 +318,10 @@ storeExportM o src _k loc meterupdate =
        populatedest = liftIO . createLinkOrCopy src
 
 retrieveExportM :: RsyncOpts -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
-retrieveExportM o _k loc dest p = do
-       rsyncRetrieve o [rsyncurl] dest (Just p)
-       return UnVerified
+retrieveExportM o k loc dest p =
+       verifyKeyContentIncrementally AlwaysVerify k $ \iv ->
+               tailVerify iv (toRawFilePath dest) $
+                       rsyncRetrieve o [rsyncurl] dest (Just p)
   where
        rsyncurl = mkRsyncUrl o (fromRawFilePath (fromExportLocation loc))
 

diff --git a/Remote/S3.hs b/Remote/S3.hs
index 0cc59120fd876f9844f57c735eb3acb90fb47453..a5a321ae76de66445d01065426d644c553b5b28b 100644 (file)
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -60,13 +60,13 @@ import Types.MetaData
 import Types.ProposedAccepted
 import Types.NumCopies
 import Utility.Metered
-import Utility.Hash (IncrementalVerifier)
 import Utility.DataUnits
 import Annex.Content
 import qualified Annex.Url as Url
 import Utility.Url (extractFromResourceT)
 import Annex.Url (getUrlOptions, withUrlOptions, UrlOptions(..))
 import Utility.Env
+import Annex.Verify
 
 type BucketName = String
 type BucketObject = String
@@ -496,15 +496,14 @@ storeExportS3' hv r rs info magic f k loc p = withS3Handle hv $ \case
                return (metag, mvid)
 
 retrieveExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
-retrieveExportS3 hv r info _k loc f p = do
+retrieveExportS3 hv r info k loc f p = verifyKeyContentIncrementally AlwaysVerify k $ \iv ->
        withS3Handle hv $ \case
-               Just h -> retrieveHelper info h (Left (T.pack exportloc)) f p Nothing
+               Just h -> retrieveHelper info h (Left (T.pack exportloc)) f p iv
                Nothing -> case getPublicUrlMaker info of
                        Just geturl -> either giveup return =<<
                                Url.withUrlOptions
-                                       (Url.download' p Nothing (geturl exportloc) f)
+                                       (Url.download' p iv (geturl exportloc) f)
                        Nothing -> giveup $ needS3Creds (uuid r)
-       return UnVerified
   where
        exportloc = bucketExportLocation info loc
 

diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 45c2f5e0805afd8e00e2df6669241f1b3daac2c3..9499f4bd76aa8b3ca3efe106dfa3888d0e83d7e5 100644 (file)
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -40,7 +40,7 @@ import qualified Remote.Helper.Chunked.Legacy as Legacy
 import Creds
 import Utility.Metered
 import Utility.Url (URLString, matchStatusCodeException, matchHttpExceptionContent)
-import Utility.Hash (IncrementalVerifier(..))
+import Annex.Verify
 import Annex.UUID
 import Remote.WebDAV.DavLocation
 import Types.ProposedAccepted
@@ -219,10 +219,10 @@ storeExportDav hdl f k loc p = case exportLocation loc of
        Left err -> giveup err
 
 retrieveExportDav :: DavHandleVar -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
-retrieveExportDav hdl  _k loc d p = case exportLocation loc of
-       Right src -> withDavHandle hdl $ \h -> runExport h $ \_dav -> do
-               retrieveHelper src d p Nothing
-               return UnVerified
+retrieveExportDav hdl  k loc d p = case exportLocation loc of
+       Right src -> verifyKeyContentIncrementally AlwaysVerify k  $ \iv ->
+               withDavHandle hdl $ \h -> runExport h $ \_dav ->
+                       retrieveHelper src d p iv
        Left err -> giveup err
 
 checkPresentExportDav :: DavHandleVar -> Remote -> Key -> ExportLocation -> Annex Bool

diff --git a/doc/todo/OPT__58_____34__bundle__34___get_+_check___40__of_checksum__41___in_a_single_operation/comment_17_39db598e93d0d858984052e3894cd96e._comment b/doc/todo/OPT__58_____34__bundle__34___get_+_check___40__of_checksum__41___in_a_single_operation/comment_17_39db598e93d0d858984052e3894cd96e._comment
new file mode 100644 (file)
index 0000000..798dc2e
--- /dev/null
+++ b/doc/todo/OPT__58_____34__bundle__34___get_+_check___40__of_checksum__41___in_a_single_operation/comment_17_39db598e93d0d858984052e3894cd96e._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 17"""
+ date="2022-05-09T17:48:31Z"
+ content="""
+Update: incremental hashing is also now done for all export remotes.
+Only import (and export+import) remotes don't support incremental hashing
+now.
+"""]]