How do you get http-conduit to accept self-signed certificates?

I have created a program using http-conduit and it needs to talk to a server that doesn't have a valid TLS certificate. It's a self-signed certificate in this case.

https-test.hs:

#!/usr/bin/env stack
-- stack --install-ghc --resolver lts-5.13 runghc --package http-conduit
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy.Char8 as L8
import           Network.HTTP.Client
import           Network.HTTP.Simple
import           Network.Connection
                 ( TLSSettings(..) )

main :: IO ()
main = do
  authenticate "self-signed.badssl.com" "" ""

authenticate :: S8.ByteString
             -> L8.ByteString
             -> L8.ByteString
             -> IO ()
authenticate hostname username password = do
  let request
        = setRequestMethod "GET"
        $ setRequestSecure True
        $ setRequestPort 443
        $ setRequestHost hostname
        $ setRequestPath "/"
        $ defaultRequest
  response <- httpLBS request
  putStrLn $ "The status code was: " ++
             show (getResponseStatusCode response)
  print $ getResponseHeader "Content-Type" response
  L8.putStrLn $ getResponseBody response

Expected output

The status code was: 200
["text/html"]
<!DOCTYPE html>
<html>
<head>
  <meta name="viewport" content="width=device-width, initial-scale=1">
  <link rel="shortcut icon" href="/icons/favicon-red.ico"/>
  <link rel="apple-touch-icon" href="/icons/icon-red.png"/>
  <title>self-signed.badssl.com</title>
  <link rel="stylesheet" href="/style.css">
  <style>body { background: red; }</style>
</head>
<body>
<div id="content">
  <h1 style="font-size: 12vw;">
    self-signed.<br>badssl.com
  </h1>
</div>

</body>
</html>

Actual output:

https-test.hs: TlsExceptionHostPort (HandshakeFailed (Error_Protocol ("certificate rejected: [SelfSigned]",True,CertificateUnknown))) "self-signed.badssl.com" 443

Solution

This is very bad idea for many reasons. You are much better off fixing the server (if you can) or encouraging the people who run it to fix it.

Bypassing TLS certificate validation removes all useful aspects of TLS, because it makes it trivial for an attacker in a man-in-the-middle position to pretend to be the server and manipulate data. All the attacker needs to do it re-encrypt their intercepted, manipulated content with another equally bad self-signed cert. Your client software will be none the wiser.

http-conduit supports the concept of a request manager. Using a request manager you can supply an alternative.

First you can construct a TLSSettingsSimple that disables server certificate validation (TLSSettingsSimple is defined in Network.Connection in the connection package):

noVerifyTlsSettings :: TLSSettings
noVerifyTlsSettings = TLSSettingsSimple
  { settingDisableCertificateValidation = True
  , settingDisableSession = True
  , settingUseServerName = False
  }

Then you can make a request manager that uses that (mkManagerSettings comes from the Network.HTTP.Client.TLS module in the http-client-tls package):

noVerifyTlsManagerSettings :: ManagerSettings
noVerifyTlsManagerSettings = mkManagerSettings noVerifyTlsSettings Nothing

Then you can initialize this request manager and set it on the request:

manager <- newManager noVerifyTlsManagerSettings
-- ...
$ setRequestManager manager
-- ...

You'll also need to have the http-client-tls package available for this so you need to modify the arguments for stack to include this:

--package http-client-tls

Here's the complete solution:

#!/usr/bin/env stack
-- stack --install-ghc --resolver lts-5.13 runghc --package http-client-tls
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy.Char8 as L8
import           Network.HTTP.Client
import           Network.HTTP.Client.TLS (mkManagerSettings)
import           Network.HTTP.Simple
import           Network.Connection (TLSSettings(..))

main :: IO ()
main = do
  authenticate "self-signed.badssl.com" "" ""

authenticate :: S8.ByteString
             -> L8.ByteString
             -> L8.ByteString
             -> IO ()
authenticate hostname username password = do
  manager <- newManager noVerifyTlsManagerSettings
  let request
        = setRequestMethod "GET"
        $ setRequestSecure True
        $ setRequestPort 443
        $ setRequestHost hostname
        $ setRequestPath "/"
        $ setRequestManager manager
        $ defaultRequest
  response <- httpLBS request
  putStrLn $ "The status code was: " ++
             show (getResponseStatusCode response)
  print $ getResponseHeader "Content-Type" response
  L8.putStrLn $ getResponseBody response

noVerifyTlsManagerSettings :: ManagerSettings
noVerifyTlsManagerSettings = mkManagerSettings noVerifyTlsSettings Nothing

noVerifyTlsSettings :: TLSSettings
noVerifyTlsSettings = TLSSettingsSimple
  { settingDisableCertificateValidation = True
  , settingDisableSession = True
  , settingUseServerName = False
  }