change Remote.repo to Remote.getRepo

This is groundwork for letting a repo be instantiated the first time
it's actually used, instead of at startup.

The only behavior change is that some old special cases for xmpp remotes
were removed. Where before git-annex silently did nothing with those
no-longer supported remotes, it may now fail in some way.

The additional IO action should have no performance impact as long as
it's simply return.

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon

Assistant/DaemonStatus.hs

@@ -55,8 +55,7 @@ calcSyncRemotes = do
 	let good r = Remote.uuid r `elem` alive
 	let syncable = filter good rs
 	contentremotes <- filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) $
-		filter (\r -> Remote.uuid r /= NoUUID) $
-		filter (not . Remote.isXMPPRemote) syncable
+		filter (\r -> Remote.uuid r /= NoUUID) syncable
 	let (exportremotes, dataremotes) = partition (exportTree . Remote.config) contentremotes
 
 	return $ \dstatus -> dstatus

Assistant/Pairing/MakeRemote.hs

@@ -47,7 +47,8 @@ finishedLocalPairing msg keypair = do
 			("git-annex-shell -c configlist " ++ T.unpack (sshDirectory sshdata))
 			Nothing
 	r <- liftAnnex $ addRemote $ makeSshRemote sshdata
-	liftAnnex $ setRemoteCost (Remote.repo r) semiExpensiveRemoteCost
+	repo <- liftAnnex $ Remote.getRepo r
+	liftAnnex $ setRemoteCost repo semiExpensiveRemoteCost
 	syncRemote r
 
 {- Mostly a straightforward conversion.  Except:

Assistant/Sync.hs

@@ -64,26 +64,25 @@ reconnectRemotes rs = void $ do
 		mapM_ signal $ filter (`notElem` failedrs) rs'
 	recordExportCommit
   where
-	gitremotes = filter (notspecialremote . Remote.repo) rs
-	(_xmppremotes, nonxmppremotes) = partition Remote.isXMPPRemote rs
+	gitremotes = liftAnnex $ 
+		filterM (notspecialremote <$$> Remote.getRepo) rs
 	notspecialremote r
 		| Git.repoIsUrl r = True
 		| Git.repoIsLocal r = True
 		| Git.repoIsLocalUnknown r = True
 		| otherwise = False
 	sync currentbranch@(Just _, _) = do
-		(failedpull, diverged) <- manualPull currentbranch gitremotes
+		(failedpull, diverged) <- manualPull currentbranch =<< gitremotes
 		now <- liftIO getCurrentTime
-		failedpush <- pushToRemotes' now gitremotes
+		failedpush <- pushToRemotes' now =<< gitremotes
 		return (nub $ failedpull ++ failedpush, diverged)
 	{- No local branch exists yet, but we can try pulling. -}
-	sync (Nothing, _) = manualPull (Nothing, Nothing) gitremotes
+	sync (Nothing, _) = manualPull (Nothing, Nothing) =<< gitremotes
 	go = do
 		(failed, diverged) <- sync
 			=<< liftAnnex (join Command.Sync.getCurrBranch)
 		addScanRemotes diverged =<<
-			filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig)
-				nonxmppremotes
+			filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) rs
 		return failed
 	signal r = liftIO . mapM_ (flip tryPutMVar ())
 		=<< fromMaybe [] . M.lookup (Remote.uuid r) . connectRemoteNotifiers
@@ -130,8 +129,7 @@ pushToRemotes' now remotes = do
 			<$> gitRepo
 			<*> join Command.Sync.getCurrBranch
 			<*> getUUID
