support incremental verification when retrieving from export/import remotes

None of the special remotes do it yet, but this lays the groundwork.

Added MustFinishIncompleteVerify so that, when an incremental verify is
started but not complete, it can be forced to finish it. Otherwise, it
would have skipped doing it when verification is disabled, but
verification must always be done when retrievin from export remotes
since files can be modified during retrieval.

Note that retrieveExportWithContentIdentifier doesn't support incremental
verification yet. And I'm not sure if it can -- it doesn't know the Key
before it downloads the content. It seems a new API call would need to
be split out of that, which is provided with the key.

Sponsored-by: Dartmouth College's Datalad project

diff --git a/Annex/Verify.hs b/Annex/Verify.hs
index 729dcfddc573c6507d36cb81b264706a76f29e69..9e4deb93ab51b232f27c1af7efd55eaa2ca90615 100644 (file)
--- a/Annex/Verify.hs
+++ b/Annex/Verify.hs
@@ -79,15 +79,19 @@ verifyKeyContentPostRetrieval rsp v verification k f = case (rsp, verification)
                ( verify
                , return True
                )
-       (_, MustVerify) -> verify
        (_, IncompleteVerify _) -> ifM (shouldVerify v)
                ( verify
                , return True
                )
+       (_, MustVerify) -> verify
+       (_, MustFinishIncompleteVerify _) -> verify
   where
        verify = enteringStage VerifyStage $
                case verification of
-                       IncompleteVerify iv -> resumeVerifyKeyContent k f iv
+                       IncompleteVerify iv -> 
+                               resumeVerifyKeyContent k f iv
+                       MustFinishIncompleteVerify iv -> 
+                               resumeVerifyKeyContent k f iv
                        _ -> verifyKeyContent k f
 
 verifyKeyContent :: Key -> RawFilePath -> Annex Bool

diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index ef90ff28b9eed4d54fbcea9bd8c6f382eeb33018..7e85db72bea83d79ac5c8d0d6c18324cb8984dba 100644 (file)
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -354,7 +354,7 @@ testExportTree runannex mkr mkk1 mkk2 =
                liftIO $ hClose h
                tryNonAsync (Remote.retrieveExport ea k testexportlocation tmp nullMeterUpdate) >>= \case
                        Left _ -> return False
-                       Right () -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify UnVerified k (toRawFilePath tmp)
+                       Right v -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify v k (toRawFilePath tmp)
        checkpresentexport ea k = Remote.checkPresentExport ea k testexportlocation
        removeexport ea k = Remote.removeExport ea k testexportlocation
        removeexportdirectory ea = case Remote.removeExportDirectory ea of

diff --git a/Remote/Adb.hs b/Remote/Adb.hs
index 915ab44b6fb1d795af8cab822a1afbfb7e6ddf4b..09c2aa219e1ce72e1bd46942bc9b505be798ba1e 100644 (file)
--- a/Remote/Adb.hs
+++ b/Remote/Adb.hs
@@ -255,8 +255,10 @@ storeExportM serial adir src _k loc _p =
   where
        dest = androidExportLocation adir loc
 
-retrieveExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
-retrieveExportM serial adir _k loc dest _p = retrieve' serial src dest
+retrieveExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
+retrieveExportM serial adir _k loc dest _p = do
+       retrieve' serial src dest
+       return UnVerified
   where
        src = androidExportLocation adir loc
 

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 93a78eda14a64138319baf5deb591d3ec00384ab..3164e4d3bf91f74a78478328dfddfb84c80f8d1a 100644 (file)
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -316,8 +316,10 @@ storeExportM d cow src _k loc p = do
        dest = exportPath d loc
        go tmp () = void $ fileCopier cow src tmp p Nothing
 
-retrieveExportM :: RawFilePath -> CopyCoWTried -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
-retrieveExportM d cow _k loc dest p = void $ fileCopier cow src dest 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
   where
        src = fromRawFilePath $ exportPath d loc
 

diff --git a/Remote/External.hs b/Remote/External.hs
index 1137cd74f505da2ee2b6f7adddb094cc503c7739..99dfae52fa6390c05d2b79a6fed0d232fd3aa38c 100644 (file)
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -291,8 +291,10 @@ storeExportM external f k loc p = either giveup return =<< go
                _ -> Nothing
        req sk = TRANSFEREXPORT Upload sk f
 
-retrieveExportM :: External -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
-retrieveExportM external k loc d p = either giveup return =<< go
+retrieveExportM :: External -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
+retrieveExportM external k loc d p = do
+       either giveup return =<< go
+       return UnVerified
   where
        go = handleRequestExport external loc req k (Just p) $ \resp -> case resp of
                TRANSFER_SUCCESS Download k'

