Fix build

This commit is contained in:
Gregor Kleen 2019-04-30 21:23:05 +02:00
parent 99fdd4b46f
commit 347a5ace63
2 changed files with 19 additions and 22 deletions

View File

@ -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

View File

@ -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