sqlserver: implement native queries as CTEs

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8818
GitOrigin-RevId: 78d84c3558b2cc27e1c1a6c025de4c5035a9cafe

scripts/make/tests.mk

@@ -144,12 +144,43 @@ test-native-queries:
 		HSPEC_MATCH=NativeQueries \
 		GRAPHQL_ENGINE=$(GRAPHQL_ENGINE_PATH) \
 		cabal run api-tests:exe:api-tests
-	HASURA_TEST_BACKEND_TYPE=BigQuery \
-		HSPEC_MATCH=NativeQuery \
+	HASURA_TEST_BACKEND_TYPE=SQLServer \
+		HSPEC_MATCH=NativeQueries \
 		GRAPHQL_ENGINE=$(GRAPHQL_ENGINE_PATH) \
 		cabal run api-tests:exe:api-tests
+	HASURA_TEST_BACKEND_TYPE=BigQuery \
+		HSPEC_MATCH=NativeQueries \
+		GRAPHQL_ENGINE=$(GRAPHQL_ENGINE_PATH) \
+		cabal run api-tests:exe:api-tests
+
+.PHONY: test-native-queries-postgres
+## test-native-queries-postgres: run all postgres tests for the Native Query feature
+test-native-queries-postgres:
+	cabal build exe:graphql-engine
+	docker compose up -d --wait postgres
+	HSPEC_MATCH=NativeQueries make test-unit
+	HASURA_TEST_BACKEND_TYPE=Postgres \
+		HSPEC_MATCH=NativeQueries \
+		GRAPHQL_ENGINE=$(GRAPHQL_ENGINE_PATH) \
+		cabal run api-tests:exe:api-tests
+
+.PHONY: test-native-queries-sqlserver
+## test-native-queries-sqlserver: run all sqlserver tests for the Native Query feature
+test-native-queries-sqlserver:
+	cabal build exe:graphql-engine
+	docker compose up -d --wait postgres sqlserver-healthcheck
 	HASURA_TEST_BACKEND_TYPE=SQLServer \
-		HSPEC_MATCH=NativeQuery \
+		HSPEC_MATCH=NativeQueries \
+		GRAPHQL_ENGINE=$(GRAPHQL_ENGINE_PATH) \
+		cabal run api-tests:exe:api-tests
+
+.PHONY: test-native-queries-bigquery
+## test-native-queries-bigquery: run all bigquery tests for the Native Query feature
+test-native-queries-bigquery:
+	cabal build exe:graphql-engine
+	docker compose up -d --wait postgres
+	HASURA_TEST_BACKEND_TYPE=BigQuery \
+		HSPEC_MATCH=NativeQueries \
 		GRAPHQL_ENGINE=$(GRAPHQL_ENGINE_PATH) \
 		cabal run api-tests:exe:api-tests
 

server/lib/api-tests/src/Test/Databases/SQLServer/NativeQueriesSpec.hs

@@ -16,7 +16,7 @@ import Harness.Schema qualified as Schema
 import Harness.Test.BackendType qualified as BackendType
 import Harness.Test.Fixture qualified as Fixture
 import Harness.TestEnvironment (GlobalTestEnvironment, TestEnvironment, getBackendTypeConfig)
-import Harness.Yaml (shouldAtLeastBe, shouldReturnYaml)
+import Harness.Yaml (shouldReturnYaml)
 import Hasura.Prelude
 import Test.Hspec (SpecWith, describe, it)
 
@@ -235,49 +235,3 @@ tests = do
               |]
 
       shouldReturnYaml testEnvironment actual expected
