From 3f76bdbfe600ef212c7f0a8f6b79f6ee5b82d05f Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Mon, 10 Jun 2013 18:56:08 +0200
Subject: [PATCH] add support for non-standard options element in roster
 versioning stream feature

---
 source/Network/Xmpp/IM/Roster.hs | 2 +-
 source/Network/Xmpp/Marshal.hs   | 4 +++-
 source/Network/Xmpp/Stream.hs    | 4 ++--
 source/Network/Xmpp/Types.hs     | 7 ++++++-
 4 files changed, 12 insertions(+), 5 deletions(-)

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