From e1f65a8399fd3344b11825f4a6ac362a5874b3d9 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Thu, 25 Apr 2019 15:43:05 +0200
Subject: [PATCH] systemd integration

---
 package.yaml       |  1 +
 src/Application.hs | 13 +++++++++++--
 stack.yaml         |  2 ++
 3 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index 47917503c..217f65626 100644
--- a/package.yaml
+++ b/package.yaml
@@ -121,6 +121,7 @@ dependencies:
   - jose-jwt
   - mono-traversable
   - lens-aeson
+  - systemd
 
 other-extensions:
   - GeneralizedNewtypeDeriving
diff --git a/src/Application.hs b/src/Application.hs
index 5b130dd50..ae1ca9dbd 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -24,7 +24,8 @@ import Language.Haskell.TH.Syntax           (qLocation)
 import Network.Wai (Middleware)
 import Network.Wai.Handler.Warp             (Settings, defaultSettings,
                                              defaultShouldDisplayException,
-                                             runSettings, setHost,
+                                             runSettings, runSettingsSocket, setHost,
+                                             setBeforeMainLoop,
                                              setOnException, setPort, getPort)
 import Network.Wai.Middleware.RequestLogger (Destination (Logger),
                                              IPAddrSource (..),
@@ -71,6 +72,8 @@ import qualified Data.Aeson as Aeson
 import System.Exit (exitFailure)
 
 import qualified Database.Memcached.Binary.IO as Memcached
+
+import qualified System.Systemd.Daemon as Systemd
   
 -- Import all relevant handler modules here.
 -- (HPack takes care to add new modules to our cabal file nowadays.)
@@ -291,6 +294,7 @@ warpSettings :: UniWorX -> Settings
 warpSettings foundation = defaultSettings
     & setPort (foundation ^. _appPort)
     & setHost (foundation ^. _appHost)
+    & setBeforeMainLoop (void Systemd.notifyReady)
     & setOnException (\_req e ->
         when (defaultShouldDisplayException e) $ do
           logger <- readTVarIO . snd $ appLogger foundation
@@ -338,7 +342,12 @@ appMain = runResourceT $ do
     app <- makeApplication foundation
 
     -- 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
 
 
 --------------------------------------------------------------
diff --git a/stack.yaml b/stack.yaml
index 94be126d8..df8eb7fb3 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -49,4 +49,6 @@ extra-deps:
   - quickcheck-classes-0.4.14
   - semirings-0.2.1.1
 
+  - systemd-1.1.2
+
 resolver: lts-10.5