split verifyKeyContent

This avoids it calling enteringStage VerifyStage when it's used in
places that only fall back to verification rarely, and which might be
called while in TransferStage and be going to perform a transfer after
the verification.

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 5f7b2f39e8b5c641ef6b079d5157251f95abb80b..6e5b98467715dd0d109cfd1c31421fa9639a5bf1 100644 (file)
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -51,6 +51,7 @@ module Annex.Content (
        pruneTmpWorkDirBefore,
        isUnmodified,
        isUnmodifiedCheap,
+       verifyKeyContentPostRetrieval,
        verifyKeyContent,
        VerifyConfig(..),
        Verification(..),
@@ -230,7 +231,7 @@ getViaTmpFromDisk rsp v key af action = checkallowed $ do
                        _ -> MustVerify
                else verification
        if ok
-               then ifM (verifyKeyContent rsp v verification' key tmpfile)
+               then ifM (verifyKeyContentPostRetrieval rsp v verification' key tmpfile)
                        ( pruneTmpWorkDirBefore tmpfile (moveAnnex key af)
                        , do
                                warning "verification of content failed"

diff --git a/Annex/Content/Presence/LowLevel.hs b/Annex/Content/Presence/LowLevel.hs
index 1191500dfc5e6aeaea3c635c8df9febfe896ee6a..6f50c187b2b45ea9cf7b6e98678086e5cb84291a 100644 (file)
--- a/Annex/Content/Presence/LowLevel.hs
+++ b/Annex/Content/Presence/LowLevel.hs
@@ -9,7 +9,6 @@ module Annex.Content.Presence.LowLevel where
 
 import Annex.Common
 import Annex.Verify
-import Types.Remote
 import Annex.InodeSentinal
 import Utility.InodeCache
 
@@ -17,7 +16,7 @@ isUnmodifiedLowLevel :: (Key -> [InodeCache] -> Annex ()) -> Key -> RawFilePath
 isUnmodifiedLowLevel addinodecaches key f fc ic =
        isUnmodifiedCheapLowLevel fc ic <||> expensivecheck
   where
-       expensivecheck = ifM (verifyKeyContent RetrievalAllKeysSecure AlwaysVerify UnVerified key f)
+       expensivecheck = ifM (verifyKeyContent key f)
                ( do
                        -- The file could have been modified while it was
                        -- being verified. Detect that.

diff --git a/Annex/Verify.hs b/Annex/Verify.hs
index 826d0e7f403315a5d13cd10f9145112bd928d2c4..10f6de8769ff394dbdd98a5e0662677387609078 100644 (file)
--- a/Annex/Verify.hs
+++ b/Annex/Verify.hs
@@ -8,6 +8,7 @@
 module Annex.Verify (
        VerifyConfig(..),
        shouldVerify,
+       verifyKeyContentPostRetrieval,
        verifyKeyContent,
        Verification(..),
        unVerified,
@@ -55,8 +56,8 @@ shouldVerify (RemoteVerify r) =
  - If the RetrievalSecurityPolicy requires verification and the key's
  - backend doesn't support it, the verification will fail.
  -}
-verifyKeyContent :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> RawFilePath -> Annex Bool
-verifyKeyContent rsp v verification k f = case (rsp, verification) of
+verifyKeyContentPostRetrieval :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> RawFilePath -> Annex Bool
+verifyKeyContentPostRetrieval rsp v verification k f = case (rsp, verification) of
        (_, Verified) -> return True
        (RetrievalVerifiableKeysSecure, _) -> ifM (isVerifiable k)
                ( verify
@@ -71,7 +72,11 @@ verifyKeyContent rsp v verification k f = case (rsp, verification) of
                )
        (_, MustVerify) -> verify
   where
-       verify = enteringStage VerifyStage $ verifysize <&&> verifycontent
+       verify = enteringStage VerifyStage $ verifyKeyContent k f
+
+verifyKeyContent :: Key -> RawFilePath -> Annex Bool
+verifyKeyContent k f = verifysize <&&> verifycontent
+  where
        verifysize = case fromKey keySize k of
                Nothing -> return True
                Just size -> do

diff --git a/Command/Reinject.hs b/Command/Reinject.hs
index a5ac6b1e3ffc83bff41ba6a2c8960e0bf46e8c44..ca757a28a494daa9aaef6c767038969adbb77989 100644 (file)
--- a/Command/Reinject.hs
+++ b/Command/Reinject.hs
@@ -50,7 +50,7 @@ startSrcDest ps@(src:dest:[])
   where
        src' = toRawFilePath src
        go key = starting "reinject" ai si $
-               ifM (verifyKeyContent RetrievalAllKeysSecure DefaultVerify UnVerified key src')
+               ifM (verifyKeyContent key src')
                        ( perform src' key
                        , giveup $ src ++ " does not have expected content of " ++ dest
                        )

diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index 43aa615b4d71e9c7147a8c37faf2d7d783334135..bc12e4580b2187666ecbab5e1e59f5eac135f6b4 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 () -> verifyKeyContent RetrievalAllKeysSecure AlwaysVerify UnVerified k (toRawFilePath tmp)
+                       Right () -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify UnVerified 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