From 500b8c10639fd3e60f28dcd8499899a297fd7e6b Mon Sep 17 00:00:00 2001
From: Jon Kristensen <info@jonkri.com>
Date: Tue, 12 Mar 2013 02:07:00 +0100
Subject: [PATCH] Add `SessionConfiguration' object

---
 source/Network/Xmpp.hs                  |  1 +
 source/Network/Xmpp/Concurrent.hs       | 15 ++++++++-------
 source/Network/Xmpp/Concurrent/Types.hs |  1 +
 source/Network/Xmpp/Types.hs            | 11 +++++++++++
 4 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs
index 19b6c2a..6d73c2a 100644
--- a/source/Network/Xmpp.hs
+++ b/source/Network/Xmpp.hs
@@ -28,6 +28,7 @@ module Network.Xmpp
     Session
   , session
   , StreamConfiguration(..)
+  , SessionConfiguration(..)
     -- TODO: Close session, etc.
     -- ** Authentication handlers
     -- | The use of 'scramSha1' is /recommended/, but 'digestMd5' might be
diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs
index bb36ff5..bbc9b04 100644
--- a/source/Network/Xmpp/Concurrent.hs
+++ b/source/Network/Xmpp/Concurrent.hs
@@ -88,8 +88,8 @@ toChans stanzaC outC iqHands sta = atomically $ do
         iqID (Right iq') = iqResultID iq'
 
 -- | Creates and initializes a new Xmpp context.
-newSession :: TMVar Stream -> IO (Either XmppFailure Session)
-newSession stream = runErrorT $ do
+newSession :: TMVar Stream -> SessionConfiguration -> IO (Either XmppFailure Session)
+newSession stream config = runErrorT $ do
     outC <- lift newTChanIO
     stanzaChan <- lift newTChanIO
     iqHandlers <- lift $ newTVarIO (Map.empty, Map.empty)
@@ -111,6 +111,7 @@ newSession stream = runErrorT $ do
                      , streamRef = streamState
                      , eventHandlers = eh
                      , stopThreads = kill >> killThread writer
+                     , conf = config
                      }
 
 -- Worker to write stanzas to the stream concurrently.
@@ -133,7 +134,7 @@ writeWorker stCh writeR = forever $ do
 -- parameters is a 'Just' value, @session@ will attempt to authenticate and
 -- acquire an XMPP resource.
 session :: HostName                          -- ^ The hostname / realm
-        -> StreamConfiguration               -- ^ configuration details
+        -> SessionConfiguration              -- ^ configuration details
         -> Maybe TLS.TLSParams               -- ^ TLS settings, if securing the
                                              -- connection to the server is
                                              -- desired
@@ -142,12 +143,12 @@ session :: HostName                          -- ^ The hostname / realm
                                              -- the server decide)
         -> IO (Either XmppFailure (Session, Maybe AuthFailure))
 session realm config mbTls mbSasl = runErrorT $ do
-    con <- ErrorT $ openStream realm config
+    stream <- ErrorT $ openStream realm (sessionStreamConfiguration config)
     case mbTls of
         Nothing -> return ()
-        Just tls -> ErrorT $ startTls tls con
+        Just tls -> ErrorT $ startTls tls stream
     aut <- case mbSasl of
         Nothing -> return Nothing
-        Just (handlers, resource) -> ErrorT $ auth handlers resource con
-    ses <- ErrorT $ newSession con
+        Just (handlers, resource) -> ErrorT $ auth handlers resource stream
+    ses <- ErrorT $ newSession stream config
     return (ses, aut)
diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs
index 5abe1f3..2ac37c8 100644
--- a/source/Network/Xmpp/Concurrent/Types.hs
+++ b/source/Network/Xmpp/Concurrent/Types.hs
@@ -47,6 +47,7 @@ data Session = Session
     , streamRef :: TMVar (TMVar Stream)
     , eventHandlers :: TVar EventHandlers
     , stopThreads :: IO ()
+    , conf :: SessionConfiguration
     }
 
 -- | IQHandlers holds the registered channels for incomming IQ requests and
diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs
index e3b4af9..6865e2f 100644
--- a/source/Network/Xmpp/Types.hs
+++ b/source/Network/Xmpp/Types.hs
@@ -46,6 +46,7 @@ module Network.Xmpp.Types
     , InvalidXmppXml(..)
     , Hostname(..)
     , hostname
+    , SessionConfiguration(..)
     )
        where
 
@@ -1020,6 +1021,7 @@ data InvalidXmppXml = InvalidXmppXml String deriving (Show, Typeable)
 
 instance Exception InvalidXmppXml
 
+-- | Configuration settings related to the stream.
 data StreamConfiguration =
     StreamConfiguration { -- | Default language when no language tag is set
                           preferredLang :: !(Maybe LangTag)
@@ -1086,3 +1088,12 @@ hostnameP = do
                 if (Text.length label) + 1 + (Text.length r) > 255
                     then fail "Hostname too long."
                     else return $ Text.concat [label, Text.pack ".", r]
+
+-- | Configuration for the @Session@ object.
+data SessionConfiguration = SessionConfiguration
+    { -- | Configuration for the @Stream@ object.
+      sessionStreamConfiguration :: StreamConfiguration
+    }
+
+instance Default SessionConfiguration where
+    def = SessionConfiguration { sessionStreamConfiguration = def }