summaryrefslogtreecommitdiff
path: root/Assistant/XMPP.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-11-10 15:33:12 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-11-10 15:33:12 -0400
commit6608d3561744d7e7c865cdd30f7eff5a7fe3c339 (patch)
tree7851119092b20aac4a9ac75f0b8bdfa6e39dc7e2 /Assistant/XMPP.hs
parentc1c42eb293c9bd7a481adcaf6a9e144438efe390 (diff)
set negative XMPP presence priority
This should help prevent git-annex clients receiving messages that were intended for normal clients they're sharing the account with. Changed XMPP protocol use to always send chat messages directed at the specific client, as the negative priority blocks less directed messages.
Diffstat (limited to 'Assistant/XMPP.hs')
-rw-r--r--Assistant/XMPP.hs9
1 files changed, 7 insertions, 2 deletions
diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs
index e473b5305..2c0004403 100644
--- a/Assistant/XMPP.hs
+++ b/Assistant/XMPP.hs
@@ -52,8 +52,9 @@ instance GitAnnexTaggable Message where
extractGitAnnexTag = headMaybe . filter isGitAnnexTag . messagePayloads
instance GitAnnexTaggable Presence where
- -- always mark extended away
- insertGitAnnexTag p elt = p { presencePayloads = extendedAway : elt : presencePayloads p }
+ -- always mark extended away and set presence priority to negative
+ insertGitAnnexTag p elt = p
+ { presencePayloads = extendedAway : negativePriority : elt : presencePayloads p }
extractGitAnnexTag = headMaybe . filter isGitAnnexTag . presencePayloads
data GitAnnexTagInfo = GitAnnexTagInfo
@@ -208,6 +209,10 @@ silentMessage = (emptyMessage MessageChat)
extendedAway :: Element
extendedAway = Element "show" [] [NodeContent $ ContentText "xa"]
+{- Add to a presence to give it a negative priority. -}
+negativePriority :: Element
+negativePriority = Element "priority" [] [NodeContent $ ContentText "-1"]
+
pushAttr :: Name
pushAttr = "push"