From 1f3a18f2eff2f22d7ff41c7252431c817e70b40d Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Mon, 6 May 2013 14:49:42 +0200
Subject: [PATCH] change pullStanza to not block the stream add debugging
 information for outgoing stanzas over TLS cleanup in Xmpp.Concurrent.Threads

---
 source/Network/Xmpp/Concurrent/Threads.hs | 25 ++++++++++-------------
 source/Network/Xmpp/Stream.hs             |  2 +-
 source/Network/Xmpp/Tls.hs                |  4 +++-
 3 files changed, 15 insertions(+), 16 deletions(-)

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
            )