<div dir="ltr"><div>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 <a href="https://hackage.haskell.org/package/warp-3.3.15/docs/Network-Wai-Handler-Warp.html#v:setInstallShutdownHandler" target="_blank">setInstallShutdownHandler</a> documentation indicates that you should also use <a href="https://hackage.haskell.org/package/warp-3.3.15/docs/Network-Wai-Handler-Warp.html#v:setGracefulShutdownTimeout" target="_blank">setGracefulShutdownTimeout</a> to ensure the server eventually shuts down.</div><div><br></div><div>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.<br></div><div><br></div><div>--- --- ---<br></div><div><br></div><div><span style="font-family:monospace">{-# LANGUAGE OverloadedStrings #-}<br><br>import qualified Control.Concurrent.Async as Async<br>import qualified Control.Concurrent.STM as STM<br>import qualified Network.HTTP.Types as HTTP<br>import qualified Network.Wai as Wai<br>import qualified Network.Wai.Handler.Warp as Warp<br><br>app :: STM.TVar Bool -> Wai.Application<br>app shutdownSignal req respond = do<br>    print ("Request from", Wai.remoteHost req)<br>    case Wai.rawPathInfo req of<br><br>        "/shutdown" -> do<br>            STM.atomically $ STM.writeTVar shutdownSignal True<br>            respond $ Wai.responseLBS HTTP.ok200 [] "shutting down"<br><br>        _ -> do<br>            respond $ Wai.responseLBS HTTP.ok200 [] "hello"<br><br>-- | Spawn a thread to wait for the shutdown signal and initiate shutdown.<br>installShutdownHandler :: STM.TVar Bool -> (IO ()) -> IO ()<br>installShutdownHandler shutdownSignal closeSocket = do<br>    _ <- Async.async $ do<br>        STM.atomically $ STM.check =<< STM.readTVar shutdownSignal<br>        closeSocket<br>    return ()<br><br>main :: IO ()<br>main = do<br>    shutdownSignal <- STM.newTVarIO False<br>    let settings<br>            = Warp.setPort 8080<br>            . Warp.setInstallShutdownHandler (installShutdownHandler shutdownSignal)<br>            . Warp.setGracefulShutdownTimeout (Just 30) -- seconds<br>            $ Warp.defaultSettings<br>    print "warp is starting"<br>    Warp.runSettings settings $ app shutdownSignal<br>    print "warp is done"</span><br></div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Tue, Apr 26, 2022 at 1:00 PM Olaf Klinke <<a href="mailto:olf@aatal-apotheke.de" target="_blank">olf@aatal-apotheke.de</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">Dear Cafe, <br>
<br>
this topic has been discussed [1,2] a decade ago. What is the current<br>
state of affairs in this matter? It still seems to be addressed neither<br>
in yesod nor warp [*]. <br>
We have two use cases: (1) A shutdown route that allows admins to<br>
cleanly shut down the web application. (2) We want certain exceptions<br>
to terminate the application and have the surrounding monitoring<br>
(systemd, docker, ...) re-start the application. For (2) we are safe, I<br>
think, because the worker threads are forked from the main thread [3]<br>
calling warp, so propagating the exceptions up to the top bypasses warp<br>
and yesod's very comprehensive exception handlers. But any exception<br>
thrown while answering a request (such as (1)) is caught by default. <br>
<br>
Thanks<br>
Olaf<br>
<br>
[1] <a href="https://groups.google.com/g/yesodweb/c/VoenrabRUBQ" rel="noreferrer" target="_blank">https://groups.google.com/g/yesodweb/c/VoenrabRUBQ</a><br>
[2] <a href="https://stackoverflow.com/questions/7881327/how-do-i-implement-a-shutdown-command-in-a-wai-server" rel="noreferrer" target="_blank">https://stackoverflow.com/questions/7881327/how-do-i-implement-a-shutdown-command-in-a-wai-server</a><br>
[3] <a href="https://mail.haskell.org/pipermail/haskell-cafe/2022-March/135132.html" rel="noreferrer" target="_blank">https://mail.haskell.org/pipermail/haskell-cafe/2022-March/135132.html</a><br>
[*] Warp offers setOnException and setOnExceptionResponse. But does re-<br>
throwing certain exceptions from there terminate warp?<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</blockquote></div>