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:
parent
a1228e27ed
commit
9a8d0be866
4 changed files with 15 additions and 3 deletions
|
@ -88,8 +88,8 @@ xmppClientThread = NamedThread "XMPPClient" $ do
|
||||||
relayNetMessage :: Assistant (XMPP ())
|
relayNetMessage :: Assistant (XMPP ())
|
||||||
relayNetMessage = convert <$> waitNetMessage
|
relayNetMessage = convert <$> waitNetMessage
|
||||||
where
|
where
|
||||||
convert (NotifyPush us) =
|
convert (NotifyPush us) = putStanza $ pushNotification us
|
||||||
putStanza $ gitAnnexPresence $ encodePushNotification us
|
convert QueryPresence = putStanza presenceQuery
|
||||||
|
|
||||||
data DecodedStanza
|
data DecodedStanza
|
||||||
= PresenceMessage Presence
|
= PresenceMessage Presence
|
||||||
|
|
|
@ -13,7 +13,11 @@ import Control.Concurrent.STM
|
||||||
import Control.Concurrent.MSampleVar
|
import Control.Concurrent.MSampleVar
|
||||||
|
|
||||||
{- Messages that can be sent out of band by a network messager. -}
|
{- 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.
|
{- Controls for the XMPP client.
|
||||||
-
|
-
|
||||||
|
|
|
@ -31,6 +31,8 @@ import Annex.UUID
|
||||||
#ifdef WITH_XMPP
|
#ifdef WITH_XMPP
|
||||||
import Assistant.XMPP.Client
|
import Assistant.XMPP.Client
|
||||||
import Network.Protocol.XMPP
|
import Network.Protocol.XMPP
|
||||||
|
import Assistant.Types.NetMessager
|
||||||
|
import Assistant.NetMessager
|
||||||
#endif
|
#endif
|
||||||
import Utility.UserInfo
|
import Utility.UserInfo
|
||||||
|
|
||||||
|
@ -55,6 +57,9 @@ getStartPairR = pairPage $ do
|
||||||
#else
|
#else
|
||||||
let localsupported = False
|
let localsupported = False
|
||||||
#endif
|
#endif
|
||||||
|
{- Ask buddies to send presence info, to get the buddy list
|
||||||
|
- populated. -}
|
||||||
|
lift $ liftAssistant $ sendNetMessage QueryPresence
|
||||||
$(widgetFile "configurators/pairing/start")
|
$(widgetFile "configurators/pairing/start")
|
||||||
#else
|
#else
|
||||||
#ifdef WITH_PAIRING
|
#ifdef WITH_PAIRING
|
||||||
|
|
|
@ -84,6 +84,9 @@ decodePushNotification (Element name attrs _nodes)
|
||||||
fromContent (ContentText t) = t
|
fromContent (ContentText t) = t
|
||||||
fromContent (ContentEntity t) = t
|
fromContent (ContentEntity t) = t
|
||||||
|
|
||||||
|
pushNotification :: [UUID] -> Presence
|
||||||
|
pushNotification = gitAnnexPresence . encodePushNotification
|
||||||
|
|
||||||
{- A request for other git-annex clients to send presence. -}
|
{- A request for other git-annex clients to send presence. -}
|
||||||
presenceQuery :: Presence
|
presenceQuery :: Presence
|
||||||
presenceQuery = gitAnnexPresence $ Element gitAnnexTagName
|
presenceQuery = gitAnnexPresence $ Element gitAnnexTagName
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue