Create Settings structure to make maxLineLength configurable

This commit simply adds the structure without actually exposing it in
the interface.
This commit is contained in:
Daniel P. Wright 2014-01-17 15:24:48 +09:00
parent cee0f0dccd
commit f910cef262
4 changed files with 41 additions and 24 deletions

View File

@ -13,4 +13,5 @@ connectIMAPSSL :: String -> IO IMAPConnection
connectIMAPSSL hostname = connectIMAPSSLPort hostname 993
connectIMAPSSLPort :: String -> PortNumber -> IO IMAPConnection
connectIMAPSSLPort hostname port = connectSSL hostname port >>= connectStream
connectIMAPSSLPort hostname port = connectSSL hostname cfg >>= connectStream
where cfg = defaultSettingsWithPort port

View File

@ -13,4 +13,5 @@ connectPop3SSL :: String -> IO POP3Connection
connectPop3SSL hostname = connectPop3SSLPort hostname 995
connectPop3SSLPort :: String -> PortNumber -> IO POP3Connection
connectPop3SSLPort hostname port = connectSSL hostname port >>= connectStream
connectPop3SSLPort hostname port = connectSSL hostname cfg >>= connectStream
where cfg = defaultSettingsWithPort port

View File

@ -28,7 +28,8 @@ connectSMTPSSL :: String -> IO SMTPConnection
connectSMTPSSL hostname = connectSMTPSSLPort hostname 465
connectSMTPSSLPort :: String -> PortNumber -> IO SMTPConnection
connectSMTPSSLPort hostname port = connectSSL hostname port >>= connectStream
connectSMTPSSLPort hostname port = connectSSL hostname cfg >>= connectStream
where cfg = defaultSettingsWithPort port
connectSMTPSTARTTLS :: String -> IO SMTPConnection
connectSMTPSTARTTLS hostname = connectSMTPSTARTTLSPort hostname 587
@ -38,7 +39,7 @@ connectSMTPSTARTTLSPort hostname port = connectSTARTTLS hostname port >>= connec
connectSTARTTLS :: String -> PortNumber -> IO BSStream
connectSTARTTLS hostname port = do
(bs, startTLS) <- connectPlain hostname port
(bs, startTLS) <- connectPlain hostname cfg
greeting <- bsGetLine bs
failIfNot bs 220 $ parseResponse greeting
@ -57,6 +58,7 @@ connectSTARTTLS hostname port = do
parse s = (getCode s, s)
getCode = read . head . words
getResponse bs = liftM parseResponse $ bsGetLine bs
cfg = defaultSettingsWithPort port
failIfNot :: BSStream -> Integer -> (Integer, String) -> IO ()
failIfNot bs code (rc, rs) = when (code /= rc) closeAndFail

View File

@ -1,6 +1,9 @@
module Network.HaskellNet.SSL ( connectSSL
, connectPlain
) where
module Network.HaskellNet.SSL
( Settings (..)
, defaultSettingsWithPort
, connectSSL
, connectPlain
) where
import Network.Connection
import Network.HaskellNet.BSStream
@ -11,8 +14,16 @@ import Data.Default
type STARTTLS = IO ()
maxLineLength :: Int
maxLineLength = 10000
data Settings = Settings
{ sslPort :: PortNumber
, sslMaxLineLength :: Int
}
defaultSettingsWithPort :: PortNumber -> Settings
defaultSettingsWithPort p = Settings
{ sslPort = p
, sslMaxLineLength = 10000
}
connectionGetBytes :: Connection -> Int -> IO B.ByteString
connectionGetBytes = loop B.empty where
@ -20,25 +31,27 @@ connectionGetBytes = loop B.empty where
loop buf c l = connectionGet c l >>= nextIteration
where nextIteration b = loop (buf `B.append` b) c $ l - B.length b
connectionToStream :: Connection -> BSStream
connectionToStream c = BSStream
{ bsGet = connectionGetBytes c
, bsPut = connectionPut c
, bsFlush = return ()
, bsClose = connectionClose c
, bsIsOpen = return True
, bsGetLine = connectionGetLine maxLineLength c
}
connectionToStream :: Connection -> Settings -> BSStream
connectionToStream c cfg = BSStream
{ bsGet = connectionGetBytes c
, bsPut = connectionPut c
, bsFlush = return ()
, bsClose = connectionClose c
, bsIsOpen = return True
, bsGetLine = connectionGetLine maxl c
} where maxl = sslMaxLineLength cfg
connectSSL :: String -> PortNumber -> IO BSStream
connectSSL hostname port = do
connectSSL :: String -> Settings -> IO BSStream
connectSSL hostname cfg = do
c <- initConnectionContext >>= flip connectTo params
return $ connectionToStream c
return $ connectionToStream c cfg
where params = ConnectionParams hostname port (Just def) Nothing
port = sslPort cfg
connectPlain :: String -> PortNumber -> IO (BSStream, STARTTLS)
connectPlain hostname port = do
connectPlain :: String -> Settings -> IO (BSStream, STARTTLS)
connectPlain hostname cfg = do
ctx <- initConnectionContext
c <- connectTo ctx params
return (connectionToStream c, connectionSetSecure ctx c def)
return (connectionToStream c cfg, connectionSetSecure ctx c def)
where params = ConnectionParams hostname port Nothing Nothing
port = sslPort cfg