cache remote.log

Unlikely to speed up any of the existing uses much, but I want to use it
in a message that might be displayed many times.

Annex.hs

@@ -69,6 +69,7 @@ import Types.AdjustedBranch
 import Types.WorkerPool
 import Types.IndexFiles
 import Types.CatFileHandles
+import Types.RemoteConfig
 import qualified Database.Keys.Handle as Keys
 import Utility.InodeCache
 import Utility.Url
@@ -129,6 +130,7 @@ data AnnexState = AnnexState
 	, uuiddescmap :: Maybe UUIDDescMap
 	, preferredcontentmap :: Maybe (FileMatcherMap Annex)
 	, requiredcontentmap :: Maybe (FileMatcherMap Annex)
+	, remoteconfigmap :: Maybe (M.Map UUID RemoteConfig)
 	, forcetrust :: TrustMap
 	, trustmap :: Maybe TrustMap
 	, groupmap :: Maybe GroupMap
@@ -188,6 +190,7 @@ newState c r = do
 		, uuiddescmap = Nothing
 		, preferredcontentmap = Nothing
 		, requiredcontentmap = Nothing
+		, remoteconfigmap = Nothing
 		, forcetrust = M.empty
 		, trustmap = Nothing
 		, groupmap = Nothing

Annex/SpecialRemote.hs

@@ -36,7 +36,7 @@ findExisting name = do
 	headMaybe
 		. sortBy (comparing $ \(u, _, _) -> Down $ M.lookup u t)
 		. findByRemoteConfig (\c -> lookupName c == Just name)
-		<$> Logs.Remote.readRemoteLog
+		<$> Logs.Remote.remoteConfigMap
 
 newConfig
 	:: RemoteName
@@ -56,7 +56,7 @@ newConfig name sameas fromuser m = case sameas of
 
 specialRemoteMap :: Annex (M.Map UUID RemoteName)
 specialRemoteMap = do
-	m <- Logs.Remote.readRemoteLog
+	m <- Logs.Remote.remoteConfigMap
 	return $ M.fromList $ mapMaybe go (M.toList m)
   where
 	go (u, c) = case lookupName c of
@@ -79,7 +79,7 @@ findType config = maybe unspecified (specified . fromProposedAccepted) $
 
 autoEnable :: Annex ()
 autoEnable = do
-	remotemap <- M.filter configured <$> readRemoteLog
+	remotemap <- M.filter configured <$> remoteConfigMap
 	enabled <- getenabledremotes
 	forM_ (M.toList remotemap) $ \(cu, c) -> unless (cu `M.member` enabled) $ do
 		let u = case findSameasUUID c of

Assistant/WebApp/Configurators/AWS.hs

@@ -154,7 +154,7 @@ postAddGlacierR = glacierConfigurator $ do
 
 getEnableS3R :: UUID -> Handler Html
 getEnableS3R uuid = do
-	m <- liftAnnex readRemoteLog
+	m <- liftAnnex remoteConfigMap
 	isia <- case M.lookup uuid m of
 		Just c -> liftAnnex $ do
 			pc <- parsedRemoteConfig S3.remote c
@@ -180,7 +180,7 @@ enableAWSRemote remotetype uuid = do
 		runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ awsCredsAForm defcreds
 	case result of
 		FormSuccess creds -> liftH $ do
-			m <- liftAnnex readRemoteLog
+			m <- liftAnnex remoteConfigMap
 			let name = fromJust $ lookupName $
 				fromJust $ M.lookup uuid m
 			makeAWSRemote enableSpecialRemote remotetype SmallArchiveGroup creds name M.empty

Assistant/WebApp/Configurators/Delete.hs

