Fix(Sqlserver): Apply Column Redaction to order_by and _where

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9971
GitOrigin-RevId: 04cae8163af2d002a2d5aea73fb45088fc0eaea4

server/lib/api-tests/src/Test/Auth/Authorization/InheritedRoles/ColumnRedaction/SqlserverSpec.hs

@@ -339,8 +339,7 @@ tests = do
 
       shouldReturnYaml testEnvironment actual expected
 
-  -- Postponed for now.
+  describe "Redaction in ordering" $ do
-  xdescribe "Redaction in ordering and distinct on" $ do
     it "ordering by column is applied over redacted column value" \testEnvironment -> do
       let schemaName = Schema.getSchemaName testEnvironment
           actual :: IO Value
@@ -350,9 +349,11 @@ tests = do
               [ ("X-Hasura-Role", "employee"),
                 ("X-Hasura-Employee-Id", "3")
               ]
+              -- Note that this test differs slightly from its Postgres counterpart, since
+              -- the MSSQL backend defaults to sorting nulls last.
               [graphql|
                 query {
-                  #{schemaName}_employee(order_by: [{ monthly_salary: desc }, {id: desc}]) {
+                  #{schemaName}_employee(order_by: [{ monthly_salary: desc_nulls_first }, {id: desc}]) {
                     id
                     first_name
                     last_name
@@ -394,59 +395,6 @@ tests = do
 
       shouldReturnYaml testEnvironment actual expected
 
-    it "ordering by a computed field is applied over redacted computed field value" \testEnvironment -> do
-      let schemaName = Schema.getSchemaName testEnvironment
-          actual :: IO Value
-          actual =
-            GraphqlEngine.postGraphqlWithHeaders
-              testEnvironment
-              [ ("X-Hasura-Role", "employee"),
-                ("X-Hasura-Employee-Id", "3")
-              ]
-              [graphql|
-                query {
-                  #{schemaName}_employee(order_by: [{ yearly_salary: desc }, {id: desc}]) {
-                    id
-                    first_name
-                    last_name
-                    yearly_salary
-                  }
-                }
-              |]
-
-          -- Xin Cheng can see her own salary, but not her peers' because the
-          -- 'employee_public_info' role does not provide access to
-          -- the monthly_salary column, but the 'employee_private_info' role
-          -- does, but only for the current employee's record (ie. hers).
-          -- This means when she orders by monthly salary, the ordering
-          -- should not know the value of any salary other than hers and therefore
-          -- should fall back to order by the id since all other salaries should
-          -- appear as null.
-          expected :: Value
-          expected =
-            [interpolateYaml|
-              data:
-                #{schemaName}_employee:
-                - id: 4
-                  first_name: Sarah
-                  last_name: Smith
-                  yearly_salary: null
-                - id: 2
-                  first_name: Grant
-                  last_name: Smith
-                  yearly_salary: null
-                - id: 1
-                  first_name: David
-                  last_name: Holden
-                  yearly_salary: null
-                - id: 3
-                  first_name: Xin
-                  last_name: Cheng
-                  yearly_salary: 66000
-            |]
-
-      shouldReturnYaml testEnvironment actual expected
-
     it "ordering by aggregate is applied over the aggregate over the redacted column value" \testEnvironment -> do
       let schemaName = Schema.getSchemaName testEnvironment
           actual :: IO Value
@@ -456,9 +404,11 @@ tests = do
               [ ("X-Hasura-Role", "hr_manager"),
                 ("X-Hasura-Manager-Id", "3")
               ]
+              -- Note that this test differs slightly from its Postgres counterpart, since
+              -- the MSSQL backend defaults to sorting nulls last.
               [graphql|
                 query {
-                  #{schemaName}_manager(order_by: [{employees_by_id_to_engineering_manager_id_aggregate: { sum: { monthly_salary: desc } }}, {id: asc}]) {
+                  #{schemaName}_manager(order_by: [{employees_by_id_to_engineering_manager_id_aggregate: { sum: { monthly_salary: desc_nulls_first } }}, {id: asc}]) {
                     id
                     first_name
                     last_name
@@ -517,54 +467,7 @@ tests = do
 
       shouldReturnYaml testEnvironment actual expected
 
-    it "distinct_on is applied over redacted column values" \testEnvironment -> do
+  describe "Redaction in filtering" $ do
-      let schemaName = Schema.getSchemaName testEnvironment
-          actual :: IO Value
-          actual =
-            GraphqlEngine.postGraphqlWithHeaders
-              testEnvironment
-              [ ("X-Hasura-Role", "hr_manager"),
-                ("X-Hasura-Manager-Id", "3")
-              ]
-              [graphql|
-                query {
-                  #{schemaName}_employee(distinct_on: [nationality], order_by: [{nationality: asc}, {id: asc}]) {
-                    id
-                    first_name
-                    last_name
-                    nationality
-                  }
-                }
-              |]
-
-          -- Althea Weiss can only see the nationality of the employees she is HR manager for.
-          -- This is because the 'manager_employee_private_info' role provides access to the nationality
-          -- for the current manager's HR-managed employees, but the rest of the employees
-          -- are accessed via 'all_managers', which does not expose 'nationality'.
-          -- So when Althea performs a distinct_on nationality, the distinct should be done over the
-          -- values of nationality after redaction, so only the first redacted nationality row gets kept
-          expected :: Value
-          expected =
-            [interpolateYaml|
-              data:
-                #{schemaName}_employee:
-                - id: 1
-                  first_name: David
-                  last_name: Holden
-                  nationality: Australian
-                - id: 3
-                  first_name: Xin
-                  last_name: Cheng
-                  nationality: Chinese
-                - id: 2
-                  first_name: Grant
-                  last_name: Smith
-                  nationality: null
-            |]
-
-      shouldReturnYaml testEnvironment actual expected
-
-  xdescribe "Redaction in filtering" $ do
     it "filtering by column is applied against redacted column value" \testEnvironment -> do
       let schemaName = Schema.getSchemaName testEnvironment
           actual :: IO Value
@@ -596,35 +499,3 @@ tests = do
             |]
 
       shouldReturnYaml testEnvironment actual expected
-
-    it "filtering by computed field is applied against redacted computed field value" \testEnvironment -> do
-      let schemaName = Schema.getSchemaName testEnvironment
-          actual :: IO Value
-          actual =
-            GraphqlEngine.postGraphqlWithHeaders
-              testEnvironment
-              [ ("X-Hasura-Role", "employee"),
-                ("X-Hasura-Employee-Id", "3")
-              ]
-              [graphql|
-                query {
-                  #{schemaName}_employee(where: { yearly_salary: { _eq: 60000 } }) {
-                    id
-                  }
-                }
-              |]
-
-          -- Xin Cheng can see her own salary, but not her peers' because the
-          -- 'employee_public_info' role does not provide access to
-          -- the yearly_salary computed field, but the 'employee_private_info' role
-          -- does, but only for the current employee's record (ie. hers).
-          -- This means she should not be able to compare against salaries
-          -- she does not have access to, such as David Holden's salary
-          expected :: Value
-          expected =
-            [interpolateYaml|
-              data:
-                #{schemaName}_employee: []
-            |]
-
-      shouldReturnYaml testEnvironment actual expected

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

