5

I have an HTTP application server that needs to exit when handling a certain request under certain conditions (in order to be restarted by a supervisor).

Given a main like:

import Network.Wai.Handler.Warp (run)

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

and a handler something like:

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." }

How do I cause the process to end after delivering the 500 response?

Jean-Paul Calderone
  • 47,755
  • 6
  • 94
  • 122

1 Answers1

11

I'm on my phone right now, so I can't type exact code for you. But the basic idea is to throw your Warp thread an async exception. That may sound complicated, but the easiest way to approach it is to use the race function from the async library. Something like this:

toExitVar <- newEmptyMVar
race warp (takeMVar toExitVar)

And then in your handler, when you want Warp to exit:

putMVar toExitVar ()

EDIT A day later and I'm back at my computer, here's a fully worked example:

#!/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!"
chwarr
  • 6,777
  • 1
  • 30
  • 57
Michael Snoyman
  • 31,100
  • 3
  • 48
  • 77
  • Thanks. This seems interesting but my Haskell abilities are too limited to actually understand what it means or how to integrate it into my app. – Jean-Paul Calderone Aug 24 '17 at 11:43
  • I've added a full example now that I'm back at my computer. – Michael Snoyman Aug 24 '17 at 12:02
  • 5
    What happens if `race_` kills the `warp` thread before it gets to `send`? Does `warp` guarantee that the response will still be send in that case? – cocreature Aug 24 '17 at 15:08
  • No, there are no such guarantees. If you want graceful shutdown, you can create the listening socket yourself and then close it, but you'll still need to figure out when it's the right time to exit the process. – Michael Snoyman Aug 25 '17 at 01:10
  • How do you figure out when the right time is? Clearly there are no absolutely guarantees possible that the peer has received the data sent - but it is at least possible to wait for the local send buffer to empty. Does Wai/Warp expose that information? – Jean-Paul Calderone Aug 25 '17 at 10:38
  • No it doesn't. We could theoretically add some kind of bookkeeping for all of the open worker threads, but this has never been a case people have asked to be addressed. Instead, it's common to either leave the server running indefinitely (waiting for machine failure or a new deployment), or just let any in-flight requests to die and let the client resubmit. – Michael Snoyman Aug 25 '17 at 11:12