cleanup(sqlserver): throw an error when native queries not supported

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8839
GitOrigin-RevId: afdaa9a0a5aa54f852d3a955a0d3de4f74b5fedf

scripts/make/tests.mk

@@ -166,7 +166,7 @@ test-native-queries-postgres:
 
 .PHONY: test-native-queries-sqlserver
 ## test-native-queries-sqlserver: run all sqlserver tests for the Native Query feature
-test-native-queries-sqlserver:
+test-native-queries-sqlserver: remove-tix-file
 	cabal build exe:graphql-engine
 	docker compose up -d --wait postgres sqlserver-healthcheck
 	HASURA_TEST_BACKEND_TYPE=SQLServer \
@@ -176,7 +176,7 @@ test-native-queries-sqlserver:
 
 .PHONY: test-native-queries-bigquery
 ## test-native-queries-bigquery: run all bigquery tests for the Native Query feature
-test-native-queries-bigquery:
+test-native-queries-bigquery: remove-tix-file
 	cabal build exe:graphql-engine
 	docker compose up -d --wait postgres
 	HASURA_TEST_BACKEND_TYPE=BigQuery \

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

@@ -77,7 +77,7 @@ buildDeleteTx deleteOperation stringifyNum queryTags = do
   -- Create a temp table
   Tx.unitQueryE defaultMSSQLTxErrorHandler (createInsertedTempTableQuery `withQueryTags` queryTags)
   let deleteQuery = TQ.fromDelete <$> TSQL.fromDelete deleteOperation
-  deleteQueryValidated <- toQueryFlat <$> runFromIrDiscardCTEs deleteQuery
+  deleteQueryValidated <- toQueryFlat <$> runFromIrErrorOnCTEs deleteQuery
 
   -- Execute DELETE statement
   Tx.unitQueryE mutationMSSQLTxErrorHandler (deleteQueryValidated `withQueryTags` queryTags)

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 <- runFromIrDiscardCTEs (toMerge tableName (_aiInsertObject $ _aiData insert) allTableColumns ifMatched)
+  merge <- runFromIrErrorOnCTEs (toMerge tableName (_aiInsertObject $ _aiData insert) allTableColumns ifMatched)
   let mergeQuery = toQueryFlat $ TQ.fromMerge merge
   Tx.unitQueryE mutationMSSQLTxErrorHandler (mergeQuery `withQueryTags` queryTags)
 
@@ -248,7 +248,7 @@ buildInsertResponseTx stringifyNum withAlias insert queryTags = do
 
   -- The check constraint is translated to boolean expression
   let checkCondition = fst $ _aiCheckCondition $ _aiData insert
-  checkBoolExp <- runFromIrDiscardCTEs (runReaderT (fromGBoolExp checkCondition) (EntityAlias withAlias))
+  checkBoolExp <- runFromIrErrorOnCTEs (runReaderT (fromGBoolExp checkCondition) (EntityAlias withAlias))
 
   let withSelect =
         emptySelect

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

@@ -82,7 +82,7 @@ buildUpdateTx updateOperation stringifyNum queryTags = do
   -- Create a temp table
   Tx.unitQueryE defaultMSSQLTxErrorHandler (createInsertedTempTableQuery `withQueryTags` queryTags)
   let updateQuery = TQ.fromUpdate <$> TSQL.fromUpdate updateOperation
-  updateQueryValidated <- toQueryFlat <$> runFromIrDiscardCTEs updateQuery
+  updateQueryValidated <- toQueryFlat <$> runFromIrErrorOnCTEs updateQuery
 
   -- Execute UPDATE statement
   Tx.unitQueryE mutationMSSQLTxErrorHandler (updateQueryValidated `withQueryTags` queryTags)
@@ -90,7 +90,7 @@ buildUpdateTx updateOperation stringifyNum queryTags = do
   let checkCondition = _auCheck updateOperation
 
   -- The check constraint is translated to boolean expression
