haskell amqp x509客户端身份验证

我一直在想如何在

Network.AMQP

中使用x509客户端身份验证。似乎我需要创建一个

AMQP.ConnectionOpts

，其中包括

cotlsettings

参数，如下所示：

import qualified Network.AMQP as AMQP
import Network.Connection
let opts = AMQP.ConnectionOpts {
    ..
  , coTLSSettings = Just $ AMQP.TLSCustom $ ...
}

此时（省略号），在阅读了一些

Network.Connection

文档之后（这超出了我的深度），它开始看起来非常复杂。我左思右想，我是否走上了正确的道路

那么，我的问题是：如何轻松实现x509客户端身份验证？如果答案是“你不能”，那么有人知道我在哪里可以找到使用

Network.Connection

模块的x509客户端身份验证示例吗？

我们需要做两件事（对于我的测试环境，有三件事）

读取客户端凭据

将密码套件设置为

defaultParamClient

设置空密码套件（我不知道为什么）

（对于我的测试环境）读取CA根证书，以便验证提供给我们的服务器证书。如果您不在测试环境中，则此证书应安装在系统证书存储中，并且应为默认证书。在这种情况下，您可以从程序中删除

证书存储

处理

以下程序中的函数

mkMyTLSSettings

将替换

defaultParamsClient

结果中提到的部分。在用作

onCertificateRequest

的函数中，您可以使用参数并根据参数发出不同的凭据。所需的值本身被读入

main

以摆脱

IO

对于下面的程序，我修改了我在这里找到的位

{-#语言重载字符串}
模块主要在哪里
导入Data.Default.Class
导入网络.AMQP
导入Network.Socket.Internal（端口号）
导入网络.TLS
导入Network.TLS.Extra.Cipher（ciphersuite\u默认值）
导入数据.X509.CertificateStore（CertificateStore（..），readCertificateStore）
导入数据，也许吧
将符合条件的数据.ByteString作为BS导入
导入合格的网络。连接为C
将限定数据.ByteString.Lazy.Char8作为BL导入
mkMyTLSSettings:：CertificateStore->Credential->C.TLSSettings
mkMyTLSSettings castore creds=
让defaultParams=defaultParamsClient“127.0.0.1”BS.empty
newClientShared=（clientShared默认参数）{sharedCAStore=castore}
newClientSupported=（clientSupported defaultParams）{supportedCiphers=ciphersuite_default}
newClientHooks=（clientHooks defaultParams）{onCertificateRequest=\\\ uUx->return（Just creds）}
在C.TLSSettings$defaultParams{clientShared=newClientShared中
，clientSupported=newClientSupported
，clientHooks=newClientHooks
}
myTLSSettings:：CertificateStore->Credential->TLSSettings
MytLSettings castore creds=TLSCustom$mkMytLSettings castore creds
MyTLS连接选项：：TLS设置->连接选项
myTLSConnectionOpts opts=连接点
[（（“127.0.0.1”，5671:：端口号）]
"/"
[简单的“来宾”或“来宾”]
（仅131072）
没有什么
（仅1）
（只是选择）
testConnectionOpts:：ConnectionOpts->IO（）
testConnectionOpts opts=do
conn所以您想验证客户端，以便服务器可以信任客户端？很抱歉延迟回复。这是正确的。我会在今天下午的某个时候测试你的答案，然后告诉你答案的进展。谢谢如果你在工作中遇到问题，请告诉我。我们也可以就此开始聊天。非常感谢你的提议。昨天下午我有点时间，但不够。然后今天被耽搁了。所以这是明天早上的重点。我的计划是尝试更多地将您的答案纳入我的工作中，但如果失败，我将单独运行您的答案，并将结果发布回这里。再次感谢你的帮助。嘿，我还没有完全找到自己的解决方案；但我想你的回答让我触手可及。谢谢。希望你不介意我稍后带着更多的问题回来。（尽管我希望不会）。再次感谢，祝你周末愉快。
{-# LANGUAGE OverloadedStrings #-}
module Main where

import Data.Default.Class
import Network.AMQP
import Network.Socket.Internal (PortNumber)
import Network.TLS
import Network.TLS.Extra.Cipher (ciphersuite_default)
import Data.X509.CertificateStore (CertificateStore (..), readCertificateStore)
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Network.Connection as C
import qualified Data.ByteString.Lazy.Char8 as BL

mkMyTLSSettings :: CertificateStore -> Credential -> C.TLSSettings
mkMyTLSSettings castore creds =
  let defaultParams = defaultParamsClient "127.0.0.1" BS.empty
      newClientShared = (clientShared defaultParams) { sharedCAStore = castore }
      newClientSupported = (clientSupported defaultParams) { supportedCiphers = ciphersuite_default }
      newClientHooks = (clientHooks defaultParams) { onCertificateRequest = \_ -> return (Just creds) }
  in C.TLSSettings $ defaultParams { clientShared = newClientShared
                                   , clientSupported = newClientSupported
                                   , clientHooks = newClientHooks
                                   }

myTLSSettings :: CertificateStore -> Credential -> TLSSettings
myTLSSettings castore creds = TLSCustom $ mkMyTLSSettings castore creds

myTLSConnectionOpts :: TLSSettings -> ConnectionOpts
myTLSConnectionOpts opts = ConnectionOpts
  [("127.0.0.1", 5671 :: PortNumber)]
  "/"
  [plain "guest" "guest"]
  (Just 131072)
  Nothing
  (Just 1)
  (Just opts)

testConnectionOpts :: ConnectionOpts -> IO ()
testConnectionOpts opts = do 
   conn <- openConnection'' opts
   chan <- openChannel conn
   declareQueue chan newQueue {queueName = "hello"}
   putStrLn "Trying to register callback"
   consumeMsgs chan "hello" Ack myCallback
   publishMsg chan "" "hello" newMsg {msgBody = (BL.pack "hello world"), msgDeliveryMode = Just Persistent}
   getLine
   closeConnection conn
   putStrLn "connection closed"

main :: IO ()
main = do
  testConnectionOpts defaultConnectionOpts
  putStrLn "trying with tls"
  castore <- maybe (error "couldn't read CA root Certificate") id <$> (readCertificateStore "/pathto/rootCA.pem")
  creds <- either error id <$> credentialLoadX509 "/pathto/client.pem" "/pathto/client.key"
  let opts = myTLSSettings castore creds
  testConnectionOpts (myTLSConnectionOpts opts)

myCallback :: (Message, Envelope) -> IO ()
myCallback (msg, env) = do
  putStrLn $ "received message: " ++ (BL.unpack $ msgBody msg)
  ackEnv env