add option to set initial roster (#85)

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

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

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