-
-    it "Runs a query that uses a built-in Stored Procedure" $ \testEnvironment -> do
-      let backendTypeMetadata = fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnvironment
-          source = BackendType.backendSourceName backendTypeMetadata
-
-          goodQuery = "EXEC sp_databases"
-
-          storedProcedureLogicalModel :: Schema.LogicalModel
-          storedProcedureLogicalModel =
-            (Schema.logicalModel "stored_procedure")
-              { Schema.logicalModelColumns =
-                  [ Schema.logicalModelScalar "database_name" Schema.TStr,
-                    Schema.logicalModelScalar "database_size" Schema.TInt,
-                    Schema.logicalModelScalar "remarks" Schema.TStr
-                  ]
-              }
-
-          useStoredProcedure :: Schema.NativeQuery
-          useStoredProcedure =
-            (Schema.nativeQuery "use_stored_procedure" goodQuery "stored_procedure")
-
-      Schema.trackLogicalModel source storedProcedureLogicalModel testEnvironment
-
-      Schema.trackNativeQuery source useStoredProcedure testEnvironment
-
-      -- making an assumption here that an SQLServer instance will always have
-      -- a `master` database
-      let expected =
-            [yaml|
-                data:
-                  use_stored_procedure:
-                    - database_name: "master"
-              |]
-
-      actual <-
-        GraphqlEngine.postGraphql
-          testEnvironment
-          [graphql|
-              query {
-                use_stored_procedure {
-                  database_name
-                }
-              }
-           |]
-
-      actual `shouldAtLeastBe` expected

server/src-lib/Hasura/Backends/MSSQL/Execute/Delete.hs

@@ -77,18 +77,18 @@ buildDeleteTx deleteOperation stringifyNum queryTags = do
   -- Create a temp table
   Tx.unitQueryE defaultMSSQLTxErrorHandler (createInsertedTempTableQuery `withQueryTags` queryTags)
   let deleteQuery = TQ.fromDelete <$> TSQL.fromDelete deleteOperation
-  deleteQueryValidated <- toQueryFlat . qwdQuery <$> runFromIr deleteQuery
+  deleteQueryValidated <- toQueryFlat . qwdQuery <$> runFromIrDiscardCTEs deleteQuery
 
   -- Execute DELETE statement
   Tx.unitQueryE mutationMSSQLTxErrorHandler (deleteQueryValidated `withQueryTags` queryTags)
-  mutationOutputSelect <- qwdQuery <$> runFromIr (mkMutationOutputSelect stringifyNum withAlias $ _adOutput deleteOperation)
+  mutationOutputSelect <- qwdQuery <$> runFromIrUseCTEs (mkMutationOutputSelect stringifyNum withAlias $ _adOutput deleteOperation)
 
   let withSelect =
         emptySelect
           { selectProjections = [StarProjection],
             selectFrom = Just $ FromTempTable $ Aliased tempTableNameDeleted "deleted_alias"
           }
-      finalMutationOutputSelect = mutationOutputSelect {selectWith = Just $ With $ pure $ Aliased withSelect withAlias}
+      finalMutationOutputSelect = mutationOutputSelect {selectWith = Just $ With $ pure $ Aliased (CTESelect withSelect) withAlias}
       mutationOutputSelectQuery = toQueryFlat $ TQ.fromSelect finalMutationOutputSelect
 
   -- Execute SELECT query and fetch mutation response

server/src-lib/Hasura/Backends/MSSQL/Execute/Insert.hs

@@ -227,7 +227,7 @@ buildUpsertTx tableName insert ifMatched queryTags = do
   Tx.unitQueryE mutationMSSQLTxErrorHandler (insertValuesIntoTempTableQuery `withQueryTags` queryTags)
 
   -- Run the MERGE query and store the mutated rows in #inserted temporary table
-  merge <- qwdQuery <$> runFromIr (toMerge tableName (_aiInsertObject $ _aiData insert) allTableColumns ifMatched)
+  merge <- qwdQuery <$> runFromIrDiscardCTEs (toMerge tableName (_aiInsertObject $ _aiData insert) allTableColumns ifMatched)
   let mergeQuery = toQueryFlat $ TQ.fromMerge merge
   Tx.unitQueryE mutationMSSQLTxErrorHandler (mergeQuery `withQueryTags` queryTags)
 
@@ -244,11 +244,11 @@ buildInsertResponseTx ::
   Tx.TxET QErr m (Text, Int)
 buildInsertResponseTx stringifyNum withAlias insert queryTags = do
   -- Generate a SQL SELECT statement which outputs the mutation response using the #inserted
