Add IMAP session logging as an option

Setting the "sslLogToConsole" parameter to True will now spit out the
IMAP session log inline, prefixed with "HaskellNet-SSL".
This commit is contained in:
Daniel P. Wright 2014-10-07 13:31:01 +09:00
parent 3f2fb2c79b
commit 263bee1392
2 changed files with 14 additions and 4 deletions

View File

@ -8,10 +8,12 @@ import Network.Socket.Internal (PortNumber)
data Settings = Settings
{ sslPort :: PortNumber
, sslMaxLineLength :: Int
, sslLogToConsole :: Bool
}
defaultSettingsWithPort :: PortNumber -> Settings
defaultSettingsWithPort p = Settings
{ sslPort = p
, sslMaxLineLength = 10000
, sslLogToConsole = False
}

View File

@ -3,7 +3,6 @@ module Network.HaskellNet.SSL.Internal
, connectPlain
) where
import Network.Connection
import Network.HaskellNet.SSL
import Network.HaskellNet.BSStream
@ -11,6 +10,8 @@ import Network.HaskellNet.BSStream
import qualified Data.ByteString.Char8 as B
import Data.Default
import Control.Monad ((>=>))
type STARTTLS = IO ()
connectionGetBytes :: Connection -> Int -> IO B.ByteString
@ -21,13 +22,20 @@ connectionGetBytes = loop B.empty where
connectionToStream :: Connection -> Settings -> BSStream
connectionToStream c cfg = BSStream
{ bsGet = connectionGetBytes c
, bsPut = connectionPut c
{ bsGet = connectionGetBytes c >=> withLog "RECV"
, bsPut = withLog "SEND" >=> connectionPut c
, bsFlush = return ()
, bsClose = connectionClose c
, bsIsOpen = return True
, bsGetLine = connectionGetLine maxl c
, bsGetLine = connectionGetLine maxl c >>= withLog "RECV"
} where maxl = sslMaxLineLength cfg
withLog = if sslLogToConsole cfg then logToConsole
else flip (const . return)
logToConsole :: String -> B.ByteString -> IO B.ByteString
logToConsole dir s = do
putStrLn $ "HaskellNet-SSL " ++ dir ++ ": " ++ show s
return s
connectSSL :: String -> Settings -> IO BSStream
connectSSL hostname cfg = do