diff --git a/Remote/Helper/ExportImport.hs b/Remote/Helper/ExportImport.hs
index 7e607ad89273e4d37cfdb8ace680954654cd4cc2..7b0839fc55093810657c0262d63f5ec69dad2ea7 100644 (file)
--- a/Remote/Helper/ExportImport.hs
+++ b/Remote/Helper/ExportImport.hs
@@ -349,8 +349,10 @@ adjustExportImport' isexport isimport r rs = do
        retrieveKeyFileFromExport dbv k _af dest p = ifM (isVerifiable k)
                ( do
                        l <- getfirstexportloc dbv k
-                       retrieveExport (exportActions r) k l dest p
-                       return MustVerify
+                       retrieveExport (exportActions r) k l dest p >>= return . \case
+                               UnVerified -> MustVerify
+                               IncompleteVerify iv -> MustFinishIncompleteVerify iv
+                               v -> v
                , giveup $ "exported content cannot be verified due to using the " ++ decodeBS (formatKeyVariety (fromKey keyVariety k)) ++ " backend"
                )
        

diff --git a/Remote/HttpAlso.hs b/Remote/HttpAlso.hs
index 49310fd01b343fa4ad15b7c79f5e411dff802703..0f26af48b25b076ba301eeced3b6943f98139d79 100644 (file)
--- a/Remote/HttpAlso.hs
+++ b/Remote/HttpAlso.hs
@@ -120,9 +120,10 @@ downloadKey baseurl ll key _af dest p vc = do
        downloadAction dest p iv key (keyUrlAction baseurl ll key)
        snd <$> finishVerifyKeyContentIncrementally iv
 
-retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
-retriveExportHttpAlso baseurl key loc dest p = 
+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
 
 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 e7e9ff740f5b42048108dace0dc1ffd4177b49b6..2915671b517cf5151809016085d37acd527b3d17 100644 (file)
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -316,8 +316,10 @@ storeExportM o src _k loc meterupdate =
        basedest = fromRawFilePath (fromExportLocation loc)
        populatedest = liftIO . createLinkOrCopy src
 
-retrieveExportM :: RsyncOpts -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
-retrieveExportM o _k loc dest p = rsyncRetrieve o [rsyncurl] dest (Just p)
+retrieveExportM :: RsyncOpts -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
+retrieveExportM o _k loc dest p = do
+       rsyncRetrieve o [rsyncurl] dest (Just p)
+       return UnVerified
   where
        rsyncurl = mkRsyncUrl o (fromRawFilePath (fromExportLocation loc))
 

diff --git a/Remote/S3.hs b/Remote/S3.hs
index 9ca1d7c87d4e6a7e810dcabc127894484a849dfb..0cc59120fd876f9844f57c735eb3acb90fb47453 100644 (file)
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -495,7 +495,7 @@ storeExportS3' hv r rs info magic f k loc p = withS3Handle hv $ \case
                setS3VersionID info rs k mvid
                return (metag, mvid)
 
-retrieveExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
+retrieveExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
 retrieveExportS3 hv r info _k loc f p = do
        withS3Handle hv $ \case
                Just h -> retrieveHelper info h (Left (T.pack exportloc)) f p Nothing
@@ -504,6 +504,7 @@ retrieveExportS3 hv r info _k loc f p = do
                                Url.withUrlOptions
                                        (Url.download' p Nothing (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 94eb224b9126e9322ed91f500fc41f655a969899..45c2f5e0805afd8e00e2df6669241f1b3daac2c3 100644 (file)
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -218,10 +218,11 @@ storeExportDav hdl f k loc p = case exportLocation loc of
                storeHelper dav (exportTmpLocation loc k) dest reqbody
        Left err -> giveup err
 
-retrieveExportDav :: DavHandleVar -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
+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 ->
+       Right src -> withDavHandle hdl $ \h -> runExport h $ \_dav -> do
                retrieveHelper src d p Nothing
+               return UnVerified
        Left err -> giveup err
 
 checkPresentExportDav :: DavHandleVar -> Remote -> Key -> ExportLocation -> Annex Bool

diff --git a/Types/Remote.hs b/Types/Remote.hs
index e8b25c2a81b50176e892b9452a12217b9edc805f..d80d48fba0db0010c5d10aa1362d9581595b60f4 100644 (file)
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -208,12 +208,15 @@ data Verification
        -- again. The verification does not need to use a
        -- cryptographically secure hash, but the hash does need to
        -- have preimage resistance.
-       | MustVerify
-       -- ^ Content likely to have been altered during transfer,
-       -- verify even if verification is normally disabled
        | IncompleteVerify IncrementalVerifier
        -- ^ Content was partially verified during transfer, but
        -- the verification is not complete.
+       | MustVerify
+       -- ^ Content likely to have been altered during transfer,
+       -- verify even if verification is normally disabled
+       | MustFinishIncompleteVerify IncrementalVerifier
+       -- ^ Content likely to have been altered during transfer,
+       -- finish verification even if verification is normally disabled.
 
 unVerified :: Monad m => m a -> m (a, Verification)
 unVerified a = do
@@ -262,7 +265,7 @@ data ExportActions a = ExportActions
        -- (The MeterUpdate does not need to be used if it writes
        -- sequentially to the file.)
        -- Throws exception on failure.
-       , retrieveExport :: Key -> ExportLocation -> FilePath -> MeterUpdate -> a ()
+       , retrieveExport :: Key -> ExportLocation -> FilePath -> MeterUpdate -> a Verification
        -- Removes an exported file (succeeds if the contents are not present)
        -- Can throw exception if unable to access remote, or if remote
        -- refuses to remove the content.