Allow connection with disabled certificate validation

This commit is contained in:
Leza Morais Lutonda (Lemol-C) 2014-12-08 21:14:38 -05:00
parent 3ded1c8aef
commit 4fd67bbf72
2 changed files with 9 additions and 5 deletions

View File

@ -6,9 +6,10 @@ module Network.HaskellNet.SSL
import Network.Socket.Internal (PortNumber) import Network.Socket.Internal (PortNumber)
data Settings = Settings data Settings = Settings
{ sslPort :: PortNumber { sslPort :: PortNumber
, sslMaxLineLength :: Int , sslMaxLineLength :: Int
, sslLogToConsole :: Bool , sslLogToConsole :: Bool
, sslDisableCertficateValidation :: Bool
} }
defaultSettingsWithPort :: PortNumber -> Settings defaultSettingsWithPort :: PortNumber -> Settings
@ -16,4 +17,5 @@ defaultSettingsWithPort p = Settings
{ sslPort = p { sslPort = p
, sslMaxLineLength = 10000 , sslMaxLineLength = 10000
, sslLogToConsole = False , sslLogToConsole = False
, sslDisableCertficateValidation = False
} }

View File

@ -41,13 +41,15 @@ connectSSL :: String -> Settings -> IO BSStream
connectSSL hostname cfg = do connectSSL hostname cfg = do
c <- initConnectionContext >>= flip connectTo params c <- initConnectionContext >>= flip connectTo params
return $ connectionToStream c cfg return $ connectionToStream c cfg
where params = ConnectionParams hostname port (Just def) Nothing where params = ConnectionParams hostname port (Just tlsCfg) Nothing
port = sslPort cfg port = sslPort cfg
tlsCfg = def { settingDisableCertificateValidation = sslDisableCertficateValidation cfg }
connectPlain :: String -> Settings -> IO (BSStream, STARTTLS) connectPlain :: String -> Settings -> IO (BSStream, STARTTLS)
connectPlain hostname cfg = do connectPlain hostname cfg = do
ctx <- initConnectionContext ctx <- initConnectionContext
c <- connectTo ctx params c <- connectTo ctx params
return (connectionToStream c cfg, connectionSetSecure ctx c def) return (connectionToStream c cfg, connectionSetSecure ctx c tlsCfg)
where params = ConnectionParams hostname port Nothing Nothing where params = ConnectionParams hostname port Nothing Nothing
port = sslPort cfg port = sslPort cfg
tlsCfg = def { settingDisableCertificateValidation = sslDisableCertficateValidation cfg }