-  mutationOutputSelect <- qwdQuery <$> runFromIr (mkMutationOutputSelect stringifyNum withAlias $ _aiOutput insert)
+  mutationOutputSelect <- qwdQuery <$> runFromIrUseCTEs (mkMutationOutputSelect stringifyNum withAlias $ _aiOutput insert)
 
   -- The check constraint is translated to boolean expression
   let checkCondition = fst $ _aiCheckCondition $ _aiData insert
-  checkBoolExp <- qwdQuery <$> runFromIr (runReaderT (fromGBoolExp checkCondition) (EntityAlias withAlias))
+  checkBoolExp <- qwdQuery <$> runFromIrDiscardCTEs (runReaderT (fromGBoolExp checkCondition) (EntityAlias withAlias))
 
   let withSelect =
         emptySelect
@@ -259,7 +259,7 @@ buildInsertResponseTx stringifyNum withAlias insert queryTags = do
       mutationOutputCheckConstraintSelect = selectMutationOutputAndCheckCondition withAlias mutationOutputSelect checkBoolExp
       -- WITH "with_alias" AS (<table_select>)
       -- SELECT (<mutation_output_select>) AS [mutation_response], (<check_constraint_select>) AS [check_constraint_select]
-      finalSelect = mutationOutputCheckConstraintSelect {selectWith = Just $ With $ pure $ Aliased withSelect withAlias}
+      finalSelect = mutationOutputCheckConstraintSelect {selectWith = Just $ With $ pure $ Aliased (CTESelect withSelect) withAlias}
 
   -- Execute SELECT query to fetch mutation response and check constraint result
   let selectQuery = toQueryFlat (TQ.fromSelect finalSelect)

server/src-lib/Hasura/Backends/MSSQL/Execute/Update.hs

@@ -82,15 +82,15 @@ buildUpdateTx updateOperation stringifyNum queryTags = do
   -- Create a temp table
   Tx.unitQueryE defaultMSSQLTxErrorHandler (createInsertedTempTableQuery `withQueryTags` queryTags)
   let updateQuery = TQ.fromUpdate <$> TSQL.fromUpdate updateOperation
-  updateQueryValidated <- toQueryFlat . qwdQuery <$> runFromIr updateQuery
+  updateQueryValidated <- toQueryFlat . qwdQuery <$> runFromIrDiscardCTEs updateQuery
 
   -- Execute UPDATE statement
   Tx.unitQueryE mutationMSSQLTxErrorHandler (updateQueryValidated `withQueryTags` queryTags)
-  mutationOutputSelect <- qwdQuery <$> runFromIr (mkMutationOutputSelect stringifyNum withAlias $ _auOutput updateOperation)
+  mutationOutputSelect <- qwdQuery <$> runFromIrUseCTEs (mkMutationOutputSelect stringifyNum withAlias $ _auOutput updateOperation)
   let checkCondition = _auCheck updateOperation
 
   -- The check constraint is translated to boolean expression
-  checkBoolExp <- qwdQuery <$> runFromIr (runReaderT (fromGBoolExp checkCondition) (EntityAlias withAlias))
+  checkBoolExp <- qwdQuery <$> runFromIrDiscardCTEs (runReaderT (fromGBoolExp checkCondition) (EntityAlias withAlias))
 
   let withSelect =
         emptySelect
@@ -98,7 +98,7 @@ buildUpdateTx updateOperation stringifyNum queryTags = do
             selectFrom = Just $ FromTempTable $ Aliased tempTableNameUpdated "updated_alias"
           }
       mutationOutputCheckConstraintSelect = selectMutationOutputAndCheckCondition withAlias mutationOutputSelect checkBoolExp
-      finalSelect = mutationOutputCheckConstraintSelect {selectWith = Just $ With $ pure $ Aliased withSelect withAlias}
+      finalSelect = mutationOutputCheckConstraintSelect {selectWith = Just $ With $ pure $ Aliased (CTESelect withSelect) withAlias}
 
   -- Execute SELECT query to fetch mutation response and check constraint result
   let finalSelectQuery = toQueryFlat $ TQ.fromSelect finalSelect