@@ -81,10 +81,10 @@ fromAnnBoolExpFld ::
   ReaderT EntityAlias FromIr Expression
 fromAnnBoolExpFld =
   \case
-    IR.AVColumn columnInfo _redactionExp opExpGs -> do
+    IR.AVColumn columnInfo redactionExp opExpGs -> do
       -- TODO(redactionExp): Deal with the redaction expression
       expressions <- traverse (fromOpExpG columnInfo) opExpGs
-      pure (AndExpression expressions)
+      potentiallyRedacted redactionExp (AndExpression expressions)
     IR.AVRelationship IR.RelInfo {riMapping = mapping, riTarget = target} (IR.RelationshipFilters tablePerm annBoolExp) -> do
       case target of
         IR.RelTargetNativeQuery _ -> error "fromAnnBoolExpFld RelTargetNativeQuery"
@@ -113,6 +113,14 @@ fromAnnBoolExpFld =
                   }
             )
   where
+    potentiallyRedacted :: IR.AnnRedactionExp 'MSSQL Expression -> Expression -> ReaderT EntityAlias FromIr Expression
+    potentiallyRedacted redactionExp ex = do
+      case redactionExp of
+        IR.NoRedaction -> pure ex
+        IR.RedactIfFalse p -> do
+          condExp <- fromGBoolExp p
+          pure $ AndExpression [condExp, ex]
+
     -- Translate a relationship field mapping into column equality comparisons.
     translateMapping ::
       From ->

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

