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)