split up xmpp and local pairing UIs
This commit is contained in:
parent
116023e05d
commit
b91f07fe83
7 changed files with 53 additions and 59 deletions
|
@ -55,34 +55,29 @@ import Control.Concurrent
|
|||
import qualified Data.Set as S
|
||||
#endif
|
||||
|
||||
{- Starts either kind of pairing. -}
|
||||
getStartPairR :: Handler RepHtml
|
||||
getStartXMPPPairR :: Handler RepHtml
|
||||
#ifdef WITH_XMPP
|
||||
getStartPairR = do
|
||||
xmppconfigured <- isJust <$> runAnnex Nothing getXMPPCreds
|
||||
#ifdef WITH_PAIRING
|
||||
let localsupported = True
|
||||
getStartXMPPPairR = ifM (isJust <$> runAnnex Nothing getXMPPCreds)
|
||||
( do
|
||||
{- Ask buddies to send presence info, to get
|
||||
- the buddy list populated. -}
|
||||
liftAssistant $ sendNetMessage QueryPresence
|
||||
pairPage $
|
||||
$(widgetFile "configurators/pairing/xmpp/prompt")
|
||||
, redirect XMPPForPairingR -- go get XMPP configured, then come back
|
||||
)
|
||||
#else
|
||||
let localsupported = False
|
||||
#endif
|
||||
{- Ask buddies to send presence info, to get the buddy list
|
||||
- populated. -}
|
||||
liftAssistant $ sendNetMessage QueryPresence
|
||||
pairPage $
|
||||
$(widgetFile "configurators/pairing/start")
|
||||
#else
|
||||
#ifdef WITH_PAIRING
|
||||
getStartPairR = redirect StartLocalPairR
|
||||
#else
|
||||
getStartPairR = noPairing "local or jabber"
|
||||
#endif
|
||||
getStartXMPPPairR = noXMPPPairing
|
||||
|
||||
noXMPPPairing :: Handler RepHtml
|
||||
noXMPPPairing = noPairing "XMPP"
|
||||
#endif
|
||||
|
||||
{- Starts pairing with an XMPP buddy, or with other clients sharing an
|
||||
{- Does pairing with an XMPP buddy, or with other clients sharing an
|
||||
- XMPP account. -}
|
||||
getStartXMPPPairR :: BuddyKey -> Handler RepHtml
|
||||
getRunningXMPPPairR :: BuddyKey -> Handler RepHtml
|
||||
#ifdef WITH_XMPP
|
||||
getStartXMPPPairR bid = do
|
||||
getRunningXMPPPairR bid = do
|
||||
buddy <- liftAssistant $ getBuddy bid <<~ buddyList
|
||||
go $ S.toList . buddyAssistants <$> buddy
|
||||
where
|
||||
|
@ -97,12 +92,9 @@ getStartXMPPPairR bid = do
|
|||
xmppPairEnd True $ if samejid then Nothing else Just exemplar
|
||||
-- A buddy could have logged out, or the XMPP client restarted,
|
||||
-- and there be no clients to message; handle unforseen by going back.
|
||||
go _ = redirect StartPairR
|
||||
go _ = redirect StartXMPPPairR
|
||||
#else
|
||||
getStartXMPPPairR _ = noXMPPPairing
|
||||
|
||||
noXMPPPairing :: Handler RepHtml
|
||||
noXMPPPairing = noPairing "XMPP"
|
||||
getRunningXMPPPairR _ = noXMPPPairing
|
||||
#endif
|
||||
|
||||
{- Starts local pairing. -}
|
||||
|
|
|
@ -57,7 +57,7 @@ getXMPPR = xmppPage $
|
|||
|
||||
getXMPPForPairingR :: Handler RepHtml
|
||||
#ifdef WITH_XMPP
|
||||
getXMPPForPairingR = getXMPPR' StartPairR
|
||||
getXMPPForPairingR = getXMPPR' StartXMPPPairR
|
||||
#else
|
||||
getXMPPForPairingR = xmppPage $
|
||||
$(widgetFile "configurators/xmpp/disabled")
|
||||
|
|
|
@ -26,11 +26,11 @@
|
|||
/config/repository/add/cloud/rsync.net AddRsyncNetR GET
|
||||
/config/repository/add/cloud/S3 AddS3R GET
|
||||
|
||||
/config/repository/pair/start StartPairR GET
|
||||
/config/repository/pair/local/start StartLocalPairR GET
|
||||
/config/repository/pair/local/running/#SecretReminder RunningLocalPairR GET
|
||||
/config/repository/pair/local/finish/#PairMsg FinishLocalPairR GET
|
||||
/config/repository/pair/xmpp/start/#BuddyKey StartXMPPPairR GET
|
||||
/config/repository/pair/xmpp/start StartXMPPPairR GET
|
||||
/config/repository/pair/xmpp/running/#BuddyKey RunningXMPPPairR GET
|
||||
/config/repository/pair/xmpp/finish/#PairKey FinishXMPPPairR GET
|
||||
|
||||
/config/repository/enable/rsync/#UUID EnableRsyncR GET
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue