diff --git a/src/Application.hs b/src/Application.hs index 675c11d92..b39657de7 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -78,10 +78,13 @@ import qualified System.Systemd.Daemon as Systemd import Control.Concurrent.Async.Lifted.Safe (async, waitAnyCancel) import System.Environment (lookupEnv) import System.Posix.Process (getProcessID) +import System.Posix.Signals (SignalInfo(..), installHandler, sigTERM) +import qualified System.Posix.Signals as Signals (Handler(..)) import Control.Monad.Trans.State (execStateT) import Network (socketPort) +import qualified Network.Socket as Socket (close) -- Import all relevant handler modules here. -- (HPack takes care to add new modules to our cabal file nowadays.) @@ -346,7 +349,9 @@ warpSettings foundation = defaultSettings $(qLocation >>= liftLoc) "yesod" LevelError - (toLogStr $ "Exception from Warp: " ++ show e)) + (toLogStr $ "Exception from Warp: " ++ show e) + ) + getAppDevSettings, getAppSettings :: MonadIO m => m AppSettings getAppDevSettings = liftIO $ adjustSettings =<< loadYamlSettings [configSettingsYml] [configSettingsYmlValue] useEnv @@ -405,6 +410,15 @@ appMain = runResourceT $ do $logDebugS "bind" . tshow =<< mapM (liftIO . socketPort) sockets + mainThreadId <- myThreadId + liftIO . void . flip (installHandler sigTERM) Nothing . Signals.CatchInfo $ \SignalInfo{..} -> runAppLoggingT foundation $ do + $logInfoS "shutdown" [st|Received signal #{tshow siginfoSignal}|] + didStore <- runMaybeT . forM_ sockets $ MaybeT . liftIO . Systemd.storeFd + case didStore of + Just () -> $logInfoS "shutdown" "Stored all bound sockets for restart" + Nothing -> forM_ sockets $ liftIO . Socket.close + liftIO . throwTo mainThreadId . ExitFailure $ 0b10000000 + fromIntegral siginfoSignal + let runWarp socket = runSettingsSocket (warpSettings foundation) socket app case sockets of [] -> $logErrorS "bind" "No sockets to listen on"