hasura/graphql-engine
1
0
Fork 0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-14 17:02:49 +03:00
Code Issues Projects Releases Wiki Activity

Fix(Sqlserver): Apply Column Redaction to aggregations

Browse Source 
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9956
GitOrigin-RevId: ed7a734fabcaaead85999a25223a61f0cba7807c
This commit is contained in:
Philip Lykke Carlsen 2023-07-26 10:52:19 +02:00 committed by hasura-bot
parent 790523556f
commit 483409c26b
10 changed files with 734 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
server/lib/api-tests/api-tests.cabal
View File

@ -115,6 +115,7 @@ library
Test.Auth.Authorization.DisableRootFields.SelectPermission.EnableAllRootFieldsSpec
Test.Auth.Authorization.DisableRootFields.SelectPermission.EnablePKSpec
Test.Auth.Authorization.DisableRootFields.SelectPermission.RelationshipSpec
Test.Auth.Authorization.InheritedRoles.ColumnRedaction.SqlserverSpec
Test.Auth.Authorization.InheritedRoles.ColumnRedactionSpec
Test.DataConnector.AggregateQuerySpec
Test.DataConnector.MetadataApiSpec

630
server/lib/api-tests/src/Test/Auth/Authorization/InheritedRoles/ColumnRedaction/SqlserverSpec.hs Normal file
View File

