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

@@ -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
+    read' <- withStream' (gets $ streamSend . streamHandle) con
-    case rd of
+    writeLock <- newTMVarIO read'
-        Left e -> return $ Left e
+    conS <- newTMVarIO con
-        Right read' -> do
+    --    lw <- forkIO $ writeWorker outC writeLock
-          writeLock <- newTMVarIO read'
+    cp <- forkIO $ connPersist writeLock
-          conS <- newTMVarIO con
+    rdw <- forkIO $ readWorker stanzaHandler (noCon eh) conS
-          --    lw <- forkIO $ writeWorker outC writeLock
+    return $ Right ( killConnection writeLock [rdw, cp]
-          cp <- forkIO $ connPersist writeLock
+                   , writeLock
-          rdw <- forkIO $ readWorker stanzaHandler (noCon eh) conS
+                   , conS
-          return $ Right ( killConnection writeLock [rdw, cp]
+                   , rdw
-                         , writeLock
+                   )
-                         , conS
-                         , rdw
-                         )
   where
     killConnection writeLock threads = liftIO $ do
         _ <- atomically $ takeTMVar writeLock -- Should we put it back?

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

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
            )