diff --git a/ARCHITECTURE.md b/ARCHITECTURE.md new file mode 100644 index 000000000..28afe1cbe --- /dev/null +++ b/ARCHITECTURE.md @@ -0,0 +1,70 @@ +# Architecture + +This document describes the high-level architecture of PostgREST. + +## Bird's Eye View + +```haskell +postgrest :: Request -> Either Error SQLStatement -> Response +``` + +On the highest level, PostgREST processes an HTTP request, if it's accepted it builds a SQL statement for it, executes it, and produces a response. + +## Code Map + +This section talks briefly about various important modules. + +The starting point of the program is `main/Main.hs`, which calls `src/PostgREST/CLI.hs` which then calls `src/PostgREST/App.hs`. + +`App.hs` is then in charge of composing the different modules. + +### ApiRequest.hs + +PostgREST operates over two types of resources: database relations(tables or views) and database functions; providing different representations(depending on the media type) +for them. + +This module is in charge of representing the operation over an `ApiRequest` type. It parses the URL querystring following PostgREST syntax, the request headers, and the request body +(if possible it avoids parsing the body and sends it directly to the db). + +A request might be rejected at this level if it's invalid, e.g. providing an unknown media type to PostgREST or using an unknown HTTP method. + +### Plan.hs + +Using the Schema Cache, this module enables more complex functionality(like resource embedding) by enriching the ApiRequest. It generates Plan types(`ReadPlan`, `MutatePlan`) +that then will be used to generate a SQL statement. + +A request might be rejected at this level if it's invalid, e.g. by doing resource embedding on a nonexistent resource. + +An OPTIONS request doesn't require a plan to be generated. + +### Query.hs + +This module constructs single SQL statements that can be parametrized and prepared. Only at this stage a PostgreSQL connection from the pool is used. + +A query might fail(and be rollbacked) at this level if it doesn't comply to certain conditions, e.g. by not returning a single row when a ``Accept: application/vnd.pgrst.object`` header is specified. + +An OPTIONS request doesn't require a query to be executed. + +### Response.hs + +This module constructs the HTTP response body with the right headers. + +It builds the OpenAPI response using the schema cache. + +### Auth.hs + +This module provides functions to deal with JWT authorization. + +### Workers.hs + +This spawns threads which are used to execute concurrent jobs. + +Jobs include connection recovery, a listener for the PostgreSQL LISTEN command, and an admin server. + +### SchemaCache.hs + +This queries the PostgreSQL system catalogs and caches the metadata into a SchemaCache type, + +### AppState.hs + +The state of the App which is kept across requests. diff --git a/nix/tools/tests.nix b/nix/tools/tests.nix index 8976ea8b7..14ebc9739 100644 --- a/nix/tools/tests.nix +++ b/nix/tools/tests.nix @@ -105,7 +105,7 @@ let checkedShellScript { name = "postgrest-dump-schema"; - docs = "Dump the loaded schema's DbStructure as a yaml file."; + docs = "Dump the loaded schema's SchemaCache as a yaml file."; inRootDir = true; withEnv = postgrest.env; withPath = [ jq ]; diff --git a/postgrest.cabal b/postgrest.cabal index 545ce1685..6761edfed 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -35,7 +35,6 @@ library NoImplicitPrelude hs-source-dirs: src exposed-modules: PostgREST.App - PostgREST.Admin PostgREST.AppState PostgREST.Auth PostgREST.CLI @@ -45,13 +44,12 @@ library PostgREST.Config.PgVersion PostgREST.Config.Proxy PostgREST.Cors - PostgREST.DbStructure - PostgREST.DbStructure.Identifiers - PostgREST.DbStructure.Proc - PostgREST.DbStructure.Relationship - PostgREST.DbStructure.Table + PostgREST.SchemaCache + PostgREST.SchemaCache.Identifiers + PostgREST.SchemaCache.Proc + PostgREST.SchemaCache.Relationship + PostgREST.SchemaCache.Table PostgREST.Error - PostgREST.GucHeader PostgREST.Logger PostgREST.MediaType PostgREST.Query @@ -63,12 +61,13 @@ library PostgREST.Plan.MutatePlan PostgREST.Plan.ReadPlan PostgREST.RangeQuery - PostgREST.Request.ApiRequest - PostgREST.Request.Preferences - PostgREST.Request.QueryParams - PostgREST.Request.Types + PostgREST.ApiRequest + PostgREST.ApiRequest.Preferences + PostgREST.ApiRequest.QueryParams + PostgREST.ApiRequest.Types PostgREST.Response PostgREST.Response.OpenAPI + PostgREST.Response.GucHeader PostgREST.Version PostgREST.Workers other-modules: Paths_postgrest diff --git a/src/PostgREST/Admin.hs b/src/PostgREST/Admin.hs deleted file mode 100644 index 3183c28c3..000000000 --- a/src/PostgREST/Admin.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} -module PostgREST.Admin - ( postgrestAdmin - ) where - -import qualified Data.Text as T - -import Network.Socket -import Network.Socket.ByteString - -import qualified Network.HTTP.Types.Status as HTTP -import qualified Network.Wai as Wai - -import qualified Hasql.Session as SQL - -import qualified PostgREST.AppState as AppState -import PostgREST.Config (AppConfig (..)) - -import Protolude - --- | PostgREST admin application -postgrestAdmin :: AppState.AppState -> AppConfig -> Wai.Application -postgrestAdmin appState appConfig req respond = do - isMainAppReachable <- any isRight <$> reachMainApp appConfig - isSchemaCacheLoaded <- isJust <$> AppState.getDbStructure appState - isConnectionUp <- - if configDbChannelEnabled appConfig - then AppState.getIsListenerOn appState - else isRight <$> AppState.usePool appState (SQL.sql "SELECT 1") - - case Wai.pathInfo req of - ["ready"] -> - respond $ Wai.responseLBS (if isMainAppReachable && isConnectionUp && isSchemaCacheLoaded then HTTP.status200 else HTTP.status503) [] mempty - ["live"] -> - respond $ Wai.responseLBS (if isMainAppReachable then HTTP.status200 else HTTP.status503) [] mempty - _ -> - respond $ Wai.responseLBS HTTP.status404 [] mempty - --- Try to connect to the main app socket --- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections --- The code for resolving the "*4", "!4", "*6", "!6", "*" special values is taken from --- https://hackage.haskell.org/package/streaming-commons-0.2.2.4/docs/src/Data.Streaming.Network.html#bindPortGenEx -reachMainApp :: AppConfig -> IO [Either IOException ()] -reachMainApp AppConfig{..} = - case configServerUnixSocket of - Just path -> do - sock <- socket AF_UNIX Stream 0 - (:[]) <$> try (do - connect sock $ SockAddrUnix path - withSocketsDo $ bracket (pure sock) close sendEmpty) - Nothing -> do - let - host | configServerHost `elem` ["*4", "!4", "*6", "!6", "*"] = Nothing - | otherwise = Just configServerHost - filterAddrs xs = - case configServerHost of - "*4" -> ipv4Addrs xs ++ ipv6Addrs xs - "!4" -> ipv4Addrs xs - "*6" -> ipv6Addrs xs ++ ipv4Addrs xs - "!6" -> ipv6Addrs xs - _ -> xs - ipv4Addrs = filter ((/=) AF_INET6 . addrFamily) - ipv6Addrs = filter ((==) AF_INET6 . addrFamily) - - addrs <- getAddrInfo (Just $ defaultHints { addrSocketType = Stream }) (T.unpack <$> host) (Just . show $ configServerPort) - tryAddr `traverse` filterAddrs addrs - where - sendEmpty sock = void $ send sock mempty - tryAddr :: AddrInfo -> IO (Either IOException ()) - tryAddr addr = do - sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) - try $ do - connect sock $ addrAddress addr - withSocketsDo $ bracket (pure sock) close sendEmpty diff --git a/src/PostgREST/Request/ApiRequest.hs b/src/PostgREST/ApiRequest.hs similarity index 95% rename from src/PostgREST/Request/ApiRequest.hs rename to src/PostgREST/ApiRequest.hs index e5dae1b0e..b2c79343f 100644 --- a/src/PostgREST/Request/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -6,7 +6,7 @@ Description : PostgREST functions to translate HTTP request to a domain type cal {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} -module PostgREST.Request.ApiRequest +module PostgREST.ApiRequest ( ApiRequest(..) , InvokeMethod(..) , Mutation(..) @@ -44,15 +44,16 @@ import Network.Wai (Request (..)) import Network.Wai.Parse (parseHttpAccept) import Web.Cookie (parseCookies) +import PostgREST.ApiRequest.Preferences (PreferCount (..), + PreferParameters (..), + PreferRepresentation (..), + PreferResolution (..), + PreferTransaction (..)) +import PostgREST.ApiRequest.QueryParams (QueryParams (..)) +import PostgREST.ApiRequest.Types (ApiRequestError (..), + RangeError (..), SelectItem) import PostgREST.Config (AppConfig (..), OpenAPIMode (..)) -import PostgREST.DbStructure (DbStructure (..)) -import PostgREST.DbStructure.Identifiers (FieldName, - QualifiedIdentifier (..), - Schema) -import PostgREST.DbStructure.Proc (ProcDescription (..), - ProcParam (..), ProcsMap, - procReturnsScalar) import PostgREST.MediaType (MTPlanAttrs (..), MTPlanFormat (..), MediaType (..)) @@ -60,18 +61,17 @@ import PostgREST.RangeQuery (NonnegRange, allRange, hasLimitZero, limitZeroRange, rangeRequested) -import PostgREST.Request.Preferences (PreferCount (..), - PreferParameters (..), - PreferRepresentation (..), - PreferResolution (..), - PreferTransaction (..)) -import PostgREST.Request.QueryParams (QueryParams (..)) -import PostgREST.Request.Types (ApiRequestError (..), - RangeError (..), SelectItem) +import PostgREST.SchemaCache (SchemaCache (..)) +import PostgREST.SchemaCache.Identifiers (FieldName, + QualifiedIdentifier (..), + Schema) +import PostgREST.SchemaCache.Proc (ProcDescription (..), + ProcParam (..), ProcsMap, + procReturnsScalar) -import qualified PostgREST.MediaType as MediaType -import qualified PostgREST.Request.Preferences as Preferences -import qualified PostgREST.Request.QueryParams as QueryParams +import qualified PostgREST.ApiRequest.Preferences as Preferences +import qualified PostgREST.ApiRequest.QueryParams as QueryParams +import qualified PostgREST.MediaType as MediaType import Protolude @@ -179,14 +179,14 @@ data ApiRequest = ApiRequest { } -- | Examines HTTP request and translates it into user intent. -userApiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest -userApiRequest conf dbStructure req reqBody = do +userApiRequest :: AppConfig -> SchemaCache -> Request -> RequestBody -> Either ApiRequestError ApiRequest +userApiRequest conf sCache req reqBody = do qPrms <- first QueryParamError $ QueryParams.parse $ rawQueryString req pInfo <- getPathInfo conf $ pathInfo req act <- getAction pInfo $ requestMethod req mediaTypes <- getMediaTypes conf (requestHeaders req) act pInfo negotiatedSchema <- getSchema conf (requestHeaders req) (requestMethod req) - apiRequest conf dbStructure req reqBody qPrms pInfo act mediaTypes negotiatedSchema + apiRequest conf sCache req reqBody qPrms pInfo act mediaTypes negotiatedSchema getPathInfo :: AppConfig -> [Text] -> Either ApiRequestError PathInfo getPathInfo AppConfig{configOpenApiMode, configDbRootSpec} path = @@ -248,8 +248,8 @@ getSchema AppConfig{configDbSchemas} hdrs method = do acceptProfile = T.decodeUtf8 <$> lookupHeader "Accept-Profile" lookupHeader = flip lookup hdrs -apiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action -> (MediaType, MediaType) -> (Schema, Bool) -> Either ApiRequestError ApiRequest -apiRequest conf dbStructure req reqBody queryparams@QueryParams{..} PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action (acceptMediaType, contentMediaType) (schema, negotiatedByProfile) +apiRequest :: AppConfig -> SchemaCache -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action -> (MediaType, MediaType) -> (Schema, Bool) -> Either ApiRequestError ApiRequest +apiRequest conf sCache req reqBody queryparams@QueryParams{..} PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action (acceptMediaType, contentMediaType) (schema, negotiatedByProfile) | isInvalidRange = Left $ InvalidRange (if rangeIsEmpty headerRange then LowerGTUpper else NegativeLimit) | shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload | not expectParams && not (L.null qsParams) = Left $ ParseRequestError "Unexpected param or filter missing operator" ("Failed to parse " <> show qsParams) @@ -325,7 +325,7 @@ apiRequest conf dbStructure req reqBody queryparams@QueryParams{..} PathInfo{pat | otherwise = Right $ TargetIdent $ QualifiedIdentifier schema pathName where callFindProc procSch procNam = findProc - (QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs dbStructure) + (QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs sCache) contentMediaType (action == ActionInvoke InvPost) shouldParsePayload = case (action, contentMediaType) of diff --git a/src/PostgREST/Request/Preferences.hs b/src/PostgREST/ApiRequest/Preferences.hs similarity index 98% rename from src/PostgREST/Request/Preferences.hs rename to src/PostgREST/ApiRequest/Preferences.hs index 4b067b063..8d208c1b8 100644 --- a/src/PostgREST/Request/Preferences.hs +++ b/src/PostgREST/ApiRequest/Preferences.hs @@ -1,12 +1,12 @@ -- | --- Module: PostgREST.Request.Preferences +-- Module: PostgREST.ApiRequest.Preferences -- Description: Track client preferences to be employed when processing requests -- -- Track client prefences set in HTTP 'Prefer' headers according to RFC7240[1]. -- -- [1] https://datatracker.ietf.org/doc/html/rfc7240 -- -module PostgREST.Request.Preferences +module PostgREST.ApiRequest.Preferences ( Preferences(..) , PreferCount(..) , PreferParameters(..) diff --git a/src/PostgREST/Request/QueryParams.hs b/src/PostgREST/ApiRequest/QueryParams.hs similarity index 95% rename from src/PostgREST/Request/QueryParams.hs rename to src/PostgREST/ApiRequest/QueryParams.hs index 41ab59a0e..fb13ae1bd 100644 --- a/src/PostgREST/Request/QueryParams.hs +++ b/src/PostgREST/ApiRequest/QueryParams.hs @@ -1,12 +1,12 @@ -- | --- Module : PostgREST.Request.QueryParams +-- Module : PostgREST.ApiRequest.QueryParams -- Description : Parser for PostgREST Query parameters -- -- This module is in charge of parsing all the querystring values in an url, e.g. -- the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`. {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} -module PostgREST.Request.QueryParams +module PostgREST.ApiRequest.QueryParams ( parse , QueryParams(..) , pRequestRange @@ -39,21 +39,23 @@ import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser, optionMaybe, sepBy1, string, try, ()) -import PostgREST.DbStructure.Identifiers (FieldName) import PostgREST.RangeQuery (NonnegRange, allRange, rangeGeq, rangeLimit, rangeOffset, restrictRange) +import PostgREST.SchemaCache.Identifiers (FieldName) -import PostgREST.Request.Types (EmbedParam (..), EmbedPath, Field, - Filter (..), FtsOperator (..), - JoinType (..), JsonOperand (..), - JsonOperation (..), JsonPath, ListVal, - LogicOperator (..), LogicTree (..), - OpExpr (..), Operation (..), - OrderDirection (..), OrderNulls (..), - OrderTerm (..), QPError (..), - SelectItem, SimpleOperator (..), - SingleVal, TrileanVal (..)) +import PostgREST.ApiRequest.Types (EmbedParam (..), EmbedPath, Field, + Filter (..), FtsOperator (..), + JoinType (..), JsonOperand (..), + JsonOperation (..), JsonPath, + ListVal, LogicOperator (..), + LogicTree (..), OpExpr (..), + Operation (..), + OrderDirection (..), + OrderNulls (..), OrderTerm (..), + QPError (..), SelectItem, + SimpleOperator (..), SingleVal, + TrileanVal (..)) import Protolude hiding (try) diff --git a/src/PostgREST/Request/Types.hs b/src/PostgREST/ApiRequest/Types.hs similarity index 95% rename from src/PostgREST/Request/Types.hs rename to src/PostgREST/ApiRequest/Types.hs index f0f179e60..5d561ac1d 100644 --- a/src/PostgREST/Request/Types.hs +++ b/src/PostgREST/ApiRequest/Types.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} -module PostgREST.Request.Types +module PostgREST.ApiRequest.Types ( Alias , Cast , Depth @@ -32,11 +32,11 @@ module PostgREST.Request.Types , SelectItem ) where -import PostgREST.DbStructure.Identifiers (FieldName, - QualifiedIdentifier) -import PostgREST.DbStructure.Proc (ProcDescription (..)) -import PostgREST.DbStructure.Relationship (Relationship) import PostgREST.MediaType (MediaType (..)) +import PostgREST.SchemaCache.Identifiers (FieldName, + QualifiedIdentifier) +import PostgREST.SchemaCache.Proc (ProcDescription (..)) +import PostgREST.SchemaCache.Relationship (Relationship) import Protolude diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 1861ee3b2..f16c9ba64 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -30,29 +30,28 @@ import qualified Hasql.Transaction.Sessions as SQL import qualified Network.Wai as Wai import qualified Network.Wai.Handler.Warp as Warp -import qualified PostgREST.Admin as Admin -import qualified PostgREST.AppState as AppState -import qualified PostgREST.Auth as Auth -import qualified PostgREST.Cors as Cors -import qualified PostgREST.Error as Error -import qualified PostgREST.Logger as Logger -import qualified PostgREST.Plan as Plan -import qualified PostgREST.Query as Query -import qualified PostgREST.Request.ApiRequest as ApiRequest -import qualified PostgREST.Request.Types as ApiRequestTypes -import qualified PostgREST.Response as Response +import qualified PostgREST.ApiRequest as ApiRequest +import qualified PostgREST.ApiRequest.Types as ApiRequestTypes +import qualified PostgREST.AppState as AppState +import qualified PostgREST.Auth as Auth +import qualified PostgREST.Cors as Cors +import qualified PostgREST.Error as Error +import qualified PostgREST.Logger as Logger +import qualified PostgREST.Plan as Plan +import qualified PostgREST.Query as Query +import qualified PostgREST.Response as Response +import qualified PostgREST.Workers as Workers -import PostgREST.AppState (AppState) -import PostgREST.Auth (AuthResult (..)) -import PostgREST.Config (AppConfig (..), LogLevel (..)) -import PostgREST.Config.PgVersion (PgVersion (..)) -import PostgREST.DbStructure (DbStructure (..)) -import PostgREST.Error (Error) -import PostgREST.Query (DbHandler) -import PostgREST.Request.ApiRequest (Action (..), ApiRequest (..), - Mutation (..), Target (..)) -import PostgREST.Version (prettyVersion) -import PostgREST.Workers (connectionWorker, listener) +import PostgREST.ApiRequest (Action (..), ApiRequest (..), + Mutation (..), Target (..)) +import PostgREST.AppState (AppState) +import PostgREST.Auth (AuthResult (..)) +import PostgREST.Config (AppConfig (..), LogLevel (..)) +import PostgREST.Config.PgVersion (PgVersion (..)) +import PostgREST.Error (Error) +import PostgREST.Query (DbHandler) +import PostgREST.SchemaCache (SchemaCache (..)) +import PostgREST.Version (prettyVersion) import Protolude hiding (Handler) @@ -65,17 +64,14 @@ type SocketRunner = Warp.Settings -> Wai.Application -> FileMode -> FilePath -> run :: SignalHandlerInstaller -> Maybe SocketRunner -> AppState -> IO () run installHandlers maybeRunWithSocket appState = do conf@AppConfig{..} <- AppState.getConfig appState - connectionWorker appState -- Loads the initial DbStructure + Workers.connectionWorker appState -- Loads the initial SchemaCache installHandlers appState -- reload schema cache + config on NOTIFY - when configDbChannelEnabled $ listener appState + Workers.runListener conf appState - let app = postgrest configLogLevel appState (connectionWorker appState) - adminApp = Admin.postgrestAdmin appState conf + Workers.runAdmin conf appState $ serverSettings conf - whenJust configAdminServerPort $ \adminPort -> do - AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort - void . forkIO $ Warp.runSettings (serverSettings conf & setPort adminPort) adminApp + let app = postgrest configLogLevel appState (Workers.connectionWorker appState) case configServerUnixSocket of Just socket -> @@ -90,9 +86,6 @@ 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{..} = @@ -113,14 +106,14 @@ postgrest logLevel appState connWorker = Left err -> respond $ Error.errorResponseFor err Right authResult -> do conf <- AppState.getConfig appState - maybeDbStructure <- AppState.getDbStructure appState + maybeSchemaCache <- AppState.getSchemaCache appState pgVer <- AppState.getPgVersion appState jsonDbS <- AppState.getJsonDbS appState let eitherResponse :: IO (Either Error Wai.Response) eitherResponse = - runExceptT $ postgrestResponse appState conf maybeDbStructure jsonDbS pgVer authResult req + runExceptT $ postgrestResponse appState conf maybeSchemaCache jsonDbS pgVer authResult req response <- either Error.errorResponseFor identity <$> eitherResponse -- Launch the connWorker when the connection is down. The postgrest @@ -135,17 +128,17 @@ postgrest logLevel appState connWorker = postgrestResponse :: AppState.AppState -> AppConfig - -> Maybe DbStructure + -> Maybe SchemaCache -> ByteString -> PgVersion -> AuthResult -> Wai.Request -> Handler IO Wai.Response -postgrestResponse appState conf@AppConfig{..} maybeDbStructure jsonDbS pgVer authResult@AuthResult{..} req = do - dbStructure <- - case maybeDbStructure of - Just dbStructure -> - return dbStructure +postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jsonDbS pgVer authResult@AuthResult{..} req = do + sCache <- + case maybeSchemaCache of + Just sCache -> + return sCache Nothing -> throwError Error.NoSchemaCacheError @@ -153,10 +146,10 @@ postgrestResponse appState conf@AppConfig{..} maybeDbStructure jsonDbS pgVer aut apiRequest <- liftEither . mapLeft Error.ApiRequestError $ - ApiRequest.userApiRequest conf dbStructure req body + ApiRequest.userApiRequest conf sCache req body Response.optionalRollback conf apiRequest $ - handleRequest authResult conf appState (Query.txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements jsonDbS pgVer apiRequest dbStructure + handleRequest authResult conf appState (Query.txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements jsonDbS pgVer apiRequest sCache runDbHandler :: AppState.AppState -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b runDbHandler appState mode authenticated prepared handler = do @@ -170,45 +163,45 @@ runDbHandler appState mode authenticated prepared handler = do liftEither resp -handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> SQL.Mode -> Bool -> Bool -> ByteString -> PgVersion -> ApiRequest -> DbStructure -> Handler IO Wai.Response -handleRequest AuthResult{..} conf appState mode authenticated prepared jsonDbS pgVer apiReq@ApiRequest{..} dbStructure = +handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> SQL.Mode -> Bool -> Bool -> ByteString -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response +handleRequest AuthResult{..} conf appState mode authenticated prepared jsonDbS pgVer apiReq@ApiRequest{..} sCache = case (iAction, iTarget) of (ActionRead headersOnly, TargetIdent identifier) -> do - rPlan <- liftEither $ Plan.readPlan identifier conf dbStructure apiReq + rPlan <- liftEither $ Plan.readPlan identifier conf sCache apiReq resultSet <- runQuery $ Query.readQuery rPlan conf apiReq return $ Response.readResponse headersOnly identifier apiReq resultSet (ActionMutate MutationCreate, TargetIdent identifier) -> do - mrPlan <- liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf dbStructure + mrPlan <- liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache resultSet <- runQuery $ Query.createQuery mrPlan apiReq conf return $ Response.createResponse identifier mrPlan apiReq resultSet (ActionMutate MutationUpdate, TargetIdent identifier) -> do - mrPlan <- liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf dbStructure + mrPlan <- liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache resultSet <- runQuery $ Query.updateQuery mrPlan apiReq conf return $ Response.updateResponse apiReq resultSet (ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do - mrPlan <- liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf dbStructure + mrPlan <- liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache resultSet <- runQuery $ Query.singleUpsertQuery mrPlan apiReq conf return $ Response.singleUpsertResponse apiReq resultSet (ActionMutate MutationDelete, TargetIdent identifier) -> do - mrPlan <- liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf dbStructure + mrPlan <- liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache resultSet <- runQuery $ Query.deleteQuery mrPlan apiReq conf return $ Response.deleteResponse apiReq resultSet (ActionInvoke invMethod, TargetProc proc _) -> do - cPlan <- liftEither $ Plan.callReadPlan proc conf dbStructure apiReq + cPlan <- liftEither $ Plan.callReadPlan proc conf sCache apiReq resultSet <- runQuery $ Query.invokeQuery proc cPlan apiReq conf return $ Response.invokeResponse invMethod proc apiReq resultSet (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do - oaiResult <- runQuery $ Query.openApiQuery dbStructure pgVer conf tSchema - return $ Response.openApiResponse headersOnly oaiResult conf dbStructure iSchema iNegotiatedByProfile + oaiResult <- runQuery $ Query.openApiQuery sCache pgVer conf tSchema + return $ Response.openApiResponse headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile (ActionInfo, _) -> - return $ Response.infoResponse iTarget dbStructure + return $ Response.infoResponse iTarget sCache _ -> -- This is unreachable as the ApiRequest.hs rejects it before diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index 5e00aa89a..5cf392464 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -5,7 +5,7 @@ module PostgREST.AppState , destroy , flushPool , getConfig - , getDbStructure + , getSchemaCache , getIsListenerOn , getJsonDbS , getMainThreadId @@ -17,7 +17,7 @@ module PostgREST.AppState , initWithPool , logWithZTime , putConfig - , putDbStructure + , putSchemaCache , putIsListenerOn , putJsonDbS , putPgVersion @@ -40,7 +40,7 @@ import Data.Time.Clock (UTCTime, getCurrentTime) import PostgREST.Config (AppConfig (..)) import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion) -import PostgREST.DbStructure (DbStructure) +import PostgREST.SchemaCache (SchemaCache) import Protolude @@ -51,8 +51,8 @@ data AppState = AppState -- | Database server version, will be updated by the connectionWorker , statePgVersion :: IORef PgVersion -- | No schema cache at the start. Will be filled in by the connectionWorker - , stateDbStructure :: IORef (Maybe DbStructure) - -- | Cached DbStructure in json + , stateSchemaCache :: IORef (Maybe SchemaCache) + -- | Cached SchemaCache in json , stateJsonDbS :: IORef ByteString -- | Binary semaphore to make sure just one connectionWorker can run at a time , stateWorkerSem :: MVar () @@ -121,11 +121,11 @@ getPgVersion = readIORef . statePgVersion putPgVersion :: AppState -> PgVersion -> IO () putPgVersion = atomicWriteIORef . statePgVersion -getDbStructure :: AppState -> IO (Maybe DbStructure) -getDbStructure = readIORef . stateDbStructure +getSchemaCache :: AppState -> IO (Maybe SchemaCache) +getSchemaCache = readIORef . stateSchemaCache -putDbStructure :: AppState -> Maybe DbStructure -> IO () -putDbStructure appState = atomicWriteIORef (stateDbStructure appState) +putSchemaCache :: AppState -> Maybe SchemaCache -> IO () +putSchemaCache appState = atomicWriteIORef (stateSchemaCache appState) getJsonDbS :: AppState -> IO ByteString getJsonDbS = readIORef . stateJsonDbS diff --git a/src/PostgREST/CLI.hs b/src/PostgREST/CLI.hs index fcb804e45..b447fb6fb 100644 --- a/src/PostgREST/CLI.hs +++ b/src/PostgREST/CLI.hs @@ -19,7 +19,7 @@ import Text.Heredoc (str) import PostgREST.AppState (AppState) import PostgREST.Config (AppConfig (..)) -import PostgREST.DbStructure (queryDbStructure) +import PostgREST.SchemaCache (querySchemaCache) import PostgREST.Version (prettyVersion) import PostgREST.Workers (reReadConfig) @@ -48,7 +48,7 @@ main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do CmdDumpSchema -> putStrLn =<< dumpSchema appState CmdRun -> App.run installSignalHandlers runAppWithSocket appState) --- | Dump DbStructure schema to JSON +-- | Dump SchemaCache schema to JSON dumpSchema :: AppState -> IO LBS.ByteString dumpSchema appState = do AppConfig{..} <- AppState.getConfig appState @@ -56,7 +56,7 @@ dumpSchema appState = do let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in AppState.usePool appState $ transaction SQL.ReadCommitted SQL.Read $ - queryDbStructure + querySchemaCache (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements @@ -64,7 +64,7 @@ dumpSchema appState = do Left e -> do hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e exitFailure - Right dbStructure -> return $ JSON.encode dbStructure + Right sCache -> return $ JSON.encode sCache -- | Command line interface options data CLI = CLI diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index d2ddb0689..81a117e35 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -54,9 +54,9 @@ import PostgREST.Config.JSPath (JSPath, JSPathExp (..), dumpJSPath, pRoleClaimKey) import PostgREST.Config.Proxy (Proxy (..), isMalformedProxyUri, toURI) -import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi, - toQi) import PostgREST.MediaType (MediaType (..), toMime) +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier, dumpQi, + toQi) import Protolude hiding (Proxy, toList) diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 17a247f3f..14e1cb87e 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -29,16 +29,16 @@ import Network.Wai (Response, responseLBS) import Network.HTTP.Types.Header (Header) -import PostgREST.MediaType (MediaType (..)) -import qualified PostgREST.MediaType as MediaType -import PostgREST.Request.Types (ApiRequestError (..), - QPError (..), - RangeError (..)) +import PostgREST.ApiRequest.Types (ApiRequestError (..), + QPError (..), + RangeError (..)) +import PostgREST.MediaType (MediaType (..)) +import qualified PostgREST.MediaType as MediaType -import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..)) -import PostgREST.DbStructure.Proc (ProcDescription (..), +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..)) +import PostgREST.SchemaCache.Proc (ProcDescription (..), ProcParam (..)) -import PostgREST.DbStructure.Relationship (Cardinality (..), +import PostgREST.SchemaCache.Relationship (Cardinality (..), Junction (..), Relationship (..)) import Protolude diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index b05a903d3..a03963081 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -25,43 +25,43 @@ module PostgREST.Plan import qualified Data.HashMap.Strict as HM import qualified Data.Set as S -import qualified PostgREST.DbStructure.Proc as Proc +import qualified PostgREST.SchemaCache.Proc as Proc import Data.Either.Combinators (mapLeft) import Data.List (delete) import Data.Tree (Tree (..)) -import PostgREST.Config (AppConfig (..)) -import PostgREST.DbStructure (DbStructure (..)) -import PostgREST.DbStructure.Identifiers (FieldName, - QualifiedIdentifier (..), - Schema) -import PostgREST.DbStructure.Proc (ProcDescription (..), - ProcParam (..), - procReturnsScalar) -import PostgREST.DbStructure.Relationship (Cardinality (..), - Junction (..), - Relationship (..), - RelationshipsMap) -import PostgREST.DbStructure.Table (tablePKCols) -import PostgREST.Error (Error (..)) -import PostgREST.Query.SqlFragment (sourceCTEName) -import PostgREST.RangeQuery (NonnegRange, allRange, - restrictRange) -import PostgREST.Request.ApiRequest (Action (..), +import PostgREST.ApiRequest (Action (..), ApiRequest (..), InvokeMethod (..), Mutation (..), Payload (..)) +import PostgREST.Config (AppConfig (..)) +import PostgREST.Error (Error (..)) +import PostgREST.Query.SqlFragment (sourceCTEName) +import PostgREST.RangeQuery (NonnegRange, allRange, + restrictRange) +import PostgREST.SchemaCache (SchemaCache (..)) +import PostgREST.SchemaCache.Identifiers (FieldName, + QualifiedIdentifier (..), + Schema) +import PostgREST.SchemaCache.Proc (ProcDescription (..), + ProcParam (..), + procReturnsScalar) +import PostgREST.SchemaCache.Relationship (Cardinality (..), + Junction (..), + Relationship (..), + RelationshipsMap) +import PostgREST.SchemaCache.Table (tablePKCols) import PostgREST.Plan.CallPlan import PostgREST.Plan.MutatePlan import PostgREST.Plan.ReadPlan as ReadPlan -import PostgREST.Request.Preferences -import PostgREST.Request.Types +import PostgREST.ApiRequest.Preferences +import PostgREST.ApiRequest.Types -import qualified PostgREST.Request.QueryParams as QueryParams +import qualified PostgREST.ApiRequest.QueryParams as QueryParams import Protolude hiding (from) @@ -75,24 +75,24 @@ data CallReadPlan = CallReadPlan { , crCallPlan :: CallPlan } -mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> DbStructure -> Either Error MutateReadPlan -mutateReadPlan mutation apiRequest identifier conf dbStructure = do - rPlan <- readPlan identifier conf dbStructure apiRequest - mPlan <- mutatePlan mutation identifier apiRequest dbStructure rPlan +mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error MutateReadPlan +mutateReadPlan mutation apiRequest identifier conf sCache = do + rPlan <- readPlan identifier conf sCache apiRequest + mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan return $ MutateReadPlan rPlan mPlan -callReadPlan :: ProcDescription -> AppConfig -> DbStructure -> ApiRequest -> Either Error CallReadPlan -callReadPlan proc conf dbStructure apiRequest = do +callReadPlan :: ProcDescription -> AppConfig -> SchemaCache -> ApiRequest -> Either Error CallReadPlan +callReadPlan proc conf sCache apiRequest = do let identifier = QualifiedIdentifier (pdSchema proc) (fromMaybe (pdName proc) $ Proc.procTableName proc) - rPlan <- readPlan identifier conf dbStructure apiRequest + rPlan <- readPlan identifier conf sCache apiRequest let cPlan = callPlan proc apiRequest rPlan return $ CallReadPlan rPlan cPlan -- | Builds the ReadPlan tree on a number of stages. -- | Adds filters, order, limits on its respective nodes. -- | Adds joins conditions obtained from resource embedding. -readPlan :: QualifiedIdentifier -> AppConfig -> DbStructure -> ApiRequest -> Either Error ReadPlanTree -readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows} DbStructure{dbRelationships} apiRequest = +readPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error ReadPlanTree +readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows} SchemaCache{dbRelationships} apiRequest = mapLeft ApiRequestError $ treeRestrictRange configDbMaxRows (iAction apiRequest) =<< augmentRequestWithJoin qiSchema dbRelationships =<< @@ -335,8 +335,8 @@ updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) = findNode :: Maybe ReadPlanTree findNode = find (\(Node ReadPlan{nodeName, nodeAlias} _) -> nodeName == targetNodeName || nodeAlias == Just targetNodeName) forest -mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> DbStructure -> ReadPlanTree -> Either Error MutatePlan -mutatePlan mutation qi ApiRequest{..} dbStructure readReq = mapLeft ApiRequestError $ +mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> SchemaCache -> ReadPlanTree -> Either Error MutatePlan +mutatePlan mutation qi ApiRequest{..} sCache readReq = mapLeft ApiRequestError $ case mutation of MutationCreate -> Right $ Insert qi iColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings pkCols @@ -359,7 +359,7 @@ mutatePlan mutation qi ApiRequest{..} dbStructure readReq = mapLeft ApiRequestEr if iPreferRepresentation == None then [] else returningCols readReq pkCols - pkCols = maybe mempty tablePKCols $ HM.lookup qi $ dbTables dbStructure + pkCols = maybe mempty tablePKCols $ HM.lookup qi $ dbTables sCache logic = map snd qsLogic rootOrder = maybe [] snd $ find (\(x, _) -> null x) qsOrder combinedLogic = foldr addFilterToLogicForest logic qsFiltersRoot diff --git a/src/PostgREST/Plan/CallPlan.hs b/src/PostgREST/Plan/CallPlan.hs index 10817ac50..743216eed 100644 --- a/src/PostgREST/Plan/CallPlan.hs +++ b/src/PostgREST/Plan/CallPlan.hs @@ -5,9 +5,9 @@ module PostgREST.Plan.CallPlan where import qualified Data.ByteString.Lazy as LBS -import PostgREST.DbStructure.Identifiers (FieldName, +import PostgREST.SchemaCache.Identifiers (FieldName, QualifiedIdentifier) -import PostgREST.DbStructure.Proc (ProcParam (..)) +import PostgREST.SchemaCache.Proc (ProcParam (..)) import Protolude diff --git a/src/PostgREST/Plan/MutatePlan.hs b/src/PostgREST/Plan/MutatePlan.hs index 1f935581d..75733eca5 100644 --- a/src/PostgREST/Plan/MutatePlan.hs +++ b/src/PostgREST/Plan/MutatePlan.hs @@ -6,11 +6,11 @@ where import qualified Data.ByteString.Lazy as LBS import qualified Data.Set as S -import PostgREST.DbStructure.Identifiers (FieldName, - QualifiedIdentifier) +import PostgREST.ApiRequest.Preferences (PreferResolution) +import PostgREST.ApiRequest.Types (LogicTree, OrderTerm) import PostgREST.RangeQuery (NonnegRange) -import PostgREST.Request.Preferences (PreferResolution) -import PostgREST.Request.Types (LogicTree, OrderTerm) +import PostgREST.SchemaCache.Identifiers (FieldName, + QualifiedIdentifier) import Protolude diff --git a/src/PostgREST/Plan/ReadPlan.hs b/src/PostgREST/Plan/ReadPlan.hs index 4d459892e..fb8d86e87 100644 --- a/src/PostgREST/Plan/ReadPlan.hs +++ b/src/PostgREST/Plan/ReadPlan.hs @@ -7,14 +7,14 @@ module PostgREST.Plan.ReadPlan import Data.Tree (Tree (..)) -import PostgREST.DbStructure.Identifiers (FieldName, - QualifiedIdentifier) -import PostgREST.DbStructure.Relationship (Relationship) -import PostgREST.RangeQuery (NonnegRange) -import PostgREST.Request.Types (Alias, Depth, Hint, +import PostgREST.ApiRequest.Types (Alias, Depth, Hint, JoinCondition, JoinType, LogicTree, NodeName, OrderTerm, SelectItem) +import PostgREST.RangeQuery (NonnegRange) +import PostgREST.SchemaCache.Identifiers (FieldName, + QualifiedIdentifier) +import PostgREST.SchemaCache.Relationship (Relationship) import Protolude diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index c6c55b2a9..2e4b1dabf 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -25,26 +25,27 @@ import qualified Hasql.DynamicStatements.Statement as SQL import qualified Hasql.Transaction as SQL import qualified Hasql.Transaction.Sessions as SQL -import qualified PostgREST.DbStructure as DbStructure -import qualified PostgREST.DbStructure.Proc as Proc import qualified PostgREST.Error as Error import qualified PostgREST.Query.QueryBuilder as QueryBuilder import qualified PostgREST.Query.Statements as Statements import qualified PostgREST.RangeQuery as RangeQuery +import qualified PostgREST.SchemaCache as SchemaCache +import qualified PostgREST.SchemaCache.Proc as Proc import Data.Scientific (FPFormat (..), formatScientific, isInteger) +import PostgREST.ApiRequest (Action (..), + ApiRequest (..), + InvokeMethod (..), + Target (..)) +import PostgREST.ApiRequest.Preferences (PreferCount (..), + PreferParameters (..), + PreferTransaction (..), + shouldCount) import PostgREST.Config (AppConfig (..), OpenAPIMode (..)) import PostgREST.Config.PgVersion (PgVersion (..), pgVersion140) -import PostgREST.DbStructure (DbStructure (..)) -import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..), - Schema) -import PostgREST.DbStructure.Proc (ProcDescription (..), - ProcVolatility (..), - ProcsMap) -import PostgREST.DbStructure.Table (TablesMap) import PostgREST.Error (Error) import PostgREST.MediaType (MediaType (..)) import PostgREST.Plan (CallReadPlan (..), @@ -56,14 +57,13 @@ import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet, setConfigLocal, setConfigLocalJson) import PostgREST.Query.Statements (ResultSet (..)) -import PostgREST.Request.ApiRequest (Action (..), - ApiRequest (..), - InvokeMethod (..), - Target (..)) -import PostgREST.Request.Preferences (PreferCount (..), - PreferParameters (..), - PreferTransaction (..), - shouldCount) +import PostgREST.SchemaCache (SchemaCache (..)) +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), + Schema) +import PostgREST.SchemaCache.Proc (ProcDescription (..), + ProcVolatility (..), + ProcsMap) +import PostgREST.SchemaCache.Table (TablesMap) import Protolude hiding (Handler) @@ -174,19 +174,19 @@ invokeQuery proc CallReadPlan{crReadPlan, crCallPlan} apiReq@ApiRequest{..} conf failNotSingular iAcceptMediaType resultSet pure resultSet -openApiQuery :: DbStructure -> PgVersion -> AppConfig -> Schema -> DbHandler (Maybe (TablesMap, ProcsMap, Maybe Text)) -openApiQuery dbStructure pgVer AppConfig{..} tSchema = +openApiQuery :: SchemaCache -> PgVersion -> AppConfig -> Schema -> DbHandler (Maybe (TablesMap, ProcsMap, Maybe Text)) +openApiQuery sCache pgVer AppConfig{..} tSchema = lift $ case configOpenApiMode of OAFollowPriv -> Just <$> ((,,) - <$> SQL.statement [tSchema] (DbStructure.accessibleTables pgVer configDbPreparedStatements) - <*> SQL.statement tSchema (DbStructure.accessibleProcs pgVer configDbPreparedStatements) - <*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)) + <$> SQL.statement [tSchema] (SchemaCache.accessibleTables pgVer configDbPreparedStatements) + <*> SQL.statement tSchema (SchemaCache.accessibleProcs pgVer configDbPreparedStatements) + <*> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements)) OAIgnorePriv -> Just <$> ((,,) - (HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbTables dbStructure) - (HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure) - <$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)) + (HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ SchemaCache.dbTables sCache) + (HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ SchemaCache.dbProcs sCache) + <$> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements)) OADisabled -> pure Nothing diff --git a/src/PostgREST/Query/QueryBuilder.hs b/src/PostgREST/Query/QueryBuilder.hs index 20090faad..7352677b2 100644 --- a/src/PostgREST/Query/QueryBuilder.hs +++ b/src/PostgREST/Query/QueryBuilder.hs @@ -22,19 +22,19 @@ import qualified Hasql.DynamicStatements.Snippet as SQL import Data.Tree (Tree (..)) -import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..)) -import PostgREST.DbStructure.Proc (ProcParam (..)) -import PostgREST.DbStructure.Relationship (Cardinality (..), +import PostgREST.ApiRequest.Preferences (PreferResolution (..)) +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..)) +import PostgREST.SchemaCache.Proc (ProcParam (..)) +import PostgREST.SchemaCache.Relationship (Cardinality (..), Junction (..), Relationship (..)) -import PostgREST.Request.Preferences (PreferResolution (..)) +import PostgREST.ApiRequest.Types import PostgREST.Plan.CallPlan import PostgREST.Plan.MutatePlan import PostgREST.Plan.ReadPlan import PostgREST.Query.SqlFragment import PostgREST.RangeQuery (allRange) -import PostgREST.Request.Types import Protolude diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index 39e3366a3..d8dd1a857 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -56,13 +56,7 @@ import Control.Arrow ((***)) import Data.Foldable (foldr1) import Text.InterpolatedString.Perl6 (qc) -import PostgREST.DbStructure.Identifiers (FieldName, - QualifiedIdentifier (..)) -import PostgREST.MediaType (MTPlanFormat (..), - MTPlanOption (..)) -import PostgREST.RangeQuery (NonnegRange, allRange, - rangeLimit, rangeOffset) -import PostgREST.Request.Types (Alias, Field, Filter (..), +import PostgREST.ApiRequest.Types (Alias, Field, Filter (..), FtsOperator (..), JoinCondition (..), JsonOperand (..), @@ -76,6 +70,12 @@ import PostgREST.Request.Types (Alias, Field, Filter (..), OrderTerm (..), SelectItem, SimpleOperator (..), TrileanVal (..)) +import PostgREST.MediaType (MTPlanFormat (..), + MTPlanOption (..)) +import PostgREST.RangeQuery (NonnegRange, allRange, + rangeLimit, rangeOffset) +import PostgREST.SchemaCache.Identifiers (FieldName, + QualifiedIdentifier (..)) import Protolude hiding (cast) diff --git a/src/PostgREST/Query/Statements.hs b/src/PostgREST/Query/Statements.hs index 52471f266..be90e8a46 100644 --- a/src/PostgREST/Query/Statements.hs +++ b/src/PostgREST/Query/Statements.hs @@ -25,13 +25,13 @@ import qualified Hasql.Statement as SQL import Control.Lens ((^?)) import Data.Maybe (fromJust) -import PostgREST.DbStructure.Identifiers (FieldName) +import PostgREST.ApiRequest.Preferences import PostgREST.MediaType (MTPlanAttrs (..), MTPlanFormat (..), MediaType (..), getMediaType) import PostgREST.Query.SqlFragment -import PostgREST.Request.Preferences +import PostgREST.SchemaCache.Identifiers (FieldName) import Protolude diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs index 737181f21..790fcc788 100644 --- a/src/PostgREST/Response.hs +++ b/src/PostgREST/Response.hs @@ -30,32 +30,30 @@ import qualified PostgREST.MediaType as MediaType import qualified PostgREST.RangeQuery as RangeQuery import qualified PostgREST.Response.OpenAPI as OpenAPI +import PostgREST.ApiRequest (ApiRequest (..), + InvokeMethod (..), + Target (..)) +import PostgREST.ApiRequest.Preferences (PreferRepresentation (..), + PreferTransaction (..), + shouldCount, + toAppliedHeader) +import PostgREST.ApiRequest.QueryParams (QueryParams (..)) import PostgREST.Config (AppConfig (..)) -import PostgREST.DbStructure (DbStructure (..)) -import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..), - Schema) -import PostgREST.DbStructure.Proc (ProcDescription (..), - ProcVolatility (..), - ProcsMap) -import PostgREST.DbStructure.Table (Table (..), TablesMap) -import PostgREST.GucHeader (GucHeader, - addHeadersIfNotIncluded, - unwrapGucHeader) import PostgREST.MediaType (MediaType (..)) import PostgREST.Plan (MutateReadPlan (..)) import PostgREST.Plan.MutatePlan (MutatePlan (..)) import PostgREST.Query.Statements (ResultSet (..)) -import PostgREST.Request.ApiRequest (ApiRequest (..), - InvokeMethod (..), - Target (..)) -import PostgREST.Request.Preferences (PreferRepresentation (..), - PreferTransaction (..), - shouldCount, - toAppliedHeader) -import PostgREST.Request.QueryParams (QueryParams (..)) +import PostgREST.Response.GucHeader (GucHeader, unwrapGucHeader) +import PostgREST.SchemaCache (SchemaCache (..)) +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), + Schema) +import PostgREST.SchemaCache.Proc (ProcDescription (..), + ProcVolatility (..), + ProcsMap) +import PostgREST.SchemaCache.Table (Table (..), TablesMap) -import qualified PostgREST.DbStructure.Proc as Proc -import qualified PostgREST.Request.Types as ApiRequestTypes +import qualified PostgREST.ApiRequest.Types as ApiRequestTypes +import qualified PostgREST.SchemaCache.Proc as Proc import Protolude hiding (Handler, toS) import Protolude.Conv (toS) @@ -176,11 +174,11 @@ deleteResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of RSPlan plan -> Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan -infoResponse :: Target -> DbStructure -> Wai.Response -infoResponse target dbStructure = +infoResponse :: Target -> SchemaCache -> Wai.Response +infoResponse target sCache = case target of TargetIdent identifier -> - case HM.lookup identifier (dbTables dbStructure) of + case HM.lookup identifier (dbTables sCache) of Just tbl -> respondInfo $ allowH tbl Nothing -> Error.errorResponseFor $ Error.ApiRequestError ApiRequestTypes.NotFound TargetProc pd _ @@ -222,11 +220,11 @@ invokeResponse invMethod proc ctxApiRequest@ApiRequest{..} resultSet = case resu RSPlan plan -> Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan -openApiResponse :: Bool -> Maybe (TablesMap, ProcsMap, Maybe Text) -> AppConfig -> DbStructure -> Schema -> Bool -> Wai.Response -openApiResponse headersOnly body conf dbStructure schema negotiatedByProfile = +openApiResponse :: Bool -> Maybe (TablesMap, ProcsMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Wai.Response +openApiResponse headersOnly body conf sCache schema negotiatedByProfile = Wai.responseLBS HTTP.status200 (MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile)) - (maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode conf dbStructure x y z) body) + (maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode conf sCache x y z) body) -- | Response with headers and status overridden from GUCs. gucResponse @@ -287,3 +285,9 @@ optionalRollback AppConfig{..} ApiRequest{..} resp = do [toAppliedHeader Rollback] | otherwise = identity + +-- | Add headers not already included to allow the user to override them instead of duplicating them +addHeadersIfNotIncluded :: [HTTP.Header] -> [HTTP.Header] -> [HTTP.Header] +addHeadersIfNotIncluded newHeaders initialHeaders = + filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++ + initialHeaders diff --git a/src/PostgREST/GucHeader.hs b/src/PostgREST/Response/GucHeader.hs similarity index 67% rename from src/PostgREST/GucHeader.hs rename to src/PostgREST/Response/GucHeader.hs index 2deba6999..10fa13253 100644 --- a/src/PostgREST/GucHeader.hs +++ b/src/PostgREST/Response/GucHeader.hs @@ -1,7 +1,6 @@ -module PostgREST.GucHeader +module PostgREST.Response.GucHeader ( GucHeader , unwrapGucHeader - , addHeadersIfNotIncluded ) where import qualified Data.Aeson as JSON @@ -29,9 +28,3 @@ instance JSON.FromJSON GucHeader where unwrapGucHeader :: GucHeader -> Header unwrapGucHeader (GucHeader (k, v)) = (k, v) - --- | Add headers not already included to allow the user to override them instead of duplicating them -addHeadersIfNotIncluded :: [Header] -> [Header] -> [Header] -addHeadersIfNotIncluded newHeaders initialHeaders = - filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++ - initialHeaders diff --git a/src/PostgREST/Response/OpenAPI.hs b/src/PostgREST/Response/OpenAPI.hs index a2f7cb9ee..1d79068af 100644 --- a/src/PostgREST/Response/OpenAPI.hs +++ b/src/PostgREST/Response/OpenAPI.hs @@ -26,14 +26,14 @@ import Data.Swagger import PostgREST.Config (AppConfig (..), Proxy (..), isMalformedProxyUri, toURI) -import PostgREST.DbStructure (DbStructure (..)) -import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..)) -import PostgREST.DbStructure.Proc (ProcDescription (..), +import PostgREST.SchemaCache (SchemaCache (..)) +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..)) +import PostgREST.SchemaCache.Proc (ProcDescription (..), ProcParam (..)) -import PostgREST.DbStructure.Relationship (Cardinality (..), +import PostgREST.SchemaCache.Relationship (Cardinality (..), Relationship (..), RelationshipsMap) -import PostgREST.DbStructure.Table (Column (..), Table (..), +import PostgREST.SchemaCache.Table (Column (..), Table (..), TablesMap) import PostgREST.Version (docsVersion, prettyVersion) @@ -41,11 +41,11 @@ import PostgREST.MediaType import Protolude hiding (Proxy, get) -encode :: AppConfig -> DbStructure -> TablesMap -> HM.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString -encode conf dbStructure tables procs schemaDescription = +encode :: AppConfig -> SchemaCache -> TablesMap -> HM.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString +encode conf sCache tables procs schemaDescription = JSON.encode $ postgrestSpec - (dbRelationships dbStructure) + (dbRelationships sCache) (concat $ HM.elems procs) (snd <$> HM.toList tables) (proxyUri conf) diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/SchemaCache.hs similarity index 97% rename from src/PostgREST/DbStructure.hs rename to src/PostgREST/SchemaCache.hs index 8c141d622..aea2ebe5b 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/SchemaCache.hs @@ -1,8 +1,8 @@ {-| -Module : PostgREST.DbStructure +Module : PostgREST.SchemaCache Description : PostgREST schema cache -This module contains queries that target PostgreSQL system catalogs, these are used to build the schema cache(DbStructure). +This module(used to be named DbStructure) contains queries that target PostgreSQL system catalogs, these are used to build the schema cache(SchemaCache). The schema cache is necessary for resource embedding, foreign keys are used for inferring the relationships between tables. @@ -18,9 +18,9 @@ These queries are executed once at startup or when PostgREST is reloaded. {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} -module PostgREST.DbStructure - ( DbStructure(..) - , queryDbStructure +module PostgREST.SchemaCache + ( SchemaCache(..) + , querySchemaCache , accessibleTables , accessibleProcs , schemaDescription @@ -40,25 +40,25 @@ import Text.InterpolatedString.Perl6 (q) import PostgREST.Config.Database (pgVersionStatement) import PostgREST.Config.PgVersion (PgVersion, pgVersion100, pgVersion110) -import PostgREST.DbStructure.Identifiers (FieldName, +import PostgREST.SchemaCache.Identifiers (FieldName, QualifiedIdentifier (..), Schema) -import PostgREST.DbStructure.Proc (PgType (..), +import PostgREST.SchemaCache.Proc (PgType (..), ProcDescription (..), ProcParam (..), ProcVolatility (..), ProcsMap, RetType (..)) -import PostgREST.DbStructure.Relationship (Cardinality (..), +import PostgREST.SchemaCache.Relationship (Cardinality (..), Junction (..), Relationship (..), RelationshipsMap) -import PostgREST.DbStructure.Table (Column (..), Table (..), +import PostgREST.SchemaCache.Table (Column (..), Table (..), TablesMap) import Protolude -data DbStructure = DbStructure +data SchemaCache = SchemaCache { dbTables :: TablesMap , dbRelationships :: RelationshipsMap , dbProcs :: ProcsMap @@ -82,8 +82,8 @@ data KeyDep -- | A SQL query that can be executed independently type SqlQuery = ByteString -queryDbStructure :: [Schema] -> [Schema] -> Bool -> SQL.Transaction DbStructure -queryDbStructure schemas extraSearchPath prepared = do +querySchemaCache :: [Schema] -> [Schema] -> Bool -> SQL.Transaction SchemaCache +querySchemaCache schemas extraSearchPath prepared = do SQL.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object pgVer <- SQL.statement mempty pgVersionStatement tabs <- SQL.statement schemas $ allTables pgVer prepared @@ -95,7 +95,7 @@ queryDbStructure schemas extraSearchPath prepared = do let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps rels = addInverseRels $ addM2MRels tabsWViewsPks $ addViewM2OAndO2ORels keyDeps m2oRels - return $ removeInternal schemas $ DbStructure { + return $ removeInternal schemas $ SchemaCache { dbTables = tabsWViewsPks , dbRelationships = getOverrideRelationshipsMap rels cRels , dbProcs = procs @@ -121,10 +121,10 @@ getOverrideRelationshipsMap rels cRels = deformedRelMap = HM.fromListWith (++) . fmap addDeformedRelKey . HM.toList addDeformedRelKey ((relT, relFT), rls) = ((relT, qiSchema relFT), rls) --- | Remove db objects that belong to an internal schema(not exposed through the API) from the DbStructure. -removeInternal :: [Schema] -> DbStructure -> DbStructure +-- | Remove db objects that belong to an internal schema(not exposed through the API) from the SchemaCache. +removeInternal :: [Schema] -> SchemaCache -> SchemaCache removeInternal schemas dbStruct = - DbStructure { + SchemaCache { dbTables = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct , dbRelationships = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$> HM.filterWithKey (\(QualifiedIdentifier sch _, _) _ -> sch `elem` schemas ) (dbRelationships dbStruct) diff --git a/src/PostgREST/DbStructure/Identifiers.hs b/src/PostgREST/SchemaCache/Identifiers.hs similarity index 96% rename from src/PostgREST/DbStructure/Identifiers.hs rename to src/PostgREST/SchemaCache/Identifiers.hs index e9cb9e6b6..1992b42b4 100644 --- a/src/PostgREST/DbStructure/Identifiers.hs +++ b/src/PostgREST/SchemaCache/Identifiers.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} -module PostgREST.DbStructure.Identifiers +module PostgREST.SchemaCache.Identifiers ( QualifiedIdentifier(..) , Schema , TableName diff --git a/src/PostgREST/DbStructure/Proc.hs b/src/PostgREST/SchemaCache/Proc.hs similarity index 96% rename from src/PostgREST/DbStructure/Proc.hs rename to src/PostgREST/SchemaCache/Proc.hs index a62f436af..d3161cd36 100644 --- a/src/PostgREST/DbStructure/Proc.hs +++ b/src/PostgREST/SchemaCache/Proc.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} -module PostgREST.DbStructure.Proc +module PostgREST.SchemaCache.Proc ( PgType(..) , ProcDescription(..) , ProcParam(..) @@ -17,7 +17,7 @@ module PostgREST.DbStructure.Proc import qualified Data.Aeson as JSON import qualified Data.HashMap.Strict as HM -import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..), +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), Schema, TableName) import Protolude diff --git a/src/PostgREST/DbStructure/Relationship.hs b/src/PostgREST/SchemaCache/Relationship.hs similarity index 95% rename from src/PostgREST/DbStructure/Relationship.hs rename to src/PostgREST/SchemaCache/Relationship.hs index 40028ea54..615eda2c9 100644 --- a/src/PostgREST/DbStructure/Relationship.hs +++ b/src/PostgREST/SchemaCache/Relationship.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} -module PostgREST.DbStructure.Relationship +module PostgREST.SchemaCache.Relationship ( Cardinality(..) , Relationship(..) , Junction(..) @@ -11,7 +11,7 @@ module PostgREST.DbStructure.Relationship import qualified Data.Aeson as JSON import qualified Data.HashMap.Strict as HM -import PostgREST.DbStructure.Identifiers (FieldName, +import PostgREST.SchemaCache.Identifiers (FieldName, QualifiedIdentifier, Schema) import Protolude diff --git a/src/PostgREST/DbStructure/Table.hs b/src/PostgREST/SchemaCache/Table.hs similarity index 93% rename from src/PostgREST/DbStructure/Table.hs rename to src/PostgREST/SchemaCache/Table.hs index 31a0770dd..3a7f886a8 100644 --- a/src/PostgREST/DbStructure/Table.hs +++ b/src/PostgREST/SchemaCache/Table.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} -module PostgREST.DbStructure.Table +module PostgREST.SchemaCache.Table ( Column(..) , Table(..) , TablesMap @@ -10,7 +10,7 @@ module PostgREST.DbStructure.Table import qualified Data.Aeson as JSON import qualified Data.HashMap.Strict as HM -import PostgREST.DbStructure.Identifiers (FieldName, +import PostgREST.SchemaCache.Identifiers (FieldName, QualifiedIdentifier (..), Schema, TableName) diff --git a/src/PostgREST/Unix.hs b/src/PostgREST/Unix.hs index c6926121c..f45decce9 100644 --- a/src/PostgREST/Unix.hs +++ b/src/PostgREST/Unix.hs @@ -47,7 +47,7 @@ installSignalHandlers appState = do install Signals.sigINT interrupt install Signals.sigTERM interrupt - -- The SIGUSR1 signal updates the internal 'DbStructure' by running + -- The SIGUSR1 signal updates the internal 'SchemaCache' by running -- 'connectionWorker' exactly as before. install Signals.sigUSR1 $ Workers.connectionWorker appState diff --git a/src/PostgREST/Workers.hs b/src/PostgREST/Workers.hs index 3d334525a..a57e6c80c 100644 --- a/src/PostgREST/Workers.hs +++ b/src/PostgREST/Workers.hs @@ -1,30 +1,40 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} module PostgREST.Workers ( connectionWorker , reReadConfig - , listener + , runListener + , runAdmin ) where import qualified Data.Aeson as JSON import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Hasql.Notifications as SQL +import qualified Hasql.Session as SQL import qualified Hasql.Transaction.Sessions as SQL +import qualified Network.HTTP.Types.Status as HTTP +import qualified Network.Wai as Wai +import qualified Network.Wai.Handler.Warp as Warp import Control.Retry (RetryStatus, capDelay, exponentialBackoff, retrying, rsPreviousDelay) import Hasql.Connection (acquire) +import Network.Socket +import Network.Socket.ByteString + import PostgREST.AppState (AppState) import PostgREST.Config (AppConfig (..), readAppConfig) import PostgREST.Config.Database (queryDbSettings, queryPgVersion) import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion) -import PostgREST.DbStructure (queryDbStructure) import PostgREST.Error (PgError (PgError), checkIsFatal, errorPayload) +import PostgREST.SchemaCache (querySchemaCache) import qualified PostgREST.AppState as AppState @@ -45,7 +55,7 @@ data SCacheStatus | SCFatalFail -- | The purpose of this worker is to obtain a healthy connection to pg and an --- up-to-date schema cache(DbStructure). This method is meant to be called +-- up-to-date schema cache(SchemaCache). This method is meant to be called -- multiple times by the same thread, but does nothing if the previous -- invocation has not terminated. In all cases this method does not halt the -- calling thread, the work is performed in a separate thread. @@ -54,7 +64,7 @@ data SCacheStatus -- 1. Tries to connect to pg server and will keep trying until success. -- 2. Checks if the pg version is supported and if it's not it kills the main -- program. --- 3. Obtains the dbStructure. If this fails, it goes back to 1. +-- 3. Obtains the sCache. If this fails, it goes back to 1. connectionWorker :: AppState -> IO () connectionWorker appState = do runExclusively (AppState.getWorkerSem appState) work @@ -148,14 +158,14 @@ establishConnection appState = when itShould $ AppState.putRetryNextIn appState delay return itShould --- | Load the DbStructure by using a connection from the pool. +-- | Load the SchemaCache by using a connection from the pool. loadSchemaCache :: AppState -> IO SCacheStatus loadSchemaCache appState = do AppConfig{..} <- AppState.getConfig appState result <- let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in AppState.usePool appState . transaction SQL.ReadCommitted SQL.Read $ - queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements + querySchemaCache (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements case result of Left e -> do let @@ -168,18 +178,22 @@ loadSchemaCache appState = do AppState.logWithZTime appState hint return SCFatalFail Nothing -> do - AppState.putDbStructure appState Nothing + AppState.putSchemaCache appState Nothing AppState.logWithZTime appState "An error ocurred when loading the schema cache" putErr return SCOnRetry - Right dbStructure -> do - AppState.putDbStructure appState (Just dbStructure) + Right sCache -> do + AppState.putSchemaCache appState (Just sCache) when (isJust configDbRootSpec) . - AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode dbStructure + AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode sCache AppState.logWithZTime appState "Schema cache loaded" return SCLoaded +runListener :: AppConfig -> AppState -> IO () +runListener AppConfig{configDbChannelEnabled} appState = + when configDbChannelEnabled $ listener appState + -- | Starts a dedicated pg connection to LISTEN for notifications. When a -- NOTIFY - with an empty payload - is done, it refills the schema -- cache. It uses the connectionWorker in case the LISTEN connection dies. @@ -264,3 +278,68 @@ reReadConfig startingUp appState = do pass else AppState.logWithZTime appState "Config reloaded" + +runAdmin :: AppConfig -> AppState -> Warp.Settings -> IO () +runAdmin conf@AppConfig{configAdminServerPort} appState settings = + whenJust configAdminServerPort $ \adminPort -> do + AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort + void . forkIO $ Warp.runSettings (settings & Warp.setPort adminPort) adminApp + where + whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m () + whenJust mg f = maybe (pure ()) f mg + adminApp = admin appState conf + +-- | PostgREST admin application +admin :: AppState.AppState -> AppConfig -> Wai.Application +admin appState appConfig req respond = do + isMainAppReachable <- any isRight <$> reachMainApp appConfig + isSchemaCacheLoaded <- isJust <$> AppState.getSchemaCache appState + isConnectionUp <- + if configDbChannelEnabled appConfig + then AppState.getIsListenerOn appState + else isRight <$> AppState.usePool appState (SQL.sql "SELECT 1") + + case Wai.pathInfo req of + ["ready"] -> + respond $ Wai.responseLBS (if isMainAppReachable && isConnectionUp && isSchemaCacheLoaded then HTTP.status200 else HTTP.status503) [] mempty + ["live"] -> + respond $ Wai.responseLBS (if isMainAppReachable then HTTP.status200 else HTTP.status503) [] mempty + _ -> + respond $ Wai.responseLBS HTTP.status404 [] mempty + +-- Try to connect to the main app socket +-- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections +-- The code for resolving the "*4", "!4", "*6", "!6", "*" special values is taken from +-- https://hackage.haskell.org/package/streaming-commons-0.2.2.4/docs/src/Data.Streaming.Network.html#bindPortGenEx +reachMainApp :: AppConfig -> IO [Either IOException ()] +reachMainApp AppConfig{..} = + case configServerUnixSocket of + Just path -> do + sock <- socket AF_UNIX Stream 0 + (:[]) <$> try (do + connect sock $ SockAddrUnix path + withSocketsDo $ bracket (pure sock) close sendEmpty) + Nothing -> do + let + host | configServerHost `elem` ["*4", "!4", "*6", "!6", "*"] = Nothing + | otherwise = Just configServerHost + filterAddrs xs = + case configServerHost of + "*4" -> ipv4Addrs xs ++ ipv6Addrs xs + "!4" -> ipv4Addrs xs + "*6" -> ipv6Addrs xs ++ ipv4Addrs xs + "!6" -> ipv6Addrs xs + _ -> xs + ipv4Addrs = filter ((/=) AF_INET6 . addrFamily) + ipv6Addrs = filter ((==) AF_INET6 . addrFamily) + + addrs <- getAddrInfo (Just $ defaultHints { addrSocketType = Stream }) (T.unpack <$> host) (Just . show $ configServerPort) + tryAddr `traverse` filterAddrs addrs + where + sendEmpty sock = void $ send sock mempty + tryAddr :: AddrInfo -> IO (Either IOException ()) + tryAddr addr = do + sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) + try $ do + connect sock $ addrAddress addr + withSocketsDo $ bracket (pure sock) close sendEmpty diff --git a/test/doc/Main.hs b/test/doc/Main.hs index e68430318..a941730c1 100644 --- a/test/doc/Main.hs +++ b/test/doc/Main.hs @@ -13,6 +13,6 @@ main = , "-XStandaloneDeriving" , "-isrc" , "src/PostgREST/Query/SqlFragment.hs" - , "src/PostgREST/Request/Preferences.hs" - , "src/PostgREST/Request/QueryParams.hs" + , "src/PostgREST/ApiRequest/Preferences.hs" + , "src/PostgREST/ApiRequest/QueryParams.hs" ] diff --git a/test/spec/Main.hs b/test/spec/Main.hs index a011f2bb6..886d50c3e 100644 --- a/test/spec/Main.hs +++ b/test/spec/Main.hs @@ -12,7 +12,7 @@ import Test.Hspec import PostgREST.App (postgrest) import PostgREST.Config (AppConfig (..), LogLevel (..)) import PostgREST.Config.Database (queryPgVersion) -import PostgREST.DbStructure (queryDbStructure) +import PostgREST.SchemaCache (querySchemaCache) import Protolude hiding (toList, toS) import Protolude.Conv (toS) import SpecHelper @@ -68,32 +68,32 @@ main = do actualPgVersion <- either (panic . show) id <$> P.use pool queryPgVersion - baseDbStructure <- - loadDbStructure pool + baseSchemaCache <- + loadSchemaCache pool (configDbSchemas testCfg) (configDbExtraSearchPath testCfg) let - -- For tests that run with the same refDbStructure + -- For tests that run with the same refSchemaCache app config = do appState <- AppState.initWithPool pool config AppState.putPgVersion appState actualPgVersion - AppState.putDbStructure appState (Just baseDbStructure) + AppState.putSchemaCache appState (Just baseSchemaCache) when (isJust $ configDbRootSpec config) $ - AppState.putJsonDbS appState $ toS $ JSON.encode baseDbStructure + AppState.putJsonDbS appState $ toS $ JSON.encode baseSchemaCache return ((), postgrest LogCrit appState $ pure ()) - -- For tests that run with a different DbStructure(depends on configSchemas) + -- For tests that run with a different SchemaCache(depends on configSchemas) appDbs config = do - customDbStructure <- - loadDbStructure pool + customSchemaCache <- + loadSchemaCache pool (configDbSchemas config) (configDbExtraSearchPath config) appState <- AppState.initWithPool pool config AppState.putPgVersion appState actualPgVersion - AppState.putDbStructure appState (Just customDbStructure) + AppState.putSchemaCache appState (Just customSchemaCache) when (isJust $ configDbRootSpec config) $ - AppState.putJsonDbS appState $ toS $ JSON.encode baseDbStructure + AppState.putJsonDbS appState $ toS $ JSON.encode baseSchemaCache return ((), postgrest LogCrit appState $ pure ()) let withApp = app testCfg @@ -259,5 +259,5 @@ main = do describe "Feature.RollbackForcedSpec" Feature.RollbackSpec.forced where - loadDbStructure pool schemas extraSearchPath = - either (panic.show) id <$> P.use pool (HT.transaction HT.ReadCommitted HT.Read $ queryDbStructure (toList schemas) extraSearchPath True) + loadSchemaCache pool schemas extraSearchPath = + either (panic.show) id <$> P.use pool (HT.transaction HT.ReadCommitted HT.Read $ querySchemaCache (toList schemas) extraSearchPath True) diff --git a/test/spec/QueryCost.hs b/test/spec/QueryCost.hs index 0a5faf8c5..3edb3132d 100644 --- a/test/spec/QueryCost.hs +++ b/test/spec/QueryCost.hs @@ -17,8 +17,8 @@ import Protolude hiding (get, toS) import PostgREST.Plan.CallPlan import PostgREST.Query.QueryBuilder (callPlanToQuery) -import PostgREST.DbStructure.Identifiers -import PostgREST.DbStructure.Proc +import PostgREST.SchemaCache.Identifiers +import PostgREST.SchemaCache.Proc import Test.Hspec diff --git a/test/spec/SpecHelper.hs b/test/spec/SpecHelper.hs index 5d17df19a..92e639b5c 100644 --- a/test/spec/SpecHelper.hs +++ b/test/spec/SpecHelper.hs @@ -26,8 +26,8 @@ import PostgREST.Config (AppConfig (..), LogLevel (..), OpenAPIMode (..), parseSecret) -import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..)) import PostgREST.MediaType (MediaType (..)) +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..)) import Protolude hiding (get, toS) import Protolude.Conv (toS)