From d81571f928c54e0074fd6295fe28860b223adea0 Mon Sep 17 00:00:00 2001
From: Philip Lykke Carlsen <plcplc@gmail.com>
Date: Tue, 18 Oct 2022 18:47:41 +0200
Subject: [PATCH] Add support for explain in CockroachDB

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6415
GitOrigin-RevId: d60363d6f466a764b79c887631f9e3f094946440
---
 server/lib/api-tests/api-tests.cabal          |  1 +
 .../test/Test/Queries/ExplainSpec.hs          | 77 +++++++++++++++++++
 .../Backends/Postgres/Instances/Execute.hs    |  4 +-
 3 files changed, 80 insertions(+), 2 deletions(-)
 create mode 100644 server/lib/api-tests/test/Test/Queries/ExplainSpec.hs

diff --git a/server/lib/api-tests/api-tests.cabal b/server/lib/api-tests/api-tests.cabal
index ff0ddd50ea9..d467fa6432b 100644
--- a/server/lib/api-tests/api-tests.cabal
+++ b/server/lib/api-tests/api-tests.cabal
@@ -113,6 +113,7 @@ executable api-tests
     Test.Queries.Directives.IncludeSpec
     Test.Queries.Directives.SkipSpec
     Test.Queries.DirectivesSpec
+    Test.Queries.ExplainSpec
     Test.Queries.FilterSearchSpec
     Test.Queries.FragmentsSpec
     Test.Queries.MultiColumnObjectRelationshipsSpec
diff --git a/server/lib/api-tests/test/Test/Queries/ExplainSpec.hs b/server/lib/api-tests/test/Test/Queries/ExplainSpec.hs
new file mode 100644
index 00000000000..60ca8218519
--- /dev/null
+++ b/server/lib/api-tests/test/Test/Queries/ExplainSpec.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+-- | Test that backend which support it are able to explain queries.
+module Test.Queries.ExplainSpec (spec) where
+
+import Data.Aeson (Value)
+import Data.List.NonEmpty qualified as NE
+import Harness.Backend.Citus qualified as Citus
+import Harness.Backend.Cockroach qualified as Cockroach
+import Harness.Backend.Mysql qualified as Mysql
+import Harness.Backend.Postgres qualified as Postgres
+import Harness.Backend.Sqlserver qualified as Sqlserver
+import Harness.GraphqlEngine
+import Harness.Quoter.Graphql
+import Harness.Quoter.Yaml (yaml)
+import Harness.Test.Fixture qualified as Fixture
+import Harness.Test.Schema qualified as Schema
+import Harness.TestEnvironment (TestEnvironment (..))
+import Harness.Yaml (shouldReturnYaml)
+import Hasura.Prelude
+import Test.Hspec (SpecWith, describe, it)
+
+spec :: SpecWith TestEnvironment
+spec =
+  Fixture.run
+    ( NE.fromList
+        [ (Fixture.fixture $ Fixture.Backend Fixture.Postgres)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Postgres.setupTablesAction schema testEnvironment
+                ]
+            },
+          (Fixture.fixture $ Fixture.Backend Fixture.Citus)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Citus.setupTablesAction schema testEnvironment
+                ]
+            },
+          (Fixture.fixture $ Fixture.Backend Fixture.Cockroach)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Cockroach.setupTablesAction schema testEnvironment
+                ]
+            },
+          (Fixture.fixture $ Fixture.Backend Fixture.SQLServer)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Sqlserver.setupTablesAction schema testEnvironment
+                ]
+            },
+          (Fixture.fixture $ Fixture.Backend Fixture.MySQL)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Mysql.setupTablesAction schema testEnvironment
+                ]
+            }
+        ]
+    )
+    tests
+
+--------------------------------------------------------------------------------
+-- Schema
+
+schema :: [Schema.Table]
+schema =
+  [ (Schema.table "example")
+      { Schema.tableColumns =
+          [ Schema.column "id" Schema.TInt,
+            Schema.column "name" Schema.TStr
+          ],
+        Schema.tablePrimaryKey = ["id"],
+        Schema.tableData = []
+      }
+  ]
+
+tests :: Fixture.Options -> SpecWith TestEnvironment
+tests _opts = do
+  describe "Explaining queries" do
+    it "Works as expected" \testEnvironment -> do
+      -- All that matters to this test is that the call completes without error.
+      _ <- postExplain testEnvironment [graphql|query{hasura_example{id}}|]
+      return ()
diff --git a/server/src-lib/Hasura/Backends/Postgres/Instances/Execute.hs b/server/src-lib/Hasura/Backends/Postgres/Instances/Execute.hs
index d548dc59a69..0ec404be710 100644
--- a/server/src-lib/Hasura/Backends/Postgres/Instances/Execute.hs
+++ b/server/src-lib/Hasura/Backends/Postgres/Instances/Execute.hs
@@ -155,7 +155,7 @@ pgDBQueryExplain fieldName userInfo sourceName sourceConfig rootSelection = do
       textSQL = PG.getQueryText querySQL
       -- CAREFUL!: an `EXPLAIN ANALYZE` here would actually *execute* this
       -- query, maybe resulting in privilege escalation:
-      withExplain = "EXPLAIN (FORMAT TEXT) " <> textSQL
+      withExplain = "EXPLAIN " <> textSQL
   let action =
         liftTx $
           PG.withQE dmlTxErrorHandler (PG.fromText withExplain) () True <&> \planList ->
@@ -177,7 +177,7 @@ pgDBSubscriptionExplain plan = do
       queryText = PG.getQueryText . PGL.unMultiplexedQuery $ _plqpQuery parameterizedPlan
       -- CAREFUL!: an `EXPLAIN ANALYZE` here would actually *execute* this
       -- query, maybe resulting in privilege escalation:
-      explainQuery = PG.fromText $ "EXPLAIN (FORMAT TEXT) " <> queryText
+      explainQuery = PG.fromText $ "EXPLAIN " <> queryText
   cohortId <- newCohortId
   explanationLines <-
     liftEitherM $