Here (below) is a short program to shut down warp-3.3.15 based on a `TVar Bool` according to any policy you desire (catching a certain exception, receiving a request to a certain route, or receiving an OS signal). You need to route the TVar into places that you want to be able to initiate graceful shutdown. I believe that warp implements graceful shutdown by preventing new clients from connecting, but I haven't dug too far into its source code. In any case, the setInstallShutdownHandler documentation indicates that you should also use setGracefulShutdownTimeout to ensure the server eventually shuts down.

I don't think that it's intended to throw exceptions in the setOnException handler or the setOnExceptionResponse handler. The former seems to be a hook for monitoring/logging and the latter a hook to give your users a less scary error page.

--- --- ---

{-# LANGUAGE OverloadedStrings #-}

import qualified Control.Concurrent.Async as Async
import qualified Control.Concurrent.STM as STM
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp

app :: STM.TVar Bool -> Wai.Application
app shutdownSignal req respond = do
    print ("Request from", Wai.remoteHost req)
    case Wai.rawPathInfo req of

        "/shutdown" -> do
            STM.atomically $ STM.writeTVar shutdownSignal True
            respond $ Wai.responseLBS HTTP.ok200 [] "shutting down"

        _ -> do
            respond $ Wai.responseLBS HTTP.ok200 [] "hello"

-- | Spawn a thread to wait for the shutdown signal and initiate shutdown.
installShutdownHandler :: STM.TVar Bool -> (IO ()) -> IO ()
installShutdownHandler shutdownSignal closeSocket = do
    _ <- Async.async $ do
        STM.atomically $ STM.check =<< STM.readTVar shutdownSignal
        closeSocket
    return ()

main :: IO ()
main = do
    shutdownSignal <- STM.newTVarIO False
    let settings
            = Warp.setPort 8080
            . Warp.setInstallShutdownHandler (installShutdownHandler shutdownSignal)
            . Warp.setGracefulShutdownTimeout (Just 30) -- seconds
            $ Warp.defaultSettings
    print "warp is starting"
    Warp.runSettings settings $ app shutdownSignal
    print "warp is done"


On Tue, Apr 26, 2022 at 1:00 PM Olaf Klinke <olf@aatal-apotheke.de> wrote:
Dear Cafe,

this topic has been discussed [1,2] a decade ago. What is the current
state of affairs in this matter? It still seems to be addressed neither
in yesod nor warp [*].
We have two use cases: (1) A shutdown route that allows admins to
cleanly shut down the web application. (2) We want certain exceptions
to terminate the application and have the surrounding monitoring
(systemd, docker, ...) re-start the application. For (2) we are safe, I
think, because the worker threads are forked from the main thread [3]
calling warp, so propagating the exceptions up to the top bypasses warp
and yesod's very comprehensive exception handlers. But any exception
thrown while answering a request (such as (1)) is caught by default.

Thanks
Olaf

[1] https://groups.google.com/g/yesodweb/c/VoenrabRUBQ
[2] https://stackoverflow.com/questions/7881327/how-do-i-implement-a-shutdown-command-in-a-wai-server
[3] https://mail.haskell.org/pipermail/haskell-cafe/2022-March/135132.html
[*] Warp offers setOnException and setOnExceptionResponse. But does re-
throwing certain exceptions from there terminate warp?

_______________________________________________
Haskell-Cafe mailing list
To (un)subscribe, modify options or view archives go to:
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
Only members subscribed via the mailman list are allowed to post.