webapp: Fix UI for removing XMPP connection.

Assistant/WebApp/Configurators/Delete.hs

@@ -39,13 +39,21 @@ notCurrentRepo uuid a = do
   	go Nothing = error "Unknown UUID"
 	go (Just _) = a
 
+handleXMPPRemoval :: UUID -> Handler Html -> Handler Html
+handleXMPPRemoval uuid nonxmpp = do
+	remote <- fromMaybe (error "unknown remote")
+		<$> liftAnnex (Remote.remoteFromUUID uuid)
+	if Remote.isXMPPRemote remote
+		then deletionPage $ $(widgetFile "configurators/delete/xmpp")
+		else nonxmpp
+
 getDisableRepositoryR :: UUID -> Handler Html
-getDisableRepositoryR uuid = notCurrentRepo uuid $ do
+getDisableRepositoryR uuid = notCurrentRepo uuid $ handleXMPPRemoval uuid $ do
 	void $ liftAssistant $ disableRemote uuid
 	redirect DashboardR
 
 getDeleteRepositoryR :: UUID -> Handler Html
-getDeleteRepositoryR uuid = notCurrentRepo uuid $
+getDeleteRepositoryR uuid = notCurrentRepo uuid $ handleXMPPRemoval uuid $ do
 	deletionPage $ do
 		reponame <- liftAnnex $ Remote.prettyUUID uuid
 		$(widgetFile "configurators/delete/start")

Assistant/WebApp/Configurators/XMPP.hs

@@ -25,6 +25,9 @@ import Assistant.WebApp.RepoList
 import Assistant.WebApp.Configurators
 import Assistant.XMPP
 #endif
+import qualified Git.Remote
+import Remote.List
+import Creds
 
 #ifdef WITH_XMPP
 import Network.Protocol.XMPP
@@ -202,5 +205,22 @@ testXMPP creds = do
 	showport (UnixSocket s) = s
 #endif
 
+getDisconnectXMPPR :: Handler Html
+getDisconnectXMPPR = do
+#ifdef WITH_XMPP
+	rs <- filter Remote.isXMPPRemote . syncRemotes
+		<$> liftAssistant getDaemonStatus
+	liftAnnex $ do
+		mapM_ (inRepo . Git.Remote.remove . Remote.name) rs
+		void remoteListRefresh
+		removeCreds xmppCredsFile
+	liftAssistant $ do
+		updateSyncRemotes
+		notifyNetMessagerRestart
+	redirect DashboardR
+#else
+	xmppPage $ $(widgetFile "configurators/xmpp/disabled")
+#endif
+
 xmppPage :: Widget -> Handler Html
 xmppPage = page "Jabber" (Just Configuration)

Assistant/WebApp/routes

@@ -20,6 +20,7 @@
 /config/xmpp/for/self XMPPConfigForPairSelfR GET POST
 /config/xmpp/for/frield XMPPConfigForPairFriendR GET POST
 /config/xmpp/needcloudrepo/#UUID NeedCloudRepoR GET
+/config/xmpp/disconnect DisconnectXMPPR GET
 /config/needconnection ConnectionNeededR GET
 /config/fsck ConfigFsckR GET POST
 /config/fsck/preferences ConfigFsckPreferencesR POST