@@ -59,7 +59,7 @@ getFinishDeleteRepositoryR uuid = deletionPage $ do
 
 	reponame <- liftAnnex $ Remote.prettyUUID uuid
 	{- If it's not listed in the remote log, it must be a git repo. -}
-	gitrepo <- liftAnnex $ M.notMember uuid <$> readRemoteLog
+	gitrepo <- liftAnnex $ M.notMember uuid <$> remoteConfigMap
 	$(widgetFile "configurators/delete/finished")	
 
 getDeleteCurrentRepositoryR :: Handler Html

Assistant/WebApp/Configurators/Edit.hs

@@ -71,7 +71,7 @@ getRepoConfig uuid mremote = do
 	void uuidDescMapLoad
 
 	groups <- lookupGroups uuid
-	remoteconfig <- M.lookup uuid <$> readRemoteLog
+	remoteconfig <- M.lookup uuid <$> remoteConfigMap
 	let (repogroup, associateddirectory) = case getStandardGroup groups of
 		Nothing -> (RepoGroupCustom $ unwords $ map fromGroup $ S.toList groups, Nothing)
 		Just g -> (RepoGroupStandard g, associatedDirectory remoteconfig g)
@@ -122,7 +122,7 @@ setRepoConfig uuid mremote oldc newc = do
 			| T.null t -> noop
 			| otherwise -> liftAnnex $ do
 				let dir = takeBaseName $ T.unpack t
-				m <- readRemoteLog
+				m <- remoteConfigMap
 				case M.lookup uuid m of
 					Nothing -> noop
 					Just remoteconfig -> configSet uuid $
@@ -220,7 +220,7 @@ editForm new (RepoUUID uuid)
 				let istransfer = repoGroup curr == RepoGroupStandard TransferGroup
 				config <- liftAnnex $ fromMaybe mempty 
 					. M.lookup uuid
-					<$> readRemoteLog
+					<$> remoteConfigMap
 				let repoInfo = getRepoInfo mremote config
 				let repoEncryption = getRepoEncryption mremote (Just config)
 				$(widgetFile "configurators/edit/repository")
@@ -230,7 +230,7 @@ editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do
 		Just rmt -> do
 			config <- liftAnnex $ fromMaybe mempty
 				. M.lookup (Remote.uuid rmt)
-				<$> readRemoteLog
+				<$> remoteConfigMap
 			getRepoInfo mr config
 		Nothing -> getRepoInfo Nothing mempty
 	g <- liftAnnex gitRepo
@@ -242,7 +242,7 @@ editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do
 checkAssociatedDirectory :: RepoConfig -> Maybe Remote -> Annex ()
 checkAssociatedDirectory _ Nothing = noop
 checkAssociatedDirectory cfg (Just r) = do
-	repoconfig <- M.lookup (Remote.uuid r) <$> readRemoteLog
+	repoconfig <- M.lookup (Remote.uuid r) <$> remoteConfigMap
 	case repoGroup cfg of
 		RepoGroupStandard gr -> case associatedDirectory repoconfig gr of
 			Just d -> do

Assistant/WebApp/Configurators/IA.hs

@@ -158,7 +158,7 @@ enableIARemote uuid = do
 		runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ iaCredsAForm defcreds
 	case result of
 		FormSuccess creds -> liftH $ do
-			m <- liftAnnex readRemoteLog
+			m <- liftAnnex remoteConfigMap
 			let name = fromJust $ lookupName $
 				fromJust $ M.lookup uuid m
 			AWS.makeAWSRemote enableSpecialRemote S3.remote PublicGroup creds name M.empty

Assistant/WebApp/Configurators/Ssh.hs

@@ -209,7 +209,7 @@ postEnableSshGitRemoteR = enableSshRemote getsshinput enableRsyncNet enablesshgi
  -}
 enableSshRemote :: (RemoteConfig -> Maybe SshData) -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> UUID -> Handler Html) -> UUID -> Handler Html
 enableSshRemote getsshdata rsyncnetsetup genericsetup u = do
-	m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog
+	m <- fromMaybe M.empty . M.lookup u <$> liftAnnex remoteConfigMap
 	case (unmangle <$> getsshdata m, lookupName m) of
 		(Just sshdata, Just reponame) -> sshConfigurator $ do
 			((result, form), enctype) <- liftH $
@@ -424,7 +424,7 @@ getConfirmSshR sshdata u
 		-- Not a UUID we know, so prompt about combining.
 		$(widgetFile "configurators/ssh/combine")
 	handleexisting (Just _) = prepSsh False sshdata $ \sshdata' -> do
-		m <- liftAnnex readRemoteLog
+		m <- liftAnnex remoteConfigMap
 		case fromProposedAccepted <$> (M.lookup typeField =<< M.lookup u m) of
 			Just "gcrypt" -> combineExistingGCrypt sshdata' u
 			_ -> makeSshRepo ExistingRepo sshdata'
