From 8911afd07919070fee6f8a38c9247b56066df4dd Mon Sep 17 00:00:00 2001 From: Steve Chavez Date: Wed, 27 Jul 2022 19:33:34 -0500 Subject: [PATCH] feat: Allow getting the EXPLAIN plan of a request --- CHANGELOG.md | 4 + nix/tools/tests.nix | 2 +- postgrest.cabal | 1 + src/PostgREST/App.hs | 284 ++++++++++-------- src/PostgREST/CLI.hs | 3 + src/PostgREST/Config.hs | 3 + src/PostgREST/Config/PgVersion.hs | 4 + src/PostgREST/MediaType.hs | 71 ++++- src/PostgREST/Query/SqlFragment.hs | 19 ++ src/PostgREST/Query/Statements.hs | 145 ++++----- src/PostgREST/Request/ApiRequest.hs | 7 +- test/io/configs/expected/aliases.config | 1 + .../configs/expected/boolean-numeric.config | 1 + .../io/configs/expected/boolean-string.config | 1 + test/io/configs/expected/defaults.config | 1 + ...efaults-with-db-other-authenticator.config | 1 + .../expected/no-defaults-with-db.config | 1 + test/io/configs/expected/no-defaults.config | 1 + test/io/configs/expected/types.config | 1 + test/io/configs/no-defaults-env.yaml | 1 + test/io/configs/no-defaults.config | 1 + test/io/db_config.sql | 2 + test/spec/Feature/Query/PlanSpec.hs | 232 ++++++++++++++ test/spec/Main.hs | 8 + test/spec/QueryCost.hs | 1 + test/spec/SpecHelper.hs | 4 + 26 files changed, 582 insertions(+), 218 deletions(-) create mode 100644 test/spec/Feature/Query/PlanSpec.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index fab71eb11..16d965a99 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -36,6 +36,10 @@ This project adheres to [Semantic Versioning](http://semver.org/). + In case of multiple geometries in the same table, you can choose which one will go into the `geometry` key with the usual `?select` query parameter. - #1082, Add security definitions to the OpenAPI output - @laurenceisla - #2378, Support http OPTIONS method on RPC and root path - @steve-chavez + - #2354, Allow getting the EXPLAIN plan of a request by using the `Accept: application/vnd.pgrst.plan` header - @steve-chavez + + Only allowed if the `db-plan-enabled` config is set to true + + Limited to generating the plan of a json representation(`application/json`) but can be extended later to allow other representations. + + The plan can be obtained in text(`Accept: application/vnd.pgrst.plan+text`) and json(`Accept: application/vnd.pgrst.plan+json` or `Accept: application/vnd.pgrst.plan`) format. ### Fixed diff --git a/nix/tools/tests.nix b/nix/tools/tests.nix index e55a3f4ad..8976ea8b7 100644 --- a/nix/tools/tests.nix +++ b/nix/tools/tests.nix @@ -22,7 +22,7 @@ let checkedShellScript { name = "postgrest-test-spec"; - docs = "Run the Haskell test suite"; + docs = "Run the Haskell test suite. Use --match PATTERN for running individual specs"; args = [ "ARG_LEFTOVERS([hspec arguments])" ]; inRootDir = true; withEnv = postgrest.env; diff --git a/postgrest.cabal b/postgrest.cabal index 73f5b8ce5..b9d0cb525 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -195,6 +195,7 @@ test-suite spec Feature.Query.DeleteSpec Feature.Query.EmbedDisambiguationSpec Feature.Query.EmbedInnerJoinSpec + Feature.Query.PlanSpec Feature.Query.HtmlRawOutputSpec Feature.Query.InsertSpec Feature.Query.JsonOperatorSpec diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 2f2e3d1bc..c13430845 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -74,6 +74,7 @@ import PostgREST.GucHeader (GucHeader, addHeadersIfNotIncluded, unwrapGucHeader) import PostgREST.MediaType (MediaType (..)) +import PostgREST.Query.Statements (ResultSet (..)) import PostgREST.Request.ApiRequest (Action (..), ApiRequest (..), InvokeMethod (..), @@ -259,9 +260,9 @@ handleRead headersOnly identifier context@RequestContext{..} = do AppConfig{..} = ctxConfig countQuery = QueryBuilder.readRequestToCountQuery req - (tableTotal, queryTotal, _ , body, gucHeaders, gucStatus) <- - lift . SQL.statement mempty $ - Statements.createReadStatement + resultSet <- + lift . SQL.statement mempty $ + Statements.prepareRead (QueryBuilder.readRequestToQuery req) (if iPreferCount == Just EstimatedCount then -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed @@ -274,23 +275,28 @@ handleRead headersOnly identifier context@RequestContext{..} = do bField configDbPreparedStatements - total <- readTotal ctxConfig ctxApiRequest tableTotal countQuery - response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders + case resultSet of + RSStandard{..} -> do + total <- readTotal ctxConfig ctxApiRequest rsTableTotal countQuery + response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders - let - (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange queryTotal total - headers = - [ contentRange - , ( "Content-Location" - , "/" - <> toUtf8 (qiName identifier) - <> if BS.null (qsCanonical iQueryParams) then mempty else "?" <> qsCanonical iQueryParams - ) - ] - ++ contentTypeHeaders context + let + (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal total + headers = + [ contentRange + , ( "Content-Location" + , "/" + <> toUtf8 (qiName identifier) + <> if BS.null (qsCanonical iQueryParams) then mempty else "?" <> qsCanonical iQueryParams + ) + ] + ++ contentTypeHeaders context - failNotSingular iAcceptMediaType queryTotal . response status headers $ - if headersOnly then mempty else LBS.fromStrict body + failNotSingular iAcceptMediaType rsQueryTotal . response status headers $ + if headersOnly then mempty else LBS.fromStrict rsBody + + RSPlan plan -> + pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan readTotal :: AppConfig -> ApiRequest -> Maybe Int64 -> SQL.Snippet -> DbHandler (Maybe Int64) readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery = @@ -306,7 +312,7 @@ readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery = return tableTotal where explain = - lift . SQL.statement mempty . Statements.createExplainStatement countQuery $ + lift . SQL.statement mempty . Statements.preparePlanRows countQuery $ configDbPreparedStatements handleCreate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response @@ -317,34 +323,41 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do then maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure else mempty - WriteQueryResult{..} <- writeQuery MutationCreate identifier True pkCols context + resultSet <- writeQuery MutationCreate identifier True pkCols context - let - response = gucResponse resGucStatus resGucHeaders - headers = - catMaybes - [ if null resFields then - Nothing - else - Just - ( HTTP.hLocation - , "/" - <> toUtf8 qiName - <> HTTP.renderSimpleQuery True (splitKeyValue <$> resFields) - ) - , Just . RangeQuery.contentRangeH 1 0 $ - if shouldCount iPreferCount then Just resQueryTotal else Nothing - , if null pkCols && isNothing (qsOnConflict iQueryParams) then - Nothing - else - toAppliedHeader <$> iPreferResolution - ] + case resultSet of + RSStandard{..} -> do - failNotSingular iAcceptMediaType resQueryTotal $ - if iPreferRepresentation == Full then - response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict resBody) - else - response HTTP.status201 headers mempty + response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders + + let + headers = + catMaybes + [ if null rsLocation then + Nothing + else + Just + ( HTTP.hLocation + , "/" + <> toUtf8 qiName + <> HTTP.renderSimpleQuery True rsLocation + ) + , Just . RangeQuery.contentRangeH 1 0 $ + if shouldCount iPreferCount then Just rsQueryTotal else Nothing + , if null pkCols && isNothing (qsOnConflict iQueryParams) then + Nothing + else + toAppliedHeader <$> iPreferResolution + ] + + failNotSingular iAcceptMediaType rsQueryTotal $ + if iPreferRepresentation == Full then + response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict rsBody) + else + response HTTP.status201 headers mempty + + RSPlan plan -> + pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response handleUpdate identifier context@RequestContext{..} = do @@ -352,68 +365,87 @@ handleUpdate identifier context@RequestContext{..} = do ApiRequest{..} = ctxApiRequest pkCols = maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure - WriteQueryResult{..} <- writeQuery MutationUpdate identifier False pkCols context + resultSet <- writeQuery MutationUpdate identifier False pkCols context - let - response = gucResponse resGucStatus resGucHeaders - fullRepr = iPreferRepresentation == Full - updateIsNoOp = S.null iColumns - status - | resQueryTotal == 0 && not updateIsNoOp = HTTP.status404 - | fullRepr = HTTP.status200 - | otherwise = HTTP.status204 - contentRangeHeader = - RangeQuery.contentRangeH 0 (resQueryTotal - 1) $ - if shouldCount iPreferCount then Just resQueryTotal else Nothing + case resultSet of + RSStandard{..} -> do + response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders - failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resQueryTotal =<< - failNotSingular iAcceptMediaType resQueryTotal ( - if fullRepr then - response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict resBody) - else - response status [contentRangeHeader] mempty) + let + fullRepr = iPreferRepresentation == Full + updateIsNoOp = S.null iColumns + status + | rsQueryTotal == 0 && not updateIsNoOp = HTTP.status404 + | fullRepr = HTTP.status200 + | otherwise = HTTP.status204 + contentRangeHeader = + RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $ + if shouldCount iPreferCount then Just rsQueryTotal else Nothing + + failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<< + failNotSingular iAcceptMediaType rsQueryTotal ( + if fullRepr then + response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict rsBody) + else + response status [contentRangeHeader] mempty) + + RSPlan plan -> + pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response handleSingleUpsert identifier context@(RequestContext _ ctxDbStructure ApiRequest{..} _) = do let pkCols = maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure - WriteQueryResult{..} <- writeQuery MutationSingleUpsert identifier False pkCols context + resultSet <- writeQuery MutationSingleUpsert identifier False pkCols context - let response = gucResponse resGucStatus resGucHeaders + case resultSet of + RSStandard {..} -> do - -- Makes sure the querystring pk matches the payload pk - -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted, - -- PUT /items?id=eq.14 { "id" : 2, .. } is rejected. - -- If this condition is not satisfied then nothing is inserted, - -- check the WHERE for INSERT in QueryBuilder.hs to see how it's done - when (resQueryTotal /= 1) $ do - lift SQL.condemn - throwError Error.PutMatchingPkError + response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders - return $ - if iPreferRepresentation == Full then - response HTTP.status200 (contentTypeHeaders context) (LBS.fromStrict resBody) - else - response HTTP.status204 [] mempty + -- Makes sure the querystring pk matches the payload pk + -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted, + -- PUT /items?id=eq.14 { "id" : 2, .. } is rejected. + -- If this condition is not satisfied then nothing is inserted, + -- check the WHERE for INSERT in QueryBuilder.hs to see how it's done + when (rsQueryTotal /= 1) $ do + lift SQL.condemn + throwError Error.PutMatchingPkError + + return $ + if iPreferRepresentation == Full then + response HTTP.status200 (contentTypeHeaders context) (LBS.fromStrict rsBody) + else + response HTTP.status204 [] mempty + + RSPlan plan -> + pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do - WriteQueryResult{..} <- writeQuery MutationDelete identifier False mempty context + resultSet <- writeQuery MutationDelete identifier False mempty context - let - response = gucResponse resGucStatus resGucHeaders - contentRangeHeader = - RangeQuery.contentRangeH 1 0 $ - if shouldCount iPreferCount then Just resQueryTotal else Nothing + case resultSet of + RSStandard {..} -> do - failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resQueryTotal =<< - failNotSingular iAcceptMediaType resQueryTotal ( - if iPreferRepresentation == Full then - response HTTP.status200 - (contentTypeHeaders context ++ [contentRangeHeader]) - (LBS.fromStrict resBody) - else - response HTTP.status204 [contentRangeHeader] mempty) + response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders + + let + contentRangeHeader = + RangeQuery.contentRangeH 1 0 $ + if shouldCount iPreferCount then Just rsQueryTotal else Nothing + + failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<< + failNotSingular iAcceptMediaType rsQueryTotal ( + if iPreferRepresentation == Full then + response HTTP.status200 + (contentTypeHeaders context ++ [contentRangeHeader]) + (LBS.fromStrict rsBody) + else + response HTTP.status204 [contentRangeHeader] mempty) + + RSPlan plan -> + pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan handleInfo :: Monad m => Target -> RequestContext -> Handler m Wai.Response handleInfo target RequestContext{..} = @@ -453,9 +485,9 @@ handleInvoke invMethod proc context@RequestContext{..} = do let callReq = ReqBuilder.callRequest proc ctxApiRequest req - (tableTotal, queryTotal, body, gucHeaders, gucStatus) <- + resultSet <- lift . SQL.statement mempty $ - Statements.callProcStatement + Statements.prepareCall (Proc.procReturnsScalar proc) (Proc.procReturnsSingle proc) (QueryBuilder.requestToCallProcQuery callReq) @@ -467,19 +499,23 @@ handleInvoke invMethod proc context@RequestContext{..} = do bField (configDbPreparedStatements ctxConfig) - response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders + case resultSet of + RSStandard {..} -> do + response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders + let + (status, contentRange) = + RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal - let - (status, contentRange) = - RangeQuery.rangeStatusHeader iTopLevelRange queryTotal tableTotal + failNotSingular iAcceptMediaType rsQueryTotal $ + if Proc.procReturnsVoid proc then + response HTTP.status204 [contentRange] mempty + else + response status + (contentTypeHeaders context ++ [contentRange]) + (if invMethod == InvHead then mempty else LBS.fromStrict rsBody) - failNotSingular iAcceptMediaType queryTotal $ - if Proc.procReturnsVoid proc then - response HTTP.status204 [contentRange] mempty - else - response status - (contentTypeHeaders context ++ [contentRange]) - (if invMethod == InvHead then mempty else LBS.fromStrict body) + RSPlan plan -> + pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest ctxPgVersion) = do @@ -523,16 +559,7 @@ txMode ApiRequest{..} = _ -> SQL.Write --- | Result from executing a write query on the database -data WriteQueryResult = WriteQueryResult - { resQueryTotal :: Int64 - , resFields :: [ByteString] - , resBody :: ByteString - , resGucStatus :: Maybe HTTP.Status - , resGucHeaders :: [GucHeader] - } - -writeQuery :: Mutation -> QualifiedIdentifier -> Bool -> [Text] -> RequestContext -> DbHandler WriteQueryResult +writeQuery :: Mutation -> QualifiedIdentifier -> Bool -> [Text] -> RequestContext -> DbHandler ResultSet writeQuery mutation identifier@QualifiedIdentifier{..} isInsert pkCols context@RequestContext{..} = do readReq <- readRequest identifier context @@ -542,18 +569,15 @@ writeQuery mutation identifier@QualifiedIdentifier{..} isInsert pkCols context@R pkCols readReq - (_, queryTotal, fields, body, gucHeaders, gucStatus) <- - lift . SQL.statement mempty $ - Statements.createWriteStatement - (QueryBuilder.readRequestToQuery readReq) - (QueryBuilder.mutateRequestToQuery mutateReq) - isInsert - (iAcceptMediaType ctxApiRequest) - (iPreferRepresentation ctxApiRequest) - pkCols - (configDbPreparedStatements ctxConfig) - - liftEither $ WriteQueryResult queryTotal fields body <$> gucStatus <*> gucHeaders + lift . SQL.statement mempty $ + Statements.prepareWrite + (QueryBuilder.readRequestToQuery readReq) + (QueryBuilder.mutateRequestToQuery mutateReq) + isInsert + (iAcceptMediaType ctxApiRequest) + (iPreferRepresentation ctxApiRequest) + pkCols + (configDbPreparedStatements ctxConfig) -- | Response with headers and status overridden from GUCs. gucResponse @@ -632,9 +656,3 @@ binaryField RequestContext{..} readReq profileHeader :: ApiRequest -> Maybe HTTP.Header profileHeader ApiRequest{..} = (,) "Content-Profile" <$> (toUtf8 <$> iProfile) - -splitKeyValue :: ByteString -> (ByteString, ByteString) -splitKeyValue kv = - (k, BS.tail v) - where - (k, v) = BS.break (== '=') kv diff --git a/src/PostgREST/CLI.hs b/src/PostgREST/CLI.hs index 338549697..fcff5efcf 100644 --- a/src/PostgREST/CLI.hs +++ b/src/PostgREST/CLI.hs @@ -144,6 +144,9 @@ exampleConfigFile = |## Limit rows in response |# db-max-rows = 1000 | + |## Allow getting the EXPLAIN plan through the `Accept: application/vnd.pgrst.plan` header + |# db-plan-enabled = false + | |## Number of open connections in the pool |db-pool = 10 | diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 331e82ffb..2247e908b 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -69,6 +69,7 @@ data AppConfig = AppConfig , configDbChannelEnabled :: Bool , configDbExtraSearchPath :: [Text] , configDbMaxRows :: Maybe Integer + , configDbPlanEnabled :: Bool , configDbPoolSize :: Int , configDbPoolTimeout :: NominalDiffTime , configDbPreRequest :: Maybe QualifiedIdentifier @@ -128,6 +129,7 @@ toText conf = ,("db-channel-enabled", T.toLower . show . configDbChannelEnabled) ,("db-extra-search-path", q . T.intercalate "," . configDbExtraSearchPath) ,("db-max-rows", maybe "\"\"" show . configDbMaxRows) + ,("db-plan-enabled", T.toLower . show . configDbPlanEnabled) ,("db-pool", show . configDbPoolSize) ,("db-pool-timeout", show . floor . configDbPoolTimeout) ,("db-pre-request", q . maybe mempty dumpQi . configDbPreRequest) @@ -216,6 +218,7 @@ parser optPath env dbSettings = <*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path") <*> optWithAlias (optInt "db-max-rows") (optInt "max-rows") + <*> (fromMaybe False <$> optBool "db-plan-enabled") <*> (fromMaybe 10 <$> optInt "db-pool") <*> (fromIntegral . fromMaybe 3600 <$> optInt "db-pool-timeout") <*> (fmap toQi <$> optWithAlias (optString "db-pre-request") diff --git a/src/PostgREST/Config/PgVersion.hs b/src/PostgREST/Config/PgVersion.hs index 8aa372752..69f5d5265 100644 --- a/src/PostgREST/Config/PgVersion.hs +++ b/src/PostgREST/Config/PgVersion.hs @@ -9,6 +9,7 @@ module PostgREST.Config.PgVersion , pgVersion110 , pgVersion112 , pgVersion114 + , pgVersion120 , pgVersion121 , pgVersion130 , pgVersion140 @@ -50,6 +51,9 @@ pgVersion112 = PgVersion 110002 "11.2" pgVersion114 :: PgVersion pgVersion114 = PgVersion 110004 "11.4" +pgVersion120 :: PgVersion +pgVersion120 = PgVersion 120000 "12.0" + pgVersion121 :: PgVersion pgVersion121 = PgVersion 120001 "12.1" diff --git a/src/PostgREST/MediaType.hs b/src/PostgREST/MediaType.hs index 6f7424049..5c0347148 100644 --- a/src/PostgREST/MediaType.hs +++ b/src/PostgREST/MediaType.hs @@ -2,6 +2,9 @@ module PostgREST.MediaType ( MediaType(..) + , MTPlanOption (..) + , MTPlanFormat (..) + , MTPlanAttrs(..) , toContentType , toMime , decodeMediaType @@ -27,7 +30,18 @@ data MediaType | MTOctetStream | MTAny | MTOther ByteString - deriving (Eq) + | MTPlan MTPlanAttrs + deriving Eq + +data MTPlanAttrs = MTPlanAttrs MTPlanFormat [MTPlanOption] +instance Eq MTPlanAttrs where + MTPlanAttrs {} == MTPlanAttrs {} = True -- we don't care about the attributes when comparing two MTPlan media types + +data MTPlanOption + = PlanAnalyze | PlanVerbose | PlanSettings | PlanBuffers | PlanWAL + +data MTPlanFormat + = PlanJSON | PlanText -- | Convert MediaType to a Content-Type HTTP Header toContentType :: MediaType -> Header @@ -51,20 +65,47 @@ toMime MTUrlEncoded = "application/x-www-form-urlencoded" toMime MTOctetStream = "application/octet-stream" toMime MTAny = "*/*" toMime (MTOther ct) = ct +toMime (MTPlan (MTPlanAttrs fmt opts)) = "application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <> + if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts) + +toMimePlanOption :: MTPlanOption -> ByteString +toMimePlanOption PlanAnalyze = "analyze" +toMimePlanOption PlanVerbose = "verbose" +toMimePlanOption PlanSettings = "settings" +toMimePlanOption PlanBuffers = "buffers" +toMimePlanOption PlanWAL = "wal" + +toMimePlanFormat :: MTPlanFormat -> ByteString +toMimePlanFormat PlanJSON = "json" +toMimePlanFormat PlanText = "text" -- | Convert from ByteString to MediaType. Warning: discards MIME parameters decodeMediaType :: BS.ByteString -> MediaType -decodeMediaType ct = - case BS.takeWhile (/= BS.c2w ';') ct of - "application/json" -> MTApplicationJSON - "application/geo+json" -> MTGeoJSON - "text/csv" -> MTTextCSV - "text/plain" -> MTTextPlain - "text/xml" -> MTTextXML - "application/openapi+json" -> MTOpenAPI - "application/vnd.pgrst.object+json" -> MTSingularJSON - "application/vnd.pgrst.object" -> MTSingularJSON - "application/x-www-form-urlencoded" -> MTUrlEncoded - "application/octet-stream" -> MTOctetStream - "*/*" -> MTAny - ct' -> MTOther ct' +decodeMediaType mt = + case BS.split (BS.c2w ';') mt of + "application/json":_ -> MTApplicationJSON + "application/geo+json":_ -> MTGeoJSON + "text/csv":_ -> MTTextCSV + "text/plain":_ -> MTTextPlain + "text/xml":_ -> MTTextXML + "application/openapi+json":_ -> MTOpenAPI + "application/vnd.pgrst.object+json":_ -> MTSingularJSON + "application/vnd.pgrst.object":_ -> MTSingularJSON + "application/x-www-form-urlencoded":_ -> MTUrlEncoded + "application/octet-stream":_ -> MTOctetStream + "application/vnd.pgrst.plan":rest -> getPlan PlanJSON rest + "application/vnd.pgrst.plan+json":rest -> getPlan PlanJSON rest + "application/vnd.pgrst.plan+text":rest -> getPlan PlanText rest + "*/*":_ -> MTAny + other:_ -> MTOther other + _ -> MTAny + where + getPlan fmt rest = + let opts = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest) + inOpts str = str `elem` opts in + MTPlan $ MTPlanAttrs fmt $ + [PlanAnalyze | inOpts "analyze" ] ++ + [PlanVerbose | inOpts "verbose" ] ++ + [PlanSettings | inOpts "settings"] ++ + [PlanBuffers | inOpts "buffers" ] ++ + [PlanWAL | inOpts "wal" ] diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index 1e70fae90..ed90eb2f7 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -37,6 +37,7 @@ module PostgREST.Query.SqlFragment , sourceCTEName , unknownEncoder , intercalateSnippet + , explainF ) where import qualified Data.ByteString.Char8 as BS @@ -50,6 +51,8 @@ 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.ReadQuery (SelectItem) @@ -367,3 +370,19 @@ unknownLiteral = unknownEncoder . encodeUtf8 intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet intercalateSnippet _ [] = mempty intercalateSnippet frag snippets = foldr1 (\a b -> a <> SQL.sql frag <> b) snippets + +explainF :: MTPlanFormat -> [MTPlanOption] -> SQL.Snippet -> SQL.Snippet +explainF fmt opts snip = + "EXPLAIN (" <> + SQL.sql (BS.intercalate ", " (fmtPlanFmt fmt : (fmtPlanOpt <$> opts))) <> + ") " <> snip + where + fmtPlanOpt :: MTPlanOption -> BS.ByteString + fmtPlanOpt PlanAnalyze = "ANALYZE" + fmtPlanOpt PlanVerbose = "VERBOSE" + fmtPlanOpt PlanSettings = "SETTINGS" + fmtPlanOpt PlanBuffers = "BUFFERS" + fmtPlanOpt PlanWAL = "WAL" + + fmtPlanFmt PlanJSON = "FORMAT JSON" + fmtPlanFmt PlanText = "FORMAT TEXT" diff --git a/src/PostgREST/Query/Statements.hs b/src/PostgREST/Query/Statements.hs index e65b98f75..368ab3279 100644 --- a/src/PostgREST/Query/Statements.hs +++ b/src/PostgREST/Query/Statements.hs @@ -8,10 +8,11 @@ This module constructs single SQL statements that can be parametrized and prepar - It generates the body format and some headers of the final HTTP response. -} module PostgREST.Query.Statements - ( createWriteStatement - , createReadStatement - , callProcStatement - , createExplainStatement + ( prepareWrite + , prepareRead + , prepareCall + , preparePlanRows + , ResultSet (..) ) where import qualified Data.Aeson as JSON @@ -32,23 +33,38 @@ import PostgREST.Error (Error (..)) import PostgREST.GucHeader (GucHeader) import PostgREST.DbStructure.Identifiers (FieldName) -import PostgREST.MediaType (MediaType (..)) +import PostgREST.MediaType (MTPlanAttrs (..), + MTPlanFormat (..), + MediaType (..)) import PostgREST.Query.SqlFragment import PostgREST.Request.Preferences import Protolude -{-| The generic query result format used by API responses. The location header - is represented as a list of strings containing variable bindings like - @"k1=eq.42"@, or the empty list if there is no location header. --} -type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Error [GucHeader], Either Error (Maybe Status)) +-- | Standard result set format used for all queries +data ResultSet + = RSStandard + { rsTableTotal :: Maybe Int64 + -- ^ count of all the table rows + , rsQueryTotal :: Int64 + -- ^ count of the query rows + , rsLocation :: [(BS.ByteString, BS.ByteString)] + -- ^ The Location header(only used for inserts) is represented as a list of strings containing + -- variable bindings like @"k1=eq.42"@, or the empty list if there is no location header. + , rsBody :: BS.ByteString + -- ^ the aggregated body of the query + , rsGucHeaders :: Either Error [GucHeader] + -- ^ the HTTP headers to be added to the response + , rsGucStatus :: Either Error (Maybe Status) + -- ^ the HTTP status to be added to the response + } + | RSPlan BS.ByteString -- ^ the plan of the query -createWriteStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> - PreferRepresentation -> [Text] -> Bool -> - SQL.Statement () ResultsWithCount -createWriteStatement selectQuery mutateQuery isInsert mediaType rep pKeys = - SQL.dynamicallyParameterized snippet decodeStandard + +prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> + PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet +prepareWrite selectQuery mutateQuery isInsert mediaType rep pKeys = + SQL.dynamicallyParameterized (mtSnippet mediaType snippet) decodeIt where snippet = "WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <> @@ -84,14 +100,14 @@ createWriteStatement selectQuery mutateQuery isInsert mediaType rep pKeys = | rep /= Full = SQL.sql ("SELECT * FROM " <> sourceCTEName) | otherwise = selectQuery - decodeStandard :: HD.Result ResultsWithCount - decodeStandard = - fromMaybe (Nothing, 0, [], mempty, Right [], Right Nothing) <$> HD.rowMaybe standardRow + decodeIt :: HD.Result ResultSet + decodeIt = case mediaType of + MTPlan{} -> planRow + _ -> fromMaybe (RSStandard Nothing 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow False) -createReadStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> Maybe FieldName -> Bool -> - SQL.Statement () ResultsWithCount -createReadStatement selectQuery countQuery countTotal mediaType binaryField = - SQL.dynamicallyParameterized snippet decodeStandard +prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> Maybe FieldName -> Bool -> SQL.Statement () ResultSet +prepareRead selectQuery countQuery countTotal mediaType binaryField = + SQL.dynamicallyParameterized (mtSnippet mediaType snippet) decodeIt where snippet = "WITH " <> @@ -100,7 +116,6 @@ createReadStatement selectQuery countQuery countTotal mediaType binaryField = SQL.sql ("SELECT " <> countResultF <> " AS total_result_set, " <> "pg_catalog.count(_postgrest_t) AS page_total, " <> - noLocationF <> " AS header, " <> bodyF <> " AS body, " <> responseHeadersF <> " AS response_headers, " <> responseStatusF <> " AS response_status " <> @@ -116,27 +131,16 @@ createReadStatement selectQuery countQuery countTotal mediaType binaryField = | isJust binaryField = asBinaryF $ fromJust binaryField | otherwise = asJsonF False - decodeStandard :: HD.Result ResultsWithCount - decodeStandard = - HD.singleRow standardRow + decodeIt :: HD.Result ResultSet + decodeIt = case mediaType of + MTPlan{} -> planRow + _ -> HD.singleRow $ standardRow True -{-| Read and Write api requests use a similar response format which includes - various record counts and possible location header. This is the decoder - for that common type of query. --} -standardRow :: HD.Row ResultsWithCount -standardRow = (,,,,,) <$> nullableColumn HD.int8 <*> column HD.int8 - <*> arrayColumn HD.bytea <*> column HD.bytea - <*> (fromMaybe (Right []) <$> nullableColumn decodeGucHeaders) - <*> (fromMaybe (Right Nothing) <$> nullableColumn decodeGucStatus) - -type ProcResults = (Maybe Int64, Int64, ByteString, Either Error [GucHeader], Either Error (Maybe Status)) - -callProcStatement :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool -> - MediaType -> Bool -> Maybe FieldName -> Bool -> - SQL.Statement () ProcResults -callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mediaType multObjects binaryField = - SQL.dynamicallyParameterized snippet decodeProc +prepareCall :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool -> + MediaType -> Bool -> Maybe FieldName -> Bool -> + SQL.Statement () ResultSet +prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mediaType multObjects binaryField = + SQL.dynamicallyParameterized (mtSnippet mediaType snippet) decodeIt where snippet = "WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <> @@ -161,35 +165,42 @@ callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQue | returnsSingle && not multObjects = asJsonSingleF returnsScalar | otherwise = asJsonF returnsScalar - decodeProc :: HD.Result ProcResults - decodeProc = - fromMaybe (Just 0, 0, mempty, defGucHeaders, defGucStatus) <$> HD.rowMaybe procRow - where - defGucHeaders = Right [] - defGucStatus = Right Nothing - procRow = (,,,,) <$> nullableColumn HD.int8 <*> column HD.int8 - <*> column HD.bytea - <*> (fromMaybe defGucHeaders <$> nullableColumn decodeGucHeaders) - <*> (fromMaybe defGucStatus <$> nullableColumn decodeGucStatus) + decodeIt :: HD.Result ResultSet + decodeIt = case mediaType of + MTPlan{} -> planRow + _ -> fromMaybe (RSStandard (Just 0) 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow True) -createExplainStatement :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64) -createExplainStatement countQuery = - SQL.dynamicallyParameterized snippet decodeExplain +preparePlanRows :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64) +preparePlanRows countQuery = + SQL.dynamicallyParameterized snippet decodeIt where - snippet = "EXPLAIN (FORMAT JSON) " <> countQuery - -- | - -- An `EXPLAIN (FORMAT JSON) select * from items;` output looks like this: - -- [{ - -- "Plan": { - -- "Node Type": "Seq Scan", "Parallel Aware": false, "Relation Name": "items", - -- "Alias": "items", "Startup Cost": 0.00, "Total Cost": 32.60, - -- "Plan Rows": 2260,"Plan Width": 8} }] - -- We only obtain the Plan Rows here. - decodeExplain :: HD.Result (Maybe Int64) - decodeExplain = + snippet = explainF PlanJSON mempty countQuery + decodeIt :: HD.Result (Maybe Int64) + decodeIt = let row = HD.singleRow $ column HD.bytea in (^? L.nth 0 . L.key "Plan" . L.key "Plan Rows" . L._Integral) <$> row +standardRow :: Bool -> HD.Row ResultSet +standardRow noLocation = + RSStandard <$> nullableColumn HD.int8 <*> column HD.int8 + <*> (if noLocation then pure mempty else fmap splitKeyValue <$> arrayColumn HD.bytea) <*> column HD.bytea + <*> (fromMaybe (Right []) <$> nullableColumn decodeGucHeaders) + <*> (fromMaybe (Right Nothing) <$> nullableColumn decodeGucStatus) + where + splitKeyValue :: ByteString -> (ByteString, ByteString) + splitKeyValue kv = + let (k, v) = BS.break (== '=') kv in + (k, BS.tail v) + +mtSnippet :: MediaType -> SQL.Snippet -> SQL.Snippet +mtSnippet mediaType snippet = case mediaType of + MTPlan (MTPlanAttrs fmt opts) -> explainF fmt opts snippet + _ -> snippet + +-- | We use rowList because when doing EXPLAIN (FORMAT TEXT), the result comes as many rows. FORMAT JSON comes as one. +planRow :: HD.Result ResultSet +planRow = RSPlan . BS.unlines <$> HD.rowList (column HD.bytea) + decodeGucHeaders :: HD.Value (Either Error [GucHeader]) decodeGucHeaders = first (const GucHeadersError) . JSON.eitherDecode . LBS.fromStrict <$> HD.bytea diff --git a/src/PostgREST/Request/ApiRequest.hs b/src/PostgREST/Request/ApiRequest.hs index 9114d407e..62fda6e23 100644 --- a/src/PostgREST/Request/ApiRequest.hs +++ b/src/PostgREST/Request/ApiRequest.hs @@ -51,7 +51,9 @@ import PostgREST.DbStructure.Identifiers (FieldName, Schema) import PostgREST.DbStructure.Proc (ProcDescription (..), ProcParam (..), ProcsMap) -import PostgREST.MediaType (MediaType (..)) +import PostgREST.MediaType (MTPlanAttrs (..), + MTPlanFormat (..), + MediaType (..)) import PostgREST.RangeQuery (NonnegRange, allRange, hasLimitZero, limitZeroRange, @@ -426,7 +428,8 @@ requestMediaTypes conf action path = ++ rawMediaTypes ++ [MTOpenAPI | pathIsRootSpec path] defaultMediaTypes = - [MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] + [MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++ + [MTPlan $ MTPlanAttrs PlanJSON mempty | configDbPlanEnabled conf] rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML] {-| diff --git a/test/io/configs/expected/aliases.config b/test/io/configs/expected/aliases.config index 24282ea9c..fa4b22109 100644 --- a/test/io/configs/expected/aliases.config +++ b/test/io/configs/expected/aliases.config @@ -3,6 +3,7 @@ db-channel = "pgrst" db-channel-enabled = true db-extra-search-path = "public" db-max-rows = 1000 +db-plan-enabled = false db-pool = 10 db-pool-timeout = 3600 db-pre-request = "check_alias" diff --git a/test/io/configs/expected/boolean-numeric.config b/test/io/configs/expected/boolean-numeric.config index da7be5a65..bfa15b0f0 100644 --- a/test/io/configs/expected/boolean-numeric.config +++ b/test/io/configs/expected/boolean-numeric.config @@ -3,6 +3,7 @@ db-channel = "pgrst" db-channel-enabled = true db-extra-search-path = "public" db-max-rows = "" +db-plan-enabled = false db-pool = 10 db-pool-timeout = 3600 db-pre-request = "" diff --git a/test/io/configs/expected/boolean-string.config b/test/io/configs/expected/boolean-string.config index da7be5a65..bfa15b0f0 100644 --- a/test/io/configs/expected/boolean-string.config +++ b/test/io/configs/expected/boolean-string.config @@ -3,6 +3,7 @@ db-channel = "pgrst" db-channel-enabled = true db-extra-search-path = "public" db-max-rows = "" +db-plan-enabled = false db-pool = 10 db-pool-timeout = 3600 db-pre-request = "" diff --git a/test/io/configs/expected/defaults.config b/test/io/configs/expected/defaults.config index 903f194e0..6bdc3298d 100644 --- a/test/io/configs/expected/defaults.config +++ b/test/io/configs/expected/defaults.config @@ -3,6 +3,7 @@ db-channel = "pgrst" db-channel-enabled = true db-extra-search-path = "public" db-max-rows = "" +db-plan-enabled = false db-pool = 10 db-pool-timeout = 3600 db-pre-request = "" diff --git a/test/io/configs/expected/no-defaults-with-db-other-authenticator.config b/test/io/configs/expected/no-defaults-with-db-other-authenticator.config index 3903c53a9..9a7c9b537 100644 --- a/test/io/configs/expected/no-defaults-with-db-other-authenticator.config +++ b/test/io/configs/expected/no-defaults-with-db-other-authenticator.config @@ -3,6 +3,7 @@ db-channel = "postgrest" db-channel-enabled = false db-extra-search-path = "public,extensions,other" db-max-rows = 100 +db-plan-enabled = true db-pool = 1 db-pool-timeout = 100 db-pre-request = "test.other_custom_headers" diff --git a/test/io/configs/expected/no-defaults-with-db.config b/test/io/configs/expected/no-defaults-with-db.config index 7cb1b8574..413513efe 100644 --- a/test/io/configs/expected/no-defaults-with-db.config +++ b/test/io/configs/expected/no-defaults-with-db.config @@ -3,6 +3,7 @@ db-channel = "postgrest" db-channel-enabled = false db-extra-search-path = "public,extensions,private" db-max-rows = 1000 +db-plan-enabled = true db-pool = 1 db-pool-timeout = 100 db-pre-request = "test.custom_headers" diff --git a/test/io/configs/expected/no-defaults.config b/test/io/configs/expected/no-defaults.config index d83c30915..a995811d6 100644 --- a/test/io/configs/expected/no-defaults.config +++ b/test/io/configs/expected/no-defaults.config @@ -3,6 +3,7 @@ db-channel = "postgrest" db-channel-enabled = false db-extra-search-path = "public,test" db-max-rows = 1000 +db-plan-enabled = true db-pool = 1 db-pool-timeout = 100 db-pre-request = "please_run_fast" diff --git a/test/io/configs/expected/types.config b/test/io/configs/expected/types.config index 718072452..b6dfe1333 100644 --- a/test/io/configs/expected/types.config +++ b/test/io/configs/expected/types.config @@ -3,6 +3,7 @@ db-channel = "pgrst" db-channel-enabled = true db-extra-search-path = "public" db-max-rows = "" +db-plan-enabled = false db-pool = 10 db-pool-timeout = 3600 db-pre-request = "" diff --git a/test/io/configs/no-defaults-env.yaml b/test/io/configs/no-defaults-env.yaml index 06002f463..59684b630 100644 --- a/test/io/configs/no-defaults-env.yaml +++ b/test/io/configs/no-defaults-env.yaml @@ -5,6 +5,7 @@ PGRST_DB_CHANNEL: postgrest PGRST_DB_CHANNEL_ENABLED: false PGRST_DB_EXTRA_SEARCH_PATH: public, test PGRST_DB_MAX_ROWS: 1000 +PGRST_DB_PLAN_ENABLED: true PGRST_DB_POOL: 1 PGRST_DB_POOL_TIMEOUT: 100 PGRST_DB_PREPARED_STATEMENTS: false diff --git a/test/io/configs/no-defaults.config b/test/io/configs/no-defaults.config index feac7aae5..e24682954 100644 --- a/test/io/configs/no-defaults.config +++ b/test/io/configs/no-defaults.config @@ -3,6 +3,7 @@ db-channel = "postgrest" db-channel-enabled = false db-extra-search-path = "public, test" db-max-rows = 1000 +db-plan-enabled = true db-pool = 1 db-pool-timeout = 100 db-pre-request = "please_run_fast" diff --git a/test/io/db_config.sql b/test/io/db_config.sql index e71d11440..cc8834a4f 100644 --- a/test/io/db_config.sql +++ b/test/io/db_config.sql @@ -11,6 +11,7 @@ ALTER ROLE db_config_authenticator SET pgrst.db_anon_role = 'anonymous'; ALTER ROLE db_config_authenticator SET pgrst.db_tx_end = 'commit-allow-override'; ALTER ROLE db_config_authenticator SET pgrst.db_schemas = 'test, tenant1, tenant2'; ALTER ROLE db_config_authenticator SET pgrst.db_root_spec = 'root'; +ALTER ROLE db_config_authenticator SET pgrst.db_plan_enabled = 'true'; ALTER ROLE db_config_authenticator SET pgrst.db_prepared_statements = 'false'; ALTER ROLE db_config_authenticator SET pgrst.db_pre_request = 'test.custom_headers'; ALTER ROLE db_config_authenticator SET pgrst.db_max_rows = '1000'; @@ -50,6 +51,7 @@ ALTER ROLE other_authenticator SET pgrst.db_anon_role = 'other'; ALTER ROLE other_authenticator SET pgrst.db_tx_end = 'rollback-allow-override'; ALTER ROLE other_authenticator SET pgrst.db_schemas = 'test, other_tenant1, other_tenant2'; ALTER ROLE other_authenticator SET pgrst.db_root_spec = 'other_root'; +ALTER ROLE other_authenticator SET pgrst.db_plan_enabled = 'true'; ALTER ROLE other_authenticator SET pgrst.db_prepared_statements = 'false'; ALTER ROLE other_authenticator SET pgrst.db_pre_request = 'test.other_custom_headers'; ALTER ROLE other_authenticator SET pgrst.db_max_rows = '100'; diff --git a/test/spec/Feature/Query/PlanSpec.hs b/test/spec/Feature/Query/PlanSpec.hs new file mode 100644 index 000000000..bec5d8905 --- /dev/null +++ b/test/spec/Feature/Query/PlanSpec.hs @@ -0,0 +1,232 @@ +module Feature.Query.PlanSpec where + +import Control.Lens ((^?)) +import Network.Wai (Application) +import Network.Wai.Test (SResponse (..)) + +import Data.Aeson.Lens +import Data.Aeson.QQ +import qualified Data.ByteString.Lazy as LBS +import Network.HTTP.Types +import Test.Hspec hiding (pendingWith) +import Test.Hspec.Wai +import Test.Hspec.Wai.JSON + +import PostgREST.Config.PgVersion (PgVersion, pgVersion120, + pgVersion130) +import Protolude hiding (get) +import SpecHelper + +spec :: PgVersion -> SpecWith ((), Application) +spec actualPgVersion = do + describe "read table/view plan" $ do + it "outputs the total cost for a single filter on a table" $ do + r <- request methodGet "/projects?id=in.(1,2,3)" + (acceptHdrs "application/vnd.pgrst.plan") "" + + let totalCost = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost" + resHeaders = simpleHeaders r + resStatus = simpleStatus r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } + totalCost `shouldBe` + if actualPgVersion > pgVersion120 + then Just [aesonQQ|15.63|] + else Just [aesonQQ|15.69|] + + it "outputs the total cost for a single filter on a view" $ do + r <- request methodGet "/projects_view?id=gt.2" + (acceptHdrs "application/vnd.pgrst.plan+json") "" + + let totalCost = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost" + resHeaders = simpleHeaders r + resStatus = simpleStatus r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } + totalCost `shouldBe` + if actualPgVersion > pgVersion120 + then Just [aesonQQ|24.28|] + else Just [aesonQQ|32.28|] + + it "outputs blocks info when using the buffers option" $ + if actualPgVersion >= pgVersion130 + then do + r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; options=buffers") "" + + let blocks = simpleBody r ^? nth 0 . key "Planning" + resHeaders = simpleHeaders r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=buffers; charset=utf-8") + blocks `shouldBe` + Just [aesonQQ| + { + "Shared Hit Blocks": 0, + "Shared Read Blocks": 0, + "Shared Dirtied Blocks": 0, + "Shared Written Blocks": 0, + "Local Hit Blocks": 0, + "Local Read Blocks": 0, + "Local Dirtied Blocks": 0, + "Local Written Blocks": 0, + "Temp Read Blocks": 0, + "Temp Written Blocks": 0 + } + |] + else do + -- analyze is required for buffers on pg < 13 + r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; options=analyze|buffers") "" + + let blocks = simpleBody r ^? nth 0 . key "Plan" . key "Shared Hit Blocks" + resHeaders = simpleHeaders r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=analyze|buffers; charset=utf-8") + blocks `shouldBe` Just [aesonQQ| 1.0 |] + + when (actualPgVersion >= pgVersion120) $ + it "outputs the search path when using the settings option" $ do + r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; options=settings") "" + + let searchPath = simpleBody r ^? nth 0 . key "Settings" + resHeaders = simpleHeaders r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=settings; charset=utf-8") + searchPath `shouldBe` + Just [aesonQQ| + { + "search_path": "\"test\"" + } + |] + + when (actualPgVersion >= pgVersion130) $ + it "outputs WAL info when using the wal option" $ do + r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; options=analyze|wal") "" + + let walRecords = simpleBody r ^? nth 0 . key "Plan" . key "WAL Records" + resHeaders = simpleHeaders r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=analyze|wal; charset=utf-8") + walRecords `shouldBe` Just [aesonQQ|0|] + + it "outputs columns info when using the verbose option" $ do + r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; options=verbose") "" + + let cols = simpleBody r ^? nth 0 . key "Plan" . key "Plans" . nth 0 . key "Output" + resHeaders = simpleHeaders r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=verbose; charset=utf-8") + cols `shouldBe` Just [aesonQQ| ["projects.id", "projects.name", "projects.client_id"] |] + + describe "writes plans" $ do + it "outputs the total cost for an insert" $ do + r <- request methodPost "/projects" + (acceptHdrs "application/vnd.pgrst.plan") [json|{"id":100, "name": "Project 100"}|] + + let totalCost = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost" + resHeaders = simpleHeaders r + resStatus = simpleStatus r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } + totalCost `shouldBe` + if actualPgVersion > pgVersion120 + then Just [aesonQQ|3.28|] + else Just [aesonQQ|3.33|] + + it "outputs the total cost for an update" $ do + r <- request methodPatch "/projects?id=eq.3" + (acceptHdrs "application/vnd.pgrst.plan") [json|{"name": "Patched Project"}|] + + let totalCost = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost" + resHeaders = simpleHeaders r + resStatus = simpleStatus r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } + totalCost `shouldBe` + if actualPgVersion > pgVersion120 + then Just [aesonQQ|12.45|] + else Just [aesonQQ|12.5|] + + it "outputs the total cost for a delete" $ do + r <- request methodDelete "/projects?id=in.(1,2,3)" + (acceptHdrs "application/vnd.pgrst.plan") "" + + let totalCost = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost" + resHeaders = simpleHeaders r + resStatus = simpleStatus r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } + totalCost `shouldBe` Just [aesonQQ|15.68|] + + it "outputs the total cost for a single upsert" $ do + r <- request methodPut "/tiobe_pls?name=eq.Go" + (acceptHdrs "application/vnd.pgrst.plan") + [json| [ { "name": "Go", "rank": 19 } ]|] + + let totalCost = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost" + resHeaders = simpleHeaders r + resStatus = simpleStatus r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } + totalCost `shouldBe` + if actualPgVersion >= pgVersion120 + then Just [aesonQQ|1.3|] + else Just [aesonQQ|1.35|] + + describe "function plan" $ do + it "outputs the total cost for a function call" $ do + r <- request methodGet "/rpc/getallprojects?id=in.(1,2,3)" + (acceptHdrs "application/vnd.pgrst.plan") "" + + let totalCost = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost" + resHeaders = simpleHeaders r + resStatus = simpleStatus r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } + totalCost `shouldBe` Just [aesonQQ|68.57|] + + describe "text format" $ + it "outputs the total cost for a function call" $ do + r <- request methodGet "/projects?id=in.(1,2,3)" + (acceptHdrs "application/vnd.pgrst.plan+text") "" + + let resBody = simpleBody r + resHeaders = simpleHeaders r + resStatus = simpleStatus r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+text; charset=utf-8") + resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } + resBody `shouldSatisfy` (\t -> LBS.take 9 t == "Aggregate") + +disabledSpec :: SpecWith ((), Application) +disabledSpec = + it "doesn't work if db-plan-enabled=false(the default)" $ do + request methodGet "/projects?id=in.(1,2,3)" + (acceptHdrs "application/vnd.pgrst.plan") "" + `shouldRespondWith` 415 + + request methodGet "/rpc/getallprojects?id=in.(1,2,3)" + (acceptHdrs "application/vnd.pgrst.plan") "" + `shouldRespondWith` 415 + + request methodDelete "/projects?id=in.(1,2,3)" + (acceptHdrs "application/vnd.pgrst.plan") "" + `shouldRespondWith` 415 diff --git a/test/spec/Main.hs b/test/spec/Main.hs index 60cab2a86..dc062b051 100644 --- a/test/spec/Main.hs +++ b/test/spec/Main.hs @@ -45,6 +45,7 @@ import qualified Feature.Query.HtmlRawOutputSpec import qualified Feature.Query.InsertSpec import qualified Feature.Query.JsonOperatorSpec import qualified Feature.Query.MultipleSchemaSpec +import qualified Feature.Query.PlanSpec import qualified Feature.Query.PostGISSpec import qualified Feature.Query.QueryLimitedSpec import qualified Feature.Query.QuerySpec @@ -110,6 +111,7 @@ main = do disallowRollbackApp = app testCfgDisallowRollback forceRollbackApp = app testCfgForceRollback testCfgLegacyGucsApp = app testCfgLegacyGucs + planEnabledApp = app testPlanEnabledCfg extraSearchPathApp = appDbs testCfgExtraSearchPath unicodeApp = appDbs testUnicodeCfg @@ -117,6 +119,7 @@ main = do multipleSchemaApp = appDbs testMultipleSchemaCfg ignorePrivOpenApi = appDbs testIgnorePrivOpenApiCfg + let analyze :: IO () analyze = do analyzeTable "items" @@ -134,6 +137,7 @@ main = do , ("Feature.Query.JsonOperatorSpec" , Feature.Query.JsonOperatorSpec.spec actualPgVersion) , ("Feature.OpenApi.OpenApiSpec" , Feature.OpenApi.OpenApiSpec.spec actualPgVersion) , ("Feature.OptionsSpec" , Feature.OptionsSpec.spec actualPgVersion) + , ("Feature.Query.PlanSpec.disabledSpec" , Feature.Query.PlanSpec.disabledSpec) , ("Feature.Query.QuerySpec" , Feature.Query.QuerySpec.spec actualPgVersion) , ("Feature.Query.RawOutputTypesSpec" , Feature.Query.RawOutputTypesSpec.spec) , ("Feature.Query.RpcSpec" , Feature.Query.RpcSpec.spec actualPgVersion) @@ -226,6 +230,10 @@ main = do parallel $ before testCfgLegacyGucsApp $ describe "Feature.LegacyGucsSpec" Feature.LegacyGucsSpec.spec + -- this test runs with db-plan-enabled = true + parallel $ before planEnabledApp $ + describe "Feature.Query.PlanSpec.spec" $ Feature.Query.PlanSpec.spec actualPgVersion + -- Note: the rollback tests can not run in parallel, because they test persistance and -- this results in race conditions diff --git a/test/spec/QueryCost.hs b/test/spec/QueryCost.hs index 1ede9727b..130280a2d 100644 --- a/test/spec/QueryCost.hs +++ b/test/spec/QueryCost.hs @@ -1,3 +1,4 @@ +-- TODO Can be replaced now by obtaining the EXPLAIN plan and adding the cost tests on PlanSpec.hs module Main where import Control.Lens ((^?)) diff --git a/test/spec/SpecHelper.hs b/test/spec/SpecHelper.hs index cba7d2bc5..8f8ad72a8 100644 --- a/test/spec/SpecHelper.hs +++ b/test/spec/SpecHelper.hs @@ -76,6 +76,7 @@ baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in , configDbChannelEnabled = True , configDbExtraSearchPath = [] , configDbMaxRows = Nothing + , configDbPlanEnabled = False , configDbPoolSize = 10 , configDbPoolTimeout = 10 , configDbPreRequest = Just $ QualifiedIdentifier "test" "switch_role" @@ -138,6 +139,9 @@ testProxyCfg = baseCfg { configOpenApiServerProxyUri = Just "https://postgrest.c testSecurityOpenApiCfg :: AppConfig testSecurityOpenApiCfg = baseCfg { configOpenApiSecurityActive = True } +testPlanEnabledCfg :: AppConfig +testPlanEnabledCfg = baseCfg { configDbPlanEnabled = True } + testCfgBinaryJWT :: AppConfig testCfgBinaryJWT = let secret = Just . B64.decodeLenient $ "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU=" in