diff options
Diffstat (limited to 'Assistant/Threads')
| -rw-r--r-- | Assistant/Threads/Merger.hs | 25 | ||||
| -rw-r--r-- | Assistant/Threads/XMPPClient.hs | 24 |
2 files changed, 26 insertions, 23 deletions
diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs index d88cf00bd..4a482583f 100644 --- a/Assistant/Threads/Merger.hs +++ b/Assistant/Threads/Merger.hs @@ -22,6 +22,7 @@ import Annex.TaggedPush import Remote (remoteFromUUID) import qualified Data.Set as S +import qualified Data.Text as T {- This thread watches for changes to .git/refs/, and handles incoming - pushes. -} @@ -89,21 +90,21 @@ onAdd file void $ liftAnnex $ Command.Sync.mergeFrom changedbranch mergecurrent _ = noop - handleDesynced = case branchTaggedBy changedbranch of + handleDesynced = case fromTaggedBranch changedbranch of Nothing -> return False - Just u -> do - s <- desynced <$> getDaemonStatus - if S.member u s - then do - modifyDaemonStatus_ $ \st -> st - { desynced = S.delete u s } - mr <- liftAnnex $ remoteFromUUID u - case mr of - Just r -> do + Just (u, info) -> do + mr <- liftAnnex $ remoteFromUUID u + case mr of + Nothing -> return False + Just r -> do + s <- desynced <$> getDaemonStatus + if S.member u s || Just (T.unpack $ getXMPPClientID r) == info + then do + modifyDaemonStatus_ $ \st -> st + { desynced = S.delete u s } addScanRemotes True [r] return True - Nothing -> return False - else return False + else return False equivBranches :: Git.Ref -> Git.Ref -> Bool equivBranches x y = base x == base y 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 |