(re)start XMPP when it's configured in the webapp
This commit is contained in:
parent
2dc40ecbd1
commit
c71836269b
5 changed files with 12 additions and 3 deletions
|
@ -197,7 +197,7 @@ startAssistant assistant daemonize webappwaiter = withThreadState $ \st -> do
|
||||||
mapM_ (startthread dstatus)
|
mapM_ (startthread dstatus)
|
||||||
[ watch $ commitThread st changechan commitchan transferqueue dstatus
|
[ watch $ commitThread st changechan commitchan transferqueue dstatus
|
||||||
#ifdef WITH_WEBAPP
|
#ifdef WITH_WEBAPP
|
||||||
, assist $ webAppThread (Just st) dstatus scanremotes transferqueue transferslots urlrenderer Nothing webappwaiter
|
, assist $ webAppThread (Just st) dstatus scanremotes transferqueue transferslots pushnotifier urlrenderer Nothing webappwaiter
|
||||||
#ifdef WITH_PAIRING
|
#ifdef WITH_PAIRING
|
||||||
, assist $ pairListenerThread st dstatus scanremotes urlrenderer
|
, assist $ pairListenerThread st dstatus scanremotes urlrenderer
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -32,6 +32,7 @@ import Assistant.DaemonStatus
|
||||||
import Assistant.ScanRemotes
|
import Assistant.ScanRemotes
|
||||||
import Assistant.TransferQueue
|
import Assistant.TransferQueue
|
||||||
import Assistant.TransferSlots
|
import Assistant.TransferSlots
|
||||||
|
import Assistant.Pushes
|
||||||
import Utility.WebApp
|
import Utility.WebApp
|
||||||
import Utility.FileMode
|
import Utility.FileMode
|
||||||
import Utility.TempFile
|
import Utility.TempFile
|
||||||
|
@ -55,17 +56,19 @@ webAppThread
|
||||||
-> ScanRemoteMap
|
-> ScanRemoteMap
|
||||||
-> TransferQueue
|
-> TransferQueue
|
||||||
-> TransferSlots
|
-> TransferSlots
|
||||||
|
-> PushNotifier
|
||||||
-> UrlRenderer
|
-> UrlRenderer
|
||||||
-> Maybe (IO String)
|
-> Maybe (IO String)
|
||||||
-> Maybe (Url -> FilePath -> IO ())
|
-> Maybe (Url -> FilePath -> IO ())
|
||||||
-> NamedThread
|
-> NamedThread
|
||||||
webAppThread mst dstatus scanremotes transferqueue transferslots urlrenderer postfirstrun onstartup = thread $ do
|
webAppThread mst dstatus scanremotes transferqueue transferslots pushnotifier urlrenderer postfirstrun onstartup = thread $ do
|
||||||
webapp <- WebApp
|
webapp <- WebApp
|
||||||
<$> pure mst
|
<$> pure mst
|
||||||
<*> pure dstatus
|
<*> pure dstatus
|
||||||
<*> pure scanremotes
|
<*> pure scanremotes
|
||||||
<*> pure transferqueue
|
<*> pure transferqueue
|
||||||
<*> pure transferslots
|
<*> pure transferslots
|
||||||
|
<*> pure pushnotifier
|
||||||
<*> (pack <$> genRandomToken)
|
<*> (pack <$> genRandomToken)
|
||||||
<*> getreldir mst
|
<*> getreldir mst
|
||||||
<*> pure $(embed "static")
|
<*> pure $(embed "static")
|
||||||
|
|
|
@ -17,6 +17,7 @@ import Utility.Yesod
|
||||||
#ifdef WITH_XMPP
|
#ifdef WITH_XMPP
|
||||||
import Assistant.Common
|
import Assistant.Common
|
||||||
import Assistant.XMPP
|
import Assistant.XMPP
|
||||||
|
import Assistant.Pushes
|
||||||
import Utility.SRV
|
import Utility.SRV
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
@ -45,6 +46,7 @@ getXMPPR = xmppPage $ do
|
||||||
where
|
where
|
||||||
storecreds creds = do
|
storecreds creds = do
|
||||||
void $ runAnnex undefined $ setXMPPCreds creds
|
void $ runAnnex undefined $ setXMPPCreds creds
|
||||||
|
liftIO . notifyRestart =<< pushNotifier <$> getYesod
|
||||||
redirect ConfigR
|
redirect ConfigR
|
||||||
#else
|
#else
|
||||||
getXMPPR = xmppPage $
|
getXMPPR = xmppPage $
|
||||||
|
|
|
@ -17,6 +17,7 @@ import Assistant.DaemonStatus
|
||||||
import Assistant.ScanRemotes
|
import Assistant.ScanRemotes
|
||||||
import Assistant.TransferQueue
|
import Assistant.TransferQueue
|
||||||
import Assistant.TransferSlots
|
import Assistant.TransferSlots
|
||||||
|
import Assistant.Pushes
|
||||||
import Assistant.Alert
|
import Assistant.Alert
|
||||||
import Assistant.Pairing
|
import Assistant.Pairing
|
||||||
import Utility.NotificationBroadcaster
|
import Utility.NotificationBroadcaster
|
||||||
|
@ -38,6 +39,7 @@ data WebApp = WebApp
|
||||||
, scanRemotes :: ScanRemoteMap
|
, scanRemotes :: ScanRemoteMap
|
||||||
, transferQueue :: TransferQueue
|
, transferQueue :: TransferQueue
|
||||||
, transferSlots :: TransferSlots
|
, transferSlots :: TransferSlots
|
||||||
|
, pushNotifier :: PushNotifier
|
||||||
, secretToken :: Text
|
, secretToken :: Text
|
||||||
, relDir :: Maybe FilePath
|
, relDir :: Maybe FilePath
|
||||||
, getStatic :: Static
|
, getStatic :: Static
|
||||||
|
|
|
@ -15,6 +15,7 @@ import Assistant.DaemonStatus
|
||||||
import Assistant.ScanRemotes
|
import Assistant.ScanRemotes
|
||||||
import Assistant.TransferQueue
|
import Assistant.TransferQueue
|
||||||
import Assistant.TransferSlots
|
import Assistant.TransferSlots
|
||||||
|
import Assistant.Pushes
|
||||||
import Assistant.Threads.WebApp
|
import Assistant.Threads.WebApp
|
||||||
import Assistant.WebApp
|
import Assistant.WebApp
|
||||||
import Assistant.Install
|
import Assistant.Install
|
||||||
|
@ -104,11 +105,12 @@ firstRun = do
|
||||||
transferqueue <- newTransferQueue
|
transferqueue <- newTransferQueue
|
||||||
transferslots <- newTransferSlots
|
transferslots <- newTransferSlots
|
||||||
urlrenderer <- newUrlRenderer
|
urlrenderer <- newUrlRenderer
|
||||||
|
pushnotifier <- newPushNotifier
|
||||||
v <- newEmptyMVar
|
v <- newEmptyMVar
|
||||||
let callback a = Just $ a v
|
let callback a = Just $ a v
|
||||||
void $ runNamedThread dstatus $
|
void $ runNamedThread dstatus $
|
||||||
webAppThread Nothing dstatus scanremotes
|
webAppThread Nothing dstatus scanremotes
|
||||||
transferqueue transferslots urlrenderer
|
transferqueue transferslots pushnotifier urlrenderer
|
||||||
(callback signaler) (callback mainthread)
|
(callback signaler) (callback mainthread)
|
||||||
where
|
where
|
||||||
signaler v = do
|
signaler v = do
|
||||||
|
|
Loading…
Add table
Reference in a new issue