From f910cef26249efd32a4ce2012b2426aca3470e0b Mon Sep 17 00:00:00 2001
From: "Daniel P. Wright" <dani@dpwright.com>
Date: Fri, 17 Jan 2014 15:24:48 +0900
Subject: [PATCH] Create Settings structure to make maxLineLength configurable

This commit simply adds the structure without actually exposing it in
the interface.
---
 src/Network/HaskellNet/IMAP/SSL.hs |  3 +-
 src/Network/HaskellNet/POP3/SSL.hs |  3 +-
 src/Network/HaskellNet/SMTP/SSL.hs |  6 ++--
 src/Network/HaskellNet/SSL.hs      | 53 +++++++++++++++++++-----------
 4 files changed, 41 insertions(+), 24 deletions(-)

diff --git a/src/Network/HaskellNet/IMAP/SSL.hs b/src/Network/HaskellNet/IMAP/SSL.hs
index c08f332..e73fa98 100644
--- a/src/Network/HaskellNet/IMAP/SSL.hs
+++ b/src/Network/HaskellNet/IMAP/SSL.hs
@@ -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
diff --git a/src/Network/HaskellNet/POP3/SSL.hs b/src/Network/HaskellNet/POP3/SSL.hs
index 31bcd51..e97d8ff 100644
--- a/src/Network/HaskellNet/POP3/SSL.hs
+++ b/src/Network/HaskellNet/POP3/SSL.hs
@@ -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
diff --git a/src/Network/HaskellNet/SMTP/SSL.hs b/src/Network/HaskellNet/SMTP/SSL.hs
index 38c13a5..45fc6a1 100644
--- a/src/Network/HaskellNet/SMTP/SSL.hs
+++ b/src/Network/HaskellNet/SMTP/SSL.hs
@@ -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
diff --git a/src/Network/HaskellNet/SSL.hs b/src/Network/HaskellNet/SSL.hs
index 7a0092f..5ee0502 100644
--- a/src/Network/HaskellNet/SSL.hs
+++ b/src/Network/HaskellNet/SSL.hs
@@ -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