haskell - 接受带有 http-client-tls 或 tls 的特定证书？

Question

我可能只是忽略了 http-client-tls 文档中的一些基本内容和 tls ，但是:我如何才能建立到服务器的 HTTPS 连接并只接受我指定的一个特定证书，该证书可能不在系统证书存储区中？

Answer 1

我知道这是一个老问题，但我只是花了一些时间编写代码来执行此操作，并认为我会在此处发布它以供后代使用……并希望从社区获得一些代码审查。 Snoyman 的评论很有帮助，但是这里有太多的代码相互依赖关系，而且 X.509 和 TLS 太沸腾了，很难调试，并且如果不深入挖掘就很难确定你没有把事情搞砸各种图书馆。我认为需要使用工作代码进行更完整的解释。

无论如何，这就是我想出的(这是一个 stack script，因此您可以自己轻松地运行它)--

#!/usr/bin/env stack
{- stack --resolver lts-7.16 runghc -}

import qualified Data.ByteString           as B
import           Data.ByteString.Lazy         (ByteString)
import           Data.Default.Class           (def)
import           Data.String                  (fromString)
import           Data.X509.CertificateStore   (CertificateStore, readCertificateStore)
import           Network.HTTP.Client          (httpLbs, newManager, ManagerSettings)
import           Network.HTTP.Client.TLS      (mkManagerSettings)
import           Network.Connection           (TLSSettings(TLSSettings))
import qualified Network.TLS               as TLS
import qualified Network.TLS.Extra.Cipher  as TLS
import           System.Environment           (getArgs, getProgName)

managerSettings :: CertificateStore -> ManagerSettings
managerSettings store = mkManagerSettings settings Nothing
  where settings = TLSSettings params
        params   = (TLS.defaultParamsClient "" B.empty) {
                       TLS.clientUseServerNameIndication = True
                     , TLS.clientShared = def {
                           TLS.sharedCAStore = store
                       }
                     , TLS.clientSupported = def {
                           TLS.supportedCiphers = TLS.ciphersuite_default
                       }
                   }

get :: FilePath -> String -> IO ()
get ca url = do
    mstore <- readCertificateStore ca
    case mstore of
        Just store -> do
            manager  <- newManager $ managerSettings store
            response <- httpLbs (fromString url) manager
            putStrLn (show response)
        Nothing    -> do
            putStrLn $ "error: invalid certificate store " ++ ca

main :: IO ()
main = do
    args <- getArgs
    case args of
        ca:url:[] -> get ca url
        _         -> do
            name <- getProgName
            putStrLn $ "usage: " ++ name ++ " ca url"

一些注意事项:

• TLS.sharedCAStore 设置是魔法发生的地方。如果您想将您的 CA 添加到系统存储(与仅您的 CA 相比)，您可以使用 getSystemCertificateStore 从 System.X509 加载系统存储，然后使用 Data.X509.CertificateStore 在 CertificateStore 和 [SignedCertificate] 之间来回转换，以创建一个包含系统证书和您自己的证书的商店。
• TLS.defaultParamsClient 采用主机名和服务器 ID，用于 TLS 服务器名称指示 (SNI)，这是一种 TLS 扩展，允许服务器在单个 IP 上托管多个站点(类似于 HTTP/1.1 主机 header 有效)。在创建管理器时，我们不一定知道将其设置为什么。幸运的是，Network.Connection(由 http-client-tls 使用)显示为 override whatever settings we use，所以没关系。
• TLS.supportedCiphers 的默认值是一个空列表，因此此设置是必需的(除非您关闭验证或其他功能)。 Network.Connection defaults to ciphersuite_all 但其中包含一些“不推荐的最后资源密码套件”，因此我选择使用 ciphersuite_default。