From f53abf01761d77c265be7e2d55fac3711853b4f4 Mon Sep 17 00:00:00 2001
From: Jon Kristensen <info@jonkri.com>
Date: Tue, 19 Jun 2012 03:09:37 +0200
Subject: [PATCH] stream id now stored in connection state

---
 source/Network/Xmpp/Monad.hs  | 30 ++++++++++++++++--------------
 source/Network/Xmpp/Stream.hs | 24 ++++++++++++++++--------
 source/Network/Xmpp/Types.hs  |  2 ++
 3 files changed, 34 insertions(+), 22 deletions(-)

diff --git a/source/Network/Xmpp/Monad.hs b/source/Network/Xmpp/Monad.hs
index 6203dbb..c642861 100644
--- a/source/Network/Xmpp/Monad.hs
+++ b/source/Network/Xmpp/Monad.hs
@@ -107,20 +107,21 @@ catchPush p = Ex.catch
 -- XmppConnection state used when there is no connection.
 xmppNoConnection :: XmppConnection
 xmppNoConnection = XmppConnection
-               { sConSrc           = zeroSource
-               , sRawSrc           = zeroSource
-               , sConPushBS        = \_ -> return False -- Nothing has been sent.
-               , sConHandle        = Nothing
-               , sFeatures         = SF Nothing [] []
-               , sConnectionState  = XmppConnectionClosed
-               , sHostname         = Nothing
-               , sJid              = Nothing
-               , sCloseConnection  = return ()
-               , sStreamLang       = Nothing
-               , sPreferredLang    = Nothing
-               , sToJid            = Nothing
-               , sJidWhenPlain     = False
-               , sFrom             = Nothing
+               { sConSrc          = zeroSource
+               , sRawSrc          = zeroSource
+               , sConPushBS       = \_ -> return False -- Nothing has been sent.
+               , sConHandle       = Nothing
+               , sFeatures        = SF Nothing [] []
+               , sConnectionState = XmppConnectionClosed
+               , sHostname        = Nothing
+               , sJid             = Nothing
+               , sCloseConnection = return ()
+               , sStreamLang      = Nothing
+               , sStreamId        = Nothing
+               , sPreferredLang   = Nothing
+               , sToJid           = Nothing
+               , sJidWhenPlain    = False
+               , sFrom            = Nothing
                }
   where
     zeroSource :: Source IO output
@@ -148,6 +149,7 @@ xmppRawConnect host hostname = do
             , sCloseConnection = (hClose con)
             , sPreferredLang   = Nothing -- TODO: Allow user to set
             , sStreamLang      = Nothing
+            , sStreamId        = Nothing
             , sToJid           = Nothing -- TODO: Allow user to set
             , sJidWhenPlain    = False -- TODO: Allow user to set
             , sFrom            = Nothing
diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs
index 77567e6..5f4c262 100644
--- a/source/Network/Xmpp/Stream.hs
+++ b/source/Network/Xmpp/Stream.hs
@@ -75,8 +75,13 @@ xmppStartStream = runErrorT $ do
                                            , Just hostname
                                            , sPreferredLang state
                                            )
-    (lt, from, features) <- ErrorT . pullToSink $ runErrorT $ xmppStream to
-    modify (\s -> s {sFeatures = features, sStreamLang = Just lt, sFrom = from})
+    (lt, from, id, features) <- ErrorT . pullToSink $ runErrorT $ xmppStream to
+    modify (\s -> s { sFeatures = features
+                    , sStreamLang = Just lt
+                    , sStreamId = id
+                    , sFrom = from
+                    }
+           )
     return ()
 
 -- Creates a new connection source (of Events) using the raw source (of bytes)
@@ -91,13 +96,17 @@ xmppRestartStream = do
 -- Reads the (partial) stream:stream and the server features from the stream.
 -- Also validates the stream element's attributes and throws an error if
 -- appropriate.
-xmppStream :: Maybe Jid -> StreamSink (LangTag, Maybe Text, ServerFeatures)
+-- TODO: from.
+xmppStream :: Maybe Jid -> StreamSink ( LangTag
+                                      , Maybe Text
+                                      , Maybe Text
+                                      , ServerFeatures)
 xmppStream expectedTo = do
-    (langTag, from) <- xmppStreamHeader
+    (langTag, from, id) <- xmppStreamHeader
     features <- xmppStreamFeatures
-    return (langTag, from, features)
+    return (langTag, from, id, features)
   where
-    xmppStreamHeader :: StreamSink (LangTag, Maybe Text)
+    xmppStreamHeader :: StreamSink (LangTag, Maybe Text, Maybe Text)
     xmppStreamHeader = do
         lift throwOutJunk
         -- Get the stream:stream element (or whatever it is) from the server,
@@ -109,10 +118,9 @@ xmppStream expectedTo = do
         unless (prefix == Just "stream") $ throwError $ StreamInvalidStreamPrefix prefix
         unless (isNothing to || (fromText $ fromJust to) == expectedTo) $ throwError $ StreamWrongTo to
         unless (ver == Just "1.0") $ throwError $ StreamWrongVersion ver
-        -- TODO: Verify id and from.
         let lang_ = maybe Nothing langTag lang
         when (isNothing lang_) $ throwError $ StreamWrongLangTag lang
-        return (fromJust lang_, from)
+        return (fromJust lang_, from, id)
     xmppStreamFeatures :: StreamSink ServerFeatures
     xmppStreamFeatures = do
         e <- lift $ elements =$ CL.head
diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs
index 8b49c29..ebb33e6 100644
--- a/source/Network/Xmpp/Types.hs
+++ b/source/Network/Xmpp/Types.hs
@@ -749,6 +749,8 @@ data XmppConnection = XmppConnection
                , sStreamLang      :: Maybe LangTag -- Will be a `Just' value
                                                    -- once connected to the
                                                    -- server.
+               , sStreamId        :: Maybe Text -- Stream ID as specified by the
+                                                -- server.
                , sToJid           :: Maybe Jid -- JID to include in the stream
                                                -- element's `to' attribute when
                                                -- the connection is secured. See