diff --git a/config/settings.yml b/config/settings.yml index 168ba3688..60e25dd9a 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -32,6 +32,7 @@ jwt-encoding: HS256 maximum-content-length: 52428800 health-check-interval: "_env:HEALTHCHECK_INTERVAL:60" health-check-http: "_env:HEALTHCHECK_HTTP:true" +health-check-delay-notify: "_env:HEALTHCHECK_DELAY_NOTIFY:true" log-settings: detailed: "_env:DETAILED_LOGGING:false" diff --git a/src/Application.hs b/src/Application.hs index 7d8927e73..91ef1c7fe 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -64,7 +64,7 @@ import qualified Yesod.Core.Types as Yesod (Logger(..)) import qualified Data.HashMap.Strict as HashMap -import Control.Lens +import Utils.Lens import Data.Proxy @@ -315,8 +315,16 @@ makeLogWare app = do warpSettings :: UniWorX -> Settings warpSettings foundation = defaultSettings & setBeforeMainLoop (runAppLoggingT foundation $ do - $logInfoS "setup" "Ready" - void $ liftIO Systemd.notifyReady + let notifyReady = do + $logInfoS "setup" "Ready" + void $ liftIO Systemd.notifyReady + if + | foundation ^. _appHealthCheckDelayNotify + -> void . fork $ do + atomically $ readTVar (foundation ^. _appHealthReport) >>= guard . maybe False ((== HealthSuccess) . classifyHealthReport . snd) + notifyReady + | otherwise + -> notifyReady ) & setHost (foundation ^. _appHost) & setPort (foundation ^. _appPort) diff --git a/src/Model/Types.hs b/src/Model/Types.hs index e7834a59f..8978b16d6 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -944,7 +944,7 @@ deriveJSON defaultOptions , omitNothingFields = True } ''HealthReport -data HealthStatus = HealthFailure | HealthWarning | HealthSuccess +data HealthStatus = HealthFailure | HealthSuccess deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) instance Universe HealthStatus diff --git a/src/Settings.hs b/src/Settings.hs index ac5e832c2..d9798caea 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -48,9 +48,6 @@ import qualified Ldap.Client as Ldap import Utils hiding (MessageStatus(..)) import Control.Lens -import Data.Maybe (fromJust) -import qualified Data.Char as Char - import qualified Network.HaskellNet.Auth as HaskellNet (UserName, Password, AuthType(..)) import qualified Network.Socket as HaskellNet (PortNumber(..), HostName) import qualified Network @@ -111,8 +108,10 @@ data AppSettings = AppSettings , appMaximumContentLength :: Maybe Word64 , appJwtExpiration :: Maybe NominalDiffTime , appJwtEncoding :: JwtEncoding + , appHealthCheckInterval :: NominalDiffTime , appHealthCheckHTTP :: Bool + , appHealthCheckDelayNotify :: Bool , appInitialLogSettings :: LogSettings @@ -280,7 +279,7 @@ deriveFromJSON deriveJSON defaultOptions - { constructorTagModifier = over (ix 1) Char.toLower . fromJust . stripPrefix "Level" + { constructorTagModifier = camelToPathPiece' 1 , sumEncoding = UntaggedValue } ''LogLevel @@ -382,6 +381,7 @@ instance FromJSON AppSettings where appHealthCheckInterval <- o .: "health-check-interval" appHealthCheckHTTP <- o .: "health-check-http" + appHealthCheckDelayNotify <- o .: "health-check-delay-notify" appSessionTimeout <- o .: "session-timeout"