add status tag to all presence messages
Necessary for push messages to not override the previously sent tag.
This commit is contained in:
parent
f38074f307
commit
6967f539d0
1 changed files with 8 additions and 10 deletions
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue