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:
parent
3f2fb2c79b
commit
263bee1392
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user