From 51a6cb799302c08419f0df7bb7c72665b85e98ff Mon Sep 17 00:00:00 2001
From: Philipp Balzarek
Date: Wed, 27 Feb 2013 15:42:08 +0100
Subject: [PATCH] replace "debug" constant with hsLogger functionality in
Network.Xmpp.Tls
---
source/Network/Xmpp/Tls.hs | 25 +++++++++++++------------
1 file changed, 13 insertions(+), 12 deletions(-)
diff --git a/source/Network/Xmpp/Tls.hs b/source/Network/Xmpp/Tls.hs
index 88cf37e..6616bc2 100644
--- a/source/Network/Xmpp/Tls.hs
+++ b/source/Network/Xmpp/Tls.hs
@@ -11,6 +11,7 @@ import Control.Monad.State.Strict
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Char8 as BSC8
import Data.Conduit
import qualified Data.Conduit.Binary as CB
import Data.Typeable
@@ -18,13 +19,14 @@ import Data.XML.Types
import Network.Xmpp.Stream
import Network.Xmpp.Types
+import System.Log.Logger (debugM)
import Control.Concurrent.STM.TMVar
-import Data.IORef
-import Crypto.Random.API
-import Network.TLS
-import Network.TLS.Extra
+import Data.IORef
+import Crypto.Random.API
+import Network.TLS
+import Network.TLS.Extra
mkBackend con = Backend { backendSend = \bs -> void (streamSend con bs)
, backendRecv = streamReceive con
@@ -96,7 +98,7 @@ startTls params con = Ex.handle (return . Left . TlsError)
Left e -> return $ Left e
Right (Element "{urn:ietf:params:xml:ns:xmpp-tls}proceed" [] []) -> return $ Right ()
Right (Element "{urn:ietf:params:xml:ns:xmpp-tls}failure" _ _) -> return $ Left XmppOtherFailure
- (raw, _snk, psh, read, ctx) <- lift $ tlsinit debug params (mkBackend con)
+ (raw, _snk, psh, read, ctx) <- lift $ tlsinit params (mkBackend con)
let newHand = StreamHandle { streamSend = catchPush . psh
, streamReceive = read
, streamFlush = contextFlush ctx
@@ -113,8 +115,7 @@ client params gen backend = do
defaultParams = defaultParamsClient
tlsinit :: (MonadIO m, MonadIO m1) =>
- Bool
- -> TLSParams
+ TLSParams
-> Backend
-> m ( Source m1 BS.ByteString
, Sink BS.ByteString m1 ()
@@ -122,14 +123,14 @@ tlsinit :: (MonadIO m, MonadIO m1) =>
, Int -> m1 BS.ByteString
, Context
)
-tlsinit debug tlsParams backend = do
- when debug . liftIO $ putStrLn "TLS with debug mode enabled"
+tlsinit tlsParams backend = do
+ liftIO $ debugM "Pontarius.Xmpp" "TLS with debug mode enabled"
gen <- liftIO $ getSystemRandomGen -- TODO: Find better random source?
con <- client tlsParams gen backend
handshake con
let src = forever $ do
dt <- liftIO $ recvData con
- when debug (liftIO $ putStr "in: " >> BS.putStrLn dt)
+ liftIO $ debugM "Pontarius.Xmpp" ("in :" ++ BSC8.unpack dt)
yield dt
let snk = do
d <- await
@@ -137,13 +138,13 @@ tlsinit debug tlsParams backend = do
Nothing -> return ()
Just x -> do
sendData con (BL.fromChunks [x])
- when debug (liftIO $ putStr "out: " >> BS.putStrLn x)
+ liftIO $ debugM "Pontarius.Xmpp" ("out :" ++ BSC8.unpack x)
snk
read <- liftIO $ mkReadBuffer (recvData con)
return ( src
, snk
, \s -> do
- when debug (liftIO $ BS.putStrLn s)
+ liftIO $ debugM "Pontarius.Xmpp" ("out :" ++ BSC8.unpack s)
sendData con $ BL.fromChunks [s]
, liftIO . read
, con