Browse Source

add support for non-standard options element in roster versioning stream feature

master
Philipp Balzarek 13 years ago
parent
commit
3f76bdbfe6
  1. 2
      source/Network/Xmpp/IM/Roster.hs
  2. 4
      source/Network/Xmpp/Marshal.hs
  3. 4
      source/Network/Xmpp/Stream.hs
  4. 7
      source/Network/Xmpp/Types.hs

2
source/Network/Xmpp/IM/Roster.hs

@ -110,7 +110,7 @@ handleRoster ref sem sta = case sta of @@ -110,7 +110,7 @@ handleRoster ref sem sta = case sta of
retrieveRoster :: Maybe Roster -> Session -> IO (Maybe Roster)
retrieveRoster mbOldRoster sess = do
useVersioning <- rosterVer <$> getFeatures sess
useVersioning <- isJust . rosterVer <$> getFeatures sess
let version = if useVersioning
then case mbOldRoster of
Nothing -> Just ""

4
source/Network/Xmpp/Marshal.hs

@ -261,7 +261,7 @@ xpStreamFeatures = ("xpStreamFeatures","") <?> xpWrap @@ -261,7 +261,7 @@ xpStreamFeatures = ("xpStreamFeatures","") <?> xpWrap
(xp4Tuple
(xpOption pickleTlsFeature)
(xpOption pickleSaslFeature)
(xpElemExists "{urn:xmpp:features:rosterver}ver")
(xpOption pickleRosterVer)
(xpAll xpElemVerbatim)
)
)
@ -275,6 +275,8 @@ xpStreamFeatures = ("xpStreamFeatures","") <?> xpWrap @@ -275,6 +275,8 @@ xpStreamFeatures = ("xpStreamFeatures","") <?> xpWrap
xpElemNodes "{urn:ietf:params:xml:ns:xmpp-sasl}mechanisms"
(xpAll $ xpElemNodes
"{urn:ietf:params:xml:ns:xmpp-sasl}mechanism" (xpContent xpId))
pickleRosterVer = xpElemNodes "{urn:xmpp:features:rosterver}ver" $
xpElemExists "{urn:xmpp:features:rosterver}optional"
xpJid :: PU Text Jid
xpJid = ("xpJid", "") <?>

4
source/Network/Xmpp/Stream.hs

@ -488,7 +488,7 @@ xmppNoStream = StreamState { @@ -488,7 +488,7 @@ xmppNoStream = StreamState {
streamConnectionState = Closed
, streamHandle = zeroHandle
, streamEventSource = zeroSource
, streamFeatures = StreamFeatures Nothing [] False []
, streamFeatures = StreamFeatures Nothing [] Nothing []
, streamAddress = Nothing
, streamFrom = Nothing
, streamId = Nothing
@ -522,7 +522,7 @@ createStream realm config = do @@ -522,7 +522,7 @@ createStream realm config = do
{ streamConnectionState = Plain
, streamHandle = hand
, streamEventSource = eSource
, streamFeatures = StreamFeatures Nothing [] False []
, streamFeatures = StreamFeatures Nothing [] Nothing []
, streamAddress = Just $ Text.pack realm
, streamFrom = Nothing
, streamId = Nothing

7
source/Network/Xmpp/Types.hs

@ -823,7 +823,12 @@ langTagParser = do @@ -823,7 +823,12 @@ langTagParser = do
data StreamFeatures = StreamFeatures
{ streamTls :: !(Maybe Bool)
, streamSaslMechanisms :: ![Text.Text]
, rosterVer :: !Bool
, rosterVer :: !(Maybe Bool) -- ^ @Nothing@ for no roster
-- versioning, @Just False@ for
-- roster versioning and @Just True@
-- when the server sends the
-- non-standard "optional" element
-- (observed with prosody).
, streamOtherFeatures :: ![Element] -- TODO: All feature elements instead?
} deriving Show

Loading…
Cancel
Save