remove xmpp support

I've long considered the XMPP support in git-annex a wart.
It's nice to remove it.

(This also removes the NetMessager, which was only used for XMPP, and the
daemonstatus's desynced list (likewise).)

Existing XMPP remotes should be ignored by git-annex.

This commit was sponsored by Brock Spratlen on Patreon.

1 files changed, 14 insertions, 52 deletions

diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index 9b9e7ebe5..e46910ccd 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -9,8 +9,6 @@ module Assistant.Sync where
 
 import Assistant.Common
 import Assistant.Pushes
-import Assistant.NetMessager
-import Assistant.Types.NetMessager
 import Assistant.Alert
 import Assistant.Alert.Utility
 import Assistant.DaemonStatus
@@ -20,7 +18,6 @@ import qualified Command.Sync
 import Utility.Parallel
 import qualified Git
 import qualified Git.Command
-import qualified Git.Ref
 import qualified Git.Merge
 import qualified Remote
 import qualified Types.Remote as Remote
@@ -40,7 +37,6 @@ import Types.Transfer
 
 import Data.Time.Clock
 import qualified Data.Map as M
-import qualified Data.Set as S
 import Control.Concurrent
 
 {- Syncs with remotes that may have been disconnected for a while.
@@ -51,21 +47,14 @@ import Control.Concurrent
  - the remotes have diverged from the local git-annex branch. Otherwise,
  - it's sufficient to requeue failed transfers.
  -
- - XMPP remotes are also signaled that we can push to them, and we request
- - they push to us. Since XMPP pushes run ansynchronously, any scan of the
- - XMPP remotes has to be deferred until they're done pushing to us, so
- - all XMPP remotes are marked as possibly desynced.
- -
  - Also handles signaling any connectRemoteNotifiers, after the syncing is
  - done.
  -}
-reconnectRemotes :: Bool -> [Remote] -> Assistant ()
-reconnectRemotes _ [] = noop
-reconnectRemotes notifypushes rs = void $ do
+reconnectRemotes :: [Remote] -> Assistant ()
+reconnectRemotes [] = noop
+reconnectRemotes rs = void $ do
 	rs' <- liftIO $ filterM (Remote.checkAvailable True) rs
 	unless (null rs') $ do
-		modifyDaemonStatus_ $ \s -> s
-			{ desynced = S.union (S.fromList $ map Remote.uuid xmppremotes) (desynced s) }
 		failedrs <- syncAction rs' (const go)
 		forM_ failedrs $ \r ->
 			whenM (liftIO $ Remote.checkAvailable False r) $
@@ -73,7 +62,7 @@ reconnectRemotes notifypushes rs = void $ do
 		mapM_ signal $ filter (`notElem` failedrs) rs'
   where
 	gitremotes = filter (notspecialremote . Remote.repo) rs
-	(xmppremotes, nonxmppremotes) = partition Remote.isXMPPRemote rs
+	(_xmppremotes, nonxmppremotes) = partition Remote.isXMPPRemote rs
 	notspecialremote r
 		| Git.repoIsUrl r = True
 		| Git.repoIsLocal r = True
@@ -82,7 +71,7 @@ reconnectRemotes notifypushes rs = void $ do
 	sync currentbranch@(Just _, _) = do
 		(failedpull, diverged) <- manualPull currentbranch gitremotes
 		now <- liftIO getCurrentTime
-		failedpush <- pushToRemotes' now notifypushes 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
@@ -102,9 +91,6 @@ reconnectRemotes notifypushes rs = void $ do
  - as "git annex sync", except in parallel, and will co-exist with use of
  - "git annex sync".
  -
- - After the pushes to normal git remotes, also signals XMPP clients that
- - they can request an XMPP push.
- -
  - Avoids running possibly long-duration commands in the Annex monad, so
  - as not to block other threads.
  -
@@ -122,27 +108,21 @@ reconnectRemotes notifypushes rs = void $ do
  -
  - Returns any remotes that it failed to push to.
  -}
-pushToRemotes :: Bool -> [Remote] -> Assistant [Remote]
-pushToRemotes notifypushes remotes = do
+pushToRemotes :: [Remote] -> Assistant [Remote]
+pushToRemotes remotes = do
 	now <- liftIO getCurrentTime
 	let remotes' = filter (not . remoteAnnexReadOnly . Remote.gitconfig) remotes
-	syncAction remotes' (pushToRemotes' now notifypushes)
-pushToRemotes' :: UTCTime -> Bool -> [Remote] -> Assistant [Remote]
-pushToRemotes' now notifypushes remotes = do
+	syncAction remotes' (pushToRemotes' now)
+pushToRemotes' :: UTCTime -> [Remote] -> Assistant [Remote]
+pushToRemotes' now remotes = do
 	(g, branch, u) <- liftAnnex $ do
 		Annex.Branch.commit "update"
 		(,,)
 			<$> gitRepo
 			<*> join Command.Sync.getCurrBranch
 			<*> getUUID
