Assimilate WATCHDOG_USEC

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"
 

package.yaml

@@ -125,6 +125,7 @@ dependencies:
   - lifted-async
   - streaming-commons
   - hourglass
+  - unix
 
 other-extensions:
   - GeneralizedNewtypeDeriving

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