Delay systemd notify ready until first successful healthcheck

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"

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)

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

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"