From 81fddbb4ce090cc9ea8da0052fcdd5e51f06551b Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Thu, 16 Dec 2021 20:02:17 -0500 Subject: [PATCH 1/7] feat: minimal check --- src/PostgREST/App.hs | 27 ++++++++++++++++++--------- src/PostgREST/AppState.hs | 11 +++++++++++ src/PostgREST/Workers.hs | 2 ++ 3 files changed, 31 insertions(+), 9 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 89a75bbe9a..bec5d5bd4f 100644 --- a/src/PostgREST/App.hs +++ b/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.status503) + 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) diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index 77819f2efa..347b0832c6 100644 --- a/src/PostgREST/AppState.hs +++ b/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 diff --git a/src/PostgREST/Workers.hs b/src/PostgREST/Workers.hs index 9f716e3829..5fdd3bca77 100644 --- a/src/PostgREST/Workers.hs +++ b/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 From df52a028f97b7c742673908d127a63a9205b914d Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Fri, 17 Dec 2021 20:29:59 -0500 Subject: [PATCH 2/7] Don't assume return=minimal for GET/HEAD --- src/PostgREST/Request/ApiRequest.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/PostgREST/Request/ApiRequest.hs b/src/PostgREST/Request/ApiRequest.hs index cd52719653..f8169c5082 100644 --- a/src/PostgREST/Request/ApiRequest.hs +++ b/src/PostgREST/Request/ApiRequest.hs @@ -195,7 +195,7 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody , iRange = ranges , iTopLevelRange = topLevelRange , iPayload = relevantPayload - , iPreferRepresentation = fromMaybe None preferRepresentation + , iPreferRepresentation = fromMaybe (if method `elem` ["GET", "HEAD"] then Full else None) preferRepresentation , iPreferParameters = preferParameters , iPreferCount = preferCount , iPreferResolution = preferResolution From c110269932ebcaa8edef74ab78391d820f9476a0 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Mon, 20 Dec 2021 21:19:53 -0500 Subject: [PATCH 3/7] Add admin port --- src/PostgREST/App.hs | 44 +++++++++++++++++------------ src/PostgREST/AppState.hs | 2 +- src/PostgREST/CLI.hs | 3 ++ src/PostgREST/Config.hs | 3 ++ src/PostgREST/Request/ApiRequest.hs | 2 +- test/SpecHelper.hs | 1 + 6 files changed, 35 insertions(+), 20 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index bec5d5bd4f..53d38ac358 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -93,7 +93,6 @@ data RequestContext = RequestContext , ctxDbStructure :: DbStructure , ctxApiRequest :: ApiRequest , ctxPgVersion :: PgVersion - , ctxListenerOn :: Bool } type Handler = ExceptT Error @@ -115,6 +114,10 @@ run installHandlers maybeRunWithSocket appState = do let app = postgrest configLogLevel appState (connectionWorker appState) + whenJust configAdminServerPort $ \adminPort -> do + AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort + void . forkIO $ Warp.runSettings (serverSettings conf & setPort adminPort) $ adminApp appState + case configServerUnixSocket of Just socket -> -- run the postgrest application with user defined socket. Only for UNIX systems @@ -128,6 +131,9 @@ run installHandlers maybeRunWithSocket appState = do do AppState.logWithZTime appState $ "Listening on port " <> show configServerPort Warp.runSettings (serverSettings conf) app + where + whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m () + whenJust mg f = maybe (pure ()) f mg serverSettings :: AppConfig -> Warp.Settings serverSettings AppConfig{..} = @@ -136,6 +142,16 @@ serverSettings AppConfig{..} = & setPort configServerPort & setServerName ("postgrest/" <> prettyVersion) +adminApp :: AppState.AppState -> Wai.Application +adminApp appState req respond = + case Wai.pathInfo req of + [] -> do + listenerOn <- AppState.getIsListenerOn appState + if listenerOn + then respond $ Wai.responseLBS HTTP.status200 [] mempty + else respond $ Wai.responseLBS HTTP.status503 [] mempty + _ -> respond $ Wai.responseLBS HTTP.status404 [] mempty + -- | PostgREST application postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application postgrest logLev appState connWorker = @@ -146,12 +162,11 @@ 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 listenerOn req + runExceptT $ postgrestResponse conf maybeDbStructure jsonDbS pgVer (AppState.getPool appState) time req response <- either Error.errorResponseFor identity <$> eitherResponse -- Launch the connWorker when the connection is down. The postgrest @@ -175,10 +190,9 @@ postgrestResponse -> PgVersion -> SQL.Pool -> UTCTime - -> Bool -> Wai.Request -> Handler IO Wai.Response -postgrestResponse conf maybeDbStructure jsonDbS pgVer pool time listenerOn req = do +postgrestResponse conf maybeDbStructure jsonDbS pgVer pool time req = do body <- lift $ Wai.strictRequestBody req dbStructure <- @@ -197,7 +211,7 @@ postgrestResponse conf maybeDbStructure jsonDbS pgVer pool time listenerOn req = let handleReq apiReq = - handleRequest $ RequestContext conf dbStructure apiReq pgVer listenerOn + handleRequest $ RequestContext conf dbStructure apiReq pgVer runDbHandler pool (txMode apiRequest) jwtClaims (configDbPreparedStatements conf) . Middleware.optionalRollback conf apiRequest $ @@ -216,7 +230,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 @@ -334,7 +348,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 @@ -356,7 +370,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 @@ -380,7 +394,7 @@ handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..} _ _) = 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 @@ -463,13 +477,7 @@ handleInvoke invMethod proc context@RequestContext{..} = do (if invMethod == InvHead then mempty else LBS.fromStrict body) handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response -handleOpenApi _ _ (RequestContext _ _ ApiRequest{iPreferRepresentation = None} _ isListenerOn) = - return $ - Wai.responseLBS - (if isListenerOn then HTTP.status200 else HTTP.status503) - mempty - mempty -handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest ctxPgVersion _) = do +handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest ctxPgVersion) = do body <- lift $ case configOpenApiMode of OAFollowPriv -> @@ -576,7 +584,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) diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index 347b0832c6..47eeaa12db 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -55,7 +55,7 @@ data AppState = AppState , stateIsWorkerOn :: IORef Bool -- | Binary semaphore used to sync the listener(NOTIFY reload) with the connectionWorker. , stateListener :: MVar () - -- | PENDING + -- | State of the LISTEN channel, used for health checks , stateIsListenerOn :: IORef Bool -- | Config that can change at runtime , stateConf :: IORef AppConfig diff --git a/src/PostgREST/CLI.hs b/src/PostgREST/CLI.hs index 6cd604dfc5..2f80c1bdf3 100644 --- a/src/PostgREST/CLI.hs +++ b/src/PostgREST/CLI.hs @@ -199,6 +199,9 @@ exampleConfigFile = |## when none is provided, 660 is applied by default |# server-unix-socket-mode = "660" | + |## admin server for health checks, it's disabled by default unless a port is specified + |# admin-server-port = 3001 + | |## determine if the OpenAPI output should follow or ignore role privileges or be disabled entirely |## admitted values: follow-privileges, ignore-privileges, disabled |openapi-mode = "follow-privileges" diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index d5d63cd92f..33f77d1578 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -93,6 +93,7 @@ data AppConfig = AppConfig , configServerPort :: Int , configServerUnixSocket :: Maybe FilePath , configServerUnixSocketMode :: FileMode + , configAdminServerPort :: Maybe Int } data LogLevel = LogCrit | LogError | LogWarn | LogInfo @@ -147,6 +148,7 @@ toText conf = ,("server-port", show . configServerPort) ,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket) ,("server-unix-socket-mode", q . T.pack . showSocketMode) + ,("admin-server-port", show . configAdminServerPort) ] -- quote all app.settings @@ -242,6 +244,7 @@ parser optPath env dbSettings = <*> (fromMaybe 3000 <$> optInt "server-port") <*> (fmap T.unpack <$> optString "server-unix-socket") <*> parseSocketFileMode "server-unix-socket-mode" + <*> optInt "admin-server-port" where parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)] parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value diff --git a/src/PostgREST/Request/ApiRequest.hs b/src/PostgREST/Request/ApiRequest.hs index f8169c5082..cd52719653 100644 --- a/src/PostgREST/Request/ApiRequest.hs +++ b/src/PostgREST/Request/ApiRequest.hs @@ -195,7 +195,7 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody , iRange = ranges , iTopLevelRange = topLevelRange , iPayload = relevantPayload - , iPreferRepresentation = fromMaybe (if method `elem` ["GET", "HEAD"] then Full else None) preferRepresentation + , iPreferRepresentation = fromMaybe None preferRepresentation , iPreferParameters = preferParameters , iPreferCount = preferCount , iPreferResolution = preferResolution diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index f9411f8f8a..3042957485 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -106,6 +106,7 @@ _baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in , configServerUnixSocketMode = 432 , configDbTxAllowOverride = True , configDbTxRollbackAll = True + , configAdminServerPort = Nothing } testCfg :: Text -> AppConfig From 5b139e4ea1a6cb214f1d8fa816279269c6b018ca Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Tue, 21 Dec 2021 17:53:03 -0500 Subject: [PATCH 4/7] correct io tests --- src/PostgREST/Config.hs | 2 +- test/io-tests/configs/expected/aliases.config | 1 + test/io-tests/configs/expected/boolean-numeric.config | 1 + test/io-tests/configs/expected/boolean-string.config | 1 + test/io-tests/configs/expected/defaults.config | 1 + .../expected/no-defaults-with-db-other-authenticator.config | 1 + test/io-tests/configs/expected/no-defaults-with-db.config | 1 + test/io-tests/configs/expected/no-defaults.config | 1 + test/io-tests/configs/expected/types.config | 1 + test/io-tests/configs/no-defaults-env.yaml | 1 + test/io-tests/configs/no-defaults.config | 1 + 11 files changed, 11 insertions(+), 1 deletion(-) diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 33f77d1578..1f315e6925 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -148,7 +148,7 @@ toText conf = ,("server-port", show . configServerPort) ,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket) ,("server-unix-socket-mode", q . T.pack . showSocketMode) - ,("admin-server-port", show . configAdminServerPort) + ,("admin-server-port", maybe "\"\"" show . configAdminServerPort) ] -- quote all app.settings diff --git a/test/io-tests/configs/expected/aliases.config b/test/io-tests/configs/expected/aliases.config index 24d89f4621..4ca5c65b98 100644 --- a/test/io-tests/configs/expected/aliases.config +++ b/test/io-tests/configs/expected/aliases.config @@ -25,3 +25,4 @@ server-host = "!4" server-port = 3000 server-unix-socket = "" server-unix-socket-mode = "660" +admin-server-port = "" diff --git a/test/io-tests/configs/expected/boolean-numeric.config b/test/io-tests/configs/expected/boolean-numeric.config index 819368bb2a..3be0ecc9db 100644 --- a/test/io-tests/configs/expected/boolean-numeric.config +++ b/test/io-tests/configs/expected/boolean-numeric.config @@ -25,3 +25,4 @@ server-host = "!4" server-port = 3000 server-unix-socket = "" server-unix-socket-mode = "660" +admin-server-port = "" diff --git a/test/io-tests/configs/expected/boolean-string.config b/test/io-tests/configs/expected/boolean-string.config index 819368bb2a..3be0ecc9db 100644 --- a/test/io-tests/configs/expected/boolean-string.config +++ b/test/io-tests/configs/expected/boolean-string.config @@ -25,3 +25,4 @@ server-host = "!4" server-port = 3000 server-unix-socket = "" server-unix-socket-mode = "660" +admin-server-port = "" diff --git a/test/io-tests/configs/expected/defaults.config b/test/io-tests/configs/expected/defaults.config index 14b97dee9e..a90007d744 100644 --- a/test/io-tests/configs/expected/defaults.config +++ b/test/io-tests/configs/expected/defaults.config @@ -25,3 +25,4 @@ server-host = "!4" server-port = 3000 server-unix-socket = "" server-unix-socket-mode = "660" +admin-server-port = "" diff --git a/test/io-tests/configs/expected/no-defaults-with-db-other-authenticator.config b/test/io-tests/configs/expected/no-defaults-with-db-other-authenticator.config index ff5ec9676a..9e13dc3314 100644 --- a/test/io-tests/configs/expected/no-defaults-with-db-other-authenticator.config +++ b/test/io-tests/configs/expected/no-defaults-with-db-other-authenticator.config @@ -25,5 +25,6 @@ server-host = "0.0.0.0" server-port = 80 server-unix-socket = "/tmp/pgrst_io_test.sock" server-unix-socket-mode = "777" +admin-server-port = 3001 app.settings.test = "test" app.settings.test2 = "test" diff --git a/test/io-tests/configs/expected/no-defaults-with-db.config b/test/io-tests/configs/expected/no-defaults-with-db.config index 4159b6b4da..890c577f10 100644 --- a/test/io-tests/configs/expected/no-defaults-with-db.config +++ b/test/io-tests/configs/expected/no-defaults-with-db.config @@ -25,5 +25,6 @@ server-host = "0.0.0.0" server-port = 80 server-unix-socket = "/tmp/pgrst_io_test.sock" server-unix-socket-mode = "777" +admin-server-port = 3001 app.settings.test = "test" app.settings.test2 = "test" diff --git a/test/io-tests/configs/expected/no-defaults.config b/test/io-tests/configs/expected/no-defaults.config index e782643fba..c438a5f61b 100644 --- a/test/io-tests/configs/expected/no-defaults.config +++ b/test/io-tests/configs/expected/no-defaults.config @@ -25,5 +25,6 @@ server-host = "0.0.0.0" server-port = 80 server-unix-socket = "/tmp/pgrst_io_test.sock" server-unix-socket-mode = "777" +admin-server-port = 3001 app.settings.test = "test" app.settings.test2 = "test" diff --git a/test/io-tests/configs/expected/types.config b/test/io-tests/configs/expected/types.config index f77e97cc00..1d91f50540 100644 --- a/test/io-tests/configs/expected/types.config +++ b/test/io-tests/configs/expected/types.config @@ -25,4 +25,5 @@ server-host = "!4" server-port = 3000 server-unix-socket = "" server-unix-socket-mode = "660" +admin-server-port = "" app.settings.test = "Bool False" diff --git a/test/io-tests/configs/no-defaults-env.yaml b/test/io-tests/configs/no-defaults-env.yaml index 27bbe2c832..bc7790da05 100644 --- a/test/io-tests/configs/no-defaults-env.yaml +++ b/test/io-tests/configs/no-defaults-env.yaml @@ -28,3 +28,4 @@ PGRST_SERVER_HOST: 0.0.0.0 PGRST_SERVER_PORT: 80 PGRST_SERVER_UNIX_SOCKET: /tmp/pgrst_io_test.sock PGRST_SERVER_UNIX_SOCKET_MODE: 777 +PGRST_ADMIN_SERVER_PORT: 3001 diff --git a/test/io-tests/configs/no-defaults.config b/test/io-tests/configs/no-defaults.config index 8284a74c20..65153f1e3e 100644 --- a/test/io-tests/configs/no-defaults.config +++ b/test/io-tests/configs/no-defaults.config @@ -25,5 +25,6 @@ server-host = "0.0.0.0" server-port = 80 server-unix-socket = "/tmp/pgrst_io_test.sock" server-unix-socket-mode = "777" +admin-server-port = 3001 app.settings.test = "test" app.settings.test2 = "test" From fdf26d94fa72251cb802692452aec07c64f0ea77 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Tue, 21 Dec 2021 17:54:50 -0500 Subject: [PATCH 5/7] Do select 1 in case no db-channel-enabled --- src/PostgREST/App.hs | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 53d38ac358..461dba4612 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -30,9 +30,10 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.HashMap.Strict as M import qualified Data.Set as S -import qualified Hasql.DynamicStatements.Snippet as SQL +import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet) import qualified Hasql.Pool as SQL -import qualified Hasql.Transaction as SQL +import qualified Hasql.Session as SQL (sql) +import qualified Hasql.Transaction as SQL hiding (sql) import qualified Hasql.Transaction.Sessions as SQL import qualified Network.HTTP.Types.Header as HTTP import qualified Network.HTTP.Types.Status as HTTP @@ -116,7 +117,7 @@ run installHandlers maybeRunWithSocket appState = do whenJust configAdminServerPort $ \adminPort -> do AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort - void . forkIO $ Warp.runSettings (serverSettings conf & setPort adminPort) $ adminApp appState + void . forkIO $ Warp.runSettings (serverSettings conf & setPort adminPort) $ adminApp appState configDbChannelEnabled case configServerUnixSocket of Just socket -> @@ -142,14 +143,18 @@ serverSettings AppConfig{..} = & setPort configServerPort & setServerName ("postgrest/" <> prettyVersion) -adminApp :: AppState.AppState -> Wai.Application -adminApp appState req respond = +adminApp :: AppState.AppState -> Bool -> Wai.Application +adminApp appState configDbChannelEnabled req respond = case Wai.pathInfo req of - [] -> do - listenerOn <- AppState.getIsListenerOn appState - if listenerOn - then respond $ Wai.responseLBS HTTP.status200 [] mempty - else respond $ Wai.responseLBS HTTP.status503 [] mempty + [] -> + if configDbChannelEnabled then do + listenerOn <- AppState.getIsListenerOn appState + respond $ Wai.responseLBS (if listenerOn then HTTP.status200 else HTTP.status503) [] mempty + else do + result <- SQL.use (AppState.getPool appState) $ SQL.sql "SELECT 1" + case result of + Right _ -> respond $ Wai.responseLBS HTTP.status200 [] mempty + Left _ -> respond $ Wai.responseLBS HTTP.status503 [] mempty _ -> respond $ Wai.responseLBS HTTP.status404 [] mempty -- | PostgREST application From 727e54f0aa094c7936a09a400f0b65180c1d10a7 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Tue, 21 Dec 2021 20:31:28 -0500 Subject: [PATCH 6/7] correct to /health endpoint --- src/PostgREST/App.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 461dba4612..faf43ae797 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -114,10 +114,11 @@ run installHandlers maybeRunWithSocket appState = do when configDbChannelEnabled $ listener appState let app = postgrest configLogLevel appState (connectionWorker appState) + adminApp = postgrestAdmin appState configDbChannelEnabled whenJust configAdminServerPort $ \adminPort -> do AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort - void . forkIO $ Warp.runSettings (serverSettings conf & setPort adminPort) $ adminApp appState configDbChannelEnabled + void . forkIO $ Warp.runSettings (serverSettings conf & setPort adminPort) adminApp case configServerUnixSocket of Just socket -> @@ -143,18 +144,17 @@ serverSettings AppConfig{..} = & setPort configServerPort & setServerName ("postgrest/" <> prettyVersion) -adminApp :: AppState.AppState -> Bool -> Wai.Application -adminApp appState configDbChannelEnabled req respond = +-- | PostgREST admin application +postgrestAdmin :: AppState.AppState -> Bool -> Wai.Application +postgrestAdmin appState configDbChannelEnabled req respond = case Wai.pathInfo req of - [] -> + ["health"] -> if configDbChannelEnabled then do listenerOn <- AppState.getIsListenerOn appState respond $ Wai.responseLBS (if listenerOn then HTTP.status200 else HTTP.status503) [] mempty else do result <- SQL.use (AppState.getPool appState) $ SQL.sql "SELECT 1" - case result of - Right _ -> respond $ Wai.responseLBS HTTP.status200 [] mempty - Left _ -> respond $ Wai.responseLBS HTTP.status503 [] mempty + respond $ Wai.responseLBS (if isRight result then HTTP.status200 else HTTP.status503) [] mempty _ -> respond $ Wai.responseLBS HTTP.status404 [] mempty -- | PostgREST application From 6e1892e000ce6af48aef5242c00fa3fb959d7bef Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Tue, 21 Dec 2021 21:31:09 -0500 Subject: [PATCH 7/7] Add tests and CHANGELOG --- CHANGELOG.md | 3 +++ test/io-tests/test_io.py | 41 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 44 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index ed9c6f07c5..7faa5ec958 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,9 @@ This project adheres to [Semantic Versioning](http://semver.org/). ### Added + - #1933, Add a minimal health check endpoint on an admin port at the `:/health` endpoint - @steve-chavez + + For enabling this, the `admin-server-port` config must be set explictly + ### Fixed - #2020, Execute deferred constraint triggers when using `Prefer: tx=rollback` - @wolfgangwalther diff --git a/test/io-tests/test_io.py b/test/io-tests/test_io.py index 94ff66a9de..50d6cd839f 100644 --- a/test/io-tests/test_io.py +++ b/test/io-tests/test_io.py @@ -729,3 +729,44 @@ def test_db_prepared_statements_disable(defaultenv): with run(env=env) as postgrest: response = postgrest.session.post("/rpc/uses_prepared_statements") assert response.text == "false" + + +def test_admin_healthy_w_channel(defaultenv): + "Should get a success response from the admin server health endpoint when the LISTEN channel is enabled" + + env = { + **defaultenv, + "PGRST_ADMIN_SERVER_PORT": "3001", + "PGRST_DB_CHANNEL_ENABLED": "true", + } + + with run(env=env) as postgrest: + response = requests.get(f"http://localhost:{env['PGRST_ADMIN_SERVER_PORT']}/health") + assert response.status_code == 200 + + +def test_admin_healthy_wo_channel(defaultenv): + "Should get a success response from the admin server health endpoint when the LISTEN channel is disabled" + + env = { + **defaultenv, + "PGRST_ADMIN_SERVER_PORT": "3001", + "PGRST_DB_CHANNEL_ENABLED": "false", + } + + with run(env=env) as postgrest: + response = requests.get(f"http://localhost:{env['PGRST_ADMIN_SERVER_PORT']}/health") + assert response.status_code == 200 + + +def test_admin_not_found(defaultenv): + "Should get a not found from the admin server" + + env = { + **defaultenv, + "PGRST_ADMIN_SERVER_PORT": "3001", + } + + with run(env=env) as postgrest: + response = requests.get(f"http://localhost:{env['PGRST_ADMIN_SERVER_PORT']}/notfound") + assert response.status_code == 404