@@ -606,16 +606,16 @@ fromAggregateField alias aggregateField =
             selectFor = JsonFor $ ForJson JsonSingleton NoRoot
           }
   where
-    potentiallyRedacted :: IR.AnnRedactionExp 'MSSQL Expression -> Expression -> ReaderT EntityAlias FromIr Expression
-    potentiallyRedacted redactionExp ex = do
-      case redactionExp of
-        IR.NoRedaction -> pure ex
-        IR.RedactIfFalse p -> do
-          condExp <- fromGBoolExp p
-          pure $ ConditionalExpression condExp ex (ValueExpression ODBC.NullValue)
-
     columnFieldAggEntity col = columnNameToFieldName col $ EntityAlias aggSubselectName
 
+potentiallyRedacted :: IR.AnnRedactionExp 'MSSQL Expression -> Expression -> ReaderT EntityAlias FromIr Expression
+potentiallyRedacted redactionExp ex = do
+  case redactionExp of
+    IR.NoRedaction -> pure ex
+    IR.RedactIfFalse p -> do
+      condExp <- fromGBoolExp p
+      pure $ ConditionalExpression condExp ex (ValueExpression ODBC.NullValue)
+
 -- | The main sources of fields, either constants, fields or via joins.
 fromAnnFieldsG ::
   Map (Either NativeQueryName TableName) EntityAlias ->
@@ -668,12 +668,7 @@ fromAnnColumnField annColumnField = do
   -- WKT format
   if typ == (IR.ColumnScalar GeometryType) || typ == (IR.ColumnScalar GeographyType)
     then pure $ MethodApplicationExpression (ColumnExpression fieldName) MethExpSTAsText
-    else case redactionExp of
+    else potentiallyRedacted redactionExp (ColumnExpression fieldName)
-      IR.NoRedaction -> pure (ColumnExpression fieldName)
-      IR.RedactIfFalse ex -> do
-        ex' <- fromGBoolExp ex
-        let nullValue = ValueExpression ODBC.NullValue
-        pure (ConditionalExpression ex' (ColumnExpression fieldName) nullValue)
   where
     IR.AnnColumnField
       { _acfColumn = column,
@@ -972,7 +967,7 @@ fromAnnotatedOrderByItemG ::
   IR.AnnotatedOrderByItemG 'MSSQL Expression ->
   WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) OrderBy
 fromAnnotatedOrderByItemG IR.OrderByItemG {obiType, obiColumn = obiColumn, obiNulls} = do
-  (orderByFieldName, orderByType) <- unfurlAnnotatedOrderByElement obiColumn
+  (orderByExpression, orderByType) <- unfurlAnnotatedOrderByElement obiColumn
   let orderByNullsOrder = fromMaybe NullsAnyOrder obiNulls
       orderByOrder = fromMaybe AscOrder obiType
   pure OrderBy {..}
@@ -982,14 +977,14 @@ fromAnnotatedOrderByItemG IR.OrderByItemG {obiType, obiColumn = obiColumn, obiNu
 -- IR.AOCArrayAggregation).
 unfurlAnnotatedOrderByElement ::
   IR.AnnotatedOrderByElement 'MSSQL Expression ->
-  WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) (FieldName, Maybe TSQL.ScalarType)
+  WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) (Expression, Maybe TSQL.ScalarType)
 unfurlAnnotatedOrderByElement =
   \case
