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.
This commit is contained in:
Joey Hess 2012-11-03 14:25:06 -04:00
parent a1228e27ed
commit 9a8d0be866
4 changed files with 15 additions and 3 deletions

View file

@ -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

View file

@ -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.
-

View file

@ -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

View file

@ -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