systemd integration
This commit is contained in:
parent
dd6d41ca59
commit
e1f65a8399
@ -121,6 +121,7 @@ dependencies:
|
|||||||
- jose-jwt
|
- jose-jwt
|
||||||
- mono-traversable
|
- mono-traversable
|
||||||
- lens-aeson
|
- lens-aeson
|
||||||
|
- systemd
|
||||||
|
|
||||||
other-extensions:
|
other-extensions:
|
||||||
- GeneralizedNewtypeDeriving
|
- GeneralizedNewtypeDeriving
|
||||||
|
|||||||
@ -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
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------
|
--------------------------------------------------------------
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user