From 6967f539d06066b69cb881b68ba6fc8dad31a743 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 25 Jul 2013 14:58:30 -0400 Subject: [PATCH] add status tag to all presence messages Necessary for push messages to not override the previously sent tag. --- Assistant/XMPP.hs | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs index 3104f844d8..0360ce8603 100644 --- a/Assistant/XMPP.hs +++ b/Assistant/XMPP.hs @@ -75,23 +75,21 @@ gitAnnexTagInfo v = case extractGitAnnexTag v of <*> pure tag _ -> Nothing -{- A presence with a git-annex tag in it. -} +{- A presence with a git-annex tag in it. + - Also includes a status tag, which may be visible in XMPP clients. -} gitAnnexPresence :: Element -> Presence -gitAnnexPresence = insertGitAnnexTag $ emptyPresence PresenceAvailable - -{- A presence with an empty git-annex tag in it, used for letting other - - clients know we're around and are a git-annex client. - - - - Also includes a status tag, which may be visible in XMPP clients. - -} -gitAnnexSignature :: Presence -gitAnnexSignature = addStatusTag $ gitAnnexPresence $ Element gitAnnexTagName [] [] +gitAnnexPresence = insertGitAnnexTag $ addStatusTag $ emptyPresence PresenceAvailable where addStatusTag p = p { presencePayloads = status : presencePayloads p } status = Element "status" [] [statusMessage] statusMessage = NodeContent $ ContentText $ T.pack "git-annex" +{- A presence with an empty git-annex tag in it, used for letting other + - clients know we're around and are a git-annex client. -} +gitAnnexSignature :: Presence +gitAnnexSignature = gitAnnexPresence $ Element gitAnnexTagName [] [] + {- XMPP client to server ping -} xmppPing :: JID -> IQ xmppPing selfjid = (emptyIQ IQGet)