ignore our own client presence

This commit is contained in:
Joey Hess 2012-11-02 21:23:58 -04:00
parent d6ccc29c03
commit bf17262986

View file

@ -35,12 +35,11 @@ pushNotifierThread = NamedThread "PushNotifier" $ do
ioupdatebuddies <- asIO1 $ \p -> do ioupdatebuddies <- asIO1 $ \p -> do
updateBuddyList (updateBuddies p) <<~ buddyList updateBuddyList (updateBuddies p) <<~ buddyList
debug =<< map show <$> getBuddyList <<~ buddyList debug =<< map show <$> getBuddyList <<~ buddyList
ioclient <- asIO $ ioemptybuddies <- asIO $
xmppClient iowaitpush iodebug iopull ioupdatebuddies
forever $ do
{- The buddy list starts empty each time the client connects,
- so that stale info is not retained. -}
updateBuddyList (const noBuddies) <<~ buddyList updateBuddyList (const noBuddies) <<~ buddyList
ioclient <- asIO $
xmppClient iowaitpush iodebug iopull ioupdatebuddies ioemptybuddies
forever $ do
tid <- liftIO $ forkIO ioclient tid <- liftIO $ forkIO ioclient
waitRestart waitRestart
liftIO $ killThread tid liftIO $ killThread tid
@ -50,8 +49,9 @@ xmppClient
-> ([String] -> IO ()) -> ([String] -> IO ())
-> ([UUID] -> IO ()) -> ([UUID] -> IO ())
-> (Presence -> IO ()) -> (Presence -> IO ())
-> IO ()
-> Assistant () -> Assistant ()
xmppClient iowaitpush iodebug iopull ioupdatebuddies = do xmppClient iowaitpush iodebug iopull ioupdatebuddies ioemptybuddies = do
v <- liftAnnex getXMPPCreds v <- liftAnnex getXMPPCreds
case v of case v of
Nothing -> noop Nothing -> noop
@ -61,10 +61,13 @@ xmppClient iowaitpush iodebug iopull ioupdatebuddies = do
void $ connectXMPP c $ \jid -> do void $ connectXMPP c $ \jid -> do
fulljid <- bindJID jid fulljid <- bindJID jid
liftIO $ iodebug ["XMPP connected", show fulljid] liftIO $ iodebug ["XMPP connected", show fulljid]
{- The buddy list starts empty each time the client
- connects, so that stale info is not retained. -}
liftIO ioemptybuddies
putStanza $ gitAnnexPresence gitAnnexSignature putStanza $ gitAnnexPresence gitAnnexSignature
s <- getSession s <- getSession
_ <- liftIO $ forkIO $ void $ runXMPP s $ _ <- liftIO $ forkIO $ void $ runXMPP s $
receivenotifications receivenotifications fulljid
sendnotifications sendnotifications
now <- getCurrentTime now <- getCurrentTime
if diffUTCTime now starttime > 300 if diffUTCTime now starttime > 300
@ -78,16 +81,18 @@ xmppClient iowaitpush iodebug iopull ioupdatebuddies = do
sendnotifications = forever $ do sendnotifications = forever $ do
us <- liftIO iowaitpush us <- liftIO iowaitpush
putStanza $ gitAnnexPresence $ encodePushNotification us putStanza $ gitAnnexPresence $ encodePushNotification us
receivenotifications = forever $ do receivenotifications fulljid = forever $ do
s <- getStanza s <- getStanza
liftIO $ iodebug ["received XMPP:", show s] liftIO $ iodebug ["received XMPP:", show s]
case s of case s of
ReceivedPresence p -> do ReceivedPresence p@(Presence { presenceFrom = from })
liftIO $ ioupdatebuddies p | from == Just fulljid -> noop
when (isGitAnnexPresence p) $ | otherwise -> do
liftIO $ iopull $ concat $ catMaybes $ liftIO $ ioupdatebuddies p
map decodePushNotification $ when (isGitAnnexPresence p) $
presencePayloads p liftIO $ iopull $ concat $ catMaybes $
map decodePushNotification $
presencePayloads p
_ -> noop _ -> noop
{- We only pull from one remote out of the set listed in the push {- We only pull from one remote out of the set listed in the push