diff options
author | Joey Hess <joey@kitenet.net> | 2012-10-27 00:06:17 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-10-27 00:06:17 -0400 |
commit | 5b7d00b6e9f79f4e0a2093feea58ad164a766ab2 (patch) | |
tree | 352475417b70328f1a59e04756f25e950c9e158b /Assistant/Threads | |
parent | c4d0e27334d58f5d67c86363d0e38376e1e97a9b (diff) |
xmpp reconnection
If it managed to run for 5 minutes, reconnect immediately. Otherwise,
wait 5 minutes before reconnecting.
Diffstat (limited to 'Assistant/Threads')
-rw-r--r-- | Assistant/Threads/PushNotifier.hs | 29 |
1 files changed, 22 insertions, 7 deletions
diff --git a/Assistant/Threads/PushNotifier.hs b/Assistant/Threads/PushNotifier.hs index 9f15d5419..46a1d3ebf 100644 --- a/Assistant/Threads/PushNotifier.hs +++ b/Assistant/Threads/PushNotifier.hs @@ -17,11 +17,13 @@ import Assistant.DaemonStatus import Assistant.Pushes import Assistant.Sync import qualified Remote +import Utility.ThreadScheduler import Network.Protocol.XMPP import Control.Concurrent import qualified Data.Set as S import qualified Git.Branch +import Data.Time.Clock thisThread :: ThreadName thisThread = "PushNotifier" @@ -31,14 +33,27 @@ pushNotifierThread st dstatus pushnotifier = NamedThread thisThread $ do v <- runThreadState st $ getXMPPCreds case v of Nothing -> return () -- no creds? exit thread - Just c -> void $ connectXMPP c $ \jid -> do - fulljid <- bindJID jid - liftIO $ debug thisThread ["XMPP connected", show fulljid] - s <- getSession - _ <- liftIO $ forkIO $ void $ runXMPP s $ - receivenotifications - sendnotifications + Just c -> loop c =<< getCurrentTime where + loop c starttime = do + void $ connectXMPP c $ \jid -> do + fulljid <- bindJID jid + liftIO $ debug thisThread ["XMPP connected", show fulljid] + s <- getSession + _ <- liftIO $ forkIO $ void $ runXMPP s $ + receivenotifications + sendnotifications + now <- getCurrentTime + if diffUTCTime now starttime > 300 + then do + debug thisThread ["XMPP connection lost; reconnecting"] + loop c now + else do + debug thisThread ["XMPP connection failed; will retry"] + threadDelaySeconds (Seconds 300) + loop c =<< getCurrentTime + + sendnotifications = forever $ do us <- liftIO $ waitPush pushnotifier let payload = [extendedAway, encodePushNotification us] |