@@ -545,7 +545,7 @@ makeSshRepo rs sshdata
 	-- Record the location of the ssh remote in the remote log, so it
 	-- can easily be enabled elsewhere using the webapp.
 	setup r = do
-		m <- readRemoteLog
+		m <- remoteConfigMap
 		let c = fromMaybe M.empty (M.lookup (Remote.uuid r) m)
 		let c' = M.insert (Proposed "location") (Proposed (genSshUrl sshdata)) $
 			M.insert typeField (Proposed "git") $

Assistant/WebApp/Configurators/WebDAV.hs

@@ -53,7 +53,7 @@ getEnableWebDAVR :: UUID -> Handler Html
 getEnableWebDAVR = postEnableWebDAVR
 postEnableWebDAVR :: UUID -> Handler Html
 postEnableWebDAVR uuid = do
-	m <- liftAnnex readRemoteLog
+	m <- liftAnnex remoteConfigMap
 	let c = fromJust $ M.lookup uuid m
 	let name = fromJust $ lookupName c
 	let url = fromProposedAccepted $ fromJust $ M.lookup (Accepted "url") c

Assistant/WebApp/Gpg.hs

@@ -80,7 +80,7 @@ getGCryptRemoteName u repoloc = do
 	mname <- ifM (inRepo $ Git.Command.runBool [Param "fetch", Param tmpremote])
 		( do
 			void Annex.Branch.forceUpdate
-			(lookupName <=< M.lookup u) <$> readRemoteLog
+			(lookupName <=< M.lookup u) <$> remoteConfigMap
 		, return Nothing
 		)
 	void $ inRepo $ Git.Remote.Remove.remove tmpremote

Assistant/WebApp/RepoList.hs

@@ -162,7 +162,7 @@ repoList reposelector
 					return $ here : l
 				else return l
 	unconfigured = liftAnnex $ do
-		m <- readRemoteLog
+		m <- remoteConfigMap
 		g <- gitRepo
 		map snd . catMaybes . filter selectedremote 
 			. map (findinfo m g)

Command/EnableRemote.hs

@@ -72,7 +72,7 @@ startNormalRemote name restparams r
 startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID)) -> CommandStart
 startSpecialRemote name config Nothing = do
 	m <- SpecialRemote.specialRemoteMap
-	confm <- Logs.Remote.readRemoteLog
+	confm <- Logs.Remote.remoteConfigMap
 	Remote.nameToUUID' name >>= \case
 		Right u | u `M.member` m ->
 			startSpecialRemote name config $

Command/InitRemote.hs

@@ -71,7 +71,7 @@ start o (name:ws) = ifM (isJust <$> findExisting name)
 				(sameas o) 
 			c <- newConfig name sameasuuid
 				(Logs.Remote.keyValToConfig Proposed ws)
-				<$> readRemoteLog
+				<$> remoteConfigMap
 			t <- either giveup return (findType c)
 			if whatElse o
 				then startingCustomOutput (ActionItemOther Nothing) $

Command/RenameRemote.hs

@@ -37,7 +37,7 @@ start ps@(oldname:newname:[]) = Annex.SpecialRemote.findExisting oldname >>= \ca
 	Nothing -> Remote.nameToUUID' oldname >>= \case
 		Left e -> giveup e
 		Right u -> do
-			m <- Logs.Remote.readRemoteLog
+			m <- Logs.Remote.remoteConfigMap
 			case M.lookup u m of
 				Nothing -> giveup "That is not a special remote."
 				Just cfg -> go u cfg Nothing

Logs/PreferredContent.hs

@@ -86,7 +86,7 @@ preferredRequiredMapsLoad mktokens = do
 preferredRequiredMapsLoad' :: (PreferredContentData -> [ParseToken (MatchFiles Annex)]) -> Annex (M.Map UUID (Either String (FileMatcher Annex)), M.Map UUID (Either String (FileMatcher Annex)))
 preferredRequiredMapsLoad' mktokens = do
 	groupmap <- groupMap
-	configmap <- readRemoteLog
+	configmap <- remoteConfigMap
 	let genmap l gm = 
 		let mk u = makeMatcher groupmap configmap gm u mktokens
 		in simpleMap

Logs/Remote.hs

