diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs index 3881cd8..1fa0c90 100644 --- a/source/Network/Xmpp/Concurrent.hs +++ b/source/Network/Xmpp/Concurrent.hs @@ -97,17 +97,12 @@ newSession stream config = runErrorT $ do let stanzaHandler = toChans stanzaChan outC iqHandlers (kill, wLock, streamState, readerThread) <- ErrorT $ startThreadsWith stanzaHandler eh stream writer <- lift $ forkIO $ writeWorker outC wLock - idRef <- lift $ newTVarIO 1 - let getId = atomically $ do - curId <- readTVar idRef - writeTVar idRef (curId + 1 :: Integer) - return . read. show $ curId return $ Session { stanzaCh = stanzaChan , outCh = outC , iqHandlers = iqHandlers , writeRef = wLock , readerThread = readerThread - , idGenerator = getId + , idGenerator = sessionStanzaIDs config , streamRef = streamState , eventHandlers = eh , stopThreads = kill >> killThread writer diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index a878db4..c230b06 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -1095,8 +1095,15 @@ data SessionConfiguration = SessionConfiguration sessionStreamConfiguration :: StreamConfiguration -- | Handler to be run when the session ends (for whatever reason). , sessionClosedHandler :: XmppFailure -> IO () + , sessionStanzaIDs :: IO StanzaID } instance Default SessionConfiguration where def = SessionConfiguration { sessionStreamConfiguration = def - , sessionClosedHandler = \_ -> return () } + , sessionClosedHandler = \_ -> return () + , sessionStanzaIDs = do + idRef <- newTVarIO 1 + atomically $ do + curId <- readTVar idRef + writeTVar idRef (curId + 1 :: Integer) + return . read. show $ curId}