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

@@ -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 :: AndroidSerial -> AndroidPath -> CheckPresent
-checkKey r serial adir k = checkKey' r serial (androidLocation adir k)
+checkKey serial adir k = checkKey' serial (androidLocation adir k)
 
-checkKey' :: Remote -> AndroidSerial -> AndroidPath -> Annex Bool
+checkKey' :: AndroidSerial -> AndroidPath -> Annex Bool
-checkKey' r serial aloc = do
+checkKey' serial aloc = do
-	showChecking r
 	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 :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> Annex Bool
-checkPresentExportM r serial adir _k loc = checkKey' r serial aloc
+checkPresentExportM serial adir _k loc = checkKey' serial aloc
   where
 	aloc = androidExportLocation adir loc
 

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 :: Git.Repo -> CheckPresent
-checkKey r bupr k
+checkKey bupr k
-	| Git.repoIsUrl bupr = do
+	| Git.repoIsUrl bupr = onBupRemote bupr boolSystem "git" params
-		showChecking r
-		onBupRemote bupr boolSystem "git" params
 	| otherwise = liftIO $ boolSystem "git" $
 		Git.Command.gitCommandLine params bupr
   where

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 :: CheckPresent
-checkKeyUrl r k = do
+checkKeyUrl k = do
-	showChecking r
 	us <- getWebUrls k
 	anyM (\u -> withUrlOptions $ checkBoth u (fromKey keySize k)) us
 

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

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

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
+checkKey r k = go =<< glacierEnv (config r) (gitconfig r) (uuid r)
-	showChecking r
-	go =<< glacierEnv (config r) (gitconfig r) (uuid r)
   where
 	go Nothing = giveup "cannot check glacier"
 	go (Just e) = do

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
 

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
+inAnnex r k = onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex"
-	showChecking r
+	[Param $ serializeKey k] []
-	onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex" [Param $ serializeKey k] []
   where
 	runcheck c p = liftIO $ dispatch =<< safeSystem c p
 	dispatch ExitSuccess = return True

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 :: HookName -> CheckPresent
-checkKey r h k = do
+checkKey h k = do
-	showChecking r
 	v <- lookupHook h action
 	liftIO $ check v
   where

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 :: Maybe URLString -> LearnedLayout -> Key -> Annex Bool
-checkKey baseurl ll r key = do
+checkKey baseurl ll key =
-	showChecking r
 	isRight <$> keyUrlAction baseurl ll key (checkKey' key)
 
 checkKey' :: Key -> URLString -> Annex (Either String ())

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 :: RsyncOpts -> CheckPresent
-checkKey r o k = do
+checkKey o k = checkPresentGeneric o (rsyncUrls o k)
-	showChecking r
-	checkPresentGeneric o (rsyncUrls o k)
 
 checkPresentGeneric :: RsyncOpts -> [RsyncUrl] -> Annex Bool
 checkPresentGeneric o rsyncurls = do

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
+	Just h -> eitherS3VersionID info rs c k (T.pack $ bucketObject info k) >>= \case
-		showChecking r
+		Left failreason -> do
-		eitherS3VersionID info rs c k (T.pack $ bucketObject info k) >>= \case
+			warning failreason
-			Left failreason -> do
+			giveup "cannot check content"
-				warning failreason
+		Right loc -> checkKeyHelper info h loc
-				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

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 $

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 :: DavHandleVar -> ChunkConfig -> CheckPresent
-checkKey hv r chunkconfig k = withDavHandle hv $ \dav -> do
+checkKey hv chunkconfig k = withDavHandle hv $ \dav ->
-	showChecking r
 	case chunkconfig of
 		LegacyChunks _ -> checkKeyLegacyChunked dav k
 		_ -> do