feat: minimal check

src/PostgREST/App.hs

@@ -93,6 +93,7 @@ data RequestContext = RequestContext
   , ctxDbStructure :: DbStructure
   , ctxApiRequest  :: ApiRequest
   , ctxPgVersion   :: PgVersion
+  , ctxListenerOn  :: Bool
   }
 
 type Handler = ExceptT Error
@@ -145,11 +146,12 @@ postgrest logLev appState connWorker =
       maybeDbStructure <- AppState.getDbStructure appState
       pgVer <- AppState.getPgVersion appState
       jsonDbS <- AppState.getJsonDbS appState
+      listenerOn <- AppState.getIsListenerOn appState
 
       let
         eitherResponse :: IO (Either Error Wai.Response)
         eitherResponse =
-          runExceptT $ postgrestResponse conf maybeDbStructure jsonDbS pgVer (AppState.getPool appState) time req
+          runExceptT $ postgrestResponse conf maybeDbStructure jsonDbS pgVer (AppState.getPool appState) time listenerOn req
 
       response <- either Error.errorResponseFor identity <$> eitherResponse
       -- Launch the connWorker when the connection is down.  The postgrest
@@ -173,9 +175,10 @@ postgrestResponse
   -> PgVersion
   -> SQL.Pool
   -> UTCTime
+  -> Bool
   -> Wai.Request
   -> Handler IO Wai.Response
-postgrestResponse conf maybeDbStructure jsonDbS pgVer pool time req = do
+postgrestResponse conf maybeDbStructure jsonDbS pgVer pool time listenerOn req = do
   body <- lift $ Wai.strictRequestBody req
 
   dbStructure <-
@@ -194,7 +197,7 @@ postgrestResponse conf maybeDbStructure jsonDbS pgVer pool time req = do
 
   let
     handleReq apiReq =
-      handleRequest $ RequestContext conf dbStructure apiReq pgVer
+      handleRequest $ RequestContext conf dbStructure apiReq pgVer listenerOn
 
   runDbHandler pool (txMode apiRequest) jwtClaims (configDbPreparedStatements conf) .
     Middleware.optionalRollback conf apiRequest $
@@ -213,7 +216,7 @@ runDbHandler pool mode jwtClaims prepared handler = do
   liftEither resp
 
 handleRequest :: RequestContext -> DbHandler Wai.Response
-handleRequest context@(RequestContext _ _ ApiRequest{..} _) =
+handleRequest context@(RequestContext _ _ ApiRequest{..} _ _) =
   case (iAction, iTarget) of
     (ActionRead headersOnly, TargetIdent identifier) ->
       handleRead headersOnly identifier context
@@ -331,7 +334,7 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
       response HTTP.status201 headers mempty
 
 handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
-handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
+handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _ _) = do
   WriteQueryResult{..} <- writeQuery identifier False mempty context
 
   let
@@ -353,7 +356,7 @@ handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
       response status [contentRangeHeader] mempty
 
 handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response
-handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..} _) = do
+handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..} _ _) = do
   when (iTopLevelRange /= RangeQuery.allRange) $
     throwError Error.PutRangeNotAllowedError
 
@@ -377,7 +380,7 @@ handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..} _) = do
       response HTTP.status204 [] mempty
 
 handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
-handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do
+handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _ _) = do
   WriteQueryResult{..} <- writeQuery identifier False mempty context
 
   let
@@ -460,7 +463,13 @@ handleInvoke invMethod proc context@RequestContext{..} = do
       (if invMethod == InvHead then mempty else LBS.fromStrict body)
 
 handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response
-handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest ctxPgVersion) = do
+handleOpenApi _ _ (RequestContext _ _ ApiRequest{iPreferRepresentation = None} _ isListenerOn) =
+  return $
+    Wai.responseLBS
+    (if isListenerOn then HTTP.status200 else HTTP.status504)
+    mempty
+    mempty
+handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest ctxPgVersion _) = do
   body <-
     lift $ case configOpenApiMode of
       OAFollowPriv ->
@@ -567,7 +576,7 @@ returnsScalar (TargetProc proc _) = Proc.procReturnsScalar proc
 returnsScalar _                   = False
 
 readRequest :: Monad m => QualifiedIdentifier -> RequestContext -> Handler m ReadRequest
-readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure apiRequest _) =
+readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure apiRequest _ _) =
   liftEither $
     ReqBuilder.readRequest qiSchema qiName configDbMaxRows
       (dbRelationships dbStructure)

src/PostgREST/AppState.hs

@@ -4,6 +4,7 @@ module PostgREST.AppState
   ( AppState
   , getConfig
   , getDbStructure
+  , getIsListenerOn
   , getIsWorkerOn
   , getJsonDbS
   , getMainThreadId
@@ -16,6 +17,7 @@ module PostgREST.AppState
   , logWithZTime
   , putConfig
   , putDbStructure
+  , putIsListenerOn
   , putIsWorkerOn
   , putJsonDbS
   , putPgVersion
@@ -53,6 +55,8 @@ data AppState = AppState
   , stateIsWorkerOn   :: IORef Bool
   -- | Binary semaphore used to sync the listener(NOTIFY reload) with the connectionWorker.
   , stateListener     :: MVar ()
+  -- | PENDING
+  , stateIsListenerOn :: IORef Bool
   -- | Config that can change at runtime
   , stateConf         :: IORef AppConfig
   -- | Time used for verifying JWT expiration
@@ -78,6 +82,7 @@ initWithPool newPool conf =
     <*> newIORef mempty
     <*> newIORef False
     <*> newEmptyMVar
+    <*> newIORef False
     <*> newIORef conf
     <*> mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
     <*> mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
@@ -153,3 +158,9 @@ waitListener = takeMVar . stateListener
 -- the connectionWorker is the only mvar producer.
 signalListener :: AppState -> IO ()
 signalListener appState = void $ tryPutMVar (stateListener appState) ()
+
+getIsListenerOn :: AppState -> IO Bool
+getIsListenerOn = readIORef . stateIsListenerOn
+
+putIsListenerOn :: AppState -> Bool -> IO ()
+putIsListenerOn = atomicWriteIORef . stateIsListenerOn

src/PostgREST/Workers.hs

@@ -200,6 +200,7 @@ listener appState = do
     case dbOrError of
       Right db -> do
         AppState.logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel"
+        AppState.putIsListenerOn appState True
         SQL.listen db $ SQL.toPgIdentifier dbChannel
         SQL.waitForNotifications handleNotification db
       _ ->
@@ -208,6 +209,7 @@ listener appState = do
     handleFinally dbChannel _ = do
       -- if the thread dies, we try to recover
       AppState.logWithZTime appState $ "Retrying listening for notifications on the " <> dbChannel <> " channel.."
+      AppState.putIsListenerOn appState False
       -- assume the pool connection was also lost, call the connection worker
       connectionWorker appState
       -- retry the listener