diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-10-27 00:42:14 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-10-27 00:42:14 -0400 |
| commit | ce5b38aa1dbd1e320c5247d95344e373bf03e7cf (patch) | |
| tree | 99e55c492457520f016188e00ba553c23f8bc187 /Assistant/XMPP.hs | |
| parent | 5b7d00b6e9f79f4e0a2093feea58ad164a766ab2 (diff) | |
reconnect XMPP when NetWatcher notices a change
Diffstat (limited to 'Assistant/XMPP.hs')
| -rw-r--r-- | Assistant/XMPP.hs | 8 |
1 files changed, 6 insertions, 2 deletions
diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs index 75d948cbd..2e38189ea 100644 --- a/Assistant/XMPP.hs +++ b/Assistant/XMPP.hs @@ -16,7 +16,7 @@ import Network import Control.Concurrent import qualified Data.Text as T import Data.XML.Types -import Control.Exception as E +import Control.Exception (SomeException) {- Everything we need to know to connect to an XMPP server. -} data XMPPCreds = XMPPCreds @@ -53,7 +53,11 @@ connectXMPP' jid c a = go =<< lookupSRV srvrecord a jid ifM (isEmptyMVar mv) (go rest, return r) - run h p a' = E.try (runClientError (Server serverjid h p) jid (xmppUsername c) (xmppPassword c) (void a')) :: IO (Either SomeException ()) + {- Async exceptions are let through so the XMPP thread can + - be killed. -} + run h p a' = tryNonAsync $ + runClientError (Server serverjid h p) jid + (xmppUsername c) (xmppPassword c) (void a') {- XMPP runClient, that throws errors rather than returning an Either -} runClientError :: Server -> JID -> T.Text -> T.Text -> XMPP a -> IO a |