From c110269932ebcaa8edef74ab78391d820f9476a0 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Mon, 20 Dec 2021 21:19:53 -0500 Subject: [PATCH] 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