feat: Allow getting the EXPLAIN plan of a request

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
 

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;

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

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) <-
+  resultSet <-
      lift . SQL.statement mempty $
-      Statements.createReadStatement
+      Statements.prepareRead
         (QueryBuilder.readRequestToQuery req)
         (if iPreferCount == Just EstimatedCount then
            -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
@@ -274,11 +275,13 @@ handleRead headersOnly identifier context@RequestContext{..} = do
         bField
         configDbPreparedStatements
 
-  total <- readTotal ctxConfig ctxApiRequest tableTotal countQuery
+  case resultSet of
-  response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders
+    RSStandard{..} -> do
+      total <- readTotal ctxConfig ctxApiRequest rsTableTotal countQuery
+      response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
 
       let
-    (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange queryTotal total
+        (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal total
         headers =
           [ contentRange
           , ( "Content-Location"
@@ -289,8 +292,11 @@ handleRead headersOnly identifier context@RequestContext{..} = do
           ]
           ++ contentTypeHeaders context
 
-  failNotSingular iAcceptMediaType queryTotal . response status headers $
+      failNotSingular iAcceptMediaType rsQueryTotal . response status headers $
-    if headersOnly then mempty else LBS.fromStrict body
+        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,104 +323,130 @@ 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
+
+  case resultSet of
+    RSStandard{..} -> do
+
+      response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
 
       let
-    response = gucResponse resGucStatus resGucHeaders
         headers =
           catMaybes
-        [ if null resFields then
+            [ if null rsLocation then
                 Nothing
               else
                 Just
                   ( HTTP.hLocation
                   , "/"
                       <> toUtf8 qiName
-                  <> HTTP.renderSimpleQuery True (splitKeyValue <$> resFields)
+                      <> HTTP.renderSimpleQuery True rsLocation
                   )
             , Just . RangeQuery.contentRangeH 1 0 $
-            if shouldCount iPreferCount then Just resQueryTotal else Nothing
+                if shouldCount iPreferCount then Just rsQueryTotal else Nothing
             , if null pkCols && isNothing (qsOnConflict iQueryParams) then
                 Nothing
               else
                 toAppliedHeader <$> iPreferResolution
             ]
 
-  failNotSingular iAcceptMediaType resQueryTotal $
+      failNotSingular iAcceptMediaType rsQueryTotal $
         if iPreferRepresentation == Full then
-      response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict resBody)
+          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
   let
     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
+
+  case resultSet of
+    RSStandard{..} -> do
+      response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
 
       let
-    response = gucResponse resGucStatus resGucHeaders
         fullRepr = iPreferRepresentation == Full
         updateIsNoOp = S.null iColumns
         status
-      | resQueryTotal == 0 && not updateIsNoOp = HTTP.status404
+          | rsQueryTotal == 0 && not updateIsNoOp = HTTP.status404
           | fullRepr = HTTP.status200
           | otherwise = HTTP.status204
         contentRangeHeader =
-      RangeQuery.contentRangeH 0 (resQueryTotal - 1) $
+          RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
-        if shouldCount iPreferCount then Just resQueryTotal else Nothing
+            if shouldCount iPreferCount then Just rsQueryTotal else Nothing
 
-  failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resQueryTotal =<<
+      failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<<
-    failNotSingular iAcceptMediaType resQueryTotal (
+        failNotSingular iAcceptMediaType rsQueryTotal (
           if fullRepr then
-        response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict resBody)
+            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
+
+      response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
 
       -- 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
+      when (rsQueryTotal /= 1) $ do
         lift SQL.condemn
         throwError Error.PutMatchingPkError
 
       return $
         if iPreferRepresentation == Full then
-      response HTTP.status200 (contentTypeHeaders context) (LBS.fromStrict resBody)
+          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
+
+  case resultSet of
+    RSStandard {..} -> do
+
+      response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
 
       let
-    response = gucResponse resGucStatus resGucHeaders
         contentRangeHeader =
           RangeQuery.contentRangeH 1 0 $
-        if shouldCount iPreferCount then Just resQueryTotal else Nothing
+            if shouldCount iPreferCount then Just rsQueryTotal else Nothing
 
-  failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resQueryTotal =<<
+      failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<<
-    failNotSingular iAcceptMediaType resQueryTotal (
+        failNotSingular iAcceptMediaType rsQueryTotal (
           if iPreferRepresentation == Full then
             response HTTP.status200
               (contentTypeHeaders context ++ [contentRangeHeader])
-          (LBS.fromStrict resBody)
+              (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{..} =
   case target of
@@ -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 queryTotal tableTotal
+          RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
 
-  failNotSingular iAcceptMediaType queryTotal $
+      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 body)
+            (if invMethod == InvHead then mempty else LBS.fromStrict rsBody)
+
+    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
+writeQuery :: Mutation -> QualifiedIdentifier -> Bool -> [Text] -> RequestContext -> DbHandler ResultSet
-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 identifier@QualifiedIdentifier{..} isInsert pkCols context@RequestContext{..} = do
   readReq <- readRequest identifier context
 
@@ -542,9 +569,8 @@ writeQuery mutation identifier@QualifiedIdentifier{..} isInsert pkCols context@R
         pkCols
         readReq
 
-  (_, queryTotal, fields, body, gucHeaders, gucStatus) <-
   lift . SQL.statement mempty $
-      Statements.createWriteStatement
+    Statements.prepareWrite
       (QueryBuilder.readRequestToQuery readReq)
       (QueryBuilder.mutateRequestToQuery mutateReq)
       isInsert
@@ -553,8 +579,6 @@ writeQuery mutation identifier@QualifiedIdentifier{..} isInsert pkCols context@R
       pkCols
       (configDbPreparedStatements ctxConfig)
 
-  liftEither $ WriteQueryResult queryTotal fields body <$> gucStatus <*> gucHeaders
-
 -- | Response with headers and status overridden from GUCs.
 gucResponse
   :: Maybe HTTP.Status
@@ -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

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
       |

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")

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"
 

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 =
+decodeMediaType mt =
-  case BS.takeWhile (/= BS.c2w ';') ct of
+  case BS.split (BS.c2w ';') mt of
-    "application/json"                  -> MTApplicationJSON
+    "application/json":_                   -> MTApplicationJSON
-    "application/geo+json"              -> MTGeoJSON
+    "application/geo+json":_               -> MTGeoJSON
-    "text/csv"                          -> MTTextCSV
+    "text/csv":_                           -> MTTextCSV
-    "text/plain"                        -> MTTextPlain
+    "text/plain":_                         -> MTTextPlain
-    "text/xml"                          -> MTTextXML
+    "text/xml":_                           -> MTTextXML
-    "application/openapi+json"          -> MTOpenAPI
+    "application/openapi+json":_           -> MTOpenAPI
-    "application/vnd.pgrst.object+json" -> MTSingularJSON
+    "application/vnd.pgrst.object+json":_  -> MTSingularJSON
-    "application/vnd.pgrst.object"      -> MTSingularJSON
+    "application/vnd.pgrst.object":_       -> MTSingularJSON
-    "application/x-www-form-urlencoded" -> MTUrlEncoded
+    "application/x-www-form-urlencoded":_  -> MTUrlEncoded
-    "application/octet-stream"          -> MTOctetStream
+    "application/octet-stream":_           -> MTOctetStream
-    "*/*"                               -> MTAny
+    "application/vnd.pgrst.plan":rest      -> getPlan PlanJSON rest
-    ct'                                 -> MTOther ct'
+    "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"     ]

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"

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
+  ( prepareWrite
-  , createReadStatement
+  , prepareRead
-  , callProcStatement
+  , prepareCall
-  , createExplainStatement
+  , 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
+-- | Standard result set format used for all queries
-    is represented as a list of strings containing variable bindings like
+data ResultSet
-    @"k1=eq.42"@, or the empty list if there is no location header.
+  = RSStandard
--}
+  { rsTableTotal :: Maybe Int64
-type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Error [GucHeader], Either Error (Maybe Status))
+  -- ^ 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 ->
+prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType ->
-                        SQL.Statement () ResultsWithCount
+                PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet
-createWriteStatement selectQuery mutateQuery isInsert mediaType rep pKeys =
+prepareWrite selectQuery mutateQuery isInsert mediaType rep pKeys =
-  SQL.dynamicallyParameterized snippet decodeStandard
+  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
+  decodeIt :: HD.Result ResultSet
-  decodeStandard =
+  decodeIt = case mediaType of
-   fromMaybe (Nothing, 0, [], mempty, Right [], Right Nothing) <$> HD.rowMaybe standardRow
+    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 ->
+prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> Maybe FieldName -> Bool -> SQL.Statement () ResultSet
-                       SQL.Statement () ResultsWithCount
+prepareRead selectQuery countQuery countTotal mediaType binaryField =
-createReadStatement selectQuery countQuery countTotal mediaType binaryField =
+  SQL.dynamicallyParameterized (mtSnippet mediaType snippet) decodeIt
-  SQL.dynamicallyParameterized snippet decodeStandard
  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
+  decodeIt :: HD.Result ResultSet
-  decodeStandard =
+  decodeIt = case mediaType of
-    HD.singleRow standardRow
+    MTPlan{} -> planRow
+    _        -> HD.singleRow $ standardRow True
 
-{-| Read and Write api requests use a similar response format which includes
+prepareCall :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
-    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
+               SQL.Statement () ResultSet
-callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mediaType multObjects binaryField =
+prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mediaType multObjects binaryField =
-  SQL.dynamicallyParameterized snippet decodeProc
+  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
+    decodeIt :: HD.Result ResultSet
-    decodeProc =
+    decodeIt = case mediaType of
-      fromMaybe (Just 0, 0, mempty, defGucHeaders, defGucStatus) <$> HD.rowMaybe procRow
+      MTPlan{} -> planRow
-      where
+      _        -> fromMaybe (RSStandard (Just 0) 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow True)
-        defGucHeaders = Right []
-        defGucStatus  = Right Nothing
-        procRow = (,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
-                         <*> column HD.bytea
-                         <*> (fromMaybe defGucHeaders <$> nullableColumn decodeGucHeaders)
-                         <*> (fromMaybe defGucStatus <$> nullableColumn decodeGucStatus)
 
-createExplainStatement :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
+preparePlanRows :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
-createExplainStatement countQuery =
+preparePlanRows countQuery =
-  SQL.dynamicallyParameterized snippet decodeExplain
+  SQL.dynamicallyParameterized snippet decodeIt
   where
-    snippet = "EXPLAIN (FORMAT JSON) " <> countQuery
+    snippet = explainF PlanJSON mempty countQuery
-    -- |
+    decodeIt :: HD.Result (Maybe Int64)
-    -- An `EXPLAIN (FORMAT JSON) select * from items;` output looks like this:
+    decodeIt =
-    -- [{
-    --   "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 =
       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
 

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]
 
 {-|

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"

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 = ""

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 = ""

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 = ""

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"

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"

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"

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 = ""

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

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"

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';

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

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
 

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                      ((^?))

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