From f8836306faa6cb7bd1f1b42b3c8fc15c73ca0b3b Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 27 Apr 2021 12:50:45 -0400
Subject: [PATCH] remove "checking remotename" message

This fixes fsck of a remote that uses chunking displaying
(checking remotename) (checking remotename)" for every chunk.

Also, some remotes displayed the message, and others did not, with no
consistency. It was originally displayed only when accessing remotes
that were expensive or might involve a password prompt, I think, but
nothing in the API said when to do it so it became an inconsistent mess.

Originally I thought fsck should always display it. But it only displays
in fsck --from remote, so the user knows the remote is being accessed,
so there is no reason to tell them it's accessing it over and over.

It was also possible for git-annex move to sometimes display it twice,
due to checking if content is present twice. But, the user of move
specifies --from/--to, so it does not need to display when it's
accessing the remote, as the user expects it to access the remote.

git-annex get might display it, but only if the remote also supports
hasKeyCheap, which is really only local git remotes, which didn't
display it always; and in any case nothing displayed it before hasKeyCheap,
which is checked first, so I don't think this needs to display it ever.

mirror is like move. And that's all the main places it would have been
displayed.

This commit was sponsored by Jochen Bartl on Patreon.
---
 Remote/Adb.hs             | 18 ++++++++----------
 Remote/Bup.hs             | 11 ++++-------
 Remote/External.hs        |  8 +++-----
 Remote/GCrypt.hs          |  2 +-
 Remote/Git.hs             |  1 -
 Remote/Glacier.hs         |  5 +----
 Remote/Helper/Messages.hs |  3 ---
 Remote/Helper/Ssh.hs      |  5 ++---
 Remote/Hook.hs            |  8 +++-----
 Remote/HttpAlso.hs        |  8 +++-----
 Remote/Rsync.hs           |  9 +++------
 Remote/S3.hs              | 14 +++++---------
 Remote/Web.hs             |  2 --
 Remote/WebDAV.hs          |  8 +++-----
 14 files changed, 36 insertions(+), 66 deletions(-)

diff --git a/Remote/Adb.hs b/Remote/Adb.hs
index edc15ac73c..d023d6f25d 100644
--- a/Remote/Adb.hs
+++ b/Remote/Adb.hs
@@ -15,7 +15,6 @@ import Types.Import
 import qualified Git
 import Config.Cost
 import Remote.Helper.Special
-import Remote.Helper.Messages
 import Remote.Helper.ExportImport
 import Annex.UUID
 import Utility.Metered
@@ -77,7 +76,7 @@ gen r u rc gc rs = do
 			, retrieveExport = retrieveExportM serial adir
 			, removeExport = removeExportM serial adir
 			, versionedExport = False
-			, checkPresentExport = checkPresentExportM this serial adir
+			, checkPresentExport = checkPresentExportM serial adir
 			, removeExportDirectory = Just $ removeExportDirectoryM serial adir
 			, renameExport = renameExportM serial adir
 			}
@@ -115,7 +114,7 @@ gen r u rc gc rs = do
 		(store serial adir)
 		(retrieve serial adir)
 		(remove serial adir)
-		(checkKey this serial adir)
+		(checkKey serial adir)
 		this
   where
 	adir = maybe (giveup "missing androiddirectory") AndroidPath
@@ -214,12 +213,11 @@ remove' :: AndroidSerial -> AndroidPath -> Annex Bool
 remove' serial aloc = adbShellBool serial
 	[Param "rm", Param "-f", File (fromAndroidPath aloc)]
 
-checkKey :: Remote -> AndroidSerial -> AndroidPath -> CheckPresent
-checkKey r serial adir k = checkKey' r serial (androidLocation adir k)
+checkKey :: AndroidSerial -> AndroidPath -> CheckPresent
+checkKey serial adir k = checkKey' serial (androidLocation adir k)
 
