From 9a8d0be866c0cc851be4e3899071c05ee0388780 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 3 Nov 2012 14:25:06 -0400
Subject: [PATCH] send a presence query when the buddy list is displayed

This ensures that clients that have not sent presence in a while will show
up in the list.
---
 Assistant/Threads/XMPPClient.hs           | 4 ++--
 Assistant/Types/NetMessager.hs            | 6 +++++-
 Assistant/WebApp/Configurators/Pairing.hs | 5 +++++
 Assistant/XMPP.hs                         | 3 +++
 4 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs
index 7fb3cc874c..9ecceabe5d 100644
--- a/Assistant/Threads/XMPPClient.hs
+++ b/Assistant/Threads/XMPPClient.hs
@@ -88,8 +88,8 @@ xmppClientThread = NamedThread "XMPPClient" $ do
 relayNetMessage :: Assistant (XMPP ())
 relayNetMessage = convert <$> waitNetMessage
   where
-	convert (NotifyPush us) =
-		putStanza $ gitAnnexPresence $ encodePushNotification us
+	convert (NotifyPush us) = putStanza $ pushNotification us
+	convert QueryPresence = putStanza presenceQuery
 
 data DecodedStanza 
 	= PresenceMessage Presence
diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs
index fea88a53aa..6bc9ec34a0 100644
--- a/Assistant/Types/NetMessager.hs
+++ b/Assistant/Types/NetMessager.hs
@@ -13,7 +13,11 @@ import Control.Concurrent.STM
 import Control.Concurrent.MSampleVar
 
 {- Messages that can be sent out of band by a network messager. -}
-data NetMessage = NotifyPush [UUID]
+data NetMessage 
+	-- indicate that pushes have been made to the repos with these uuids
+	= NotifyPush [UUID]
+	-- requests other clients to inform us of their presence
+	| QueryPresence
 
 {- Controls for the XMPP client. 
  -
diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs
index 2ec5f9891e..f62d9e7cd5 100644
--- a/Assistant/WebApp/Configurators/Pairing.hs
+++ b/Assistant/WebApp/Configurators/Pairing.hs
@@ -31,6 +31,8 @@ import Annex.UUID
 #ifdef WITH_XMPP
 import Assistant.XMPP.Client
 import Network.Protocol.XMPP
+import Assistant.Types.NetMessager
+import Assistant.NetMessager
 #endif
 import Utility.UserInfo
 
@@ -55,6 +57,9 @@ getStartPairR = pairPage $ do
 #else
 	let localsupported = False
 #endif
+	{- Ask buddies to send presence info, to get the buddy list
+	 - populated. -}
+	lift $ liftAssistant $ sendNetMessage QueryPresence
 	$(widgetFile "configurators/pairing/start")
 #else
 #ifdef WITH_PAIRING
diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs
index 05bc94fa30..834055fbc2 100644
--- a/Assistant/XMPP.hs
+++ b/Assistant/XMPP.hs
@@ -84,6 +84,9 @@ decodePushNotification (Element name attrs _nodes)
 	fromContent (ContentText t) = t
 	fromContent (ContentEntity t) = t
 
+pushNotification :: [UUID] -> Presence
+pushNotification = gitAnnexPresence . encodePushNotification
+
 {- A request for other git-annex clients to send presence. -}
 presenceQuery :: Presence
 presenceQuery = gitAnnexPresence $ Element gitAnnexTagName