@ -0,0 +1,630 @@
module Test.Auth.Authorization.InheritedRoles.ColumnRedaction.SqlserverSpec
( spec,
)
where
import Data.Aeson (Value (String), object, (.=))
import Data.List.NonEmpty qualified as NE
import Harness.Backend.Sqlserver qualified as Sqlserver
import Harness.GraphqlEngine qualified as GraphqlEngine
import Harness.Permissions (InheritedRoleDetails (..), Permission (..), SelectPermissionDetails (..), selectPermission)
import Harness.Quoter.Graphql
import Harness.Quoter.Yaml (interpolateYaml)
import Harness.Schema (Table (..), table)
import Harness.Schema qualified as Schema
import Harness.Test.Fixture qualified as Fixture
import Harness.Test.SetupAction (setupPermissionsAction)
import Harness.TestEnvironment (GlobalTestEnvironment, TestEnvironment)
import Harness.Yaml (shouldReturnYaml)
import Hasura.Prelude
import Test.Hspec
--------------------------------------------------------------------------------
-- Preamble
spec :: SpecWith GlobalTestEnvironment
spec =
Fixture.run
( NE.fromList
[ (Fixture.fixture $ Fixture.Backend Sqlserver.backendTypeMetadata)
{ Fixture.setupTeardown = \(testEnv, _) ->
[ Sqlserver.setupTablesAction schema testEnv,
setupPermissionsAction permissions testEnv
]
}
]
)
tests
--------------------------------------------------------------------------------
-- Schema
schema :: [Schema.Table]
schema = [manager, employee]
manager :: Schema.Table
manager =
(table "manager")
{ tableColumns =
[ Schema.column "id" Schema.TInt,
Schema.column "first_name" Schema.TStr,
Schema.column "last_name" Schema.TStr
],
tablePrimaryKey = ["id"],
tableData =
[ [Schema.VInt 1, Schema.VStr "Ryan", Schema.VStr "Ray"],
[Schema.VInt 2, Schema.VStr "Martin", Schema.VStr "Graham"],
[Schema.VInt 3, Schema.VStr "Althea", Schema.VStr "Weiss"],
[Schema.VInt 4, Schema.VStr "Bec", Schema.VStr "Vo"]
]
}
employee :: Schema.Table
employee =
(table "employee")
{ tableColumns =
[ Schema.column "id" Schema.TInt,
Schema.column "first_name" Schema.TStr,
Schema.column "last_name" Schema.TStr,
Schema.column "nationality" Schema.TStr,
Schema.column "monthly_salary" Schema.TInt,
Schema.column "engineering_manager_id" Schema.TInt,
Schema.column "hr_manager_id" Schema.TInt
],
tablePrimaryKey = ["id"],
tableReferences =
[ (Schema.reference "engineering_manager_id" "manager" "id")
{ Schema.referenceCascade = False
},
(Schema.reference "hr_manager_id" "manager" "id")
{ Schema.referenceCascade = False
}
],
tableData =
[ [Schema.VInt 1, Schema.VStr "David", Schema.VStr "Holden", Schema.VStr "Australian", Schema.VInt 5000, Schema.VInt 1, Schema.VInt 3],
[Schema.VInt 2, Schema.VStr "Grant", Schema.VStr "Smith", Schema.VStr "Australian", Schema.VInt 6000, Schema.VInt 1, Schema.VInt 4],
[Schema.VInt 3, Schema.VStr "Xin", Schema.VStr "Cheng", Schema.VStr "Chinese", Schema.VInt 5500, Schema.VInt 2, Schema.VInt 3],
[Schema.VInt 4, Schema.VStr "Sarah", Schema.VStr "Smith", Schema.VStr "British", Schema.VInt 4000, Schema.VInt 2, Schema.VInt 4]
]
}
--------------------------------------------------------------------------------
-- Permissions
permissions :: [Permission]
permissions =
[ SelectPermission
selectPermission
{ selectPermissionTable = "employee",
selectPermissionRole = "employee_public_info",
selectPermissionColumns = ["id", "first_name", "last_name"],
selectPermissionAllowAggregations = True,
selectPermissionRows = object []
},
SelectPermission
selectPermission
{ selectPermissionTable = "employee",
selectPermissionRole = "employee_private_info",
selectPermissionColumns = ["id", "first_name", "last_name", "monthly_salary"],
selectPermissionAllowAggregations = True,
selectPermissionRows =
object
[ "id" .= String "X-Hasura-Employee-Id"
]
},
InheritedRole
InheritedRoleDetails
{ inheritedRoleName = "employee",
inheritedRoleRoleSet = ["employee_public_info", "employee_private_info"]
},
SelectPermission
selectPermission
{ selectPermissionTable = "manager",
selectPermissionRole = "all_managers",
selectPermissionColumns = ["id", "first_name", "last_name"],
selectPermissionAllowAggregations = True,
selectPermissionRows = object []
},
SelectPermission
selectPermission
{ selectPermissionTable = "employee",
selectPermissionRole = "all_managers",
selectPermissionColumns = ["id", "first_name", "last_name", "engineering_manager_id", "hr_manager_id"],
selectPermissionAllowAggregations = True,
selectPermissionRows = object []
},
SelectPermission
selectPermission
{ selectPermissionTable = "employee",
selectPermissionRole = "manager_employee_private_info",
selectPermissionColumns = ["id", "first_name", "last_name", "nationality", "monthly_salary", "engineering_manager_id", "hr_manager_id"],
selectPermissionAllowAggregations = True,
selectPermissionRows =
object
[ "hr_manager_id" .= String "X-Hasura-Manager-Id"
]
},
InheritedRole
InheritedRoleDetails
{ inheritedRoleName = "hr_manager",
inheritedRoleRoleSet = ["all_managers", "manager_employee_private_info"]
}
]
--------------------------------------------------------------------------------
-- Tests
tests :: SpecWith TestEnvironment
tests = do
describe "Redaction in column selection sets" $ do
it "Check redaction in regular queries" \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: { id: asc }) {
id
first_name
last_name
monthly_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 & yearly_salary computed field,
-- but the 'employee_private_info' role does, but only for the current
-- employee's record (ie. hers)
expected :: Value
expected =
[interpolateYaml|
data:
#{schemaName}_employee:
- id: 1
first_name: David
last_name: Holden
monthly_salary: null
- id: 2
first_name: Grant
last_name: Smith
monthly_salary: null
- id: 3
first_name: Xin
last_name: Cheng
monthly_salary: 5500
- id: 4
first_name: Sarah
last_name: Smith
monthly_salary: null
|]
shouldReturnYaml testEnvironment actual expected
it "Check column redaction in nodes in aggregate queries" \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_aggregate(order_by: { id: asc }) {
nodes {
id
first_name
last_name
monthly_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 & yearly_salary computed field,
-- but the 'employee_private_info' role does, but only for the current
-- employee's record (ie. hers)
expected :: Value
expected =
[interpolateYaml|
data:
#{schemaName}_employee_aggregate:
nodes:
- id: 1
first_name: David
last_name: Holden
monthly_salary: null
- id: 2
first_name: Grant
last_name: Smith
monthly_salary: null
- id: 3
first_name: Xin
last_name: Cheng
monthly_salary: 5500
- id: 4
first_name: Sarah
last_name: Smith
monthly_salary: null
|]
shouldReturnYaml testEnvironment actual expected
describe "Redaction in aggregation calculations" $ do
it "Check redaction of input values to aggregation functions" \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_aggregate {
aggregate {
count
sum {
monthly_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)
expected :: Value
expected =
[interpolateYaml|
data:
#{schemaName}_employee_aggregate:
aggregate:
count: 4
sum:
monthly_salary: 5500
|]
shouldReturnYaml testEnvironment actual expected
it "Check redaction of input values to count aggregations that use columns" \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_aggregate {
aggregate {
count
count_distinct_salary: count(distinct: true, column: monthly_salary)
count_not_distinct_salary: count(distinct: false, column: monthly_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 & yearly_salary computed field,
-- but the 'employee_private_info' role does, but only for the current
-- employee's record (ie. hers)
expected :: Value
expected =
[interpolateYaml|
data:
#{schemaName}_employee_aggregate:
aggregate:
count: 4
count_distinct_salary: 1
count_not_distinct_salary: 1
|]
shouldReturnYaml testEnvironment actual expected
-- Postponed for now.
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
actual =
GraphqlEngine.postGraphqlWithHeaders
testEnvironment
[ ("X-Hasura-Role", "employee"),
("X-Hasura-Employee-Id", "3")
]
[graphql|
query {
#{schemaName}_employee(order_by: [{ monthly_salary: desc }, {id: desc}]) {
id
first_name
last_name
monthly_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
monthly_salary: null
- id: 2
first_name: Grant
last_name: Smith
monthly_salary: null
- id: 1
first_name: David
last_name: Holden
monthly_salary: null
- id: 3
first_name: Xin
last_name: Cheng
monthly_salary: 5500
|]
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
actual =
GraphqlEngine.postGraphqlWithHeaders
testEnvironment
[ ("X-Hasura-Role", "hr_manager"),
("X-Hasura-Manager-Id", "3")
]
[graphql|
query {
#{schemaName}_manager(order_by: [{employees_by_id_to_engineering_manager_id_aggregate: { sum: { monthly_salary: desc } }}, {id: asc}]) {
id
first_name
last_name
employees_by_id_to_engineering_manager_id_aggregate {
aggregate {
sum {
monthly_salary
}
}
}
}
}
|]
-- Althea Weiss can only see the salaries of the employees she is HR manager for.
-- This is because the 'manager_employee_private_info' role provides access to the salary
-- for the current manager's HR-managed employees, but the rest of the employees
-- are accessed via 'all_managers', which does not expose 'monthly_salary'.
-- So when Althea orders all managers by the sum of the salary of the employees they
-- are the _engineering manager_ for, she should only be ordering them by
-- aggregate of the salaries she can see.
expected :: Value
expected =
[interpolateYaml|
data:
#{schemaName}_manager:
- id: 3
first_name: Althea
last_name: Weiss
employees_by_id_to_engineering_manager_id_aggregate:
aggregate:
sum:
monthly_salary: null
- id: 4
first_name: Bec
last_name: Vo
employees_by_id_to_engineering_manager_id_aggregate:
aggregate:
sum:
monthly_salary: null
- id: 2
first_name: Martin
last_name: Graham
employees_by_id_to_engineering_manager_id_aggregate:
aggregate:
sum:
monthly_salary: 5500
- id: 1
first_name: Ryan
last_name: Ray
employees_by_id_to_engineering_manager_id_aggregate:
aggregate:
sum:
monthly_salary: 5000
|]
shouldReturnYaml testEnvironment actual expected
it "distinct_on is applied over redacted column values" \testEnvironment -> 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
actual =
GraphqlEngine.postGraphqlWithHeaders
testEnvironment
[ ("X-Hasura-Role", "employee"),
("X-Hasura-Employee-Id", "3")
]
[graphql|
query {
#{schemaName}_employee(where: { monthly_salary: { _eq: 5000 } }) {
id
}
}
|]
-- 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 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
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

33
server/lib/test-harness/src/Harness/Backend/Sqlserver.hs
View File

@ -184,22 +184,25 @@ mkPrimaryKey key =
]
mkReference :: Schema.Reference -> Text
mkReference Schema.Reference {referenceLocalColumn, referenceTargetTable, referenceTargetColumn} =
mkReference Schema.Reference {referenceLocalColumn, referenceTargetTable, referenceTargetColumn, referenceCascade} =
T.unwords
[ "CONSTRAINT ",
constraintName,
"FOREIGN KEY ",
"(",
wrapIdentifier referenceLocalColumn,
")",
"REFERENCES",
T.pack Constants.sqlserverDb <> "." <> referenceTargetTable,
"(",
wrapIdentifier referenceTargetColumn,
")",
"ON DELETE CASCADE",
"ON UPDATE CASCADE"
]
$ [ "CONSTRAINT ",
constraintName,
"FOREIGN KEY ",
"(",
wrapIdentifier referenceLocalColumn,
")",
"REFERENCES",
T.pack Constants.sqlserverDb <> "." <> referenceTargetTable,
"(",
wrapIdentifier referenceTargetColumn,
")"
]
++ [ x | referenceCascade, x <-
[ "ON DELETE CASCADE",
"ON UPDATE CASCADE"
]
]
where
constraintName :: Text
constraintName =

6
server/lib/test-harness/src/Harness/Schema/Table.hs
View File

@ -100,7 +100,8 @@ data Reference = Reference
referenceTargetTable :: Text,
referenceTargetColumn :: Text,
referenceTargetQualifiers :: [Text],
referenceInsertionOrder :: InsertOrder
referenceInsertionOrder :: InsertOrder,
referenceCascade :: Bool
}
deriving (Show, Eq)
@ -111,7 +112,8 @@ reference localColumn targetTable targetColumn =
referenceTargetTable = targetTable,
referenceTargetColumn = targetColumn,
referenceTargetQualifiers = mempty,
referenceInsertionOrder = BeforeParent
referenceInsertionOrder = BeforeParent,
referenceCascade = True
}
-- | Type representing manual relationship between tables. This is

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

@ -428,7 +428,7 @@ fromSelectAggregate
expss :: [(Int, Projection)] <- flip runReaderT (fromAlias selectFrom) $ sequence $ mapMaybe fromTableExpFieldG fields
nodes :: [(Int, (IR.FieldName, [FieldSource]))] <-
flip runReaderT (fromAlias selectFrom) $ sequence $ mapMaybe (fromTableNodesFieldG argsExistingJoins) fields
let aggregates :: [(Int, (IR.FieldName, [Projection]))] = mapMaybe fromTableAggFieldG fields
aggregates :: [(Int, (IR.FieldName, [Projection]))] <- flip runReaderT (EntityAlias aggSubselectName) $ sequence $ mapMaybe fromTableAggFieldG fields
pure
emptySelect
{ selectProjections =
@ -552,14 +552,14 @@ fromTableExpFieldG = \case
fromTableAggFieldG ::
(Int, (IR.FieldName, IR.TableAggregateFieldG 'MSSQL Void Expression)) ->
Maybe (Int, (IR.FieldName, [Projection]))
Maybe (ReaderT EntityAlias FromIr (Int, (IR.FieldName, [Projection])))
fromTableAggFieldG = \case
(index, (fieldName, IR.TAFAgg (aggregateFields :: [(IR.FieldName, IR.AggregateField 'MSSQL Expression)]))) ->
Just
$ let aggregates =
aggregateFields <&> \(fieldName', aggregateField) ->
fromAggregateField (IR.getFieldNameTxt fieldName') aggregateField
in (index, (fieldName, aggregates))
Just $ do
aggregates <-
forM aggregateFields \(fieldName', aggregateField) ->
fromAggregateField (IR.getFieldNameTxt fieldName') aggregateField
pure (index, (fieldName, aggregates))
_ -> Nothing
fromTableNodesFieldG ::
@ -572,35 +572,48 @@ fromTableNodesFieldG argsExistingJoins = \case
pure (index, (fieldName, fieldSources'))
_ -> Nothing
fromAggregateField :: Text -> IR.AggregateField 'MSSQL Expression -> Projection
fromAggregateField :: Text -> IR.AggregateField 'MSSQL Expression -> ReaderT EntityAlias FromIr Projection
fromAggregateField alias aggregateField =
case aggregateField of
IR.AFExp text -> AggregateProjection $ Aliased (TextAggregate text) alias
IR.AFCount countType -> AggregateProjection . flip Aliased alias . CountAggregate $ case getConst countType of
StarCountable -> StarCountable
NonNullFieldCountable name -> NonNullFieldCountable $ columnFieldAggEntity name
DistinctCountable name -> DistinctCountable $ columnFieldAggEntity name
IR.AFOp IR.AggregateOp {_aoOp = op, _aoFields = fields} ->
let projections :: [Projection] =
fields <&> \(fieldName, columnField) ->
case columnField of
-- TODO(redactionExp): Deal with redaction expression?
IR.SFCol column _columnType _redactionExp ->
let fname = columnFieldAggEntity column
in AggregateProjection $ Aliased (OpAggregate op [ColumnExpression fname]) (IR.getFieldNameTxt fieldName)
IR.SFExp text ->
ExpressionProjection $ Aliased (ValueExpression (ODBC.TextValue text)) (IR.getFieldNameTxt fieldName)
-- See Hasura.RQL.Types.Backend.supportsAggregateComputedFields
IR.SFComputedField _ _ -> error "Aggregate computed fields aren't currently supported for MSSQL!"
in ExpressionProjection
$ flip Aliased alias
$ safeJsonQueryExpression JsonSingleton
$ SelectExpression
$ emptySelect
{ selectProjections = projections,
selectFor = JsonFor $ ForJson JsonSingleton NoRoot
}
IR.AFExp text -> pure $ AggregateProjection $ Aliased (TextAggregate text) alias
IR.AFCount countType ->
AggregateProjection . flip Aliased alias . CountAggregate <$> case getCountType countType of
StarCountable -> pure StarCountable
NonNullFieldCountable (name, redactionExp) -> do
ex <- potentiallyRedacted redactionExp (ColumnExpression (columnFieldAggEntity name))
pure $ NonNullFieldCountable ex
DistinctCountable (name, redactionExp) -> do
ex <- potentiallyRedacted redactionExp (ColumnExpression (columnFieldAggEntity name))
pure $ DistinctCountable ex
IR.AFOp IR.AggregateOp {_aoOp = op, _aoFields = fields} -> do
projections :: [Projection] <- forM fields \(fieldName, columnField) ->
case columnField of
IR.SFCol column _columnType redactionExp -> do
let fname = columnFieldAggEntity column
colExp <- potentiallyRedacted redactionExp (ColumnExpression fname)
pure $ AggregateProjection $ Aliased (OpAggregate op [colExp]) (IR.getFieldNameTxt fieldName)
IR.SFExp text ->
pure $ ExpressionProjection $ Aliased (ValueExpression (ODBC.TextValue text)) (IR.getFieldNameTxt fieldName)
-- See Hasura.RQL.Types.Backend.supportsAggregateComputedFields
IR.SFComputedField _ _ -> error "Aggregate computed fields aren't currently supported for MSSQL!"
pure
$ ExpressionProjection
$ flip Aliased alias
$ safeJsonQueryExpression JsonSingleton
$ SelectExpression
$ emptySelect
{ selectProjections = projections,
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
-- | The main sources of fields, either constants, fields or via joins.
@ -658,7 +671,7 @@ fromAnnColumnField annColumnField = do
else case redactionExp of
IR.NoRedaction -> pure (ColumnExpression fieldName)
IR.RedactIfFalse ex -> do
ex' <- fromGBoolExp (coerce ex)
ex' <- fromGBoolExp ex
let nullValue = ValueExpression ODBC.NullValue
pure (ConditionalExpression ex' (ColumnExpression fieldName) nullValue)
where

7
server/src-lib/Hasura/Backends/MSSQL/Instances/Schema.hs
View File

@ -7,7 +7,6 @@
-- Defines a 'Hasura.GraphQL.Schema.Backend.BackendSchema' type class instance for MSSQL.
module Hasura.Backends.MSSQL.Instances.Schema () where
import Control.Applicative (Const (..))
import Data.Char qualified as Char
import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty qualified as NE
@ -403,9 +402,9 @@ msCountTypeInput = \case
Nothing -> pure $ flip mkCountType Nothing
where
mkCountType :: IR.CountDistinct -> Maybe (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL) -> CountType 'MSSQL (UnpreparedValue 'MSSQL)
mkCountType _ Nothing = Const MSSQL.StarCountable
mkCountType IR.SelectCountDistinct (Just (col, _redactionExp)) = Const $ MSSQL.DistinctCountable col -- TODO(redactionExp): Deal with redaction expressions
mkCountType IR.SelectCountNonDistinct (Just (col, _redactionExp)) = Const $ MSSQL.NonNullFieldCountable col -- TODO(redactionExp): Deal with redaction expressions
mkCountType _ Nothing = MSSQL.CountType MSSQL.StarCountable
mkCountType IR.SelectCountDistinct (Just (col, redactionExp)) = MSSQL.CountType $ MSSQL.DistinctCountable (col, redactionExp)
mkCountType IR.SelectCountNonDistinct (Just (col, redactionExp)) = MSSQL.CountType $ MSSQL.NonNullFieldCountable (col, redactionExp)
msParseUpdateOperators ::
forall m n r.

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

@ -38,7 +38,7 @@ instance Backend 'MSSQL where
type ConstraintName 'MSSQL = MSSQL.ConstraintName
type BasicOrderType 'MSSQL = MSSQL.Order
type NullsOrderType 'MSSQL = MSSQL.NullsOrder
type CountType 'MSSQL = Const (MSSQL.Countable MSSQL.ColumnName) -- TODO(redactionExp): Going to need to replace this Const with a fixed up type here
type CountType 'MSSQL = MSSQL.CountType
type Column 'MSSQL = MSSQL.ColumnName
type ScalarValue 'MSSQL = MSSQL.Value
type ScalarType 'MSSQL = MSSQL.ScalarType

6
server/src-lib/Hasura/Backends/MSSQL/ToQuery.hs
View File

@ -739,12 +739,12 @@ fromAggregate =
<+> ")"
TextAggregate text -> fromExpression (ValueExpression (TextValue text))
fromCountable :: Countable FieldName -> Printer
fromCountable :: Countable Expression -> Printer
fromCountable =
\case
StarCountable -> "*"
NonNullFieldCountable field -> fromFieldName field
DistinctCountable field -> "DISTINCT " <+> fromFieldName field
NonNullFieldCountable field -> fromExpression field
DistinctCountable field -> "DISTINCT " <+> fromExpression field
fromWhere :: Where -> Printer
fromWhere =

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

@ -1,6 +1,7 @@
{- ORMOLU_DISABLE -}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
-- NOTE: This module previously used Template Haskell to generate its instances,
-- but additional restrictions on Template Haskell splices introduced in GHC 9.0 impose an ordering
-- on the generated instances that is difficult to satisfy
@ -23,6 +24,9 @@ import Hasura.Metadata.DTO.Placeholder (placeholderCodecViaJSON)
import Hasura.Prelude
import Language.Haskell.TH.Syntax
import Hasura.Base.ToErrorValue
import Hasura.RQL.Types.Backend qualified as Backend
import Hasura.RQL.Types.BackendType qualified as Backend
import qualified Hasura.RQL.Types.Backend as IR
deriving instance Generic (Aliased a)
instance Hashable a => Hashable (Aliased a)
@ -256,6 +260,24 @@ deriving newtype instance FromJSONKey ColumnName
--------------------------------------------------------------------------------
-- Manual instances
deriving instance Generic (CountType n)
deriving instance (Backend.Backend 'Backend.MSSQL, Show n,
Show (IR.AggregationPredicates 'Backend.MSSQL n),
Show (IR.FunctionArgumentExp 'Backend.MSSQL n),
Show (IR.BooleanOperators 'Backend.MSSQL n)) => Show (CountType n)
deriving instance (Backend.Backend 'Backend.MSSQL) => Functor CountType
deriving instance (Backend.Backend 'Backend.MSSQL) => Foldable CountType
deriving instance (Backend.Backend 'Backend.MSSQL) => Traversable CountType
deriving instance Foldable Countable
deriving instance Traversable Countable
deriving instance (Backend.Backend 'Backend.MSSQL, Eq n,
Eq (IR.AggregationPredicates 'Backend.MSSQL n),
Eq (IR.FunctionArgumentExp 'Backend.MSSQL n),
Eq (IR.BooleanOperators 'Backend.MSSQL n)) => Eq (CountType n)
deriving instance Generic (Countable n)
instance Hashable n => Hashable (Countable n)

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

@ -26,6 +26,7 @@ module Hasura.Backends.MSSQL.Types.Internal
Comment (..),
ConstraintName (..),
Countable (..),
CountType (..),
DataLength (..),
Delete (..),
DeleteOutput,
@ -117,6 +118,7 @@ import Hasura.Base.Error
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.NativeQuery.Metadata (InterpolatedQuery)
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp (AnnRedactionExp)
import Hasura.RQL.Types.Backend (SupportedNamingCase (..))
import Hasura.RQL.Types.BackendType
import Hasura.SQL.GeoJSON qualified as Geo
@ -465,10 +467,12 @@ data JsonPath
| IndexPath JsonPath Integer
data Aggregate
= CountAggregate (Countable FieldName)
= CountAggregate (Countable Expression)
| OpAggregate Text [Expression]
| TextAggregate Text
newtype CountType field = CountType {getCountType :: Countable (ColumnName, AnnRedactionExp 'MSSQL field)}
data Countable name
= StarCountable
| NonNullFieldCountable name