-    -- TODO(redactionExp): Use the redaction expression
+    IR.AOCColumn columnInfo redactionExp -> do
-    IR.AOCColumn columnInfo _redactionExp -> do
       fieldName <- lift (fromColumnInfo columnInfo)
+      ex <- lift $ potentiallyRedacted redactionExp (ColumnExpression fieldName)
       pure
-        ( fieldName,
+        ( ex,
           case IR.ciType columnInfo of
             IR.ColumnScalar t -> Just t
             -- Above: It is of interest to us whether the type is
@@ -1023,10 +1018,10 @@ unfurlAnnotatedOrderByElement =
               (const (fromAlias selectFrom))
               ( case annAggregateOrderBy of
                   IR.AAOCount -> pure (CountAggregate StarCountable)
-                  -- TODO(redactionExp): Use the redaction expression
+                  IR.AAOOp (IR.AggregateOrderByColumn text _resultType columnInfo redactionExp) -> do
-                  IR.AAOOp (IR.AggregateOrderByColumn text _resultType columnInfo _redactionExp) -> do
                     fieldName <- fromColumnInfo columnInfo
-                    pure (OpAggregate text (pure (ColumnExpression fieldName)))
+                    ex <- potentiallyRedacted redactionExp (ColumnExpression fieldName)
+                    pure (OpAggregate text (pure ex))
               )
           )
       tell
@@ -1063,7 +1058,7 @@ unfurlAnnotatedOrderByElement =
             )
         )
       pure
-        ( FieldName {fieldNameEntity = joinAliasEntity, fieldName = alias},
+        ( ColumnExpression $ FieldName {fieldNameEntity = joinAliasEntity, fieldName = alias},
           Nothing
         )
   where

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

@@ -666,10 +666,10 @@ fromOrderBys top moffset morderBys =
 
 fromOrderBy :: OrderBy -> [Printer]
 fromOrderBy OrderBy {..} =
-  [ fromNullsOrder orderByFieldName orderByNullsOrder,
+  [ fromNullsOrder orderByExpression orderByNullsOrder,
     -- Above: This doesn't do anything when using text, ntext or image
     -- types. See below on CAST commentary.
-    wrapNullHandling (fromFieldName orderByFieldName)
+    wrapNullHandling (fromExpression orderByExpression)
       <+> " "
       <+> fromOrder orderByOrder
   ]
@@ -695,12 +695,12 @@ fromOrder =
     AscOrder -> "ASC"
     DescOrder -> "DESC"
 
-fromNullsOrder :: FieldName -> NullsOrder -> Printer
+fromNullsOrder :: Expression -> NullsOrder -> Printer
-fromNullsOrder fieldName =
+fromNullsOrder ex =
   \case
     NullsAnyOrder -> ""
-    NullsFirst -> "IIF(" <+> fromFieldName fieldName <+> " IS NULL, 0, 1)"
+    NullsFirst -> "IIF(" <+> fromExpression ex <+> " IS NULL, 0, 1)"
-    NullsLast -> "IIF(" <+> fromFieldName fieldName <+> " IS NULL, 1, 0)"
+    NullsLast -> "IIF(" <+> fromExpression ex <+> " IS NULL, 1, 0)"
 
 fromJoinAlias :: JoinAlias -> Printer
 fromJoinAlias JoinAlias {..} =

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

@@ -328,7 +328,7 @@ data Reselect = Reselect
   }
 
 data OrderBy = OrderBy
-  { orderByFieldName :: FieldName,
+  { orderByExpression :: Expression,
     orderByOrder :: Order,
     orderByNullsOrder :: NullsOrder,
     orderByType :: Maybe ScalarType