diff options
author | Joey Hess <joey@kitenet.net> | 2013-03-06 16:29:19 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-03-06 16:29:19 -0400 |
commit | dc82128f6f0ffef9f6973baed3ad63d89802c898 (patch) | |
tree | 93ff21057d04f9d1c48e4c9e2fa75de092dc1908 /Assistant/Threads/XMPPClient.hs | |
parent | 49b88039e597ec761227d00ddf125f8ebe5c6a4f (diff) |
tag xmpp pushes with jid
This fixes the issue mentioned in the last commit.
Turns out just collecting UUID of clients behind a XMPP remote is
insufficient (although I should probably still do it for other reasons),
because a single remote repo might be connected via both XMPP and local
pairing. So a way is needed to know when a push was received from any
client using a given XMPP remote over XMPP, as opposed to via ssh.
Diffstat (limited to 'Assistant/Threads/XMPPClient.hs')
-rw-r--r-- | Assistant/Threads/XMPPClient.hs | 24 |
1 files changed, 13 insertions, 11 deletions
diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index ebface796..688d0121b 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -38,18 +38,20 @@ xmppClientThread urlrenderer = namedThread "XMPPClient" $ restartableClient . xmppClient urlrenderer =<< getAssistant id {- Runs the client, handing restart events. -} -restartableClient :: IO () -> Assistant () -restartableClient a = forever $ do - tid <- liftIO $ forkIO a - waitNetMessagerRestart - liftIO $ killThread tid +restartableClient :: (XMPPCreds -> IO ()) -> Assistant () +restartableClient a = forever $ go =<< liftAnnex getXMPPCreds + where + go Nothing = waitNetMessagerRestart + go (Just creds) = do + modifyDaemonStatus_ $ \s -> s + { xmppClientID = Just $ xmppJID creds } + tid <- liftIO $ forkIO $ a creds + waitNetMessagerRestart + liftIO $ killThread tid -xmppClient :: UrlRenderer -> AssistantData -> IO () -xmppClient urlrenderer d = do - v <- liftAssistant $ liftAnnex getXMPPCreds - case v of - Nothing -> noop -- will be restarted once creds get configured - Just c -> retry (runclient c) =<< getCurrentTime +xmppClient :: UrlRenderer -> AssistantData -> XMPPCreds -> IO () +xmppClient urlrenderer d creds = + retry (runclient creds) =<< getCurrentTime where liftAssistant = runAssistant d inAssistant = liftIO . liftAssistant |