feat: Allow getting the EXPLAIN plan of a request

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