-  checkBoolExp <- runFromIrDiscardCTEs (runReaderT (fromGBoolExp checkCondition) (EntityAlias withAlias))
+  checkBoolExp <- runFromIrErrorOnCTEs (runReaderT (fromGBoolExp checkCondition) (EntityAlias withAlias))
 
   let withSelect =
         emptySelect

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

@@ -10,7 +10,7 @@
 module Hasura.Backends.MSSQL.FromIr
   ( -- * The central Monad
     FromIr,
-    runFromIrDiscardCTEs,
+    runFromIrErrorOnCTEs,
     runFromIrUseCTEs,
     runFromIrUseCTEsT,
     Error (..),
@@ -60,59 +60,65 @@ tellCTE cte =
 --   translation output retain a resemblance with source names without the
 --   translation process needing to be bothered about potential name shadowing.
 --   See 'generateAlias'.
+--
+-- * It has a writer part for reporting native queries that need to be wrapped in a CTE
+--
+-- The Inner part 'FromIrInner' containing the state and validate are extracted to a different
+-- type so we can peel the writer for queries and report errors in the process if needed.
 newtype FromIr a = FromIr
-  { unFromIr ::
-      WriterT
-        IRWriter
-        ( StateT
-            (Map Text Int)
-            (Validate (NonEmpty Error))
-        )
-        a
+  { unFromIr :: WriterT IRWriter FromIrInner 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 ::
-  (Traversable t, MonadError QErr m) =>
-  ((a, IRWriter) -> a) ->
-  t (FromIr a) ->
-  m (t a)
-runFromIr toResult =
-  flip onLeft (throw500 . tshow)
-    . V.runValidate
-    . flip evalStateT mempty
-    . fmap (fmap toResult)
-    . traverse (runWriterT . unFromIr)
+-- | We extract the state and validate parts of FromIr so we can peel off
+--   the writer part of 'FromIr' for queries and report errors in the process if needed.
+type FromIrInner = StateT (Map Text Int) (Validate (NonEmpty Error))
 
 -- | 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 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 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 Select)
 runFromIrUseCTEsT = runFromIr attachCTEs
 
-attachCTEs :: (Select, IRWriter) -> Select
-attachCTEs (select, IRWriter ctes) = select {selectWith = ctes <> selectWith select}
+-- | 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.
+--
+-- If CTEs were reported, we throw an error, since we don't support native queries
+-- in this context yet.
+runFromIrErrorOnCTEs :: MonadError QErr m => FromIr a -> m a
+runFromIrErrorOnCTEs fromir = runIdentity <$> runFromIr errorOnCTEs (Identity fromir)
 
-discardCTEs :: (a, IRWriter) -> a
-discardCTEs =
-  -- TODO: assert ctes is empty, or throw an error "not supported"
-  fst
+-- | Run a 'FromIr' action, throwing errors that have been collected using the supplied action.
+runFromIr :: (Traversable t, MonadError QErr m) => ((a, IRWriter) -> FromIrInner a) -> t (FromIr a) -> m (t a)
+runFromIr toResult =
+  flip onLeft (throw500 . tshow)
+    . V.runValidate
+    . flip evalStateT mempty
+    . join
+    . fmap (traverse toResult)
+    . traverse (runWriterT . unFromIr)
+
+-- | attach CTEs created from native queries to the select query.
+attachCTEs :: MonadValidate (NonEmpty Error) m => (Select, IRWriter) -> m Select
+attachCTEs (select, IRWriter ctes) = pure $ select {selectWith = ctes <> selectWith select}
+
+-- | If CTEs were reported, we throw an error, since we don't support native queries
+--   in this context yet.
+errorOnCTEs :: MonadValidate (NonEmpty Error) m => (a, IRWriter) -> m a
+errorOnCTEs (result, IRWriter ctes) =
+  case ctes of
+    Nothing -> pure result
+    Just _ -> refute $ pure NativeQueriesNotSupported
 
 -- | Errors that may happen during translation.
 data Error
   = UnsupportedOpExpG (IR.OpExpG 'MSSQL Expression)
   | FunctionNotSupported
+  | NativeQueriesNotSupported
   deriving (Show, Eq)
 
 -- | Hints about the type of entity that 'generateAlias' is producing an alias