From fea7e3f7ac3322b89321f16837ed0ff1d641d7ba Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Thu, 21 Mar 2013 16:21:21 +0100
Subject: [PATCH] fix debugging messaages in Network.Xmpp.Sasl and write
 inbound TCP messages to debug logger

---
 source/Network/Xmpp/Sasl.hs   | 12 +++++-------
 source/Network/Xmpp/Stream.hs |  9 +++++++--
 2 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/source/Network/Xmpp/Sasl.hs b/source/Network/Xmpp/Sasl.hs
index 1c201af..00df024 100644
--- a/source/Network/Xmpp/Sasl.hs
+++ b/source/Network/Xmpp/Sasl.hs
@@ -101,19 +101,17 @@ xmppBind rsrc c = runErrorT $ do
     answer <- ErrorT $ pushIQ "bind" Nothing Set Nothing (bindBody rsrc) c
     case answer of
         Right IQResult{iqResultPayload = Just b} -> do
-            lift $ debugM "Pontarius.XMPP" "xmppBind: IQ result received; unpickling JID..."
+            lift $ debugM "Pontarius.Xmpp" "xmppBind: IQ result received; unpickling JID..."
             let jid = unpickleElem xpJid b
             case jid of
                 Right jid' -> do
-                    lift $ infoM "Pontarius.XMPP" $ "Bound JID: " ++ show jid'
-                    _ <- lift $ withStream ( do
-                                                  modify $ \s ->
-                                                      s{streamJid = Just jid'}
-                                                  return $ Right ())
+                    lift $ infoM "Pontarius.Xmpp" $ "Bound JID: " ++ show jid'
+                    _ <- lift $ withStream ( do modify $ \s ->
+                                                    s{streamJid = Just jid'})
                                            c
                     return jid'
                 _ -> do
-                    lift $ errorM "Pontarius.XMPP"
+                    lift $ errorM "Pontarius.Xmpp"
                         $ "xmppBind: JID could not be unpickled from: "
                           ++ show b
                     throwError $ XmppOtherFailure
diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs
index 1ee3266..0349cb5 100644
--- a/source/Network/Xmpp/Stream.hs
+++ b/source/Network/Xmpp/Stream.hs
@@ -29,6 +29,7 @@ import           Data.Maybe
 import           Data.Ord
 import           Data.Text (Text)
 import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
 import           Data.Void (Void)
 import           Data.XML.Pickle
 import           Data.XML.Types
@@ -236,7 +237,11 @@ restartStream = do
         bs <- liftIO (rd 4096)
         if BS.null bs
             then return ()
-            else yield bs >> loopRead rd
+            else do
+               liftIO $ debugM "Pontarius.Xmpp" $ "in: " ++
+                              (Text.unpack . Text.decodeUtf8 $ bs)
+               yield bs
+               loopRead rd
 
 -- Reads the (partial) stream:stream and the server features from the stream.
 -- Returns the (unvalidated) stream attributes, the unparsed element, or
@@ -739,7 +744,7 @@ elements = do
         compressNodes $ NodeContent (ContentText $ x `Text.append` y) : z
     compressNodes (x:xs) = x : compressNodes xs
 
-withStream :: StateT StreamState IO (Either XmppFailure c) -> Stream -> IO (Either XmppFailure c)
+withStream :: StateT StreamState IO a -> Stream -> IO a
 withStream action (Stream stream) = Ex.bracketOnError
                                          (atomically $ takeTMVar stream )
                                          (atomically . putTMVar stream)