-checkKey' :: Remote -> AndroidSerial -> AndroidPath -> Annex Bool
-checkKey' r serial aloc = do
-	showChecking r
+checkKey' :: AndroidSerial -> AndroidPath -> Annex Bool
+checkKey' serial aloc = do
 	out <- adbShellRaw serial $ unwords
 		[ "if test -e ", shellEscape (fromAndroidPath aloc)
 		, "; then echo y"
@@ -268,8 +266,8 @@ removeExportDirectoryM serial abase dir =
 	go = adbShellBool serial [Param "rm", Param "-rf", File (fromAndroidPath adir)]
 	adir = androidExportLocation abase (mkExportLocation (fromExportDirectory dir))
 
-checkPresentExportM :: Remote -> AndroidSerial -> AndroidPath -> Key -> ExportLocation -> Annex Bool
-checkPresentExportM r serial adir _k loc = checkKey' r serial aloc
+checkPresentExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> Annex Bool
+checkPresentExportM serial adir _k loc = checkKey' serial aloc
   where
 	aloc = androidExportLocation adir loc
 
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 9b14480d54..c3a8763f68 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -27,7 +27,6 @@ import Config.Cost
 import qualified Remote.Helper.Ssh as Ssh
 import Annex.SpecialRemote.Config
 import Remote.Helper.Special
-import Remote.Helper.Messages
 import Remote.Helper.ExportImport
 import Utility.Hash
 import Utility.UserInfo
@@ -110,7 +109,7 @@ gen r u rc gc rs = do
 		(store this buprepo)
 		(retrieve buprepo)
 		(remove buprepo)
-		(checkKey r bupr')
+		(checkKey bupr')
 		this
   where
 	buprepo = fromMaybe (giveup "missing buprepo") $ remoteAnnexBupRepo gc
@@ -212,11 +211,9 @@ remove buprepo k = do
  - in a bup repository. One way it to check if the git repository has
  - a branch matching the name (as created by bup split -n).
  -}
-checkKey :: Git.Repo -> Git.Repo -> CheckPresent
-checkKey r bupr k
-	| Git.repoIsUrl bupr = do
-		showChecking r
-		onBupRemote bupr boolSystem "git" params
+checkKey :: Git.Repo -> CheckPresent
+checkKey bupr k
+	| Git.repoIsUrl bupr = onBupRemote bupr boolSystem "git" params
 	| otherwise = liftIO $ boolSystem "git" $
 		Git.Command.gitCommandLine params bupr
   where
diff --git a/Remote/External.hs b/Remote/External.hs
index b1d6d669f4..0677fcce78 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -27,7 +27,6 @@ import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.ExportImport
 import Remote.Helper.ReadOnly
-import Remote.Helper.Messages
 import Utility.Metered
 import Types.Transfer
 import Logs.PreferredContent.Raw
@@ -71,7 +70,7 @@ gen r u rc gc rs
 			readonlyStorer
 			retrieveUrl
 			readonlyRemoveKey
-			(checkKeyUrl r)
+			checkKeyUrl
 			Nothing
 			(externalInfo externaltype)
 			Nothing
@@ -815,9 +814,8 @@ retrieveUrl = fileRetriever $ \f k p -> do
 	unlessM (withUrlOptions $ downloadUrl k p us f) $
 		giveup "failed to download content"
 
-checkKeyUrl :: Git.Repo -> CheckPresent
-checkKeyUrl r k = do
-	showChecking r
+checkKeyUrl :: CheckPresent
+checkKeyUrl k = do
 	us <- getWebUrls k
 	anyM (\u -> withUrlOptions $ checkBoth u (fromKey keySize k)) us
 
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index e4f923b0ef..3d710e40f8 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -460,7 +460,7 @@ checkKey' repo r rsyncopts accessmethod k
 	| accessmethod == AccessRsyncOverSsh = checkrsync
 	| otherwise = unsupportedUrl
   where
-	checkrsync = Remote.Rsync.checkKey repo rsyncopts k
+	checkrsync = Remote.Rsync.checkKey rsyncopts k
 	checkshell = Ssh.inAnnex repo k
 
 {- Annexed objects are hashed using lower-case directories for max
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 6d24e06a47..43105a4fcd 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -407,7 +407,6 @@ inAnnex' repo rmt st@(State connpool duc _ _ _) key
 	| otherwise = checklocal
   where
 	checkhttp = do
-		showChecking repo
 		gc <- Annex.getGitConfig
 		ifM (Url.withUrlOptionsPromptingCreds $ \uo -> anyM (\u -> Url.checkBoth u (fromKey keySize key) uo) (keyUrls gc repo rmt key))
 			( return True
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 91f54212f0..cc6a91f118 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -19,7 +19,6 @@ import Config
 import Config.Cost
 import Annex.SpecialRemote.Config
 import Remote.Helper.Special
-import Remote.Helper.Messages
 import Remote.Helper.ExportImport
 import qualified Remote.Helper.AWS as AWS
 import Creds
@@ -222,9 +221,7 @@ remove r k = unlessM go $
 		]
 
 checkKey :: Remote -> CheckPresent
-checkKey r k = do
-	showChecking r
-	go =<< glacierEnv (config r) (gitconfig r) (uuid r)
+checkKey r k = go =<< glacierEnv (config r) (gitconfig r) (uuid r)
   where
 	go Nothing = giveup "cannot check glacier"
 	go (Just e) = do
diff --git a/Remote/Helper/Messages.hs b/Remote/Helper/Messages.hs
index ef112fb26a..7cbfb9ec4c 100644
--- a/Remote/Helper/Messages.hs
+++ b/Remote/Helper/Messages.hs
@@ -25,9 +25,6 @@ instance Describable (Remote.RemoteA a) where
 instance Describable String where
 	describe = id
 
-showChecking :: Describable a => a -> Annex ()
-showChecking v = showAction $ "checking " ++ describe v
-
 cantCheck :: Describable a => a -> e
 cantCheck v = giveup $ "unable to check " ++ describe v
 
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index 270cc700ed..6f0fd40712 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -94,9 +94,8 @@ onRemote cs r (with, errorval) command params fields = do
 
 {- Checks if a remote contains a key. -}
 inAnnex :: Git.Repo -> Key -> Annex Bool
-inAnnex r k = do
-	showChecking r
-	onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex" [Param $ serializeKey k] []
+inAnnex r k = onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex"
+	[Param $ serializeKey k] []
   where
 	runcheck c p = liftIO $ dispatch =<< safeSystem c p
 	dispatch ExitSuccess = return True
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 301cb92c7d..ab3f53524a 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -17,7 +17,6 @@ import Config.Cost
 import Annex.UUID
 import Annex.SpecialRemote.Config
 import Remote.Helper.Special
-import Remote.Helper.Messages
 import Remote.Helper.ExportImport
 import Utility.Env
 import Messages.Progress
@@ -54,7 +53,7 @@ gen r u rc gc rs = do
 		(store hooktype)
 		(retrieve hooktype)
 		(remove hooktype)
-		(checkKey r hooktype)
+		(checkKey hooktype)
 		Remote
 			{ uuid = u
 			, cost = cst
@@ -169,9 +168,8 @@ remove h k =
 	unlessM (runHook' h "remove" k Nothing $ return True) $
 		giveup "failed to remove content"
 
-checkKey :: Git.Repo -> HookName -> CheckPresent
-checkKey r h k = do
-	showChecking r
+checkKey :: HookName -> CheckPresent
+checkKey h k = do
 	v <- lookupHook h action
 	liftIO $ check v
   where
diff --git a/Remote/HttpAlso.hs b/Remote/HttpAlso.hs
index b111d76734..796ee19718 100644
--- a/Remote/HttpAlso.hs
+++ b/Remote/HttpAlso.hs
@@ -11,7 +11,6 @@ import Annex.Common
 import Types.Remote
 import Types.ProposedAccepted
 import Types.Export
-import Remote.Helper.Messages
 import Remote.Helper.ExportImport
 import Remote.Helper.Special
 import qualified Git
@@ -67,7 +66,7 @@ gen r u rc gc rs = do
 		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = cannotModify
 		, lockContent = Nothing
-		, checkPresent = checkKey url ll (this url ll c cst)
+		, checkPresent = checkKey url ll
 		, checkPresentCheap = False
 		, exportActions = ExportActions
 			{ storeExport = cannotModify
@@ -130,9 +129,8 @@ downloadAction dest p key run =
 			run (\url -> Url.download' p url dest uo)
 				>>= either giveup (const (return ()))
 
-checkKey :: Maybe URLString -> LearnedLayout -> Remote -> Key -> Annex Bool
-checkKey baseurl ll r key = do
-	showChecking r
+checkKey :: Maybe URLString -> LearnedLayout -> Key -> Annex Bool
+checkKey baseurl ll key =
 	isRight <$> keyUrlAction baseurl ll key (checkKey' key)
 
 checkKey' :: Key -> URLString -> Annex (Either String ())
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index d9cc05884b..ffb54aaf1e 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -29,7 +29,6 @@ import Annex.UUID
 import Annex.Ssh
 import Annex.Perms
 import Remote.Helper.Special
-import Remote.Helper.Messages
 import Remote.Helper.ExportImport
 import Types.Export
 import Types.ProposedAccepted
@@ -84,7 +83,7 @@ gen r u rc gc rs = do
 		(fileStorer $ store o)
 		(fileRetriever $ retrieve o)
 		(remove o)
-		(checkKey r o)
+		(checkKey o)
 		Remote
 			{ uuid = u
 			, cost = cst
@@ -280,10 +279,8 @@ removeGeneric o includes = do
 	unless ok $
 		giveup "rsync failed"
 
-checkKey :: Git.Repo -> RsyncOpts -> CheckPresent
-checkKey r o k = do
-	showChecking r
-	checkPresentGeneric o (rsyncUrls o k)
+checkKey :: RsyncOpts -> CheckPresent
+checkKey o k = checkPresentGeneric o (rsyncUrls o k)
 
 checkPresentGeneric :: RsyncOpts -> [RsyncUrl] -> Annex Bool
 checkPresentGeneric o rsyncurls = do
diff --git a/Remote/S3.hs b/Remote/S3.hs
index f8aecea2d3..0824dea23b 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -47,7 +47,6 @@ import Config.Cost
 import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.Http
-import Remote.Helper.Messages
 import Remote.Helper.ExportImport
 import Types.Import
 import qualified Remote.Helper.AWS as AWS
@@ -449,20 +448,17 @@ lockContentS3 hv r rs c info
 
 checkKey :: S3HandleVar -> Remote -> RemoteStateHandle -> ParsedRemoteConfig -> S3Info -> CheckPresent
 checkKey hv r rs c info k = withS3Handle hv $ \case
-	Just h -> do
-		showChecking r
-		eitherS3VersionID info rs c k (T.pack $ bucketObject info k) >>= \case
-			Left failreason -> do
-				warning failreason
-				giveup "cannot check content"
-			Right loc -> checkKeyHelper info h loc
+	Just h -> eitherS3VersionID info rs c k (T.pack $ bucketObject info k) >>= \case
+		Left failreason -> do
+			warning failreason
+			giveup "cannot check content"
+		Right loc -> checkKeyHelper info h loc
 	Nothing ->
 		getPublicWebUrls' (uuid r) rs info c k >>= \case
 			Left failreason -> do
 				warning failreason
 				giveup "cannot check content"
 			Right us -> do
-				showChecking r
 				let check u = withUrlOptions $ 
 					Url.checkBoth u (fromKey keySize k)
 				anyM check us
diff --git a/Remote/Web.hs b/Remote/Web.hs
index f62a7943d5..6b18a2fb31 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -9,7 +9,6 @@ module Remote.Web (remote, getWebUrls) where
 
 import Annex.Common
 import Types.Remote
-import Remote.Helper.Messages
 import Remote.Helper.ExportImport
 import qualified Git
 import qualified Git.Construct
@@ -112,7 +111,6 @@ checkKey key = do
 checkKey' :: Key -> [URLString] -> Annex (Either String Bool)
 checkKey' key us = firsthit us (Right False) $ \u -> do
 	let (u', downloader) = getDownloader u
-	showChecking u'
 	case downloader of
 		YoutubeDownloader -> youtubeDlCheck u'
 		_ -> catchMsgIO $
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index f1fd5bd85d..e55b2cc343 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -33,7 +33,6 @@ import Config
 import Config.Cost
 import Annex.SpecialRemote.Config
 import Remote.Helper.Special
-import Remote.Helper.Messages
 import Remote.Helper.Http
 import Remote.Helper.ExportImport
 import qualified Remote.Helper.Chunked.Legacy as Legacy
@@ -78,7 +77,7 @@ gen r u rc gc rs = do
 		(store hdl chunkconfig)
 		(retrieve hdl chunkconfig)
 		(remove hdl)
-		(checkKey hdl this chunkconfig)
+		(checkKey hdl chunkconfig)
 		this
 	  where
 		this = Remote
@@ -198,9 +197,8 @@ removeHelper d = do
 				Right False -> return ()
 				_ -> giveup "failed to remove content from remote"
 
-checkKey :: DavHandleVar -> Remote -> ChunkConfig -> CheckPresent
-checkKey hv r chunkconfig k = withDavHandle hv $ \dav -> do
-	showChecking r
+checkKey :: DavHandleVar -> ChunkConfig -> CheckPresent
+checkKey hv chunkconfig k = withDavHandle hv $ \dav ->
 	case chunkconfig of
 		LegacyChunks _ -> checkKeyLegacyChunked dav k
 		_ -> do