server/src-lib/Hasura/Backends/MSSQL/FromIr.hs

@@ -10,10 +10,13 @@
 module Hasura.Backends.MSSQL.FromIr
   ( -- * The central Monad
     FromIr,
-    runFromIr,
+    runFromIrDiscardCTEs,
+    runFromIrUseCTEs,
+    runFromIrUseCTEsT,
     Error (..),
     tellBefore,
     tellAfter,
+    tellCTE,
 
     -- * Name generation
     NameTemplate (..),
@@ -30,6 +33,7 @@ import Data.Text qualified as T
 import Hasura.Backends.MSSQL.Instances.Types ()
 import Hasura.Backends.MSSQL.Types.Internal as TSQL
 import Hasura.Base.Error (QErr, throw500)
+import Hasura.NativeQuery.Metadata (InterpolatedQuery)
 import Hasura.Prelude
 import Hasura.RQL.IR qualified as IR
 import Hasura.SQL.Backend
@@ -37,24 +41,29 @@ import Hasura.SQL.Backend
 -- | Allow the query process to emit extra setup / teardown steps
 data IRWriter = IRWriter
   { irwBefore :: [TempTableDDL],
-    irwAfter :: [TempTableDDL]
+    irwAfter :: [TempTableDDL],
+    irwCTEs :: Maybe With
   }
 
 instance Semigroup IRWriter where
-  (IRWriter a b) <> (IRWriter a' b') = IRWriter (a <> a') (b' <> b)
+  (IRWriter a b c) <> (IRWriter a' b' c') = IRWriter (a <> a') (b' <> b) (c <> c')
 
 instance Monoid IRWriter where
-  mempty = IRWriter mempty mempty
+  mempty = IRWriter mempty mempty Nothing
 
 -- | add a step to be run before the main query
 tellBefore :: TempTableDDL -> FromIr ()
 tellBefore step =
-  tell (IRWriter {irwBefore = [step], irwAfter = mempty})
+  tell (IRWriter {irwBefore = [step], irwAfter = mempty, irwCTEs = Nothing})
 
 -- | add a step to be run after the main query
 tellAfter :: TempTableDDL -> FromIr ()
 tellAfter step =
-  tell (IRWriter {irwBefore = mempty, irwAfter = [step]})
+  tell (IRWriter {irwBefore = mempty, irwAfter = [step], irwCTEs = Nothing})
+
+tellCTE :: Aliased (InterpolatedQuery Expression) -> FromIr ()
+tellCTE cte =
+  tell (IRWriter {irwBefore = mempty, irwAfter = mempty, irwCTEs = Just (With $ pure $ CTEUnsafeRawSQL <$> cte)})
 
 -- | The central Monad used throughout for all conversion functions.
 --
@@ -69,23 +78,53 @@ tellAfter step =
 --   See 'generateAlias'.
 newtype FromIr a = FromIr
   { unFromIr ::
-      StateT
-        (Map Text Int)
-        (WriterT IRWriter (Validate (NonEmpty Error)))
+      WriterT
+        IRWriter
+        ( StateT
+            (Map Text Int)
+            (Validate (NonEmpty Error))
+        )
         a
   }
   deriving (Functor, Applicative, Monad, MonadValidate (NonEmpty Error), MonadWriter IRWriter)
 
 -- | Run a 'FromIr' action, throwing errors that have been collected using the
 -- supplied action.
-runFromIr :: MonadError QErr m => FromIr a -> m (QueryWithDDL a)
-runFromIr =
-  fmap (\(result, IRWriter before after) -> QueryWithDDL before result after)
-    . flip onLeft (throw500 . tshow)
+runFromIr ::
+  (Traversable t, MonadError QErr m) =>
+  ((a, IRWriter) -> QueryWithDDL a) ->
+  t (FromIr a) ->
+  m (t (QueryWithDDL a))
+runFromIr toQueryWithDDL =
+  flip onLeft (throw500 . tshow)
     . V.runValidate
-    . runWriterT
     . flip evalStateT mempty
-    . unFromIr
+    . fmap (fmap toQueryWithDDL)
+    . traverse (runWriterT . unFromIr)
+
+-- | Run a 'FromIr' action, throwing errors that have been collected using the
+-- supplied action, and attach CTEs created from native queries to the select query.
+runFromIrUseCTEs :: MonadError QErr m => FromIr Select -> m (QueryWithDDL Select)
+runFromIrUseCTEs fromir = runIdentity <$> runFromIr attachCTEs (Identity fromir)
+
+-- | Run a 'FromIr' action, throwing errors that have been collected using the
+-- supplied action, and discard CTEs created from native queries to the select query.
+runFromIrDiscardCTEs :: MonadError QErr m => FromIr a -> m (QueryWithDDL a)
+runFromIrDiscardCTEs fromir = runIdentity <$> runFromIr discardCTEs (Identity fromir)
+
+-- | Run a 'FromIr' action, throwing errors that have been collected using the
+-- supplied action, and attach CTEs created from native queries to the select query.
+runFromIrUseCTEsT :: (Traversable t, MonadError QErr m) => t (FromIr Select) -> m (t (QueryWithDDL Select))
+runFromIrUseCTEsT = runFromIr attachCTEs
+
+attachCTEs :: (Select, IRWriter) -> QueryWithDDL Select
+attachCTEs (select, IRWriter before after ctes) =
+  QueryWithDDL before select {selectWith = ctes <> selectWith select} after
+
+discardCTEs :: (a, IRWriter) -> QueryWithDDL a
+discardCTEs (a, IRWriter before after _ctes) =
+  -- TODO: assert ctes is empty, or throw an error "not supported"
+  QueryWithDDL before a after
 
 -- | Errors that may happen during translation.
 data Error

server/src-lib/Hasura/Backends/MSSQL/FromIr/Query.hs

@@ -14,7 +14,6 @@ import Control.Applicative (getConst)
 import Control.Monad.Validate
 import Data.Aeson.Extended qualified as J
 import Data.HashMap.Strict qualified as HM
-import Data.HashMap.Strict.InsOrd qualified as InsOrd
 import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as M
@@ -27,17 +26,14 @@ import Hasura.Backends.MSSQL.FromIr
     FromIr,
     NameTemplate (..),
     generateAlias,
-    tellAfter,
-    tellBefore,
+    tellCTE,
   )
 import Hasura.Backends.MSSQL.FromIr.Constants
 import Hasura.Backends.MSSQL.FromIr.Expression
 import Hasura.Backends.MSSQL.Instances.Types ()
 import Hasura.Backends.MSSQL.Types.Internal as TSQL
