From 99fdd4b46f4c2b794243fca79905068c803ab0d3 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 30 Apr 2019 21:15:37 +0200
Subject: [PATCH] Assimilate WATCHDOG_USEC

---
 config/settings.yml |  2 +-
 package.yaml        |  1 +
 src/Application.hs  | 17 ++++++++++++++++-
 3 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/config/settings.yml b/config/settings.yml
index 60e25dd9a..974b2e7e2 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -30,7 +30,7 @@ session-timeout: 7200
 jwt-expiration: 604800
 jwt-encoding: HS256
 maximum-content-length: 52428800
-health-check-interval: "_env:HEALTHCHECK_INTERVAL:60"
+health-check-interval: "_env:HEALTHCHECK_INTERVAL:600" # or WATCHDOG_USEC/2, whichever is smaller
 health-check-http: "_env:HEALTHCHECK_HTTP:true"
 health-check-delay-notify: "_env:HEALTHCHECK_DELAY_NOTIFY:true"
 
diff --git a/package.yaml b/package.yaml
index d1c262645..3994357bf 100644
--- a/package.yaml
+++ b/package.yaml
@@ -125,6 +125,7 @@ dependencies:
   - lifted-async
   - streaming-commons
   - hourglass
+  - unix
 
 other-extensions:
   - GeneralizedNewtypeDeriving
diff --git a/src/Application.hs b/src/Application.hs
index 91ef1c7fe..30d0947de 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -76,6 +76,10 @@ import qualified Database.Memcached.Binary.IO as Memcached
 
 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 Control.Monad.Trans.State (execStateT)
   
 -- Import all relevant handler modules here.
 -- (HPack takes care to add new modules to our cabal file nowadays.)
@@ -360,7 +364,7 @@ develMain = runResourceT $
 appMain :: MonadResourceBase m => m ()
 appMain = runResourceT $ do
     -- Get the settings from all relevant sources
-    settings <- liftIO $
+    settings' <- liftIO $
       loadYamlSettingsArgs
         -- fall back to compile-time values, set to [] to require values at runtime
         [configSettingsYmlValue]
@@ -368,6 +372,17 @@ appMain = runResourceT $ do
         -- allow environment variables to override
         useEnv
 
+    settings <- execStateT ?? settings' $ do
+      watchdogMicroSec <- liftIO $ (>>= readMay) <$> lookupEnv "WATCHDOG_USEC"
+      watchdogProcess <- liftIO $ (>>= fmap fromInteger . readMay) <$> lookupEnv "WATCHDOG_PID"
+      myProcessID <- liftIO getProcessID
+      $logDebugS "WATCHDOG_USEC" $ tshow (watchdogMicroSec, watchdogProcess, myProcessID)
+      case watchdogMicroSec of
+        Just wInterval
+          | maybe True (== myProcessID) watchdogProcess
+            -> _appHealthCheckInterval %= min (fromRational $ (toRational wInterval / 1e6) / 2)
+        _other -> return ()
+
     -- Generate the foundation from the settings
     foundation <- makeFoundation settings