xmpp buddy list tracking

1 files changed, 26 insertions, 9 deletions

diff --git a/Assistant/Threads/PushNotifier.hs b/Assistant/Threads/PushNotifier.hs
index d2d5e08bf..8830d9459 100644
--- a/Assistant/Threads/PushNotifier.hs
+++ b/Assistant/Threads/PushNotifier.hs
@@ -12,7 +12,10 @@ module Assistant.Threads.PushNotifier where
 
 import Assistant.Common
 import Assistant.XMPP
+import Assistant.XMPP.Client
 import Assistant.Pushes
+import Assistant.Types.Buddies
+import Assistant.XMPP.Buddies
 import Assistant.Sync
 import Assistant.DaemonStatus
 import qualified Remote
@@ -28,15 +31,27 @@ pushNotifierThread :: NamedThread
 pushNotifierThread = NamedThread "PushNotifier" $ do
 	iodebug <- asIO1 debug
 	iopull <- asIO1 pull
-	iowaitpush <- asIO $ waitPush
-	ioclient <- asIO2 $ xmppClient $ iowaitpush
+	iowaitpush <- asIO waitPush
+	ioupdatebuddies <- asIO1 $ \p -> do
+		updateBuddyList (updateBuddies p) <<~ buddyList
+		debug =<< map show <$> getBuddyList <<~ buddyList
+	ioclient <- asIO $
+		xmppClient iowaitpush iodebug iopull ioupdatebuddies
 	forever $ do
-		tid <- liftIO $ forkIO $ ioclient iodebug iopull
+		{- The buddy list starts empty each time the client connects,
+		 - so that stale info is not retained. -}
+		updateBuddyList (const noBuddies) <<~ buddyList
+		tid <- liftIO $ forkIO ioclient
 		waitRestart
 		liftIO $ killThread tid
 
-xmppClient :: (IO [UUID]) -> ([String] -> IO ()) -> ([UUID] -> IO ()) -> Assistant ()
-xmppClient iowaitpush iodebug iopull = do
+xmppClient
+	:: (IO [UUID])
+	-> ([String] -> IO ()) 
+	-> ([UUID] -> IO ()) 
+	-> (Presence -> IO ())
+	-> Assistant ()
+xmppClient iowaitpush iodebug iopull ioupdatebuddies = do
 	v <- liftAnnex getXMPPCreds
 	case v of
 		Nothing -> noop
@@ -67,10 +82,12 @@ xmppClient iowaitpush iodebug iopull = do
 		s <- getStanza
 		liftIO $ iodebug ["received XMPP:", show s]
 		case s of
-			ReceivedPresence p@(Presence { presenceType = PresenceAvailable }) ->
-				liftIO $ iopull $ concat $ catMaybes $
-					map decodePushNotification $
-						presencePayloads p
+			ReceivedPresence p -> do
+				liftIO $ ioupdatebuddies p
+				when (isGitAnnexPresence p) $
+					liftIO $ iopull $ concat $ catMaybes $
+						map decodePushNotification $
+							presencePayloads p
 			_ -> noop
 
 {- We only pull from one remote out of the set listed in the push