systemd integration

This commit is contained in:
Gregor Kleen 2019-04-25 15:43:05 +02:00
parent dd6d41ca59
commit e1f65a8399
3 changed files with 14 additions and 2 deletions

View File

@ -121,6 +121,7 @@ dependencies:
- jose-jwt - jose-jwt
- mono-traversable - mono-traversable
- lens-aeson - lens-aeson
- systemd
other-extensions: other-extensions:
- GeneralizedNewtypeDeriving - GeneralizedNewtypeDeriving

View File

@ -24,7 +24,8 @@ import Language.Haskell.TH.Syntax (qLocation)
import Network.Wai (Middleware) import Network.Wai (Middleware)
import Network.Wai.Handler.Warp (Settings, defaultSettings, import Network.Wai.Handler.Warp (Settings, defaultSettings,
defaultShouldDisplayException, defaultShouldDisplayException,
runSettings, setHost, runSettings, runSettingsSocket, setHost,
setBeforeMainLoop,
setOnException, setPort, getPort) setOnException, setPort, getPort)
import Network.Wai.Middleware.RequestLogger (Destination (Logger), import Network.Wai.Middleware.RequestLogger (Destination (Logger),
IPAddrSource (..), IPAddrSource (..),
@ -71,6 +72,8 @@ import qualified Data.Aeson as Aeson
import System.Exit (exitFailure) import System.Exit (exitFailure)
import qualified Database.Memcached.Binary.IO as Memcached import qualified Database.Memcached.Binary.IO as Memcached
import qualified System.Systemd.Daemon as Systemd
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
-- (HPack takes care to add new modules to our cabal file nowadays.) -- (HPack takes care to add new modules to our cabal file nowadays.)
@ -291,6 +294,7 @@ warpSettings :: UniWorX -> Settings
warpSettings foundation = defaultSettings warpSettings foundation = defaultSettings
& setPort (foundation ^. _appPort) & setPort (foundation ^. _appPort)
& setHost (foundation ^. _appHost) & setHost (foundation ^. _appHost)
& setBeforeMainLoop (void Systemd.notifyReady)
& setOnException (\_req e -> & setOnException (\_req e ->
when (defaultShouldDisplayException e) $ do when (defaultShouldDisplayException e) $ do
logger <- readTVarIO . snd $ appLogger foundation logger <- readTVarIO . snd $ appLogger foundation
@ -338,7 +342,12 @@ appMain = runResourceT $ do
app <- makeApplication foundation app <- makeApplication foundation
-- Run the application with Warp -- Run the application with Warp
liftIO $ runSettings (warpSettings foundation) app activatedSockets <- liftIO Systemd.getActivatedSockets
liftIO $ case activatedSockets of
Just [sock]
-> runSettingsSocket (warpSettings foundation) sock app
_other
-> runSettings (warpSettings foundation) app
-------------------------------------------------------------- --------------------------------------------------------------

View File

@ -49,4 +49,6 @@ extra-deps:
- quickcheck-classes-0.4.14 - quickcheck-classes-0.4.14
- semirings-0.2.1.1 - semirings-0.2.1.1
- systemd-1.1.2
resolver: lts-10.5 resolver: lts-10.5