From 817ccbbc47156c24aade4c6c4dc0c195332a991e Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 29 Jul 2021 13:36:19 -0400
Subject: [PATCH] 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.
---
 Annex/Content.hs                   |  3 ++-
 Annex/Content/Presence/LowLevel.hs |  3 +--
 Annex/Verify.hs                    | 11 ++++++++---
 Command/Reinject.hs                |  2 +-
 Command/TestRemote.hs              |  2 +-
 5 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 5f7b2f39e8..6e5b984677 100644
--- 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 1191500dfc..6f50c187b2 100644
--- 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 826d0e7f40..10f6de8769 100644
--- 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 a5ac6b1e3f..ca757a28a4 100644
--- 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 43aa615b4d..bc12e4580b 100644
--- 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