summaryrefslogtreecommitdiff
path: root/Assistant/XMPP.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-11-03 21:38:27 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-11-03 21:38:27 -0400
commit82c6426b785bc7fca45e2f5a44e1e8d29e40d7f1 (patch)
tree49bd71b581dcccccd480bef9b085da499b9f362b /Assistant/XMPP.hs
parent5a08135f784648387cfc715eeb6218ee27e6da62 (diff)
avoid repeated pairing alerts
Diffstat (limited to 'Assistant/XMPP.hs')
-rw-r--r--Assistant/XMPP.hs28
1 files changed, 21 insertions, 7 deletions
diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs
index 59113a0b0..d18087976 100644
--- a/Assistant/XMPP.hs
+++ b/Assistant/XMPP.hs
@@ -96,15 +96,29 @@ isPresenceQuery p = case filter isGitAnnexTag (presencePayloads p) of
((Element _name attrs _nodes):_) -> any (isAttr queryAttr) attrs
{- A notification about a stage of pairing, sent as directed presence
- - to all clients of a jid. -}
-pairingNotification :: PairStage -> UUID -> JID -> JID -> Presence
-pairingNotification pairstage u tojid fromjid = (gitAnnexPresence elt)
- { presenceTo = Just $ JID (jidNode tojid) (jidDomain tojid) Nothing
- , presenceFrom = Just fromjid
- }
+ - to all clients of a jid.
+ -
+ - For PairReq, the directed presence is followed by a second presence
+ - without the pair notification. This is done because XMPP servers
+ - resend the last directed presence periodically, which can make
+ - the pair request alert be re-displayed annoyingly. For PairAck and
+ - PairDone, that resending is a desirable feature, as it helps ensure
+ - clients see them.
+ -}
+pairingNotification :: PairStage -> UUID -> JID -> JID -> [Presence]
+pairingNotification pairstage u tojid fromjid
+ | pairstage == PairReq = [send, clear]
+ | otherwise = [send]
where
- elt = Element gitAnnexTagName
+ send = directed $ gitAnnexPresence $ Element gitAnnexTagName
[(pairAttr, [ContentText content])] []
+ clear = directed $ gitAnnexPresence gitAnnexSignature
+
+ directed p = p
+ { presenceTo = Just $ JID (jidNode tojid) (jidDomain tojid) Nothing
+ , presenceFrom = Just fromjid
+ }
+
content = T.unwords
[ T.pack $ show pairstage
, T.pack $ fromUUID u