5

我有一个 HTTP 应用程序服务器，在某些条件下处理某个请求时需要退出（以便由主管重新启动）。

给定一个主要的：

import Network.Wai.Handler.Warp (run)

main :: IO ()
main = do
  config <- readConfig
  run (portNumber config) (makeApp config)

和一个处理程序，例如：

livenessServer1 :: UTCTime -> FilePath -> Server LivenessProbeAPI1
livenessServer1 initialModificationTime monitorPath = do
  mtime <- liftIO $ getModificationTime monitorPath
  case mtime == initialModificationTime of
    True  -> return $ Liveness initialModificationTime mtime
    False -> throwError $ err500 { errBody = "File modified." }

在提供 500 响应后，如何使流程结束？

4

1 回答 1

10

我现在正在打电话，所以我不能为你输入确切的代码。但是基本的想法是给你的 Warp 线程一个异步异常。这听起来可能很复杂，但最简单的方法是使用异步库中的竞赛函数。像这样的东西：

toExitVar <- newEmptyMVar
race warp (takeMVar toExitVar)

然后在您的处理程序中，当您希望 Warp 退出时：

putMVar toExitVar ()

编辑一天后，我回到我的电脑前，这是一个完整的例子：

#!/usr/bin/env stack
-- stack --resolver lts-9.0 script
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Network.Wai
import Network.Wai.Handler.Warp
import Network.HTTP.Types
import Control.Concurrent.Async
import Control.Concurrent.MVar

main :: IO ()
main = do
toDie <- newEmptyMVar
race_ (takeMVar toDie) $ run 3000 $ \req send ->
    if pathInfo req == ["die"]
    then do
        putMVar toDie ()
        send $ responseLBS status200 [] "Goodbye!"
    else send $ responseLBS status200 [] "Still alive!"
于 2017-08-23T17:46:29.360 回答