-	let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
+	let (_xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
 	ret <- go True branch g u normalremotes
-	unless (null xmppremotes) $ do
-		shas <- liftAnnex $ map fst <$>
-			inRepo (Git.Ref.matchingWithHEAD
-				[Annex.Branch.fullname, Git.Ref.headRef])
-		forM_ xmppremotes $ \r -> sendNetMessage $
-			Pushing (getXMPPClientID r) (CanPush u shas)
 	return ret
   where
 	go _ (Nothing, _) _ _ _ = return [] -- no branch, so nothing to do
@@ -152,11 +132,7 @@ pushToRemotes' now notifypushes remotes = do
 		(succeeded, failed) <- parallelPush g rs (push branch)
 		updatemap succeeded []
 		if null failed
-			then do
-				when notifypushes $
-					sendNetMessage $ NotifyPush $
-						map Remote.uuid succeeded
-				return failed
+			then return []
 			else if shouldretry
 				then retry currbranch g u failed
 				else fallback branch g u failed
@@ -175,9 +151,6 @@ pushToRemotes' now notifypushes remotes = do
 		debug ["fallback pushing to", show rs]
 		(succeeded, failed) <- parallelPush g rs (taggedPush u Nothing branch)
 		updatemap succeeded failed
-		when (notifypushes && (not $ null succeeded)) $
-			sendNetMessage $ NotifyPush $
-				map Remote.uuid succeeded
 		return failed
 		
 	push branch remote = Command.Sync.pushBranch remote branch
@@ -195,10 +168,6 @@ parallelPush g rs a = do
 {- Displays an alert while running an action that syncs with some remotes,
  - and returns any remotes that it failed to sync with.
  -
- - XMPP remotes are handled specially; since the action can only start
- - an async process for them, they are not included in the alert, but are
- - still passed to the action.
- -
  - Readonly remotes are also hidden (to hide the web special remote).
  -}
 syncAction :: [Remote] -> ([Remote] -> Assistant [Remote]) -> Assistant [Remote]
@@ -222,15 +191,11 @@ syncAction rs a
  - remotes that it failed to pull from, and a Bool indicating
  - whether the git-annex branches of the remotes and local had
  - diverged before the pull.
- -
- - After pulling from the normal git remotes, requests pushes from any
- - XMPP remotes. However, those pushes will run asynchronously, so their
- - results are not included in the return data.
  -}
 manualPull :: Command.Sync.CurrBranch -> [Remote] -> Assistant ([Remote], Bool)
 manualPull currentbranch remotes = do
 	g <- liftAnnex gitRepo
-	let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
+	let (_xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
 	failed <- forM normalremotes $ \r -> do
 		g' <- liftAnnex $ sshOptionsTo (Remote.repo r) (Remote.gitconfig r) g
 		ifM (liftIO $ Git.Command.runBool [Param "fetch", Param $ Remote.name r] g')
@@ -240,9 +205,6 @@ manualPull currentbranch remotes = do
 	haddiverged <- liftAnnex Annex.Branch.forceUpdate
 	forM_ normalremotes $ \r ->
 		liftAnnex $ Command.Sync.mergeRemote r currentbranch mergeConfig
-	u <- liftAnnex getUUID
-	forM_ xmppremotes $ \r ->
-		sendNetMessage $ Pushing (getXMPPClientID r) (PushRequest u)
 	return (catMaybes failed, haddiverged)
 
 mergeConfig :: [Git.Merge.MergeConfig]
@@ -257,7 +219,7 @@ syncRemote :: Remote -> Assistant ()
 syncRemote remote = do
 	updateSyncRemotes
 	thread <- asIO $ do
-		reconnectRemotes False [remote]
+		reconnectRemotes [remote]
 		addScanRemotes True [remote]
 	void $ liftIO $ forkIO $ thread