add status tag to all presence messages

Necessary for push messages to not override the previously sent tag.
This commit is contained in:
Joey Hess 2013-07-25 14:58:30 -04:00
parent f38074f307
commit 6967f539d0

View file

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