From 347a5ace6327446ed8c3e811580bf6193684f924 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 30 Apr 2019 21:23:05 +0200
Subject: [PATCH] Fix build

---
 src/Application.hs       | 36 +++++++++++++++---------------------
 src/Jobs/HealthReport.hs |  5 ++++-
 2 files changed, 19 insertions(+), 22 deletions(-)

diff --git a/src/Application.hs b/src/Application.hs
index 30d0947de..503386d64 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -352,8 +352,20 @@ getApplicationDev = do
     app <- makeApplication foundation
     return (wsettings, app)
 
-getAppDevSettings :: MonadIO m => m AppSettings
-getAppDevSettings = liftIO $ loadYamlSettings [configSettingsYml] [configSettingsYmlValue] useEnv
+getAppDevSettings, getAppSettings :: MonadIO m => m AppSettings
+getAppDevSettings = liftIO $ adjustSettings =<< loadYamlSettings [configSettingsYml] [configSettingsYmlValue] useEnv
+getAppSettings = liftIO $ adjustSettings =<< loadYamlSettingsArgs [configSettingsYmlValue] useEnv
+
+adjustSettings :: MonadIO m => AppSettings -> m AppSettings
+adjustSettings = execStateT $ do
+  watchdogMicroSec <- liftIO $ (>>= readMay) <$> lookupEnv "WATCHDOG_USEC"
+  watchdogProcess <- liftIO $ (>>= fmap fromInteger . readMay) <$> lookupEnv "WATCHDOG_PID"
+  myProcessID <- liftIO getProcessID
+  case watchdogMicroSec of
+    Just wInterval
+      | maybe True (== myProcessID) watchdogProcess
+        -> _appHealthCheckInterval %= min (fromRational $ (toRational wInterval / 1e6) / 2)
+    _other -> return () 
 
 -- | main function for use by yesod devel
 develMain :: IO ()
@@ -363,25 +375,7 @@ develMain = runResourceT $
 -- | The @main@ function for an executable running this site.
 appMain :: MonadResourceBase m => m ()
 appMain = runResourceT $ do
-    -- Get the settings from all relevant sources
-    settings' <- liftIO $
-      loadYamlSettingsArgs
-        -- fall back to compile-time values, set to [] to require values at runtime
-        [configSettingsYmlValue]
-
-        -- 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 ()
+    settings <- getAppSettings
 
     -- Generate the foundation from the settings
     foundation <- makeFoundation settings
diff --git a/src/Jobs/HealthReport.hs b/src/Jobs/HealthReport.hs
index d1edc5faf..a8f6a0ff4 100644
--- a/src/Jobs/HealthReport.hs
+++ b/src/Jobs/HealthReport.hs
@@ -77,7 +77,8 @@ matchingClusterConfig = runDB $ and <$> forM universeF clusterSettingMatches
 httpReachable :: Handler (Maybe Bool)
 httpReachable = do
   staticAppRoot <- getsYesod $ view _appRoot
-  for staticAppRoot $ \_textAppRoot -> do
+  doHTTP <- getsYesod $ view _appHealthCheckHTTP
+  for (staticAppRoot <* guard doHTTP) $ \_textAppRoot -> do
     url <- getUrlRender <*> pure InstanceR
     baseRequest <- HTTP.parseRequest $ unpack url
     httpManager <- getsYesod appHttpManager
@@ -128,7 +129,9 @@ widgetMemcached = do
         mimeType = "application/octet-stream"
     content <- pack . take 256 <$> liftIO getRandoms
     staticLink <- addStaticContent ext mimeType content
+    doHTTP <- getsYesod $ view _appHealthCheckHTTP
     case staticLink of
+      _ | not doHTTP -> return True
       Just (Left url) -> do
         baseRequest <- HTTP.parseRequest $ unpack url
         httpManager <- getsYesod appHttpManager