diff --git a/source/Network/Xmpp/Concurrent/Threads.hs b/source/Network/Xmpp/Concurrent/Threads.hs index 5c0b03b..7a73a09 100644 --- a/source/Network/Xmpp/Concurrent/Threads.hs +++ b/source/Network/Xmpp/Concurrent/Threads.hs @@ -78,20 +78,17 @@ startThreadsWith :: (Stanza -> IO ()) TMVar Stream, ThreadId)) startThreadsWith stanzaHandler eh con = do - rd <- withStream' (gets $ streamSend . streamHandle >>= \d -> return $ Right d) con - case rd of - Left e -> return $ Left e - Right read' -> do - writeLock <- newTMVarIO read' - conS <- newTMVarIO con - -- lw <- forkIO $ writeWorker outC writeLock - cp <- forkIO $ connPersist writeLock - rdw <- forkIO $ readWorker stanzaHandler (noCon eh) conS - return $ Right ( killConnection writeLock [rdw, cp] - , writeLock - , conS - , rdw - ) + read' <- withStream' (gets $ streamSend . streamHandle) con + writeLock <- newTMVarIO read' + conS <- newTMVarIO con + -- lw <- forkIO $ writeWorker outC writeLock + cp <- forkIO $ connPersist writeLock + rdw <- forkIO $ readWorker stanzaHandler (noCon eh) conS + return $ Right ( killConnection writeLock [rdw, cp] + , writeLock + , conS + , rdw + ) where killConnection writeLock threads = liftIO $ do _ <- atomically $ takeTMVar writeLock -- Should we put it back? diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index b760483..bbd5790 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -429,7 +429,7 @@ pullUnpickle p = do -- | Pulls a stanza (or stream error) from the stream. pullStanza :: Stream -> IO (Either XmppFailure Stanza) -pullStanza = withStream $ do +pullStanza = withStream' $ do res <- pullUnpickle xpStreamStanza case res of Left e -> return $ Left e diff --git a/source/Network/Xmpp/Tls.hs b/source/Network/Xmpp/Tls.hs index f9f1745..75ea5dc 100644 --- a/source/Network/Xmpp/Tls.hs +++ b/source/Network/Xmpp/Tls.hs @@ -134,7 +134,9 @@ tlsinit params backend = do readWithBuffer <- liftIO $ mkReadBuffer (recvData con) return ( src , snk - , \s -> sendData con $ BL.fromChunks [s] + , \s -> do + liftIO $ debugM "Pontarius.Xmpp.TLS" ("out :" ++ BSC8.unpack s) + sendData con $ BL.fromChunks [s] , liftIO . readWithBuffer , con )