@@ -1,12 +1,13 @@
 {- git-annex remote log
  - 
- - Copyright 2011-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
  - 
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
 module Logs.Remote (
 	remoteLog,
+	remoteConfigMap,
 	readRemoteLog,
 	configSet,
 	keyValToConfig,
@@ -18,6 +19,7 @@ module Logs.Remote (
 ) where
 
 import Annex.Common
+import qualified Annex
 import qualified Annex.Branch
 import Types.Remote
 import Logs
@@ -35,8 +37,20 @@ configSet u cfg = do
 		buildRemoteConfigLog
 			. changeLog c u (removeSameasInherited cfg)
 			. parseRemoteConfigLog
+	Annex.changeState $ \s -> s { Annex.remoteconfigmap = Nothing }
+
+{- Map of remotes by uuid containing key/value config maps.
+ - Cached for speed. -}
+remoteConfigMap :: Annex (M.Map UUID RemoteConfig)
+remoteConfigMap = maybe remoteConfigMapLoad return
+	=<< Annex.getState Annex.remoteconfigmap
+
+remoteConfigMapLoad :: Annex (M.Map UUID RemoteConfig)
+remoteConfigMapLoad = do
+	m <- readRemoteLog
+	Annex.changeState $ \s -> s { Annex.remoteconfigmap = Just m }
+	return m
 
-{- Map of remotes by uuid containing key/value config maps. -}
 readRemoteLog :: Annex (M.Map UUID RemoteConfig)
 readRemoteLog = calcRemoteConfigMap 
 	<$> Annex.Branch.get remoteLog

Remote/GCrypt.hs

@@ -109,7 +109,7 @@ gen baser u rc gc rs = do
 	-- correctly.
 	resetup gcryptid r = do
 		let u' = genUUIDInNameSpace gCryptNameSpace gcryptid
-		v <- M.lookup u' <$> readRemoteLog
+		v <- M.lookup u' <$> remoteConfigMap
 		case (Git.remoteName baser, v) of
 			(Just remotename, Just rc') -> do
 				pc <- parsedRemoteConfig remote rc'

Remote/GitLFS.hs

@@ -187,9 +187,9 @@ mySetup ss mu _ c gc = do
 configKnownUrl :: Git.Repo -> Annex (Maybe Git.Repo)
 configKnownUrl r
 	| Git.repoIsUrl r = do
-		l <- readRemoteLog
+		m <- remoteConfigMap
 		g <- Annex.gitRepo
-		case Annex.SpecialRemote.Config.findByRemoteConfig (match g) l of
+		case Annex.SpecialRemote.Config.findByRemoteConfig (match g) m of
 			((u, _, mcu):[]) -> Just <$> go u mcu
 			_ -> return Nothing
 	| otherwise = return Nothing

Remote/List.hs

@@ -72,7 +72,7 @@ remoteList = do
 
 remoteList' :: Bool -> Annex [Remote]
 remoteList' autoinit = do
-	m <- readRemoteLog
+	m <- remoteConfigMap
 	rs <- concat <$> mapM (process m) remoteTypes
 	Annex.changeState $ \s -> s { Annex.remotes = rs }
 	return rs
@@ -96,7 +96,7 @@ remoteGen m t g = do
 {- Updates a local git Remote, re-reading its git config. -}
 updateRemote :: Remote -> Annex (Maybe Remote)
 updateRemote remote = do
-	m <- readRemoteLog
+	m <- remoteConfigMap
 	remote' <- updaterepo =<< getRepo remote
 	remoteGen m (remotetype remote) remote'
   where

doc/todo/make___34____Try_making_some_of_these_repositories_available__34___more_informative/comment_4_aefdd17cbfc249ac9b3c6880cabca6d1._comment

@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2020-09-22T16:45:19Z"
+ content="""
+This risks changing the --json output. Eg currently it has:
+
+	{"command":"get","wanted":[{"here":false,"uuid":"7f03b57d-5923-489a-be26-1ab254d0620d","description":"archive-13 [house]"}],"note":"from house...\nrsync failed -- run git annex again to resume file transfer\nUnable to access these remotes: house\nTry making some of these repositories available:\n\t7f03b57d-5923-489a-be26-1ab254d0620d -- archive-13 [house]\n","skipped":[]
+
+The "wanted" list comes from the display of the list of
+uuids, but now there would be up to 3 lists displayed.
+
+I doubt anything uses that, but I don't want to change the json,
+so I suppose it would need to keep the current behavior when json is
+enabled, ugh.
+"""]]