webapp: Fix UI for removing XMPP connection.
This commit is contained in:
parent
17d2e2b346
commit
9724667a3d
8 changed files with 56 additions and 3 deletions
|
@ -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")
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue