如何让 http-conduit 接受自签名证书?

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

我使用 http-conduit 创建了一个程序,它需要与没有有效 TLS 证书的服务器通信。在这种情况下,它是一个自签名证书。

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

预期输出

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>

实际输出:

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

出于多种原因,这是非常糟糕的主意。修复服务器(如果可以的话)或鼓励 运行 修复它的人会更好。

绕过 TLS 证书验证会删除 TLS 的所有有用方面,因为它使处于中间人位置的攻击者很容易伪装成服务器并操纵数据。所有攻击者都需要用另一个同样糟糕的自签名证书重新加密他们拦截、操纵的内容。您的客户端软件将 none 变得更聪明。

http-conduit 支持请求管理器的概念。使用请求管理器,您可以提供替代方案。

首先你可以构建一个禁用服务器证书验证的 TLSSettingsSimple (TLSSettingsSimple is defined in Network.Connection in the connection package):

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

然后你可以创建一个使用它的请求管理器 (mkManagerSettings comes from the Network.HTTP.Client.TLS module in the http-client-tls package):

noVerifyTlsManagerSettings :: ManagerSettings
noVerifyTlsManagerSettings = mkManagerSettings noVerifyTlsSettings Nothing

然后你可以初始化这个请求管理器并在请求上设置它:

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

您还需要为此提供 http-client-tls 包,因此您需要修改 stack[=38= 的参数] 包括这个:

--package http-client-tls

完整的解决方案如下:

#!/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
  }