How do I implement a shutdown command in a WAI server?

Question

I\'d like to implement a \'graceful shutdown\' command for my webapp (as opposed to my first instinct, which is to just ask people to kill the process)

My first two atte

Answer 1

1. Use an MVar. Block the main thread until the MVar has been signaled, then cleanup and exit.
2. Call exitImmediately. One of the fastest ways to tear down the process, and also terribly annoying to debug. I don't believe finalizers/brackets/finally blocks will be called on the way down, depending on your application it may corrupt state.
3. Throw an exception to the main thread. Warp.run doesn't catch exceptions, so this works by allowing the default exception handler on the main thread (and the main thread only) to terminate the process.

As others have mentioned, using an MVar is probably the best option. I included the others for the sake of completeness, but they do have their place. throwTo is used somewhat in the base library and I've worked on a few applications that use the C equivalent of exitImmediately: exit(), though I haven't run across any Haskell apps that use this method.

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import Control.Concurrent (MVar, ThreadId, forkIO, myThreadId, newEmptyMVar, putMVar, takeMVar)
import Control.Exception (Exception, throwTo)
import Control.Monad.Trans (liftIO)
import Data.ByteString (ByteString)
import Data.Data (Data, Typeable)
import Data.Enumerator (Iteratee)
import Network.HTTP.Types
import Network.Wai as Wai
import Network.Wai.Handler.Warp as Warp
import System.Exit (ExitCode (ExitSuccess))
import System.Posix.Process (exitImmediately)

data Shutdown = Shutdown deriving (Data, Typeable, Show)
instance Exception Shutdown

app :: ThreadId -> MVar () -> Request -> Iteratee ByteString IO Response
app mainThread shutdownMVar Request{pathInfo = pathInfo} = do
  liftIO $ case pathInfo of
    ["shutdownByThrowing"] -> throwTo mainThread Shutdown
    ["shutdownByMVar"]     -> putMVar shutdownMVar ()
    ["shutdownByExit"]     -> exitImmediately ExitSuccess
    _                      -> return ()
  return $ responseLBS statusOK [headerContentType "text/plain"] "ok"

main :: IO ()
main = do
  mainThread <- myThreadId
  shutdownMVar <- newEmptyMVar
  forkIO $ Warp.run 3000 (app mainThread shutdownMVar)
  takeMVar shutdownMVar