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
retrieveRoster :: Maybe Roster -> Session -> IO (Maybe Roster) retrieveRoster :: Maybe Roster -> Session -> IO (Maybe Roster)
retrieveRoster mbOldRoster sess = do retrieveRoster mbOldRoster sess = do
useVersioning <- rosterVer <$> getFeatures sess useVersioning <- isJust . rosterVer <$> getFeatures sess
let version = if useVersioning let version = if useVersioning
then case mbOldRoster of then case mbOldRoster of
Nothing -> Just "" Nothing -> Just ""

4
source/Network/Xmpp/Marshal.hs

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

4
source/Network/Xmpp/Stream.hs

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

7
source/Network/Xmpp/Types.hs

@ -823,7 +823,12 @@ langTagParser = do
data StreamFeatures = StreamFeatures data StreamFeatures = StreamFeatures
{ streamTls :: !(Maybe Bool) { streamTls :: !(Maybe Bool)
, streamSaslMechanisms :: ![Text.Text] , 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? , streamOtherFeatures :: ![Element] -- TODO: All feature elements instead?
} deriving Show } deriving Show

Loading…
Cancel
Save