-	let (_xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
-	ret <- go True branch g u normalremotes
+	ret <- go True branch g u remotes
 	return ret
   where
 	go _ (Nothing, _) _ _ _ = return [] -- no branch, so nothing to do
@@ -174,7 +172,8 @@ parallelPush g rs a = do
   where
 	topush r = (,)
 		<$> pure r
-		<*> sshOptionsTo (Remote.repo r) (Remote.gitconfig r) g
+		<*> (Remote.getRepo r >>= \repo ->
+			sshOptionsTo repo (Remote.gitconfig r) g)
 
 {- Displays an alert while running an action that syncs with some remotes,
  - and returns any remotes that it failed to sync with.
@@ -187,7 +186,7 @@ syncAction rs a
 	| otherwise = do
 		i <- addAlert $ syncAlert visibleremotes
 		failed <- a rs
-		let failed' = filter (not . Git.repoIsLocalUnknown . Remote.repo) failed
+		failed' <- filterM (not . Git.repoIsLocalUnknown <$$> liftAnnex . Remote.getRepo) failed
 		let succeeded = filter (`notElem` failed) visibleremotes
 		if null succeeded && null failed'
 			then removeAlert i
@@ -195,8 +194,7 @@ syncAction rs a
 				syncResultAlert succeeded failed'
 		return failed
   where
-	visibleremotes = filter (not . Remote.readonly) $
-		filter (not . Remote.isXMPPRemote) rs
+	visibleremotes = filter (not . Remote.readonly) rs
 
 {- Manually pull from remotes and merge their branches. Returns any
  - remotes that it failed to pull from, and a Bool indicating
@@ -206,17 +204,18 @@ syncAction rs a
 manualPull :: Command.Sync.CurrBranch -> [Remote] -> Assistant ([Remote], Bool)
 manualPull currentbranch remotes = do
 	g <- liftAnnex gitRepo
-	let (_xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
-	failed <- forM normalremotes $ \r -> if wantpull $ Remote.gitconfig r
+	failed <- forM remotes $ \r -> if wantpull $ Remote.gitconfig r
 		then do
-			g' <- liftAnnex $ sshOptionsTo (Remote.repo r) (Remote.gitconfig r) g
+			g' <- liftAnnex $ do
+				repo <- Remote.getRepo r
+				sshOptionsTo repo (Remote.gitconfig r) g
 			ifM (liftIO $ Git.Command.runBool [Param "fetch", Param $ Remote.name r] g')
 				( return Nothing
 				, return $ Just r
 				)
 		else return Nothing
 	haddiverged <- liftAnnex Annex.Branch.forceUpdate
-	forM_ normalremotes $ \r ->
+	forM_ remotes $ \r ->
 		liftAnnex $ Command.Sync.mergeRemote r
 			currentbranch Command.Sync.mergeConfig def
 	when haddiverged $
@@ -263,10 +262,10 @@ changeSyncable (Just r) False = do
 
 changeSyncFlag :: Remote -> Bool -> Annex ()
 changeSyncFlag r enabled = do
+	repo <- Remote.getRepo r
+	let key = Config.remoteConfig repo "sync"
 	Config.setConfig key (boolConfig enabled)
 	void Remote.remoteListRefresh
-  where
-	key = Config.remoteConfig (Remote.repo r) "sync"
 
 updateExportTreeFromLogAll :: Assistant ()
 updateExportTreeFromLogAll = do

Assistant/Threads/Cronner.hs

@@ -210,11 +210,11 @@ runActivity' urlrenderer (ScheduledRemoteFsck u s d) = dispatch =<< liftAnnex (r
 			 - Annex monad. -}
 			go rmt =<< liftAnnex (mkfscker (annexFsckParams d))
 	go rmt annexfscker = do
+		repo <- liftAnnex $ Remote.getRepo rmt
 		fsckresults <- showFscking urlrenderer (Just rmt) $ tryNonAsync $ do
 			void annexfscker
-			let r = Remote.repo rmt
-			if Git.repoIsLocal r && not (Git.repoIsLocalUnknown r)
-				then Just <$> Git.Fsck.findBroken True r
+			if Git.repoIsLocal repo && not (Git.repoIsLocalUnknown repo)
+				then Just <$> Git.Fsck.findBroken True repo
 				else pure Nothing
 		maybe noop (void . repairWhenNecessary urlrenderer u (Just rmt)) fsckresults
 

Assistant/Threads/MountWatcher.hs

@@ -144,7 +144,8 @@ handleMounts urlrenderer wasmounted nowmounted =
 handleMount :: UrlRenderer -> FilePath -> Assistant ()
 handleMount urlrenderer dir = do
 	debug ["detected mount of", dir]
-	rs <- filter (Git.repoIsLocal . Remote.repo) <$> remotesUnder dir
+	rs <- filterM (Git.repoIsLocal <$$> liftAnnex . Remote.getRepo)
+		=<< remotesUnder dir
 	mapM_ (fsckNudge urlrenderer . Just) rs
 	reconnectRemotes rs
 

Assistant/Threads/ProblemFixer.hs

@@ -49,20 +49,23 @@ handleProblem urlrenderer repoproblem = do
 		liftIO $ afterFix repoproblem
 
 handleRemoteProblem :: UrlRenderer -> Remote -> Assistant Bool
-handleRemoteProblem urlrenderer rmt
-	| Git.repoIsLocal r && not (Git.repoIsLocalUnknown r) =
+handleRemoteProblem urlrenderer rmt = do
+	repo <- liftAnnex $ Remote.getRepo rmt
+	handleRemoteProblem' repo urlrenderer rmt
+
+handleRemoteProblem' :: Git.Repo -> UrlRenderer -> Remote -> Assistant Bool
+handleRemoteProblem' repo urlrenderer rmt
+	| Git.repoIsLocal repo && not (Git.repoIsLocalUnknown repo) =
 		ifM (liftIO $ checkAvailable True rmt)
 			( do
-				fixedlocks <- repairStaleGitLocks r
+				fixedlocks <- repairStaleGitLocks repo
 				fsckresults <- showFscking urlrenderer (Just rmt) $ tryNonAsync $
-					Git.Fsck.findBroken True r
+					Git.Fsck.findBroken True repo
 				repaired <- repairWhenNecessary urlrenderer (Remote.uuid rmt) (Just rmt) fsckresults
 				return $ fixedlocks || repaired
 			, return False
 			)
 	| otherwise = return False
-  where
-	r = Remote.repo rmt
 
 {- This is not yet used, and should probably do a fsck. -}
 handleLocalRepoProblem :: UrlRenderer -> Assistant Bool

Assistant/Threads/RemoteControl.hs

@@ -99,7 +99,7 @@ remoteResponderThread fromh urimap = go M.empty
 			cont
 
 getURIMap :: Annex (M.Map URI Remote)
-getURIMap = Remote.remoteMap' id (mkk . Git.location . Remote.repo)
+getURIMap = Remote.remoteMap' id (\r -> mkk . Git.location <$> Remote.getRepo r)
   where
 	mkk (Git.Url u) = Just u
 	mkk _ = Nothing

Assistant/TransferSlots.hs

@@ -106,13 +106,13 @@ runTransferThread' program batchmaker d run = go
  - already have been updated to include the transfer. -}
 genTransfer :: Transfer -> TransferInfo -> TransferGenerator
 genTransfer t info = case transferRemote info of
-	Just remote 
-		| Git.repoIsLocalUnknown (Remote.repo remote) -> do
-			-- optimisation for removable drives not plugged in
+	Just remote -> ifM (unpluggedremovabledrive remote)
+		( do
+			-- optimisation, since the transfer would fail
 			liftAnnex $ recordFailedTransfer t info
 			void $ removeTransfer t
 			return Nothing
-		| otherwise -> ifM (liftAnnex $ shouldTransfer t info)
+		, ifM (liftAnnex $ shouldTransfer t info)
 			( do
 				debug [ "Transferring:" , describeTransfer t info ]
 				notifyTransfer
@@ -124,11 +124,15 @@ genTransfer t info = case transferRemote info of
 				finishedTransfer t (Just info)
 				return Nothing
 			)
+		)
 	_ -> return Nothing
   where
 	direction = transferDirection t
 	isdownload = direction == Download
 
+	unpluggedremovabledrive remote = Git.repoIsLocalUnknown
+		<$> liftAnnex (Remote.getRepo remote)
+
 	{- Alerts are only shown for successful transfers.
 	 - Transfers can temporarily fail for many reasons,
 	 - so there's no point in bothering the user about

Assistant/WebApp/Configurators/Edit.hs

@@ -146,8 +146,8 @@ setRepoConfig uuid mremote oldc newc = do
 
 	legalName = makeLegalName . T.unpack . repoName
 
-editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig
-editRepositoryAForm mremote d = RepoConfig
+editRepositoryAForm :: Maybe Git.Repo -> Maybe Remote -> RepoConfig -> MkAForm RepoConfig
+editRepositoryAForm mrepo mremote d = RepoConfig
 	<$> areq (if ishere then readonlyTextField else textField)
 		(bfs "Name") (Just $ repoName d)
 	<*> aopt textField (bfs "Description") (Just $ repoDescription d)
@@ -156,8 +156,7 @@ editRepositoryAForm mremote d = RepoConfig
 	<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable d)
   where
 	ishere = isNothing mremote
-	isspecial = fromMaybe False $
-		(== Git.Unknown) . Git.location . Remote.repo <$> mremote
+	isspecial = maybe False ((== Git.Unknown) . Git.location) mrepo
 	groups = customgroups ++ standardgroups
 	standardgroups :: [(Text, RepoGroup)]
 	standardgroups = map (\g -> (T.pack $ descStandardGroup g , RepoGroupStandard g)) $
@@ -204,8 +203,11 @@ editForm new (RepoUUID uuid)
 				error "unknown remote"
 		curr <- liftAnnex $ getRepoConfig uuid mremote
 		liftAnnex $ checkAssociatedDirectory curr mremote
+		mrepo <- liftAnnex $
+			maybe (pure Nothing) (Just <$$> Remote.getRepo) mremote
 		((result, form), enctype) <- liftH $
-			runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ editRepositoryAForm mremote curr
+			runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
+				editRepositoryAForm mrepo mremote curr
 		case result of
 			FormSuccess input -> liftH $ do
 				setRepoConfig uuid mremote curr input
@@ -221,7 +223,8 @@ editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do
 	mr <- liftAnnex (repoIdRemote r)
 	let repoInfo = getRepoInfo mr Nothing
 	g <- liftAnnex gitRepo
-	let sshrepo = maybe False (remoteLocationIsSshUrl . flip parseRemoteLocation g . Git.repoLocation . Remote.repo) mr
+	mrepo <- liftAnnex $ maybe (pure Nothing) (Just <$$> Remote.getRepo) mr
+	let sshrepo = maybe False (remoteLocationIsSshUrl . flip parseRemoteLocation g . Git.repoLocation) mrepo
 	$(widgetFile "configurators/edit/nonannexremote")
 
 {- Makes any directory associated with the repository. -}
@@ -246,7 +249,7 @@ getRepoInfo (Just r) (Just c) = case M.lookup "type" c of
 		| otherwise -> AWS.getRepoInfo c
 	Just t
 		| t /= "git" -> [whamlet|#{t} remote|]
-	_ -> getGitRepoInfo $ Remote.repo r
+	_ -> getGitRepoInfo =<< liftAnnex (Remote.getRepo r)
 getRepoInfo (Just r) _ = getRepoInfo (Just r) (Just $ Remote.config r)
 getRepoInfo _ _ = [whamlet|git repository|]
 
@@ -283,9 +286,11 @@ getUpgradeRepositoryR r = go =<< liftAnnex (repoIdRemote r)
 	go Nothing = redirect DashboardR
 	go (Just rmt) = do
 		liftIO fixSshKeyPairIdentitiesOnly
-		liftAnnex $ setConfig 
-			(remoteConfig (Remote.repo rmt) "ignore")
-			(Git.Config.boolConfig False)
+		liftAnnex $ do
+			repo <- Remote.getRepo rmt
+			setConfig
+				(remoteConfig repo "ignore")
+				(Git.Config.boolConfig False)
 		liftAnnex $ void Remote.remoteListRefresh
 		liftAssistant updateSyncRemotes
 		liftAssistant $ syncRemote rmt

Assistant/WebApp/MakeRemote.hs

@@ -38,8 +38,9 @@ setupCloudRemote = setupRemote postsetup . Just
 setupRemote :: (Remote -> Handler a) -> Maybe StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a
 setupRemote postsetup mgroup mcost getname = do
 	r <- liftAnnex $ addRemote getname
+	repo <- liftAnnex $ Remote.getRepo r
 	liftAnnex $ do
 		maybe noop (defaultStandardGroup (Remote.uuid r)) mgroup
-		maybe noop (Config.setRemoteCost (Remote.repo r)) mcost
+		maybe noop (Config.setRemoteCost repo) mcost
 	liftAssistant $ syncRemote r
 	postsetup r

Assistant/WebApp/RepoList.hs

@@ -139,10 +139,11 @@ repoList reposelector
 			unwanted <- S.fromList
 				<$> filterM inUnwantedGroup (map Remote.uuid syncremotes)
 			trustmap <- trustMap
+			allrs <- concat . Remote.byCost <$> Remote.remoteList
 			rs <- filter (\r -> M.lookup (Remote.uuid r) trustmap /= Just DeadTrusted)
-				. filter selectedrepo 
-				. concat . Remote.byCost
-				<$> Remote.remoteList
+				. map fst
+				. filter selectedrepo
+				<$> forM allrs (\r -> (,) <$> pure r <*> Remote.getRepo r)
 			let l = flip map (map mkRepoId rs) $ \r -> case r of
 				(RepoUUID u)
 					| u `S.member` unwanted -> (r, mkUnwantedRepoActions r)
@@ -165,11 +166,10 @@ repoList reposelector
 		map snd . catMaybes . filter selectedremote 
 			. map (findinfo m g)
 			<$> trustExclude DeadTrusted (M.keys m)
-	selectedrepo r
+	selectedrepo (r, repo)
 		| Remote.readonly r = False
-		| onlyCloud reposelector = Git.repoIsUrl (Remote.repo r)
+		| onlyCloud reposelector = Git.repoIsUrl repo
 			&& Remote.uuid r /= NoUUID 
-			&& not (Remote.isXMPPRemote r)
 		| otherwise = True
 	selectedremote Nothing = False
 	selectedremote (Just (iscloud, _))
@@ -238,8 +238,9 @@ getRepositoriesReorderR = do
 	go list (Just remote) = do
 		rs <- catMaybes <$> mapM repoIdRemote list
 		forM_ (reorderCosts remote rs) $ \(r, newcost) ->
-			when (Remote.cost r /= newcost) $
-				setRemoteCost (Remote.repo r) newcost
+			when (Remote.cost r /= newcost) $ do
+				repo <- Remote.getRepo r
+				setRemoteCost repo newcost
 		void remoteListRefresh
 	fromjs = fromMaybe (RepoUUID NoUUID) . readish . T.unpack