-import Hasura.LogicalModel.Common (columnsFromFields)
-import Hasura.LogicalModel.IR (LogicalModel (..))
 import Hasura.NativeQuery.IR qualified as IR
-import Hasura.NativeQuery.Types (NativeQueryName (..), NullableScalarType (..))
+import Hasura.NativeQuery.Types (NativeQueryName (..))
 import Hasura.Prelude
 import Hasura.RQL.IR qualified as IR
 import Hasura.RQL.Types.Column qualified as IR
@@ -336,30 +332,11 @@ fromNativeQuery :: IR.NativeQuery 'MSSQL Expression -> FromIr TSQL.From
 fromNativeQuery nativeQuery = do
   let nativeQueryName = IR.nqRootFieldName nativeQuery
       nativeQuerySql = IR.nqInterpolatedQuery nativeQuery
-      nativeQueryReturnType = IR.nqLogicalModel nativeQuery
+      cteName = T.toTxt (getNativeQueryName nativeQueryName)
 
-      rawTempTableName = T.toTxt (getNativeQueryName nativeQueryName)
-      aliasedTempTableName = Aliased (TempTableName rawTempTableName) rawTempTableName
+  tellCTE (Aliased nativeQuerySql cteName)
 
-  let columns =
-        ( \(name, ty) ->
-            UnifiedColumn
-              { name = name,
-                type' = (nstType ty)
-              }
-        )
-          <$> InsOrd.toList (columnsFromFields $ lmFields nativeQueryReturnType)
-
-  -- \| add create temp table to "the environment"
-  tellBefore (CreateTemp (TempTableName rawTempTableName) columns)
-
-  -- \| add insert into temp table
-  tellBefore (InsertTemp (TempTableName rawTempTableName) nativeQuerySql)
-
-  -- \| when we're done, drop the temp table
-  tellAfter (DropTemp (TempTableName rawTempTableName))
-
-  pure $ TSQL.FromTempTable aliasedTempTableName
+  pure $ TSQL.FromIdentifier cteName
 
 fromSelectAggregate ::
   Maybe (EntityAlias, HashMap ColumnName ColumnName) ->

