diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs index 3544a5e..8736829 100644 --- a/source/Network/Xmpp/Concurrent.hs +++ b/source/Network/Xmpp/Concurrent.hs @@ -50,6 +50,7 @@ import System.Random (randomRIO) import Control.Monad.State.Strict +runHandlers :: [Stanza -> [Annotation] -> IO [Annotated Stanza]] -> Stanza -> IO () runHandlers [] sta = do errorM "Pontarius.Xmpp" $ "No stanza handlers set, discarding stanza" ++ show sta @@ -94,7 +95,7 @@ handleIQ iqHands out sta as = do Right res -> IQResultS $ IQResult iqid Nothing from lang res Ex.bracketOnError (atomically $ takeTMVar sentRef) - (atomically . putTMVar sentRef) + (atomically . tryPutTMVar sentRef) $ \wasSent -> do case wasSent of True -> do @@ -154,11 +155,11 @@ newSession stream config realm mbSasl = runErrorT $ do ] , rosterH ] - (kill, wLock, streamState, reader) <- ErrorT $ startThreadsWith writeSem stanzaHandler eh stream + (kill, streamState, reader) <- ErrorT $ startThreadsWith writeSem stanzaHandler eh stream idGen <- liftIO $ sessionStanzaIDs config let sess = Session { stanzaCh = stanzaChan , iqHandlers = iqHands - , writeSemaphore = wLock + , writeSemaphore = writeSem , readerThread = reader , idGenerator = idGen , streamRef = streamState diff --git a/source/Network/Xmpp/Concurrent/Threads.hs b/source/Network/Xmpp/Concurrent/Threads.hs index 5f711b0..69b1813 100644 --- a/source/Network/Xmpp/Concurrent/Threads.hs +++ b/source/Network/Xmpp/Concurrent/Threads.hs @@ -94,9 +94,8 @@ startThreadsWith :: TMVar (BS.ByteString -> IO Bool) -> TMVar EventHandlers -> Stream -> IO (Either XmppFailure (IO (), - TMVar (BS.ByteString -> IO Bool), - TMVar Stream, - ThreadId)) + TMVar Stream, + ThreadId)) startThreadsWith writeSem stanzaHandler eh con = do -- read' <- withStream' (gets $ streamSend . streamHandle) con -- writeSem <- newTMVarIO read' @@ -104,7 +103,6 @@ startThreadsWith writeSem stanzaHandler eh con = do cp <- forkIO $ connPersist writeSem rdw <- forkIO $ readWorker stanzaHandler (noCon eh) conS return $ Right ( killConnection [rdw, cp] - , writeSem , conS , rdw )