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 connectIMAPSSL hostname = connectIMAPSSLPort hostname 993
connectIMAPSSLPort :: String -> PortNumber -> IO IMAPConnection 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 connectPop3SSL hostname = connectPop3SSLPort hostname 995
connectPop3SSLPort :: String -> PortNumber -> IO POP3Connection 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 connectSMTPSSL hostname = connectSMTPSSLPort hostname 465
connectSMTPSSLPort :: String -> PortNumber -> IO SMTPConnection 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 :: String -> IO SMTPConnection
connectSMTPSTARTTLS hostname = connectSMTPSTARTTLSPort hostname 587 connectSMTPSTARTTLS hostname = connectSMTPSTARTTLSPort hostname 587
@ -38,7 +39,7 @@ connectSMTPSTARTTLSPort hostname port = connectSTARTTLS hostname port >>= connec
connectSTARTTLS :: String -> PortNumber -> IO BSStream connectSTARTTLS :: String -> PortNumber -> IO BSStream
connectSTARTTLS hostname port = do connectSTARTTLS hostname port = do
(bs, startTLS) <- connectPlain hostname port (bs, startTLS) <- connectPlain hostname cfg
greeting <- bsGetLine bs greeting <- bsGetLine bs
failIfNot bs 220 $ parseResponse greeting failIfNot bs 220 $ parseResponse greeting
@ -57,6 +58,7 @@ connectSTARTTLS hostname port = do
parse s = (getCode s, s) parse s = (getCode s, s)
getCode = read . head . words getCode = read . head . words
getResponse bs = liftM parseResponse $ bsGetLine bs getResponse bs = liftM parseResponse $ bsGetLine bs
cfg = defaultSettingsWithPort port
failIfNot :: BSStream -> Integer -> (Integer, String) -> IO () failIfNot :: BSStream -> Integer -> (Integer, String) -> IO ()
failIfNot bs code (rc, rs) = when (code /= rc) closeAndFail failIfNot bs code (rc, rs) = when (code /= rc) closeAndFail

View File

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