mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add status tag to all presence messages

Browse source 
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
1 changed files with 8 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
Assistant/XMPP.hs
View file

@ -75,23 +75,21 @@ gitAnnexTagInfo v = case extractGitAnnexTag v of
<*> pure tag <*> pure tag
_ -> Nothing _ -> 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 :: Element -> Presence
gitAnnexPresence = insertGitAnnexTag $ emptyPresence PresenceAvailable gitAnnexPresence = insertGitAnnexTag $ addStatusTag $ 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 [] []
where where
addStatusTag p = p addStatusTag p = p
{ presencePayloads = status : presencePayloads p } { presencePayloads = status : presencePayloads p }
status = Element "status" [] [statusMessage] status = Element "status" [] [statusMessage]
statusMessage = NodeContent $ ContentText $ T.pack "git-annex" 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 -} {- XMPP client to server ping -}
xmppPing :: JID -> IQ xmppPing :: JID -> IQ
xmppPing selfjid = (emptyIQ IQGet) xmppPing selfjid = (emptyIQ IQGet)