diff options
| author |  Joey Hess <joey@kitenet.net> | 2013-03-16 15:37:23 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2013-03-16 16:00:37 -0400 |
| commit | 0d967326df6332d701e39206d3389b4770735397 (patch) | |
| tree | ee1935781f6398685cc04322bdf9c93c168f477e /Assistant | |
| parent | e49fedcb95420362ee2c37540e095ba430f64372 (diff) | |
xmpp: Re-enable XA flag, since disabling it did not turn out to help with the problems Google Talk has with not always sending presence messages to clients.
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Threads/XMPPClient.hs | 9 | ||||
| -rw-r--r-- | Assistant/XMPP.hs | 7 |
2 files changed, 11 insertions, 5 deletions
diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index d31bfea6f..79bb33b0e 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -179,16 +179,17 @@ relayNetMessage :: JID -> Assistant (XMPP ()) relayNetMessage selfjid = do msg <- waitNetMessage debug ["sending:", show $ sanitizeNetMessage msg] - handleImportant msg - convert msg + a1 <- handleImportant msg + a2 <- convert msg + return (a1 >> a2) where handleImportant msg = case parseJID =<< isImportantNetMessage msg of Just tojid | tojid == baseJID tojid -> do - putStanza presenceQuery storeImportantNetMessage msg (formatJID tojid) $ \c -> (baseJID <$> parseJID c) == Just tojid - _ -> noop + return $ putStanza presenceQuery + _ -> return noop convert (Pushing c pushstage) = withOtherClient selfjid c $ \tojid -> do if tojid == baseJID tojid then do diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs index 49cc82368..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 and set presence priority to negative insertGitAnnexTag p elt = p - { presencePayloads = negativePriority : elt : presencePayloads p } + { presencePayloads = extendedAway : negativePriority : elt : presencePayloads p } extractGitAnnexTag = headMaybe . filter isGitAnnexTag . presencePayloads data GitAnnexTagInfo = GitAnnexTagInfo @@ -204,6 +205,10 @@ silentMessage = (emptyMessage MessageChat) , elementNodes = [] } +{- Add to a presence to mark its client as extended away. -} +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"] |