server/src-lib/Hasura/Backends/MSSQL/Plan.hs

@@ -92,7 +92,7 @@ runIrWrappingRoot ::
   FromIr Select ->
   m (QueryWithDDL Select)
 runIrWrappingRoot selectAction =
-  runFromIr selectAction `onLeft` (throwError . overrideQErrStatus HTTP.status400 NotSupported)
+  runFromIrUseCTEs selectAction `onLeft` (throwError . overrideQErrStatus HTTP.status400 NotSupported)
 
 -- | Prepare a value without any query planning; we just execute the
 -- query with the values embedded.
@@ -138,7 +138,9 @@ planSubscription unpreparedMap sessionVariables = do
           unpreparedMap
       )
       emptyPrepareState
-  selectMap <- qwdQuery <$> runFromIr (traverse fromQueryRootField rootFieldMap)
+  let rootFields :: InsOrdHashMap G.Name (FromIr Select)
+      rootFields = fmap fromQueryRootField rootFieldMap
+  selectMap <- fmap qwdQuery <$> runFromIrUseCTEsT rootFields
   pure (collapseMap selectMap, prepareState)
 
 -- Plan a query without prepare/exec.

server/src-lib/Hasura/Backends/MSSQL/ToQuery.hs

@@ -563,7 +563,16 @@ fromWith (With withSelects) =
   "WITH " <+> SepByPrinter ", " (map fromAliasedSelect (toList withSelects)) <+> NewlinePrinter
   where
     fromAliasedSelect (Aliased {..}) =
-      fromNameText aliasedAlias <+> " AS " <+> "( " <+> fromSelect aliasedThing <+> " )"
+      fromNameText aliasedAlias
+        <+> " AS "
+        <+> "( "
+        <+> ( case aliasedThing of
+                CTESelect select ->
+                  fromSelect select
+                CTEUnsafeRawSQL nativeQuery ->
+                  renderInterpolatedQuery nativeQuery <+> "\n"
+            )
+        <+> " )"
 
 renderInterpolatedQuery :: InterpolatedQuery Expression -> Printer
 renderInterpolatedQuery = foldr (<+>) "" . renderedParts

server/src-lib/Hasura/Backends/MSSQL/Types/Instances.hs

@@ -82,6 +82,7 @@ INSTANCE_CLUMP_2(ScalarType)
 INSTANCE_CLUMP_2(TableName)
 INSTANCE_CLUMP_2(Select)
 INSTANCE_CLUMP_2(With)
+INSTANCE_CLUMP_2(CTEBody)
 INSTANCE_CLUMP_2(Top)
 INSTANCE_CLUMP_2(FieldName)
 INSTANCE_CLUMP_2(JsonPath)

server/src-lib/Hasura/Backends/MSSQL/Types/Internal.hs

@@ -89,6 +89,7 @@ module Hasura.Backends.MSSQL.Types.Internal
     Values (..),
     Where (..),
     With (..),
+    CTEBody (..),
     emptySelect,
     geoTypes,
     getGQLTableName,
@@ -379,7 +380,13 @@ newtype Where
   = Where [Expression]
 
 newtype With
-  = With (NonEmpty (Aliased Select))
+  = With (NonEmpty (Aliased CTEBody))
+  deriving (Semigroup)
+
+-- | Something that can appear in a CTE body.
+data CTEBody
+  = CTESelect Select
+  | CTEUnsafeRawSQL (InterpolatedQuery Expression)
 
 -- | Extra query steps that can be emitted from the main
 -- query to do things like setup temp tables