fix debugging messaages in Network.Xmpp.Sasl and write inbound TCP messages to debug logger

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 $ infoM "Pontarius.Xmpp" $ "Bound JID: " ++ show jid'
-                    _ <- lift $ withStream ( do
+                    _ <- lift $ withStream ( do modify $ \s ->
-                                                  modify $ \s ->
+                                                    s{streamJid = Just jid'})
-                                                      s{streamJid = Just jid'}
-                                                  return $ Right ())
                                            c
                     return jid'
                 _ -> do
-                    lift $ errorM "Pontarius.XMPP"
+                    lift $ errorM "Pontarius.Xmpp"
                         $ "xmppBind: JID could not be unpickled from: "
                           ++ show b
                     throwError $ XmppOtherFailure

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)