Haskell 如何使用Snap检查客户端证书

我知道它很少使用，但是否可以在Snap中访问客户端证书

---

如果没有，是否可以使用不同的web堆栈？

这在Snap的

Snap server

包中不可用，我假设这就是您运行服务器的方式

BuuUut构建并不困难，无论是通过分叉还是作为一个单独的模块（不过，您必须复制一些代码，因为您需要的一些内部值没有导出）

bindHttps

，是您想要的目标。该函数主要是对

HsOpenSSL

库调用的包装，它本身是对OpenSSL库的松散包装

幸运的是，OpenSSL完全支持客户端证书。您只需将设置为

SSL\u VERIFY\u PEER

。还有其他的旋钮你也可以摆弄。您还必须确保安装了一个证书链来实际验证客户端证书。信任链和所有的爵士乐。如需参考，请参阅如何

更好的是，这个函数在

HsOpenSSL

中作为函数

contextSetVerificationMode:：SSLContext->VerificationMode->IO（）

。您会注意到，Snap的

bindHttps

定义中存在

ctx:：SSLContext

。您所要做的就是复制或分叉该模块并介绍您的调用

它看起来像这样（未验证的代码警报）：

±%diff-u/tmp/{old，new}
---/tmp/old 2016-04-11 11:02:42.000000000-0400
+++/tmp/new 2016-04-11 11:02:56.000000000-0400
@@ -19,6 +19,7 @@
ctx返回值（真）
如果链证书
然后SSL.contextSetCertificateChainFile ctx cert
else SSL.contextSetCertificateFile ctx证书

---

第一个布尔值告诉OpenSSL，如果不存在客户端证书，则OpenSSL将失败。第二个布尔值告诉OpenSSL，客户端证书只在第一个请求时需要，在重新协商时不再需要。第三个值是回调。我认为正确的做法是在回调中返回True。总之，这就是问题所在。

更一般地说，我想知道是否有任何Haskell web框架提供对基于证书的客户端身份验证的支持。这是一种非答案，但作为一种解决方法，您可以使用nginx验证证书并通过标头传递DN。

± % diff -u /tmp/{old,new}
--- /tmp/old    2016-04-11 11:02:42.000000000 -0400
+++ /tmp/new    2016-04-11 11:02:56.000000000 -0400
@@ -19,6 +19,7 @@

      ctx <- SSL.context
      SSL.contextSetPrivateKeyFile ctx key
+     SSL.contextSetVerificationMode ctx (SSL.VerifyPeer True True (Just (\_ _ -> return True)))
      if chainCert
        then SSL.contextSetCertificateChainFile ctx cert
        else SSL.contextSetCertificateFile ctx cert