Fix build
This commit is contained in:
parent
99fdd4b46f
commit
347a5ace63
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user