throwTo warp tls 线程挂起 idefinetly

Question

我有一个带有 warp 服务器的 Yesod 应用程序，它的一些功能依赖于异步异常。最近有迁移到https的需求，我用包warp-tls做了。但是现在我不能通过抛出 ThreadKilled 异常来杀死 warp 线程，throwTo 函数只是挂起并且什么都不做。

考虑以下示例。这里我们用 MVar () 监控 warp 线程的状态，当线程为运行时为空，当线程被杀死时有一个 () 值。

import MyApplication (waiPage)
-- waiPage :: Application

runWai :: MVar () -> IO ()
runWai finishVar = bracket
  (return ())
  (const $ putMVar finishVar ())
  (const runApp)
  where
    -- change this to normal or tls to check
    runApp = runAppTls
    runAppNormal = runSettings warpSettings waiPage
    runAppTls = runTLS siteTlsSettings warpSettings waiPage
    --
    warpSettings = setPort 8080 defaultSettings
    siteTlsSettings = tlsSettings "cert.pem" "key.pem"



main :: IO ()
main = do
  finishVar <- newEmptyMVar
  thread_id <- forkIO $ runWai finishVar
  -- Try to kill warp thread. Fork because throw might hang
  forkIO $ throwTo thread_id ThreadKilled
  threadDelay (2 * 10^6) -- microseconds to seconds
  isAlive <- isEmptyMVar finishVar
  if isAlive then putStrLn "Couldn't kill warp thread"
             else putStrLn "Succesfully killed warp thread"
  -- Wait for forked warp thread to finish
  readMVar finishVar

当您有 runApp = runAppNormal 时，您将收到 Succesfully killed warp thread 消息，应用程序将退出。

当您有 runApp = runAppTls 时，您将收到 Couldn't kill warp thread 消息，应用程序将挂起并继续服务。

那么我该如何摆脱这种异常拦截行为呢？或者至少有没有办法以任何其他方式杀死 warpTls 线程？

Answer 1

事实证明这是我使用的 warp-tls == 3.2.4 版本中的一个 Windows-only 错误，已在更高版本中修复。我查看了修复程序，它是一个名为 windowsThreadBlockHack 的函数，所以如果有人被有点过时的 warp 困住了，你也可以为你反向移植这个修复程序。

throwTo warp tls 线程挂起 idefinetly

throwTo warp tls thread hangs idefinetly

multithreading

haskell

ghc

haskell-warp