From 62779c4d7fc683a8eb417e994d0d494c643cd9f0 Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Mon, 16 Nov 2015 17:01:15 +0100
Subject: [PATCH] add option to set initial roster (#85)

---
 ChangeLog.md                            | 28 +++++--------------------
 source/Network/Xmpp/Concurrent.hs       | 13 +++++++++---
 source/Network/Xmpp/Concurrent/Types.hs |  3 +++
 3 files changed, 18 insertions(+), 26 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index 92979ce..db2112d 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,23 +1,5 @@
-# 0.3 to 0.4
-
-## Major changes
-* Added Lenses
-* Added Plugins
-
-## newly exported functions
-* simpleAuth
-* jid (QuasiQuoter)
-* presenceUnsubscribed
-* associatedErrorType
-* mkStanzaError
-
-## major bugs fixed
-* Didn't check jid of IQResults
-
-## incompatible changes
-### IQ
-* sendIQ returns an STM action rather than a TMVar
-* sendIQ' takes a timeout parameter
-* removed IQResponseTimeout from IQResponse data type
-* renamed listenIQChan to listenIQ and changed return type from TChan to STM
-* renamed dropIQChan to unlistenIQ
+# 0.4.5 to 0.4.6
+* Support for the session element is now determined from stream features, the
+  establishSession option was removed
+* An initial roster can now be set with the initialRoster session configuration
+  option
diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs
index 30ec7d4..7ac691c 100644
--- a/source/Network/Xmpp/Concurrent.hs
+++ b/source/Network/Xmpp/Concurrent.hs
@@ -166,13 +166,20 @@ newSession stream config realm mbSasl = runErrorT $ do
     stanzaChan <- lift newTChanIO
     iqHands  <- lift $ newTVarIO (Map.empty, Map.empty)
     eh <- lift $ newEmptyTMVarIO
-    ros <- liftIO . newTVarIO $ Roster Nothing Map.empty
+    ros <- case enableRoster config of
+                False -> return $ Roster Nothing Map.empty
+                True -> do
+                    mbRos <- liftIO $ initialRoster config
+                    return $ case mbRos of
+                              Nothing -> Roster Nothing Map.empty
+                              Just r -> r
+    rosRef <- liftIO $ newTVarIO ros
     peers <- liftIO . newTVarIO $ Peers Map.empty
     rew <- lift $ newTVarIO 60
     let out = writeStanza writeSem
     boundJid <- liftIO $ withStream' (gets streamJid) stream
     let rosterH = if (enableRoster config)
-                  then [handleRoster boundJid ros
+                  then [handleRoster boundJid rosRef
                           (fromMaybe (\_ -> return ()) $ onRosterPush config)
                           out]
                   else []
@@ -200,7 +207,7 @@ newSession stream config realm mbSasl = runErrorT $ do
                        , eventHandlers = eh
                        , stopThreads = kill
                        , conf = config
-                       , rosterRef = ros
+                       , rosterRef = rosRef
                        , presenceRef = peers
                        , sendStanza' = sStanza
                        , sRealm = realm
diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs
index bcacf62..aca4939 100644
--- a/source/Network/Xmpp/Concurrent/Types.hs
+++ b/source/Network/Xmpp/Concurrent/Types.hs
@@ -85,6 +85,8 @@ data SessionConfiguration = SessionConfiguration
       -- | Enable roster handling according to rfc 6121. See 'getRoster' to
       -- acquire the current roster
     , enableRoster               :: Bool
+      -- | Initial Roster to user when versioned rosters are supported
+    , initialRoster              :: IO (Maybe Roster)
       -- | Callback called on a roster Push. The callback is called after the
       -- roster is updated
     , onRosterPush               :: Maybe (QueryItem -> IO ())
@@ -115,6 +117,7 @@ instance Default SessionConfiguration where
                                          return . Text.pack . show $ curId
                                , plugins = []
                                , enableRoster = True
+                               , initialRoster = return Nothing
                                , onRosterPush = Nothing
                                , enablePresenceTracking = True
                                , onPresenceChange = Nothing