diff --git a/source/Network/Xmpp/IM/Roster.hs b/source/Network/Xmpp/IM/Roster.hs index 2e2a9a3..ba01377 100644 --- a/source/Network/Xmpp/IM/Roster.hs +++ b/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 mbOldRoster sess = do - useVersioning <- rosterVer <$> getFeatures sess + useVersioning <- isJust . rosterVer <$> getFeatures sess let version = if useVersioning then case mbOldRoster of Nothing -> Just "" diff --git a/source/Network/Xmpp/Marshal.hs b/source/Network/Xmpp/Marshal.hs index 1a08d5f..afa68f6 100644 --- a/source/Network/Xmpp/Marshal.hs +++ b/source/Network/Xmpp/Marshal.hs @@ -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 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", "") diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 089514f..d5460bb 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -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 { streamConnectionState = Plain , streamHandle = hand , streamEventSource = eSource - , streamFeatures = StreamFeatures Nothing [] False [] + , streamFeatures = StreamFeatures Nothing [] Nothing [] , streamAddress = Just $ Text.pack realm , streamFrom = Nothing , streamId = Nothing diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 2d93f12..8a651b1 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -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