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)
data Settings = Settings
{ sslPort :: PortNumber
, sslMaxLineLength :: Int
, sslLogToConsole :: Bool
{ sslPort :: PortNumber
, sslMaxLineLength :: Int
, sslLogToConsole :: Bool
, sslDisableCertficateValidation :: Bool
}
defaultSettingsWithPort :: PortNumber -> Settings
@ -16,4 +17,5 @@ defaultSettingsWithPort p = Settings
{ sslPort = p
, sslMaxLineLength = 10000
, sslLogToConsole = False
, sslDisableCertficateValidation = False
}

View File

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