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:
parent
cee0f0dccd
commit
f910cef262
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user