我有一个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 响应后结束?
我现在在手机上,所以我无法为您输入确切的代码。但基本思想是抛出你的 Warp 线程一个异步异常。这听起来可能很复杂,但最简单的方法是使用异步库中的 race 函数。像这样:
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!"