hasura/graphql-engine
1
0
Fork 0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-10-05 06:18:04 +03:00
Code Issues Projects Releases Wiki Activity

server: split boolean operators between core and backend-specific

Browse Source 
GitOrigin-RevId: f1291946a1122220e82371676d88867fd7b2b7c4
This commit is contained in:
Antoine Leblanc 2021-03-25 17:50:08 +00:00 committed by hasura-bot
parent 9052518da2
commit d8c56a40f6
49 changed files with 1130 additions and 910 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
server/graphql-engine.cabal
View File

@ -333,6 +333,9 @@ library
, Hasura.Backends.Postgres.Translate.Select
, Hasura.Backends.Postgres.Translate.Types
, Hasura.Backends.Postgres.Translate.Update
, Hasura.Backends.Postgres.Types.BoolExp
, Hasura.Backends.Postgres.Types.Column
, Hasura.Backends.Postgres.Types.Table
, Hasura.Backends.MSSQL.Connection
, Hasura.Backends.MSSQL.DDL

32
server/src-lib/Data/Aeson/Extended.hs
View File

@ -1,13 +1,33 @@
module Data.Aeson.Extended
( module J
, encodeToStrictText
) where
( module J
, encodeToStrictText
, ToJSONKeyValue (..)
, FromJSONKeyValue (..)
) where
import Hasura.Prelude
import Data.Aeson as J
import qualified Data.Aeson.Text as JT
import qualified Data.Text.Lazy as LT
import qualified Data.Aeson.Text as JT
import qualified Data.Text.Lazy as LT
import Data.Aeson as J
import Data.Aeson.Types (Parser)
import Data.Functor.Const
encodeToStrictText :: (ToJSON a) => a -> Text
encodeToStrictText = LT.toStrict . JT.encodeToLazyText
class ToJSONKeyValue a where
toJSONKeyValue :: a -> (Text, J.Value)
class FromJSONKeyValue a where
parseJSONKeyValue :: (Text, J.Value) -> Parser a
instance ToJSONKeyValue Void where
toJSONKeyValue = absurd
instance ToJSONKeyValue a => ToJSONKeyValue (Const a b) where
toJSONKeyValue = toJSONKeyValue . getConst

28
server/src-lib/Hasura/Backends/MSSQL/DDL/BoolExp.hs
View File

@ -69,21 +69,21 @@ parseBoolExpOperations rhsParser _fields columnInfo value =
"$nlike" -> parseNlike
"_nlike" -> parseNlike
"_st_contains" -> parseGeometryOrGeographyOp ASTContains
"$st_contains" -> parseGeometryOrGeographyOp ASTContains
"_st_equals" -> parseGeometryOrGeographyOp ASTEquals
"$st_equals" -> parseGeometryOrGeographyOp ASTEquals
"_st_intersects" -> parseGeometryOrGeographyOp ASTIntersects
"$st_intersects" -> parseGeometryOrGeographyOp ASTIntersects
"_st_overlaps" -> parseGeometryOrGeographyOp ASTOverlaps
"$st_overlaps" -> parseGeometryOrGeographyOp ASTOverlaps
"_st_within" -> parseGeometryOrGeographyOp ASTWithin
"$st_within" -> parseGeometryOrGeographyOp ASTWithin
"_st_contains" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTContains
"$st_contains" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTContains
"_st_equals" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTEquals
"$st_equals" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTEquals
"_st_intersects" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTIntersects
"$st_intersects" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTIntersects
"_st_overlaps" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTOverlaps
"$st_overlaps" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTOverlaps
"_st_within" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTWithin
"$st_within" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTWithin
"_st_crosses" -> parseGeometryOp ASTCrosses
"$st_crosses" -> parseGeometryOp ASTCrosses
"_st_touches" -> parseGeometryOp ASTTouches
"$st_touches" -> parseGeometryOp ASTTouches
"_st_crosses" -> ABackendSpecific <$> parseGeometryOp ASTCrosses
"$st_crosses" -> ABackendSpecific <$> parseGeometryOp ASTCrosses
"_st_touches" -> ABackendSpecific <$> parseGeometryOp ASTTouches
"$st_touches" -> ABackendSpecific <$> parseGeometryOp ASTTouches
x -> throw400 UnexpectedPayload $ "Unknown operator : " <> x

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

@ -804,62 +804,40 @@ fromMapping localFrom =
fromOpExpG :: Expression -> IR.OpExpG 'MSSQL Expression -> FromIr Expression
fromOpExpG expression op =
case op of
IR.ANISNULL -> pure (TSQL.IsNullExpression expression)
IR.ANISNOTNULL -> pure (TSQL.IsNotNullExpression expression)
IR.AEQ False val -> pure (nullableBoolEquality expression val)
IR.AEQ True val -> pure (TSQL.EqualExpression expression val)
IR.ANE False val -> pure (nullableBoolInequality expression val)
IR.ANE True val -> pure (TSQL.NotEqualExpression expression val)
IR.AGT val -> pure (OpExpression TSQL.GT expression val)
IR.ALT val -> pure (OpExpression TSQL.LT expression val)
IR.AGTE val -> pure (OpExpression TSQL.GTE expression val)
IR.ALTE val -> pure (OpExpression TSQL.LTE expression val)
IR.AIN val -> pure (OpExpression TSQL.IN expression val)
IR.ANIN val -> pure (OpExpression TSQL.NIN expression val)
IR.ALIKE val -> pure (OpExpression TSQL.LIKE expression val)
IR.ANLIKE val -> pure (OpExpression TSQL.NLIKE expression val)
IR.ASTContains val -> pure (TSQL.STOpExpression TSQL.STContains expression val)
IR.ASTCrosses val -> pure (TSQL.STOpExpression TSQL.STCrosses expression val)
IR.ASTEquals val -> pure (TSQL.STOpExpression TSQL.STEquals expression val)
IR.ASTIntersects val -> pure (TSQL.STOpExpression TSQL.STIntersects expression val)
IR.ASTOverlaps val -> pure (TSQL.STOpExpression TSQL.STOverlaps expression val)
IR.ASTTouches val -> pure (TSQL.STOpExpression TSQL.STTouches expression val)
IR.ASTWithin val -> pure (TSQL.STOpExpression TSQL.STWithin expression val)
-- https://docs.microsoft.com/en-us/sql/relational-databases/hierarchical-data-sql-server
IR.AAncestor _ -> refute (pure (UnsupportedOpExpG op))
IR.AAncestorAny _ -> refute (pure (UnsupportedOpExpG op))
IR.ADescendant _ -> refute (pure (UnsupportedOpExpG op))
IR.ADescendantAny _ -> refute (pure (UnsupportedOpExpG op))
IR.AMatches _ -> refute (pure (UnsupportedOpExpG op))
IR.AMatchesAny _ -> refute (pure (UnsupportedOpExpG op))
IR.AMatchesFulltext _ -> refute (pure (UnsupportedOpExpG op))
-- No equivalent operators in SQL Server for the following
-- https://docs.microsoft.com/en-us/sql/t-sql/functions/json-functions-transact-sql
IR.AContains _val -> refute (pure (UnsupportedOpExpG op))
IR.AContainedIn _val -> refute (pure (UnsupportedOpExpG op))
IR.AHasKey _val -> refute (pure (UnsupportedOpExpG op))
IR.AHasKeysAny _val -> refute (pure (UnsupportedOpExpG op))
IR.AHasKeysAll _val -> refute (pure (UnsupportedOpExpG op))
-- https://docs.microsoft.com/en-us/sql/t-sql/language-elements/like-transact-sql
IR.ASIMILAR _val -> refute (pure (UnsupportedOpExpG op))
IR.ANSIMILAR _val -> refute (pure (UnsupportedOpExpG op))
IR.AREGEX _val -> refute (pure (UnsupportedOpExpG op))
IR.AIREGEX _val -> refute (pure (UnsupportedOpExpG op))
IR.ANREGEX _val -> refute (pure (UnsupportedOpExpG op))
IR.ANIREGEX _val -> refute (pure (UnsupportedOpExpG op))
-- https://docs.microsoft.com/en-us/sql/relational-databases/spatial/spatial-data-sql-server
IR.ACast _casts -> refute (pure (UnsupportedOpExpG op))
IR.ASTDWithinGeom {} -> refute (pure (UnsupportedOpExpG op))
IR.ASTDWithinGeog {} -> refute (pure (UnsupportedOpExpG op))
IR.ASTIntersectsRast _val -> refute (pure (UnsupportedOpExpG op))
IR.ASTIntersectsNbandGeom {} -> refute (pure (UnsupportedOpExpG op))
IR.ASTIntersectsGeomNband {} -> refute (pure (UnsupportedOpExpG op))
IR.CEQ _rhsCol -> refute (pure (UnsupportedOpExpG op))
IR.CNE _rhsCol -> refute (pure (UnsupportedOpExpG op))
IR.CGT _rhsCol -> refute (pure (UnsupportedOpExpG op))
IR.CLT _rhsCol -> refute (pure (UnsupportedOpExpG op))
IR.CGTE _rhsCol -> refute (pure (UnsupportedOpExpG op))
IR.CLTE _rhsCol -> refute (pure (UnsupportedOpExpG op))
IR.ANISNULL -> pure $ TSQL.IsNullExpression expression
IR.ANISNOTNULL -> pure $ TSQL.IsNotNullExpression expression
IR.AEQ False val -> pure $ nullableBoolEquality expression val
IR.AEQ True val -> pure $ TSQL.EqualExpression expression val
IR.ANE False val -> pure $ nullableBoolInequality expression val
IR.ANE True val -> pure $ TSQL.NotEqualExpression expression val
IR.AGT val -> pure $ OpExpression TSQL.GT expression val
IR.ALT val -> pure $ OpExpression TSQL.LT expression val
IR.AGTE val -> pure $ OpExpression TSQL.GTE expression val
IR.ALTE val -> pure $ OpExpression TSQL.LTE expression val
IR.AIN val -> pure $ OpExpression TSQL.IN expression val
IR.ANIN val -> pure $ OpExpression TSQL.NIN expression val
IR.ALIKE val -> pure $ OpExpression TSQL.LIKE expression val
IR.ANLIKE val -> pure $ OpExpression TSQL.NLIKE expression val
IR.ABackendSpecific o -> case o of
ASTContains val -> pure $ TSQL.STOpExpression TSQL.STContains expression val
ASTCrosses val -> pure $ TSQL.STOpExpression TSQL.STCrosses expression val
ASTEquals val -> pure $ TSQL.STOpExpression TSQL.STEquals expression val
ASTIntersects val -> pure $ TSQL.STOpExpression TSQL.STIntersects expression val
ASTOverlaps val -> pure $ TSQL.STOpExpression TSQL.STOverlaps expression val
ASTTouches val -> pure $ TSQL.STOpExpression TSQL.STTouches expression val
ASTWithin val -> pure $ TSQL.STOpExpression TSQL.STWithin expression val
-- As of March 2021, only geometry/geography casts are supported
IR.ACast _casts -> refute (pure (UnsupportedOpExpG op)) -- mkCastsExp casts
-- We do not yet support column names in permissions
IR.CEQ _rhsCol -> refute (pure (UnsupportedOpExpG op)) -- S.BECompare S.SEQ lhs $ mkQCol rhsCol
IR.CNE _rhsCol -> refute (pure (UnsupportedOpExpG op)) -- S.BECompare S.SNE lhs $ mkQCol rhsCol
IR.CGT _rhsCol -> refute (pure (UnsupportedOpExpG op)) -- S.BECompare S.SGT lhs $ mkQCol rhsCol
IR.CLT _rhsCol -> refute (pure (UnsupportedOpExpG op)) -- S.BECompare S.SLT lhs $ mkQCol rhsCol
IR.CGTE _rhsCol -> refute (pure (UnsupportedOpExpG op)) -- S.BECompare S.SGTE lhs $ mkQCol rhsCol
IR.CLTE _rhsCol -> refute (pure (UnsupportedOpExpG op)) -- S.BECompare S.SLTE lhs $ mkQCol rhsCol
nullableBoolEquality :: Expression -> Expression -> Expression
nullableBoolEquality x y =

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

@ -328,29 +328,29 @@ msComparisonExps = P.memoize 'comparisonExps \columnType -> do
, guard (isScalarColumnWhere (`elem` MSSQL.geoTypes) columnType) *>
[ P.fieldOptional $$(G.litName "_st_contains")
(Just "does the column contain the given value")
(ASTContains . mkParameter <$> typedParser)
(ABackendSpecific . MSSQL.ASTContains . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_equals")
(Just "is the column equal to given value (directionality is ignored)")
(ASTEquals . mkParameter <$> typedParser)
(ABackendSpecific . MSSQL.ASTEquals . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_intersects")
(Just "does the column spatially intersect the given value")
(ASTIntersects . mkParameter <$> typedParser)
(ABackendSpecific . MSSQL.ASTIntersects . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_overlaps")
(Just "does the column 'spatially overlap' (intersect but not completely contain) the given value")
(ASTOverlaps . mkParameter <$> typedParser)
(ABackendSpecific . MSSQL.ASTOverlaps . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_within")
(Just "is the column contained in the given value")
(ASTWithin . mkParameter <$> typedParser)
(ABackendSpecific . MSSQL.ASTWithin . mkParameter <$> typedParser)
]
-- Ops for Geometry types
, guard (isScalarColumnWhere (MSSQL.GeometryType ==) columnType) *>
[ P.fieldOptional $$(G.litName "_st_crosses")
(Just "does the column cross the given geometry value")
(ASTCrosses . mkParameter <$> typedParser)
(ABackendSpecific . MSSQL.ASTCrosses . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_touches")
(Just "does the column have at least one point in common with the given geometry value")
(ASTTouches . mkParameter <$> typedParser)
(ABackendSpecific . MSSQL.ASTTouches . mkParameter <$> typedParser)
]
]
where

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

@ -34,11 +34,10 @@ instance Backend 'MSSQL where
type Column 'MSSQL = MSSQL.ColumnName
type ScalarValue 'MSSQL = MSSQL.Value
type ScalarType 'MSSQL = MSSQL.ScalarType
type BooleanOperators 'MSSQL = MSSQL.BooleanOperators
type SQLExpression 'MSSQL = MSSQL.Expression
type SQLOperator 'MSSQL = MSSQL.Op
type XAILIKE 'MSSQL = XDisable
type XANILIKE 'MSSQL = XDisable
type XComputedField 'MSSQL = XDisable
type XRemoteField 'MSSQL = XDisable
type XRelay 'MSSQL = XDisable

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

@ -9,7 +9,7 @@ import Hasura.Prelude
import qualified Database.ODBC.SQLServer as ODBC
import Data.Aeson
import Data.Aeson.Extended
import Data.Aeson.Types
import Data.Text.Extended (ToTxt (..))
import Hasura.Backends.MSSQL.Types.Internal
@ -186,3 +186,24 @@ instance Semigroup Top where
(<>) NoTop x = x
(<>) x NoTop = x
(<>) (Top x) (Top y) = Top (min x y)
deriving instance Generic (BooleanOperators a)
deriving instance Functor BooleanOperators
deriving instance Foldable BooleanOperators
deriving instance Traversable BooleanOperators
deriving instance Show a => Show (BooleanOperators a)
deriving instance Eq a => Eq (BooleanOperators a)
instance NFData a => NFData (BooleanOperators a)
instance Hashable a => Hashable (BooleanOperators a)
instance Cacheable a => Cacheable (BooleanOperators a)
instance ToJSON a => ToJSONKeyValue (BooleanOperators a) where
toJSONKeyValue = \case
ASTContains a -> ("_st_contains", toJSON a)
ASTCrosses a -> ("_st_crosses", toJSON a)
ASTEquals a -> ("_st_equals", toJSON a)
ASTIntersects a -> ("_st_intersects", toJSON a)
ASTOverlaps a -> ("_st_overlaps", toJSON a)
ASTTouches a -> ("_st_touches", toJSON a)
ASTWithin a -> ("_st_within", toJSON a)

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

@ -59,6 +59,15 @@ data UnifiedOn = UnifiedOn
-------------------------------------------------------------------------------
-- AST types
data BooleanOperators a
= ASTContains !a
| ASTCrosses !a
| ASTEquals !a
| ASTIntersects !a
| ASTOverlaps !a
| ASTTouches !a
| ASTWithin !a
data Select = Select
{ selectTop :: !Top
, selectProjections :: ![Projection]

11
server/src-lib/Hasura/Backends/Postgres/DDL.hs
View File

@ -6,8 +6,14 @@ where
import Data.Aeson
import Hasura.Backends.Postgres.DDL.BoolExp as M
import Hasura.Backends.Postgres.DDL.Field as M
import Hasura.Backends.Postgres.DDL.Function as M
import Hasura.Backends.Postgres.DDL.Source as M
import Hasura.Backends.Postgres.DDL.Table as M
import Hasura.Backends.Postgres.SQL.DML
import Hasura.Backends.Postgres.Translate.Column
import Hasura.Backends.Postgres.Types.Column
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Column
@ -17,11 +23,6 @@ import Hasura.SQL.Types
import Hasura.Server.Utils
import Hasura.Session
import Hasura.Backends.Postgres.DDL.BoolExp as M
import Hasura.Backends.Postgres.DDL.Field as M
import Hasura.Backends.Postgres.DDL.Function as M
import Hasura.Backends.Postgres.DDL.Source as M
import Hasura.Backends.Postgres.DDL.Table as M
parseCollectableType
:: (MonadError QErr m)

101
server/src-lib/Hasura/Backends/Postgres/DDL/BoolExp.hs
View File

@ -2,13 +2,14 @@ module Hasura.Backends.Postgres.DDL.BoolExp
(parseBoolExpOperations)
where
import qualified Data.HashMap.Strict as Map
import qualified Data.Text as T
import qualified Data.HashMap.Strict as Map
import qualified Data.Text as T
import Data.Aeson
import Data.Text.Extended
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.Types.BoolExp
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Column
@ -18,6 +19,7 @@ import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Hasura.SQL.Types
-- | Represents a reference to a Postgres column, possibly casted an arbitrary
-- number of times. Used within 'parseOperationsExpression' for bookkeeping.
data ColumnReference (b :: BackendType)
@ -123,17 +125,17 @@ parseBoolExpOperations rhsParser fim columnInfo value = do
"_is_null" -> parseIsNull
-- jsonb type
"_contains" -> guardType [PGJSONB] >> AContains <$> parseOne
"$contains" -> guardType [PGJSONB] >> AContains <$> parseOne
"_contained_in" -> guardType [PGJSONB] >> AContainedIn <$> parseOne
"$contained_in" -> guardType [PGJSONB] >> AContainedIn <$> parseOne
"_has_key" -> guardType [PGJSONB] >> AHasKey <$> parseWithTy (ColumnScalar PGText)
"$has_key" -> guardType [PGJSONB] >> AHasKey <$> parseWithTy (ColumnScalar PGText)
"_contains" -> guardType [PGJSONB] >> ABackendSpecific . AContains <$> parseOne
"$contains" -> guardType [PGJSONB] >> ABackendSpecific . AContains <$> parseOne
"_contained_in" -> guardType [PGJSONB] >> ABackendSpecific . AContainedIn <$> parseOne
"$contained_in" -> guardType [PGJSONB] >> ABackendSpecific . AContainedIn <$> parseOne
"_has_key" -> guardType [PGJSONB] >> ABackendSpecific . AHasKey <$> parseWithTy (ColumnScalar PGText)
"$has_key" -> guardType [PGJSONB] >> ABackendSpecific . AHasKey <$> parseWithTy (ColumnScalar PGText)
"_has_keys_any" -> guardType [PGJSONB] >> AHasKeysAny <$> parseManyWithType (ColumnScalar PGText)
"$has_keys_any" -> guardType [PGJSONB] >> AHasKeysAny <$> parseManyWithType (ColumnScalar PGText)
"_has_keys_all" -> guardType [PGJSONB] >> AHasKeysAll <$> parseManyWithType (ColumnScalar PGText)
"$has_keys_all" -> guardType [PGJSONB] >> AHasKeysAll <$> parseManyWithType (ColumnScalar PGText)
"_has_keys_any" -> guardType [PGJSONB] >> ABackendSpecific . AHasKeysAny <$> parseManyWithType (ColumnScalar PGText)
"$has_keys_any" -> guardType [PGJSONB] >> ABackendSpecific . AHasKeysAny <$> parseManyWithType (ColumnScalar PGText)
"_has_keys_all" -> guardType [PGJSONB] >> ABackendSpecific . AHasKeysAll <$> parseManyWithType (ColumnScalar PGText)
"$has_keys_all" -> guardType [PGJSONB] >> ABackendSpecific . AHasKeysAll <$> parseManyWithType (ColumnScalar PGText)
-- geometry types
"_st_contains" -> parseGeometryOp ASTContains
@ -175,54 +177,55 @@ parseBoolExpOperations rhsParser fim columnInfo value = do
"_clte" -> parseClte
-- ltree types
"_ancestor" -> guardType [PGLtree] >> AAncestor <$> parseOne
"$ancestor" -> guardType [PGLtree] >> AAncestor <$> parseOne
"_ancestor_any" -> guardType [PGLtree] >> AAncestorAny <$> parseManyWithType (ColumnScalar PGLtree)
"$ancestor_any" -> guardType [PGLtree] >> AAncestorAny <$> parseManyWithType (ColumnScalar PGLtree)
"_descendant" -> guardType [PGLtree] >> ADescendant <$> parseOne
"$descendant" -> guardType [PGLtree] >> ADescendant <$> parseOne
"_descendant_any" -> guardType [PGLtree] >> ADescendantAny <$> parseManyWithType (ColumnScalar PGLtree)
"$descendant_any" -> guardType [PGLtree] >> ADescendantAny <$> parseManyWithType (ColumnScalar PGLtree)
"_matches" -> guardType [PGLtree] >> AMatches <$> parseWithTy (ColumnScalar PGLquery)
"$matches" -> guardType [PGLtree] >> AMatches <$> parseWithTy (ColumnScalar PGLquery)
"_matches_any" -> guardType [PGLtree] >> AMatchesAny <$> parseManyWithType (ColumnScalar PGLquery)
"$matches_any" -> guardType [PGLtree] >> AMatchesAny <$> parseManyWithType (ColumnScalar PGLquery)
"_matches_fulltext" -> guardType [PGLtree] >> AMatchesFulltext <$> parseWithTy (ColumnScalar PGLtxtquery)
"$matches_fulltext" -> guardType [PGLtree] >> AMatchesFulltext <$> parseWithTy (ColumnScalar PGLtxtquery)
"_ancestor" -> guardType [PGLtree] >> ABackendSpecific . AAncestor <$> parseOne
"$ancestor" -> guardType [PGLtree] >> ABackendSpecific . AAncestor <$> parseOne
"_ancestor_any" -> guardType [PGLtree] >> ABackendSpecific . AAncestorAny <$> parseManyWithType (ColumnScalar PGLtree)
"$ancestor_any" -> guardType [PGLtree] >> ABackendSpecific . AAncestorAny <$> parseManyWithType (ColumnScalar PGLtree)
"_descendant" -> guardType [PGLtree] >> ABackendSpecific . ADescendant <$> parseOne
"$descendant" -> guardType [PGLtree] >> ABackendSpecific . ADescendant <$> parseOne
"_descendant_any" -> guardType [PGLtree] >> ABackendSpecific . ADescendantAny <$> parseManyWithType (ColumnScalar PGLtree)
"$descendant_any" -> guardType [PGLtree] >> ABackendSpecific . ADescendantAny <$> parseManyWithType (ColumnScalar PGLtree)
"_matches" -> guardType [PGLtree] >> ABackendSpecific . AMatches <$> parseWithTy (ColumnScalar PGLquery)
"$matches" -> guardType [PGLtree] >> ABackendSpecific . AMatches <$> parseWithTy (ColumnScalar PGLquery)
"_matches_any" -> guardType [PGLtree] >> ABackendSpecific . AMatchesAny <$> parseManyWithType (ColumnScalar PGLquery)
"$matches_any" -> guardType [PGLtree] >> ABackendSpecific . AMatchesAny <$> parseManyWithType (ColumnScalar PGLquery)
"_matches_fulltext" -> guardType [PGLtree] >> ABackendSpecific . AMatchesFulltext <$> parseWithTy (ColumnScalar PGLtxtquery)
"$matches_fulltext" -> guardType [PGLtree] >> ABackendSpecific . AMatchesFulltext <$> parseWithTy (ColumnScalar PGLtxtquery)
x -> throw400 UnexpectedPayload $ "Unknown operator : " <> x
where
colTy = columnReferenceType column
parseIsNull = bool ANISNOTNULL ANISNULL <$> parseVal -- is null
parseEq = AEQ False <$> parseOne -- equals
parseNe = ANE False <$> parseOne -- <>
parseIn = AIN <$> parseManyWithType colTy -- in an array
parseIn = AIN <$> parseManyWithType colTy -- in an array
parseNin = ANIN <$> parseManyWithType colTy -- not in an array
parseGt = AGT <$> parseOne -- >
parseLt = ALT <$> parseOne -- <
parseGt = AGT <$> parseOne -- >
parseLt = ALT <$> parseOne -- <
parseGte = AGTE <$> parseOne -- >=
parseLte = ALTE <$> parseOne -- <=
parseLike = guardType stringTypes >> ALIKE <$> parseOne
parseNlike = guardType stringTypes >> ANLIKE <$> parseOne
parseIlike = guardType stringTypes >> AILIKE () <$> parseOne
parseNilike = guardType stringTypes >> ANILIKE () <$> parseOne
parseSimilar = guardType stringTypes >> ASIMILAR <$> parseOne
parseNsimilar = guardType stringTypes >> ANSIMILAR <$> parseOne
parseRegex = guardType stringTypes >> AREGEX <$> parseOne
parseIRegex = guardType stringTypes >> AIREGEX <$> parseOne
parseNRegex = guardType stringTypes >> ANREGEX <$> parseOne
parseNIRegex = guardType stringTypes >> ANIREGEX <$> parseOne
parseIsNull = bool ANISNOTNULL ANISNULL -- is null
<$> parseVal
parseCeq = CEQ <$> decodeAndValidateRhsCol
parseCne = CNE <$> decodeAndValidateRhsCol
parseCgt = CGT <$> decodeAndValidateRhsCol
parseClt = CLT <$> decodeAndValidateRhsCol
parseCeq = CEQ <$> decodeAndValidateRhsCol
parseCne = CNE <$> decodeAndValidateRhsCol
parseCgt = CGT <$> decodeAndValidateRhsCol
parseClt = CLT <$> decodeAndValidateRhsCol
parseCgte = CGTE <$> decodeAndValidateRhsCol
parseClte = CLTE <$> decodeAndValidateRhsCol
parseLike = guardType stringTypes >> ALIKE <$> parseOne
parseNlike = guardType stringTypes >> ANLIKE <$> parseOne
parseIlike = guardType stringTypes >> ABackendSpecific . AILIKE <$> parseOne
parseNilike = guardType stringTypes >> ABackendSpecific . ANILIKE <$> parseOne
parseRegex = guardType stringTypes >> ABackendSpecific . AREGEX <$> parseOne
parseIRegex = guardType stringTypes >> ABackendSpecific . AIREGEX <$> parseOne
parseNRegex = guardType stringTypes >> ABackendSpecific . ANREGEX <$> parseOne
parseNIRegex = guardType stringTypes >> ABackendSpecific . ANIREGEX <$> parseOne
parseSimilar = guardType stringTypes >> ABackendSpecific . ASIMILAR <$> parseOne
parseNsimilar = guardType stringTypes >> ABackendSpecific . ANSIMILAR <$> parseOne
parseCast = do
castOperations <- parseVal
parsedCastOperations <-
@ -242,11 +245,11 @@ parseBoolExpOperations rhsParser fim columnInfo value = do
"cannot cast column of type " <> colTy <<> " to type " <>> targetType
parseGeometryOp f =
guardType [PGGeometry] >> f <$> parseOneNoSess colTy val
guardType [PGGeometry] >> ABackendSpecific . f <$> parseOneNoSess colTy val
parseGeometryOrGeographyOp f =
guardType geoTypes >> f <$> parseOneNoSess colTy val
guardType geoTypes >> ABackendSpecific . f <$> parseOneNoSess colTy val
parseSTDWithinObj = case colTy of
parseSTDWithinObj = ABackendSpecific <$> case colTy of
ColumnScalar PGGeometry -> do
DWithinGeomOp distVal fromVal <- parseVal
dist <- withPathK "distance" $ parseOneNoSess (ColumnScalar PGFloat) distVal

1
server/src-lib/Hasura/Backends/Postgres/Execute/LiveQuery.hs
View File

@ -30,6 +30,7 @@ import Hasura.Backends.Postgres.SQL.Error
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Backends.Postgres.Translate.Column (toTxtValue)
import Hasura.Backends.Postgres.Types.Column
import Hasura.GraphQL.Context
import Hasura.GraphQL.Execute.LiveQuery.Plan
import Hasura.GraphQL.Parser

112
server/src-lib/Hasura/Backends/Postgres/Instances/Schema.hs
View File

@ -4,33 +4,35 @@ module Hasura.Backends.Postgres.Instances.Schema () where
import Hasura.Prelude
import qualified Data.Aeson as J
import qualified Data.HashMap.Strict as Map
import qualified Data.HashMap.Strict.Extended as M
import qualified Data.HashMap.Strict.InsOrd.Extended as OMap
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import qualified Language.GraphQL.Draft.Syntax as G
import qualified Data.Aeson as J
import qualified Data.HashMap.Strict as Map
import qualified Data.HashMap.Strict.Extended as M
import qualified Data.HashMap.Strict.InsOrd.Extended as OMap
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import qualified Language.GraphQL.Draft.Syntax as G
import Data.Parser.JSONPath
import Data.Text.Extended
import qualified Hasura.GraphQL.Parser as P
import qualified Hasura.GraphQL.Schema.Backend as BS
import qualified Hasura.GraphQL.Schema.Build as GSB
import qualified Hasura.RQL.IR.Select as IR
import qualified Hasura.RQL.IR.Update as IR
import qualified Hasura.SQL.AnyBackend as AB
import qualified Hasura.GraphQL.Parser as P
import qualified Hasura.GraphQL.Schema.Backend as BS
import qualified Hasura.GraphQL.Schema.Build as GSB
import qualified Hasura.RQL.IR.Select as IR
import qualified Hasura.RQL.IR.Update as IR
import qualified Hasura.SQL.AnyBackend as AB
import Hasura.Backends.Postgres.SQL.DML as PG hiding (CountType)
import Hasura.Backends.Postgres.SQL.Types as PG hiding (FunctionName, TableName)
import Hasura.Backends.Postgres.SQL.Value as PG
import Hasura.Backends.Postgres.SQL.DML as PG hiding (CountType)
import Hasura.Backends.Postgres.SQL.Types as PG hiding (FunctionName, TableName)
import Hasura.Backends.Postgres.SQL.Value as PG
import Hasura.Backends.Postgres.Types.BoolExp
import Hasura.Backends.Postgres.Types.Column
import Hasura.GraphQL.Context
import Hasura.GraphQL.Parser hiding (EnumValueInfo, field)
import Hasura.GraphQL.Parser.Internal.Parser hiding (field)
import Hasura.GraphQL.Schema.Backend (BackendSchema, ComparisonExp,
MonadBuildSchema)
import Hasura.GraphQL.Parser hiding (EnumValueInfo, field)
import Hasura.GraphQL.Parser.Internal.Parser hiding (field)
import Hasura.GraphQL.Schema.Backend (BackendSchema, ComparisonExp,
MonadBuildSchema)
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Select
import Hasura.GraphQL.Schema.Table
@ -278,13 +280,13 @@ comparisonExps = P.memoize 'comparisonExps \columnType -> do
, guard (isScalarColumnWhere (== PGRaster) columnType) *>
[ P.fieldOptional $$(G.litName "_st_intersects_rast")
Nothing
(ASTIntersectsRast . mkParameter <$> typedParser)
(ABackendSpecific . ASTIntersectsRast . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_intersects_nband_geom")
Nothing
(ASTIntersectsNbandGeom <$> ingInputParser)
(ABackendSpecific . ASTIntersectsNbandGeom <$> ingInputParser)
, P.fieldOptional $$(G.litName "_st_intersects_geom_nband")
Nothing
(ASTIntersectsGeomNband <$> ignInputParser)
(ABackendSpecific . ASTIntersectsGeomNband <$> ignInputParser)
]
-- Ops for String like types
, guard (isScalarColumnWhere isStringType columnType) *>
@ -296,107 +298,107 @@ comparisonExps = P.memoize 'comparisonExps \columnType -> do
(ANLIKE . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_ilike")
(Just "does the column match the given case-insensitive pattern")
(AILIKE () . mkParameter <$> typedParser)
(ABackendSpecific . AILIKE . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_nilike")
(Just "does the column NOT match the given case-insensitive pattern")
(ANILIKE () . mkParameter <$> typedParser)
(ABackendSpecific . ANILIKE . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_similar")
(Just "does the column match the given SQL regular expression")
(ASIMILAR . mkParameter <$> typedParser)
(ABackendSpecific . ASIMILAR . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_nsimilar")
(Just "does the column NOT match the given SQL regular expression")
(ANSIMILAR . mkParameter <$> typedParser)
(ABackendSpecific . ANSIMILAR . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_regex")
(Just "does the column match the given POSIX regular expression, case sensitive")
(AREGEX . mkParameter <$> typedParser)
(ABackendSpecific . AREGEX . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_iregex")
(Just "does the column match the given POSIX regular expression, case insensitive")
(AIREGEX . mkParameter <$> typedParser)
(ABackendSpecific . AIREGEX . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_nregex")
(Just "does the column NOT match the given POSIX regular expression, case sensitive")
(ANREGEX . mkParameter <$> typedParser)
(ABackendSpecific . ANREGEX . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_niregex")
(Just "does the column NOT match the given POSIX regular expression, case insensitive")
(ANIREGEX . mkParameter <$> typedParser)
(ABackendSpecific . ANIREGEX . mkParameter <$> typedParser)
]
-- Ops for JSONB type
, guard (isScalarColumnWhere (== PGJSONB) columnType) *>
[ P.fieldOptional $$(G.litName "_contains")
(Just "does the column contain the given json value at the top level")
(AContains . mkParameter <$> typedParser)
(ABackendSpecific . AContains . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_contained_in")
(Just "is the column contained in the given json value")
(AContainedIn . mkParameter <$> typedParser)
(ABackendSpecific . AContainedIn . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_has_key")
(Just "does the string exist as a top-level key in the column")
(AHasKey . mkParameter <$> nullableTextParser)
(ABackendSpecific . AHasKey . mkParameter <$> nullableTextParser)
, P.fieldOptional $$(G.litName "_has_keys_any")
(Just "do any of these strings exist as top-level keys in the column")
(AHasKeysAny . mkListLiteral (ColumnScalar PGText) <$> textListParser)
(ABackendSpecific . AHasKeysAny . mkListLiteral (ColumnScalar PGText) <$> textListParser)
, P.fieldOptional $$(G.litName "_has_keys_all")
(Just "do all of these strings exist as top-level keys in the column")
(AHasKeysAll . mkListLiteral (ColumnScalar PGText) <$> textListParser)
(ABackendSpecific . AHasKeysAll . mkListLiteral (ColumnScalar PGText) <$> textListParser)
]
-- Ops for Geography type
, guard (isScalarColumnWhere (== PGGeography) columnType) *>
[ P.fieldOptional $$(G.litName "_st_intersects")
(Just "does the column spatially intersect the given geography value")
(ASTIntersects . mkParameter <$> typedParser)
(ABackendSpecific . ASTIntersects . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_d_within")
(Just "is the column within a given distance from the given geography value")
(ASTDWithinGeog <$> geogInputParser)
(ABackendSpecific . ASTDWithinGeog <$> geogInputParser)
]
-- Ops for Geometry type
, guard (isScalarColumnWhere (== PGGeometry) columnType) *>
[ P.fieldOptional $$(G.litName "_st_contains")
(Just "does the column contain the given geometry value")
(ASTContains . mkParameter <$> typedParser)
(ABackendSpecific . ASTContains . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_crosses")
(Just "does the column cross the given geometry value")
(ASTCrosses . mkParameter <$> typedParser)
(ABackendSpecific . ASTCrosses . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_equals")
(Just "is the column equal to given geometry value (directionality is ignored)")
(ASTEquals . mkParameter <$> typedParser)
(ABackendSpecific . ASTEquals . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_overlaps")
(Just "does the column 'spatially overlap' (intersect but not completely contain) the given geometry value")
(ASTOverlaps . mkParameter <$> typedParser)
(ABackendSpecific . ASTOverlaps . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_touches")
(Just "does the column have atleast one point in common with the given geometry value")
(ASTTouches . mkParameter <$> typedParser)
(ABackendSpecific . ASTTouches . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_within")
(Just "is the column contained in the given geometry value")
(ASTWithin . mkParameter <$> typedParser)
(ABackendSpecific . ASTWithin . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_intersects")
(Just "does the column spatially intersect the given geometry value")
(ASTIntersects . mkParameter <$> typedParser)
(ABackendSpecific . ASTIntersects . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_st_d_within")
(Just "is the column within a given distance from the given geometry value")
(ASTDWithinGeom <$> geomInputParser)
(ABackendSpecific . ASTDWithinGeom <$> geomInputParser)
]
-- Ops for Ltree type
, guard (isScalarColumnWhere (== PGLtree) columnType) *>
[ P.fieldOptional $$(G.litName "_ancestor")
(Just "is the left argument an ancestor of right (or equal)?")
(AAncestor . mkParameter <$> typedParser)
(ABackendSpecific . AAncestor . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_ancestor_any")
(Just "does array contain an ancestor of `ltree`?")
(AAncestorAny . mkListLiteral columnType <$> columnListParser)
(ABackendSpecific . AAncestorAny . mkListLiteral columnType <$> columnListParser)
, P.fieldOptional $$(G.litName "_descendant")
(Just "is the left argument a descendant of right (or equal)?")
(ADescendant . mkParameter <$> typedParser)
(ABackendSpecific . ADescendant . mkParameter <$> typedParser)
, P.fieldOptional $$(G.litName "_descendant_any")
(Just "does array contain a descendant of `ltree`?")
(ADescendantAny . mkListLiteral columnType <$> columnListParser)
(ABackendSpecific . ADescendantAny . mkListLiteral columnType <$> columnListParser)
, P.fieldOptional $$(G.litName "_matches")
(Just "does `ltree` match `lquery`?")
(AMatches . mkParameter <$> lqueryParser)
(ABackendSpecific . AMatches . mkParameter <$> lqueryParser)
, P.fieldOptional $$(G.litName "_matches_any")
(Just "does `ltree` match any `lquery` in array?")
(AMatchesAny . mkListLiteral (ColumnScalar PGLquery) <$> textListParser)
(ABackendSpecific . AMatchesAny . mkListLiteral (ColumnScalar PGLquery) <$> textListParser)
, P.fieldOptional $$(G.litName "_matches_fulltext")
(Just "does `ltree` match `ltxtquery`?")
(AMatchesFulltext . mkParameter <$> ltxtqueryParser)
(ABackendSpecific . AMatchesFulltext . mkParameter <$> ltxtqueryParser)
]
]
where
@ -571,6 +573,8 @@ updateOperators table updatePermissions = do
nullableTextParser _ = fmap P.mkParameter <$> columnParser (ColumnScalar PGText) (G.Nullability True)
nonNullableIntParser _ = fmap P.mkParameter <$> columnParser (ColumnScalar PGInteger) (G.Nullability False)
onlyJSONBCols = filter (isScalarColumnWhere (== PGJSONB) . pgiType)
updateOperator
:: G.Name
-> G.Name

13
server/src-lib/Hasura/Backends/Postgres/Instances/Types.hs
View File

@ -4,12 +4,12 @@ module Hasura.Backends.Postgres.Instances.Types where
import Hasura.Prelude
import qualified Hasura.Backends.Postgres.Connection as PG
import qualified Hasura.Backends.Postgres.SQL.DML as PG
import qualified Hasura.Backends.Postgres.SQL.Types as PG
import qualified Hasura.Backends.Postgres.SQL.Value as PG
import qualified Hasura.Backends.Postgres.Connection as PG
import qualified Hasura.Backends.Postgres.SQL.DML as PG
import qualified Hasura.Backends.Postgres.SQL.Types as PG
import qualified Hasura.Backends.Postgres.SQL.Value as PG
import qualified Hasura.Backends.Postgres.Types.BoolExp as PG
import Hasura.RQL.DDL.Headers ()
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Error
@ -31,11 +31,10 @@ instance Backend 'Postgres where
type Column 'Postgres = PG.PGCol
type ScalarValue 'Postgres = PG.PGScalarValue
type ScalarType 'Postgres = PG.PGScalarType
type BooleanOperators 'Postgres = PG.BooleanOperators
type SQLExpression 'Postgres = PG.SQLExp
type SQLOperator 'Postgres = PG.SQLOp
type XAILIKE 'Postgres = XEnable
type XANILIKE 'Postgres = XEnable
type XComputedField 'Postgres = XEnable
type XRemoteField 'Postgres = XEnable
type XRelay 'Postgres = XEnable

150
server/src-lib/Hasura/Backends/Postgres/Translate/BoolExp.hs
View File

@ -7,17 +7,17 @@ module Hasura.Backends.Postgres.Translate.BoolExp
import Hasura.Prelude
import qualified Data.HashMap.Strict as M
import qualified Data.HashMap.Strict as M
import Data.Monoid
import qualified Hasura.Backends.Postgres.SQL.DML as S
import qualified Hasura.Backends.Postgres.SQL.DML as S
import qualified Hasura.SQL.AnyBackend as AB
import Hasura.Backends.Postgres.SQL.Types hiding (TableName)
import Hasura.Backends.Postgres.Instances.Types ()
import Hasura.Backends.Postgres.SQL.Types hiding (TableName)
import Hasura.Backends.Postgres.Types.BoolExp
import Hasura.RQL.Types
import Hasura.SQL.Types
-- This convoluted expression instead of col = val
-- to handle the case of col : null
equalsBoolExpBuilder :: SQLExpression 'Postgres -> SQLExpression 'Postgres -> S.BoolExp
@ -136,7 +136,7 @@ foldBoolExp f = \case
BoolFld ce -> f ce
mkFieldCompExp
:: S.Qual -> FieldName -> OpExpG 'Postgres (SQLExpression 'Postgres) -> S.BoolExp
:: S.Qual -> FieldName -> OpExpG 'Postgres S.SQLExp -> S.BoolExp
mkFieldCompExp qual lhsField = mkCompExp (mkQField lhsField)
where
mkQCol = S.SEQIdentifier . S.QIdentifier qual . toIdentifier
@ -149,66 +149,68 @@ mkFieldCompExp qual lhsField = mkCompExp (mkQField lhsField)
AEQ True val -> S.BECompare S.SEQ lhs val
ANE False val -> notEqualsBoolExpBuilder lhs val
ANE True val -> S.BECompare S.SNE lhs val
AIN val -> S.BECompareAny S.SEQ lhs val
ANIN val -> S.BENot $ S.BECompareAny S.SEQ lhs val
AGT val -> S.BECompare S.SGT lhs val
ALT val -> S.BECompare S.SLT lhs val
AGTE val -> S.BECompare S.SGTE lhs val
ALTE val -> S.BECompare S.SLTE lhs val
ALIKE val -> S.BECompare S.SLIKE lhs val
ANLIKE val -> S.BECompare S.SNLIKE lhs val
AILIKE _ val -> S.BECompare S.SILIKE lhs val
ANILIKE _ val -> S.BECompare S.SNILIKE lhs val
ASIMILAR val -> S.BECompare S.SSIMILAR lhs val
ANSIMILAR val -> S.BECompare S.SNSIMILAR lhs val
AREGEX val -> S.BECompare S.SREGEX lhs val
AIREGEX val -> S.BECompare S.SIREGEX lhs val
ANREGEX val -> S.BECompare S.SNREGEX lhs val
ANIREGEX val -> S.BECompare S.SNIREGEX lhs val
AContains val -> S.BECompare S.SContains lhs val
AContainedIn val -> S.BECompare S.SContainedIn lhs val
AHasKey val -> S.BECompare S.SHasKey lhs val
AHasKeysAny val -> S.BECompare S.SHasKeysAny lhs val
AHasKeysAll val -> S.BECompare S.SHasKeysAll lhs val
AAncestor val -> S.BECompare S.SContains lhs val
AAncestorAny val -> S.BECompare S.SContains lhs val
ADescendant val -> S.BECompare S.SContainedIn lhs val
ADescendantAny val -> S.BECompare S.SContainedIn lhs val
AMatches val -> S.BECompare S.SREGEX lhs val
AMatchesAny val -> S.BECompare S.SHasKey lhs val
AMatchesFulltext val -> S.BECompare S.SMatchesFulltext lhs val
ASTContains val -> mkGeomOpBe "ST_Contains" val
ASTCrosses val -> mkGeomOpBe "ST_Crosses" val
ASTEquals val -> mkGeomOpBe "ST_Equals" val
ASTIntersects val -> mkGeomOpBe "ST_Intersects" val
ASTOverlaps val -> mkGeomOpBe "ST_Overlaps" val
ASTTouches val -> mkGeomOpBe "ST_Touches" val
ASTWithin val -> mkGeomOpBe "ST_Within" val
ASTDWithinGeom (DWithinGeomOp r val) ->
applySQLFn "ST_DWithin" [lhs, val, r]
ASTDWithinGeog (DWithinGeogOp r val sph) ->
applySQLFn "ST_DWithin" [lhs, val, r, sph]
ASTIntersectsRast val ->
applySTIntersects [lhs, val]
ASTIntersectsNbandGeom (STIntersectsNbandGeommin nband geommin) ->
applySTIntersects [lhs, nband, geommin]
ASTIntersectsGeomNband (STIntersectsGeomminNband geommin mNband)->
applySTIntersects [lhs, geommin, withSQLNull mNband]
ANISNULL -> S.BENull lhs
ANISNOTNULL -> S.BENotNull lhs
CEQ rhsCol -> S.BECompare S.SEQ lhs $ mkQCol rhsCol
CNE rhsCol -> S.BECompare S.SNE lhs $ mkQCol rhsCol
CGT rhsCol -> S.BECompare S.SGT lhs $ mkQCol rhsCol
CLT rhsCol -> S.BECompare S.SLT lhs $ mkQCol rhsCol
CGTE rhsCol -> S.BECompare S.SGTE lhs $ mkQCol rhsCol
CLTE rhsCol -> S.BECompare S.SLTE lhs $ mkQCol rhsCol
ANISNULL -> S.BENull lhs
ANISNOTNULL -> S.BENotNull lhs
ABackendSpecific (AILIKE val) -> S.BECompare S.SILIKE lhs val
ABackendSpecific (ANILIKE val) -> S.BECompare S.SNILIKE lhs val
ABackendSpecific (ASIMILAR val) -> S.BECompare S.SSIMILAR lhs val
ABackendSpecific (ANSIMILAR val) -> S.BECompare S.SNSIMILAR lhs val
ABackendSpecific (AREGEX val) -> S.BECompare S.SREGEX lhs val
ABackendSpecific (AIREGEX val) -> S.BECompare S.SIREGEX lhs val
ABackendSpecific (ANREGEX val) -> S.BECompare S.SNREGEX lhs val
ABackendSpecific (ANIREGEX val) -> S.BECompare S.SNIREGEX lhs val
ABackendSpecific (AContains val) -> S.BECompare S.SContains lhs val
ABackendSpecific (AContainedIn val) -> S.BECompare S.SContainedIn lhs val
ABackendSpecific (AHasKey val) -> S.BECompare S.SHasKey lhs val
ABackendSpecific (AHasKeysAny val) -> S.BECompare S.SHasKeysAny lhs val
ABackendSpecific (AHasKeysAll val) -> S.BECompare S.SHasKeysAll lhs val
ABackendSpecific (AAncestor val) -> S.BECompare S.SContains lhs val
ABackendSpecific (AAncestorAny val) -> S.BECompare S.SContains lhs val
ABackendSpecific (ADescendant val) -> S.BECompare S.SContainedIn lhs val
ABackendSpecific (ADescendantAny val) -> S.BECompare S.SContainedIn lhs val
ABackendSpecific (AMatches val) -> S.BECompare S.SREGEX lhs val
ABackendSpecific (AMatchesAny val) -> S.BECompare S.SHasKey lhs val
ABackendSpecific (AMatchesFulltext val) -> S.BECompare S.SMatchesFulltext lhs val
ABackendSpecific (ASTContains val) -> mkGeomOpBe "ST_Contains" val
ABackendSpecific (ASTCrosses val) -> mkGeomOpBe "ST_Crosses" val
ABackendSpecific (ASTEquals val) -> mkGeomOpBe "ST_Equals" val
ABackendSpecific (ASTIntersects val) -> mkGeomOpBe "ST_Intersects" val
ABackendSpecific (ASTOverlaps val) -> mkGeomOpBe "ST_Overlaps" val
ABackendSpecific (ASTTouches val) -> mkGeomOpBe "ST_Touches" val
ABackendSpecific (ASTWithin val) -> mkGeomOpBe "ST_Within" val
ABackendSpecific (ASTDWithinGeom (DWithinGeomOp r val) ) ->
applySQLFn "ST_DWithin" [lhs, val, r]
ABackendSpecific (ASTDWithinGeog (DWithinGeogOp r val sph) ) ->
applySQLFn "ST_DWithin" [lhs, val, r, sph]
ABackendSpecific (ASTIntersectsRast val ) ->
applySTIntersects [lhs, val]
ABackendSpecific (ASTIntersectsNbandGeom (STIntersectsNbandGeommin nband geommin) ) ->
applySTIntersects [lhs, nband, geommin]
ABackendSpecific (ASTIntersectsGeomNband (STIntersectsGeomminNband geommin mNband)) ->
applySTIntersects [lhs, geommin, withSQLNull mNband]
where
mkGeomOpBe fn v = applySQLFn fn [lhs, v]
@ -224,47 +226,3 @@ mkFieldCompExp qual lhsField = mkCompExp (mkQField lhsField)
in sqlAll $ map (mkCompExp (S.SETyAnn lhs targetAnn)) operations
sqlAll = foldr (S.BEBin S.AndOp) (S.BELit True)
hasStaticExp :: OpExpG backend (PartialSQLExp backend) -> Bool
hasStaticExp = getAny . foldMap (coerce isStaticValue)
getColExpDeps
:: forall b
. (Backend b)
=> SourceName -> TableName b -> AnnBoolExpFldPartialSQL b -> [SchemaDependency]
getColExpDeps source tn = \case
AVCol colInfo opExps ->
let cn = pgiColumn colInfo
colDepReason = bool DRSessionVariable DROnType $ any hasStaticExp opExps
colDep = mkColDep colDepReason source tn cn
depColsInOpExp = mapMaybe opExpDepCol opExps
colDepsInOpExp = map (mkColDep DROnType source tn) depColsInOpExp
in colDep:colDepsInOpExp
AVRel relInfo relBoolExp ->
let rn = riName relInfo
relTN = riRTable relInfo
pd = SchemaDependency
(SOSourceObj source
$ AB.mkAnyBackend
$ SOITableObj tn (TORel rn))
DROnType
in pd : getBoolExpDeps source relTN relBoolExp
getBoolExpDeps
:: forall b
. (Backend b)
=> SourceName -> TableName b -> AnnBoolExpPartialSQL b -> [SchemaDependency]
getBoolExpDeps source tn = \case
BoolAnd exps -> procExps exps
BoolOr exps -> procExps exps
BoolNot e -> getBoolExpDeps source tn e
BoolExists (GExists refqt whereExp) ->
let tableDep = SchemaDependency
(SOSourceObj source
$ AB.mkAnyBackend
$ SOITable refqt)
DRRemoteTable
in tableDep:getBoolExpDeps source refqt whereExp
BoolFld fld -> getColExpDeps source tn fld
where
procExps = concatMap (getBoolExpDeps source tn)

1
server/src-lib/Hasura/Backends/Postgres/Translate/Column.hs
View File

@ -6,6 +6,7 @@ import Hasura.Prelude
import Hasura.Backends.Postgres.SQL.DML
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Backends.Postgres.Types.Column
import Hasura.RQL.Types.Column
import Hasura.SQL.Backend

7
server/src-lib/Hasura/Backends/Postgres/Translate/Mutation.hs
View File

@ -5,15 +5,16 @@ where
import Hasura.Prelude
import qualified Data.HashMap.Strict as Map
import qualified Data.HashMap.Strict as Map
import Data.Text.Extended
import qualified Hasura.Backends.Postgres.SQL.DML as S
import qualified Hasura.Backends.Postgres.SQL.DML as S
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.SQL.Value
import Hasura.RQL.Instances ()
import Hasura.Backends.Postgres.Types.Column
import Hasura.RQL.Instances ()
import Hasura.RQL.Types
import Hasura.SQL.Types

66
server/src-lib/Hasura/Backends/Postgres/Translate/Select.hs
View File

@ -363,8 +363,8 @@ getAnnArr (f, annFld) = case annFld of
withWriteJoinTree
:: (MonadWriter (JoinTree 'Postgres) m)
=> (JoinTree 'Postgres -> b -> JoinTree 'Postgres)
:: (MonadWriter JoinTree m)
=> (JoinTree -> b -> JoinTree)
-> m (a, b)
-> m a
withWriteJoinTree joinTreeUpdater action =
@ -375,8 +375,8 @@ withWriteJoinTree joinTreeUpdater action =
pure (out, fromJoinTree)
withWriteObjectRelation
:: (MonadWriter (JoinTree 'Postgres) m)
=> m ( ObjectRelationSource 'Postgres
:: (MonadWriter JoinTree m)
=> m ( ObjectRelationSource
, HM.HashMap S.Alias S.SQLExp
, a
)
@ -391,8 +391,8 @@ withWriteObjectRelation action =
in mempty{_jtObjectRelations = HM.singleton source selectNode}
withWriteArrayRelation
:: (MonadWriter (JoinTree 'Postgres) m)
=> m ( ArrayRelationSource 'Postgres
:: (MonadWriter JoinTree m)
=> m ( ArrayRelationSource
, S.Extractor
, HM.HashMap S.Alias S.SQLExp
, a
@ -409,8 +409,8 @@ withWriteArrayRelation action =
in mempty{_jtArrayRelations = HM.singleton source arraySelectNode}
withWriteArrayConnection
:: (MonadWriter (JoinTree 'Postgres) m)
=> m ( ArrayConnectionSource 'Postgres
:: (MonadWriter JoinTree m)
=> m ( ArrayConnectionSource
, S.Extractor
, HM.HashMap S.Alias S.SQLExp
, a
@ -427,8 +427,8 @@ withWriteArrayConnection action =
in mempty{_jtArrayConnections = HM.singleton source arraySelectNode}
withWriteComputedFieldTableSet
:: (MonadWriter (JoinTree 'Postgres) m)
=> m ( ComputedFieldTableSetSource 'Postgres
:: (MonadWriter JoinTree m)
=> m ( ComputedFieldTableSetSource
, HM.HashMap S.Alias S.SQLExp
, a
)
@ -445,13 +445,13 @@ withWriteComputedFieldTableSet action =
processAnnSimpleSelect
:: forall m . ( MonadReader Bool m
, MonadWriter (JoinTree 'Postgres) m
)
, MonadWriter JoinTree m
)
=> SourcePrefixes
-> FieldName
-> PermissionLimitSubQuery
-> AnnSimpleSel 'Postgres
-> m ( SelectSource 'Postgres
-> m ( SelectSource
, HM.HashMap S.Alias S.SQLExp
)
processAnnSimpleSelect sourcePrefixes fieldAlias permLimitSubQuery annSimpleSel = do
@ -468,12 +468,12 @@ processAnnSimpleSelect sourcePrefixes fieldAlias permLimitSubQuery annSimpleSel
processAnnAggregateSelect
:: forall m. ( MonadReader Bool m
, MonadWriter (JoinTree 'Postgres) m
, MonadWriter JoinTree m
)
=> SourcePrefixes
-> FieldName
-> AnnAggregateSelect 'Postgres
-> m ( SelectSource 'Postgres
-> m ( SelectSource
, HM.HashMap S.Alias S.SQLExp
, S.Extractor
)
@ -546,7 +546,7 @@ mkPermissionLimitSubQuery permLimit aggFields orderBys =
processArrayRelation
:: forall m. ( MonadReader Bool m
, MonadWriter (JoinTree 'Postgres) m
, MonadWriter JoinTree m
)
=> SourcePrefixes
-> FieldName
@ -589,7 +589,7 @@ processArrayRelation sourcePrefixes fieldAlias relAlias arrSel =
processSelectParams
:: forall m. ( MonadReader Bool m
, MonadWriter (JoinTree 'Postgres) m
, MonadWriter JoinTree m
)
=> SourcePrefixes
-> FieldName
@ -598,7 +598,7 @@ processSelectParams
-> PermissionLimitSubQuery
-> TablePerm 'Postgres
-> SelectArgs 'Postgres
-> m ( SelectSource 'Postgres
-> m ( SelectSource
, [(S.Alias, S.SQLExp)]
, Maybe S.SQLExp -- Order by cursor
)
@ -639,7 +639,7 @@ processSelectParams sourcePrefixes fieldAlias similarArrFields selectFrom
processOrderByItems
:: forall m. ( MonadReader Bool m
, MonadWriter (JoinTree 'Postgres) m
, MonadWriter JoinTree m
)
=> Identifier
-> FieldName
@ -778,7 +778,7 @@ the schema has been generated. The SQL generated will look like this:
processAnnFields
:: forall m
. ( MonadReader Bool m
, MonadWriter (JoinTree 'Postgres) m
, MonadWriter JoinTree m
)
=> Identifier
-> FieldName
@ -919,8 +919,8 @@ mkJoinCond baseTablepfx colMapn =
generateSQLSelect
:: S.BoolExp -- ^ Pre join condition
-> SelectSource 'Postgres
-> SelectNode 'Postgres
-> SelectSource
-> SelectNode
-> S.Select
generateSQLSelect joinCondition selectSource selectNode =
S.mkSelect
@ -960,7 +960,7 @@ generateSQLSelect joinCondition selectSource selectNode =
objectRelationToFromItem
:: (ObjectRelationSource 'Postgres, SelectNode 'Postgres) -> S.FromItem
:: (ObjectRelationSource, SelectNode) -> S.FromItem
objectRelationToFromItem (objectRelationSource, node) =
let ObjectRelationSource _ colMapping objectSelectSource = objectRelationSource
alias = S.Alias $ _ossPrefix objectSelectSource
@ -969,7 +969,7 @@ generateSQLSelect joinCondition selectSource selectNode =
in S.mkLateralFromItem select alias
arrayRelationToFromItem
:: (ArrayRelationSource 'Postgres, ArraySelectNode 'Postgres) -> S.FromItem
:: (ArrayRelationSource, ArraySelectNode) -> S.FromItem
arrayRelationToFromItem (arrayRelationSource, arraySelectNode) =
let ArrayRelationSource _ colMapping source = arrayRelationSource
alias = S.Alias $ _ssPrefix source
@ -978,14 +978,14 @@ generateSQLSelect joinCondition selectSource selectNode =
in S.mkLateralFromItem select alias
arrayConnectionToFromItem
:: (ArrayConnectionSource 'Postgres, ArraySelectNode 'Postgres) -> S.FromItem
:: (ArrayConnectionSource, ArraySelectNode) -> S.FromItem
arrayConnectionToFromItem (arrayConnectionSource, arraySelectNode) =
let selectWith = connectionToSelectWith baseSelectAlias arrayConnectionSource arraySelectNode
alias = S.Alias $ _ssPrefix $ _acsSource arrayConnectionSource
in S.FISelectWith (S.Lateral True) selectWith alias
computedFieldToFromItem
:: (ComputedFieldTableSetSource 'Postgres, SelectNode 'Postgres) -> S.FromItem
:: (ComputedFieldTableSetSource, SelectNode) -> S.FromItem
computedFieldToFromItem (computedFieldTableSource, node) =
let ComputedFieldTableSetSource fieldName selectTy source = computedFieldTableSource
internalSelect = generateSQLSelect (S.BELit True) source node
@ -999,8 +999,8 @@ generateSQLSelect joinCondition selectSource selectNode =
in S.mkLateralFromItem select alias
generateSQLSelectFromArrayNode
:: SelectSource 'Postgres
-> ArraySelectNode 'Postgres
:: SelectSource
-> ArraySelectNode
-> S.BoolExp
-> S.Select
generateSQLSelectFromArrayNode selectSource arraySelectNode joinCondition =
@ -1116,14 +1116,14 @@ encodeBase64 =
processConnectionSelect
:: ( MonadReader Bool m
, MonadWriter (JoinTree 'Postgres) m
, MonadWriter JoinTree m
)
=> SourcePrefixes
-> FieldName
-> S.Alias
-> HM.HashMap PGCol PGCol
-> ConnectionSelect 'Postgres S.SQLExp
-> m ( ArrayConnectionSource 'Postgres
-> m ( ArrayConnectionSource
, S.Extractor
, HM.HashMap S.Alias S.SQLExp
)
@ -1212,7 +1212,7 @@ processConnectionSelect sourcePrefixes fieldAlias relAlias colMapping connection
processFields
:: ( MonadReader Bool m
, MonadWriter (JoinTree 'Postgres) m
, MonadWriter JoinTree m
, MonadState [(S.Alias, S.SQLExp)] m
)
=> Maybe S.OrderByExp -> m S.SQLExp
@ -1257,8 +1257,8 @@ processConnectionSelect sourcePrefixes fieldAlias relAlias colMapping connection
connectionToSelectWith
:: S.Alias
-> ArrayConnectionSource 'Postgres
-> ArraySelectNode 'Postgres
-> ArrayConnectionSource
-> ArraySelectNode
-> S.SelectWithG S.Select
connectionToSelectWith baseSelectAlias arrayConnectionSource arraySelectNode =
let extractionSelect = S.mkSelect

84
server/src-lib/Hasura/Backends/Postgres/Translate/Types.hs
View File

@ -10,9 +10,7 @@ import qualified Hasura.Backends.Postgres.SQL.DML as PG
import qualified Hasura.Backends.Postgres.SQL.Types as PG
import Hasura.RQL.IR.Select
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.SQL.Backend
data SourcePrefixes
@ -25,7 +23,7 @@ data SourcePrefixes
} deriving (Show, Eq, Generic)
instance Hashable SourcePrefixes
data SelectSource (b :: BackendType)
data SelectSource
= SelectSource
{ _ssPrefix :: !PG.Identifier
, _ssFrom :: !PG.FromItem
@ -33,19 +31,19 @@ data SelectSource (b :: BackendType)
, _ssWhere :: !PG.BoolExp
, _ssOrderBy :: !(Maybe PG.OrderByExp)
, _ssLimit :: !(Maybe Int)
, _ssOffset :: !(Maybe (SQLExpression b))
, _ssOffset :: !(Maybe (PG.SQLExp))
} deriving (Generic)
instance Hashable (SelectSource 'Postgres)
deriving instance Show (SelectSource 'Postgres)
deriving instance Eq (SelectSource 'Postgres)
instance Hashable SelectSource
deriving instance Show SelectSource
deriving instance Eq SelectSource
data SelectNode (b :: BackendType)
data SelectNode
= SelectNode
{ _snExtractors :: !(HM.HashMap (Alias b) (SQLExpression b))
, _snJoinTree :: !(JoinTree b)
{ _snExtractors :: !(HM.HashMap PG.Alias PG.SQLExp)
, _snJoinTree :: !JoinTree
}
instance Semigroup (SelectNode 'Postgres) where
instance Semigroup SelectNode where
SelectNode lExtrs lJoinTree <> SelectNode rExtrs rJoinTree =
SelectNode (lExtrs <> rExtrs) (lJoinTree <> rJoinTree)
@ -57,76 +55,76 @@ data ObjectSelectSource
} deriving (Show, Eq, Generic)
instance Hashable ObjectSelectSource
objectSelectSourceToSelectSource :: ObjectSelectSource -> (SelectSource backend)
objectSelectSourceToSelectSource :: ObjectSelectSource -> SelectSource
objectSelectSourceToSelectSource ObjectSelectSource{..} =
SelectSource _ossPrefix _ossFrom Nothing _ossWhere Nothing Nothing Nothing
data ObjectRelationSource (b :: BackendType)
data ObjectRelationSource
= ObjectRelationSource
{ _orsRelationshipName :: !RelName
, _orsRelationMapping :: !(HM.HashMap (Column b) (Column b))
, _orsRelationMapping :: !(HM.HashMap PG.PGCol PG.PGCol)
, _orsSelectSource :: !ObjectSelectSource
} deriving (Generic)
instance Hashable (ObjectRelationSource 'Postgres)
deriving instance Eq (Column b) => Eq (ObjectRelationSource b)
instance Hashable ObjectRelationSource
deriving instance Eq ObjectRelationSource
data ArrayRelationSource (b :: BackendType)
data ArrayRelationSource
= ArrayRelationSource
{ _arsAlias :: !(Alias b)
, _arsRelationMapping :: !(HM.HashMap (Column b) (Column b))
, _arsSelectSource :: !(SelectSource b)
{ _arsAlias :: !PG.Alias
, _arsRelationMapping :: !(HM.HashMap PG.PGCol PG.PGCol)
, _arsSelectSource :: !SelectSource
} deriving (Generic)
instance Hashable (ArrayRelationSource 'Postgres)
deriving instance Eq (ArrayRelationSource 'Postgres)
instance Hashable ArrayRelationSource
deriving instance Eq ArrayRelationSource
data ArraySelectNode (b :: BackendType)
data ArraySelectNode
= ArraySelectNode
{ _asnTopExtractors :: ![PG.Extractor]
, _asnSelectNode :: !(SelectNode b)
, _asnSelectNode :: !SelectNode
}
instance Semigroup (ArraySelectNode 'Postgres) where
instance Semigroup ArraySelectNode where
ArraySelectNode lTopExtrs lSelNode <> ArraySelectNode rTopExtrs rSelNode =
ArraySelectNode (lTopExtrs <> rTopExtrs) (lSelNode <> rSelNode)
data ComputedFieldTableSetSource (b :: BackendType)
data ComputedFieldTableSetSource
= ComputedFieldTableSetSource
{ _cftssFieldName :: !FieldName
, _cftssSelectType :: !JsonAggSelect
, _cftssSelectSource :: !(SelectSource b)
, _cftssSelectSource :: !SelectSource
} deriving (Generic)
instance Hashable (ComputedFieldTableSetSource 'Postgres)
deriving instance Show (ComputedFieldTableSetSource 'Postgres)
deriving instance Eq (ComputedFieldTableSetSource 'Postgres)
instance Hashable ComputedFieldTableSetSource
deriving instance Show ComputedFieldTableSetSource
deriving instance Eq ComputedFieldTableSetSource
data ArrayConnectionSource (b :: BackendType)
data ArrayConnectionSource
= ArrayConnectionSource
{ _acsAlias :: !(Alias b)
, _acsRelationMapping :: !(HM.HashMap (Column b) (Column b))
{ _acsAlias :: !PG.Alias
, _acsRelationMapping :: !(HM.HashMap PG.PGCol PG.PGCol)
, _acsSplitFilter :: !(Maybe PG.BoolExp)
, _acsSlice :: !(Maybe ConnectionSlice)
, _acsSource :: !(SelectSource b)
, _acsSource :: !SelectSource
} deriving (Generic)
deriving instance Eq (ArrayConnectionSource 'Postgres)
deriving instance Eq ArrayConnectionSource
instance Hashable (ArrayConnectionSource 'Postgres)
instance Hashable ArrayConnectionSource
data JoinTree (b :: BackendType)
data JoinTree
= JoinTree
{ _jtObjectRelations :: !(HM.HashMap (ObjectRelationSource b) (SelectNode b))
, _jtArrayRelations :: !(HM.HashMap (ArrayRelationSource b) (ArraySelectNode b))
, _jtArrayConnections :: !(HM.HashMap (ArrayConnectionSource b) (ArraySelectNode b))
, _jtComputedFieldTableSets :: !(HM.HashMap (ComputedFieldTableSetSource b) (SelectNode b))
{ _jtObjectRelations :: !(HM.HashMap ObjectRelationSource SelectNode)
, _jtArrayRelations :: !(HM.HashMap ArrayRelationSource ArraySelectNode)
, _jtArrayConnections :: !(HM.HashMap ArrayConnectionSource ArraySelectNode)
, _jtComputedFieldTableSets :: !(HM.HashMap ComputedFieldTableSetSource SelectNode)
}
instance Semigroup (JoinTree 'Postgres) where
instance Semigroup JoinTree where
JoinTree lObjs lArrs lArrConns lCfts <> JoinTree rObjs rArrs rArrConns rCfts =
JoinTree (HM.unionWith (<>) lObjs rObjs)
(HM.unionWith (<>) lArrs rArrs)
(HM.unionWith (<>) lArrConns rArrConns)
(HM.unionWith (<>) lCfts rCfts)
instance Monoid (JoinTree 'Postgres) where
instance Monoid JoinTree where
mempty = JoinTree mempty mempty mempty mempty

95
server/src-lib/Hasura/Backends/Postgres/Types/BoolExp.hs Normal file
View File

@ -0,0 +1,95 @@
module Hasura.Backends.Postgres.Types.BoolExp where
import Hasura.Prelude
import Data.Aeson.Extended
import Hasura.Incremental (Cacheable)
import Hasura.RQL.IR.BoolExp
data BooleanOperators a
= AILIKE !a -- ILIKE, case insensitive
| ANILIKE !a -- NOT ILIKE, case insensitive
| ASIMILAR !a -- similar, regex
| ANSIMILAR !a -- not similar, regex
| AREGEX !a -- regex: match POSIX case sensitive
| AIREGEX !a -- regex: match POSIX case insensitive
| ANREGEX !a -- regex: dont match POSIX case sensitive
| ANIREGEX !a -- regex: dont match POSIX case insensitive
| AContains !a
| AContainedIn !a
| AHasKey !a
| AHasKeysAny !a
| AHasKeysAll !a
| ASTContains !a
| ASTCrosses !a
| ASTEquals !a
| ASTIntersects !a
| ASTOverlaps !a
| ASTTouches !a
| ASTWithin !a
| ASTIntersectsRast !a
| ASTDWithinGeom !(DWithinGeomOp a)
| ASTDWithinGeog !(DWithinGeogOp a)
| ASTIntersectsGeomNband !(STIntersectsGeomminNband a)
| ASTIntersectsNbandGeom !(STIntersectsNbandGeommin a)
| AAncestor !a
| AAncestorAny !a
| ADescendant !a
| ADescendantAny !a
| AMatches !a
| AMatchesAny !a
| AMatchesFulltext !a
deriving (Eq, Generic, Functor, Foldable, Traversable)
instance NFData a => NFData (BooleanOperators a)
instance Hashable a => Hashable (BooleanOperators a)
instance Cacheable a => Cacheable (BooleanOperators a)
instance ToJSON a => ToJSONKeyValue (BooleanOperators a) where
toJSONKeyValue = \case
AILIKE a -> ("_ilike", toJSON a)
ANILIKE a -> ("_nilike", toJSON a)
ASIMILAR a -> ("_similar", toJSON a)
ANSIMILAR a -> ("_nsimilar", toJSON a)
AREGEX a -> ("_regex", toJSON a)
AIREGEX a -> ("_iregex", toJSON a)
ANREGEX a -> ("_nregex", toJSON a)
ANIREGEX a -> ("_niregex", toJSON a)
AContains a -> ("_contains", toJSON a)
AContainedIn a -> ("_contained_in", toJSON a)
AHasKey a -> ("_has_key", toJSON a)
AHasKeysAny a -> ("_has_keys_any", toJSON a)
AHasKeysAll a -> ("_has_keys_all", toJSON a)
ASTContains a -> ("_st_contains", toJSON a)
ASTCrosses a -> ("_st_crosses", toJSON a)
ASTDWithinGeom o -> ("_st_d_within", toJSON o)
ASTDWithinGeog o -> ("_st_d_within", toJSON o)
ASTEquals a -> ("_st_equals", toJSON a)
ASTIntersects a -> ("_st_intersects", toJSON a)
ASTOverlaps a -> ("_st_overlaps", toJSON a)
ASTTouches a -> ("_st_touches", toJSON a)
ASTWithin a -> ("_st_within", toJSON a)
ASTIntersectsRast a -> ("_st_intersects_rast", toJSON a)
ASTIntersectsNbandGeom a -> ("_st_intersects_nband_geom", toJSON a)
ASTIntersectsGeomNband a -> ("_st_intersects_geom_nband", toJSON a)
AAncestor a -> ("_ancestor", toJSON a)
AAncestorAny a -> ("_ancestor_any", toJSON a)
ADescendant a -> ("_descendant", toJSON a)
ADescendantAny a -> ("_descendant_any", toJSON a)
AMatches a -> ("_matches", toJSON a)
AMatchesAny a -> ("_matches_any", toJSON a)
AMatchesFulltext a -> ("_matches_fulltext", toJSON a)

16
server/src-lib/Hasura/Backends/Postgres/Types/Column.hs Normal file
View File

@ -0,0 +1,16 @@
module Hasura.Backends.Postgres.Types.Column where
import Hasura.Backends.Postgres.Instances.Types ()
import Hasura.Backends.Postgres.SQL.Types
import Hasura.RQL.Instances ()
import Hasura.RQL.Types.Column
import Hasura.SQL.Backend
-- | Gets the representation type associated with a 'ColumnType'. Avoid using this if possible.
-- Prefer 'parsePGScalarValue', 'parsePGScalarValues', or
-- 'Hasura.RQL.Types.BoolExp.mkTypedSessionVar'.
unsafePGColumnToBackend :: ColumnType 'Postgres -> PGScalarType
unsafePGColumnToBackend = \case
ColumnScalar scalarType -> scalarType
ColumnEnumReference _ -> PGText

21
server/src-lib/Hasura/Backends/Postgres/Types/Table.hs Normal file
View File

@ -0,0 +1,21 @@
module Hasura.Backends.Postgres.Types.Table where
import Hasura.Prelude
import Data.Text.Extended
import Hasura.Backends.Postgres.SQL.Types
import Hasura.RQL.Types.Error
import Hasura.RQL.Types.Table
mutableView
:: (MonadError QErr m)
=> QualifiedTable
-> (ViewInfo -> Bool)
-> Maybe ViewInfo
-> Text
-> m ()
mutableView qt f mVI operation =
unless (isMutable f mVI) $
throw400 NotSupported $ "view " <> qt <<> " is not " <> operation

5
server/src-lib/Hasura/GraphQL/Context.hs
View File

@ -42,6 +42,7 @@ import qualified Hasura.SQL.AnyBackend as AB
import Hasura.GraphQL.Parser
import Hasura.SQL.Backend
-- | For storing both a normal GQLContext and one for the backend variant.
-- Currently, this is to enable the backend variant to have certain insert
-- permissions which the frontend variant does not.
@ -124,7 +125,7 @@ type SubscriptionRootField v = RootField (QueryDBRoot v) Void Void Void
traverseQueryDB
:: forall f a b backend
. Applicative f
. (Applicative f, RQL.Backend backend)
=> (a -> f b)
-> QueryDB backend a
-> f (QueryDB backend b)
@ -135,7 +136,7 @@ traverseQueryDB f = \case
QDBConnection s -> QDBConnection <$> IR.traverseConnectionSelect f s
traverseActionQuery
:: Applicative f
:: (Applicative f, RQL.Backend backend)
=> (a -> f b)
-> ActionQuery backend a
-> f (ActionQuery backend b)

2
server/src-lib/Hasura/GraphQL/Execute/Insert.hs
View File

@ -35,7 +35,7 @@ import Hasura.Server.Version (HasVersion)
traverseAnnInsert
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> IR.AnnInsert backend a
-> f (IR.AnnInsert backend b)

1
server/src-lib/Hasura/GraphQL/Execute/Prepare.hs
View File

@ -27,6 +27,7 @@ import qualified Hasura.Backends.Postgres.SQL.DML as S
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Backends.Postgres.Translate.Column
import Hasura.Backends.Postgres.Types.Column
import Hasura.GraphQL.Execute.Backend
import Hasura.GraphQL.Parser.Column
import Hasura.GraphQL.Parser.Schema

1
server/src-lib/Hasura/GraphQL/Schema/Action.hs
View File

@ -20,6 +20,7 @@ import qualified Hasura.RQL.DML.Internal as RQL
import qualified Hasura.RQL.IR.Select as RQL
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.Types.Column
import Hasura.GraphQL.Parser (FieldParser, InputFieldsParser, Kind (..),
Parser, UnpreparedValue (..))
import Hasura.GraphQL.Parser.Class

6
server/src-lib/Hasura/GraphQL/Schema/Mutation.hs
View File

@ -320,7 +320,8 @@ updateTableByPk table fieldName description updatePerms selectPerms = runMaybeT
<&> mkUpdateObject table columns updatePerms . fmap IR.MOutSinglerowObject
mkUpdateObject
:: TableName b
:: Backend b
=> TableName b
-> [ColumnInfo b]
-> UpdPermInfo b
-> ( ( [(Column b, IR.UpdOpExpG (UnpreparedValue b))]
@ -385,7 +386,8 @@ deleteFromTableByPk table fieldName description deletePerms selectPerms = runMay
<&> mkDeleteObject table columns deletePerms . fmap IR.MOutSinglerowObject
mkDeleteObject
:: TableName b
:: Backend b
=> TableName b
-> [ColumnInfo b]
-> DelPermInfo b
-> (AnnBoolExp b (UnpreparedValue b), IR.MutationOutputG b (UnpreparedValue b))

4
server/src-lib/Hasura/GraphQL/Schema/Select.hs
View File

@ -1078,7 +1078,7 @@ computedFieldPG ComputedFieldInfo{..} selectPermissions = runMaybeT do
in mkDescriptionWith (_cffDescription _cfiFunction) defaultDescription
computedFieldFunctionArgs
:: ComputedFieldFunction -> m (InputFieldsParser n (IR.FunctionArgsExpTableRow 'Postgres (UnpreparedValue 'Postgres)))
:: ComputedFieldFunction 'Postgres -> m (InputFieldsParser n (IR.FunctionArgsExpTableRow 'Postgres (UnpreparedValue 'Postgres)))
computedFieldFunctionArgs ComputedFieldFunction{..} =
functionArgs _cffName (IAUserProvided <$> _cffInputArgs) <&> fmap addTableAndSessionArgument
where
@ -1295,7 +1295,7 @@ functionArgs functionName (toList -> inputArgs) = do
Nothing -> whenMaybe (not $ unHasDefault $ faHasDefault arg) $
parseErrorWith NotSupported "Non default arguments cannot be omitted"
tablePermissionsInfo :: SelPermInfo b -> TablePerms b
tablePermissionsInfo :: Backend b => SelPermInfo b -> TablePerms b
tablePermissionsInfo selectPermissions = IR.TablePerm
{ IR._tpFilter = fmapAnnBoolExp partialSQLExpToUnpreparedValue $ spiFilter selectPermissions
, IR._tpLimit = spiLimit selectPermissions

8
server/src-lib/Hasura/GraphQL/Transport/HTTP.hs
View File

@ -151,13 +151,15 @@ runSessVarPred :: SessVarPred -> SessionVariables -> SessionVariables
runSessVarPred = filterSessionVariables . unSessVarPred
-- | Filter out only those session variables used by the query AST provided
filterVariablesFromQuery :: [RootField (QueryDBRoot UnpreparedValue) c (ActionQuery backend (UnpreparedValue bet)) d] -> SessVarPred
filterVariablesFromQuery
:: Backend backend
=> [RootField (QueryDBRoot UnpreparedValue) c (ActionQuery backend (UnpreparedValue bet)) d]
-> SessVarPred
filterVariablesFromQuery query = fold $ rootToSessVarPreds =<< query
where
rootToSessVarPreds :: RootField (QueryDBRoot UnpreparedValue) c (ActionQuery backend (UnpreparedValue bet)) d -> [SessVarPred]
rootToSessVarPreds = \case
RFDB _ exists ->
AB.runBackend exists \case
AB.dispatchAnyBackend @Backend exists \case
SourceConfigWith _ (QDBR db) -> toPred <$> toListOf traverseQueryDB db
RFAction actionQ -> toPred <$> toListOf traverseActionQuery actionQ
_ -> []

4
server/src-lib/Hasura/Incremental/Internal/Dependency.hs
View File

@ -17,6 +17,7 @@ import Data.Aeson (Value)
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI)
import Data.Functor.Classes (Eq1 (..), Eq2 (..))
import Data.Functor.Const
import Data.GADT.Compare
import Data.Int
import Data.Scientific (Scientific)
@ -31,6 +32,7 @@ import System.Cron.Types
import Hasura.Incremental.Select
-- | A 'Dependency' represents a value that a 'Rule' can /conditionally/ depend on. A 'Dependency'
-- is created using 'newDependency', and it can be “opened” again using 'dependOn'. What makes a
-- 'Dependency' useful is the way it cooperates with 'cache'---if a 'Dependency' is passed to a
@ -256,6 +258,8 @@ instance (Cacheable (a b), Cacheable b) => Cacheable (G.TypedOperationDefinition
instance Cacheable a => Cacheable (G.Value a)
instance Cacheable a => Cacheable (Const a b)
deriving instance Cacheable G.Description
deriving instance Cacheable G.EnumValue
deriving instance Cacheable a => Cacheable (G.ExecutableDocument a)

1
server/src-lib/Hasura/RQL/DML/Delete.hs
View File

@ -23,6 +23,7 @@ import qualified Hasura.Tracing as Tracing
import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.Execute.Mutation
import Hasura.Backends.Postgres.Translate.Returning
import Hasura.Backends.Postgres.Types.Table
import Hasura.EncJSON
import Hasura.RQL.DML.Internal
import Hasura.RQL.DML.Types

6
server/src-lib/Hasura/RQL/DML/Insert.hs
View File

@ -4,6 +4,7 @@ module Hasura.RQL.DML.Insert
import Hasura.Prelude
import qualified Data.Environment as Env
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.Sequence as DS
@ -14,11 +15,13 @@ import Data.Aeson.Types
import Data.Text.Extended
import qualified Hasura.Backends.Postgres.SQL.DML as S
import qualified Hasura.Tracing as Tracing
import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.Execute.Mutation
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.Translate.Returning
import Hasura.Backends.Postgres.Types.Table
import Hasura.EncJSON
import Hasura.RQL.DML.Internal
import Hasura.RQL.DML.Types
@ -29,9 +32,6 @@ import Hasura.Server.Version (HasVersion)
import Hasura.Session
import qualified Data.Environment as Env
import qualified Hasura.Tracing as Tracing
convObj
:: (UserInfoM m, QErrM m)
=> (ColumnType 'Postgres -> Value -> m S.SQLExp)

6
server/src-lib/Hasura/RQL/DML/Internal.hs
View File

@ -22,10 +22,12 @@ import Hasura.Backends.Postgres.SQL.Types hiding (TableName)
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Backends.Postgres.Translate.BoolExp
import Hasura.Backends.Postgres.Translate.Column
import Hasura.Backends.Postgres.Types.Column
import Hasura.RQL.Types
import Hasura.SQL.Types
import Hasura.Session
newtype DMLP1T m a
= DMLP1T { unDMLP1T :: StateT (DS.Seq Q.PrepArg) m a }
deriving ( Functor, Applicative, Monad, MonadTrans
@ -220,7 +222,7 @@ checkOnColExp spi sessVarBldr annFld = case annFld of
return $ AVRel relInfo $ andAnnBoolExps modAnn resolvedFltr
convAnnBoolExpPartialSQL
:: (Applicative f)
:: (Applicative f, Backend backend)
=> SessVarBldr backend f
-> AnnBoolExpPartialSQL backend
-> f (AnnBoolExpSQL backend)
@ -228,7 +230,7 @@ convAnnBoolExpPartialSQL f =
traverseAnnBoolExp (convPartialSQLExp f)
convAnnColumnCaseBoolExpPartialSQL
:: (Applicative f)
:: (Applicative f, Backend backend)
=> SessVarBldr backend f
-> AnnColumnCaseBoolExpPartialSQL backend
-> f (AnnColumnCaseBoolExp backend (SQLExpression backend))

11
server/src-lib/Hasura/RQL/DML/Types.hs
View File

@ -34,20 +34,21 @@ module Hasura.RQL.DML.Types
import Hasura.Prelude
import qualified Data.Attoparsec.Text as AT
import qualified Data.HashMap.Strict as M
import qualified Data.Attoparsec.Text as AT
import qualified Data.HashMap.Strict as M
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import qualified Hasura.Backends.Postgres.SQL.DML as PG
import qualified Hasura.Backends.Postgres.SQL.DML as PG
import Hasura.Backends.Postgres.Instances.Types ()
import Hasura.Backends.Postgres.SQL.Types
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.OrderBy
import Hasura.RQL.Instances ()
import Hasura.RQL.Types.Backend hiding (ConstraintName)
import Hasura.RQL.Instances ()
import Hasura.RQL.Types.Backend hiding (ConstraintName)
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.SQL.Backend

1
server/src-lib/Hasura/RQL/DML/Update.hs
View File

@ -20,6 +20,7 @@ import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.Execute.Mutation
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.Translate.Returning
import Hasura.Backends.Postgres.Types.Table
import Hasura.EncJSON
import Hasura.RQL.DML.Internal
import Hasura.RQL.DML.Types

738
server/src-lib/Hasura/RQL/IR/BoolExp.hs
View File

@ -1,58 +1,57 @@
{-# LANGUAGE UndecidableInstances #-}
module Hasura.RQL.IR.BoolExp
( BoolExp(..)
, ColExp(..)
, GBoolExp(..)
, gBoolExpTrue
, gBoolExpToJSON
, parseGBoolExp
, GExists(..)
( BoolExp(..)
, ColExp(..)
, GBoolExp(..)
, gBoolExpTrue
, GExists(..)
, geWhere
, geTable
, _BoolExists
, geWhere
, geTable
, _BoolExists
, DWithinGeomOp(..)
, DWithinGeogOp(..)
, CastExp
, OpExpG(..)
, opExpDepCol
, STIntersectsNbandGeommin(..)
, STIntersectsGeomminNband(..)
, DWithinGeomOp(..)
, DWithinGeogOp(..)
, CastExp
, OpExpG(..)
, opExpDepCol
, STIntersectsNbandGeommin(..)
, STIntersectsGeomminNband(..)
, AnnBoolExpFld(..)
, AnnBoolExp
, AnnColumnCaseBoolExpPartialSQL
, AnnColumnCaseBoolExp
, AnnColumnCaseBoolExpField(..)
, traverseAnnBoolExp
, fmapAnnBoolExp
, traverseAnnColumnCaseBoolExp
, fmapAnnColumnCaseBoolExp
, annBoolExpTrue
, andAnnBoolExps
, AnnBoolExpFld(..)
, AnnBoolExp
, AnnColumnCaseBoolExpPartialSQL
, AnnColumnCaseBoolExp
, AnnColumnCaseBoolExpField(..)
, traverseAnnBoolExp
, fmapAnnBoolExp
, traverseAnnColumnCaseBoolExp
, fmapAnnColumnCaseBoolExp
, annBoolExpTrue
, andAnnBoolExps
, AnnBoolExpFldSQL
, AnnBoolExpSQL
, PartialSQLExp(..)
, isStaticValue
, AnnBoolExpFldPartialSQL
, AnnBoolExpPartialSQL
, AnnBoolExpFldSQL
, AnnBoolExpSQL
, PartialSQLExp(..)
, isStaticValue
, hasStaticExp
, AnnBoolExpPartialSQL
, PreSetColsG
, PreSetColsPartial
) where
, PreSetColsG
, PreSetColsPartial
) where
import Hasura.Prelude
import qualified Data.Aeson.Types as J
import qualified Data.HashMap.Strict as M
import Control.Lens.Plated
import Control.Lens.TH
import Data.Aeson
import Data.Aeson.Extended
import Data.Aeson.Internal
import Data.Aeson.TH
import Data.Monoid
import Data.Text.Extended
import Data.Typeable
@ -66,6 +65,98 @@ import Hasura.SQL.Types
import Hasura.Session
----------------------------------------------------------------------------------------------------
-- Boolean structure
-- | This type represents a hierarchical boolean expression. It is parametric over the actual
-- implementation of the actual boolean term values. It nonetheless leaks some information:
-- "exists" is only used in permissions, to add conditions based on another table.
data GBoolExp (b :: BackendType) a
= BoolAnd ![GBoolExp b a]
| BoolOr ![GBoolExp b a]
| BoolNot !(GBoolExp b a)
| BoolExists !(GExists b a)
| BoolFld !a
deriving (Show, Eq, Functor, Foldable, Traversable, Data, Generic)
instance (Backend b, NFData a) => NFData (GBoolExp b a)
instance (Backend b, Data a) => Plated (GBoolExp b a)
instance (Backend b, Cacheable a) => Cacheable (GBoolExp b a)
instance (Backend b, Hashable a) => Hashable (GBoolExp b a)
instance (Backend b, FromJSONKeyValue a) => FromJSON (GBoolExp b a) where
parseJSON = withObject "boolean expression" \o ->
BoolAnd <$> forM (M.toList o) \(k, v) ->
if | k == "$or" -> BoolOr <$> parseJSON v <?> Key k
| k == "_or" -> BoolOr <$> parseJSON v <?> Key k
| k == "$and" -> BoolAnd <$> parseJSON v <?> Key k
| k == "_and" -> BoolAnd <$> parseJSON v <?> Key k
| k == "$not" -> BoolNot <$> parseJSON v <?> Key k
| k == "_not" -> BoolNot <$> parseJSON v <?> Key k
| k == "$exists" -> BoolExists <$> parseJSON v <?> Key k
| k == "_exists" -> BoolExists <$> parseJSON v <?> Key k
| otherwise -> BoolFld <$> parseJSONKeyValue (k, v)
instance (Backend b, ToJSONKeyValue a) => ToJSON (GBoolExp b a) where
toJSON be = case be of
-- special encoding for _and
BoolAnd bExps ->
let m = M.fromList $ map getKV bExps
-- if the keys aren't repeated, then object encoding can be used
in if length m == length bExps
then toJSON m
else object $ pure kv
_ -> object $ pure kv
where
kv = getKV be
getKV = \case
BoolAnd bExps -> "_and" .= map toJSON bExps
BoolOr bExps -> "_or" .= map toJSON bExps
BoolNot bExp -> "_not" .= toJSON bExp
BoolExists bExists -> "_exists" .= toJSON bExists
BoolFld a -> toJSONKeyValue a
gBoolExpTrue :: GBoolExp b a
gBoolExpTrue = BoolAnd []
-- | Represents a condition on an aribtrary table. Used as part of our permissions boolean
-- expressions. See our documentation for more information:
-- https://hasura.io/docs/latest/graphql/core/auth/authorization/permission-rules.html#using-unrelated-tables-views
data GExists (b :: BackendType) a
= GExists
{ _geTable :: !(TableName b)
, _geWhere :: !(GBoolExp b a)
} deriving (Functor, Foldable, Traversable, Generic)
deriving instance (Backend b, Show a) => Show (GExists b a)
deriving instance (Backend b, Eq a) => Eq (GExists b a)
deriving instance (Backend b, Typeable a, Data a) => Data (GExists b a)
instance (Backend b, NFData a) => NFData (GExists b a)
instance (Backend b, Data a) => Plated (GExists b a)
instance (Backend b, Cacheable a) => Cacheable (GExists b a)
instance (Backend b, Hashable a) => Hashable (GExists b a)
instance (Backend b, FromJSONKeyValue a) => FromJSON (GExists b a) where
parseJSON = withObject "_exists" \o -> do
qt <- o .: "_table"
wh <- o .: "_where"
pure $ GExists qt wh
instance (Backend b, ToJSONKeyValue a) => ToJSON (GExists b a) where
toJSON (GExists gTable gWhere) =
object [ "_table" .= gTable
, "_where" .= gWhere
]
makeLenses ''GExists
----------------------------------------------------------------------------------------------------
-- Boolean expressions in permissions
-- | We don't allow conditions across relationships in permissions: the type we use as the terms in
-- GBoolExp is this one, ColExp, which only contains a FieldName and a JSON Value.
data ColExp
= ColExp
{ ceCol :: !FieldName
@ -74,229 +165,124 @@ data ColExp
instance NFData ColExp
instance Cacheable ColExp
instance FromJSONKeyValue ColExp where
parseJSONKeyValue (k, v) = ColExp (FieldName k) <$> parseJSON v
data GExists (b :: BackendType) a
= GExists
{ _geTable :: !(TableName b)
, _geWhere :: !(GBoolExp b a)
} deriving (Functor, Foldable, Traversable, Generic)
deriving instance (Backend b, Show a) => Show (GExists b a)
deriving instance (Backend b, Eq a) => Eq (GExists b a)
deriving instance (Backend b, Typeable a, Data a) => Data (GExists b a)
instance (Backend b, NFData a) => NFData (GExists b a)
instance (Backend b, Data a) => Plated (GExists b a)
instance (Backend b, Cacheable a) => Cacheable (GExists b a)
instance (Backend b, Hashable a) => Hashable (GExists b a)
gExistsToJSON :: Backend b => (a -> (Text, Value)) -> GExists b a -> Value
gExistsToJSON f (GExists qt wh) =
object [ "_table" .= qt
, "_where" .= gBoolExpToJSON f wh
]
parseGExists
:: Backend b => ((Text, Value) -> J.Parser a) -> Value -> J.Parser (GExists b a)
parseGExists f = \case
Object o -> do
qt <- o .: "_table"
wh <- o .: "_where"
GExists qt <$> parseGBoolExp f wh
_ -> fail "expecting an Object for _exists expression"
data GBoolExp (b :: BackendType) a
= BoolAnd ![GBoolExp b a]
| BoolOr ![GBoolExp b a]
| BoolNot !(GBoolExp b a)
| BoolExists !(GExists b a)
| BoolFld !a
deriving (Show, Eq, Functor, Foldable, Traversable, Data, Generic)
instance (Backend b, NFData a) => NFData (GBoolExp b a)
instance (Backend b, Data a) => Plated (GBoolExp b a)
instance (Backend b, Cacheable a) => Cacheable (GBoolExp b a)
instance (Backend b, Hashable a) => Hashable (GBoolExp b a)
gBoolExpTrue :: GBoolExp b a
gBoolExpTrue = BoolAnd []
gBoolExpToJSON :: Backend b => (a -> (Text, Value)) -> GBoolExp b a -> Value
gBoolExpToJSON f be = case be of
-- special encoding for _and
BoolAnd bExps ->
let m = M.fromList $ map getKV bExps
-- if the keys aren't repeated, then object encoding can be used
in if length m == length bExps
then toJSON m
else object $ pure kv
_ -> object $ pure kv
where
kv = getKV be
getKV = \case
BoolAnd bExps -> "_and" .= map (gBoolExpToJSON f) bExps
BoolOr bExps -> "_or" .= map (gBoolExpToJSON f) bExps
BoolNot bExp -> "_not" .= gBoolExpToJSON f bExp
BoolExists bExists -> "_exists" .= gExistsToJSON f bExists
BoolFld a -> f a
parseGBoolExp
:: Backend b => ((Text, Value) -> J.Parser a) -> Value -> J.Parser (GBoolExp b a)
parseGBoolExp f = \case
Object o -> do
boolExps <- forM (M.toList o) $ \(k, v) -> if
| k == "$or" -> BoolOr <$> parseGBoolExpL v <?> Key k
| k == "_or" -> BoolOr <$> parseGBoolExpL v <?> Key k
| k == "$and" -> BoolAnd <$> parseGBoolExpL v <?> Key k
| k == "_and" -> BoolAnd <$> parseGBoolExpL v <?> Key k
| k == "$not" -> BoolNot <$> parseGBoolExp f v <?> Key k
| k == "_not" -> BoolNot <$> parseGBoolExp f v <?> Key k
| k == "$exists" -> BoolExists <$> parseGExists f v <?> Key k
| k == "_exists" -> BoolExists <$> parseGExists f v <?> Key k
| otherwise -> BoolFld <$> f (k, v)
return $ BoolAnd boolExps
_ -> fail "expecting an Object for boolean exp"
where
parseGBoolExpL v =
parseJSON v >>= mapM (parseGBoolExp f)
instance ToJSONKeyValue ColExp where
toJSONKeyValue (ColExp k v) = (getFieldNameTxt k, v)
-- | This @BoolExp@ type is a simple alias for the boolean expressions used in permissions, that
-- uses 'ColExp' as the term in GBoolExp.
newtype BoolExp (b :: BackendType)
= BoolExp { unBoolExp :: GBoolExp b ColExp }
deriving (Show, Eq, Generic, NFData, Cacheable)
deriving newtype (Show, Eq, Generic, NFData, Cacheable, ToJSON, FromJSON)
$(makeWrapped ''BoolExp)
instance Backend b => ToJSON (BoolExp b) where
toJSON (BoolExp gBoolExp) =
gBoolExpToJSON f gBoolExp
where
f (ColExp k v) =
(getFieldNameTxt k, v)
instance Backend b => FromJSON (BoolExp b) where
parseJSON =
fmap BoolExp . parseGBoolExp f
where
f (k, v) = ColExp (FieldName k) <$> parseJSON v
makePrisms ''GBoolExp
data DWithinGeomOp a =
DWithinGeomOp
{ dwgeomDistance :: !a
, dwgeomFrom :: !a
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
instance (NFData a) => NFData (DWithinGeomOp a)
instance (Cacheable a) => Cacheable (DWithinGeomOp a)
instance (Hashable a) => Hashable (DWithinGeomOp a)
$(deriveJSON hasuraJSON ''DWithinGeomOp)
-- | Permissions get translated into boolean expressions that are threaded throuhgout the
-- parsers. For the leaf values of those permissions, we use this type, which references but doesn't
-- inline the session variables.
data PartialSQLExp (b :: BackendType)
= PSESessVar !(SessionVarType b) !SessionVariable
| PSESQLExp !(SQLExpression b)
deriving (Generic)
deriving instance (Backend b) => Eq (PartialSQLExp b)
deriving instance (Backend b) => Data (PartialSQLExp b)
instance (Backend b, NFData (BooleanOperators b (PartialSQLExp b))) => NFData (PartialSQLExp b)
instance (Backend b, Cacheable (BooleanOperators b (PartialSQLExp b))) => Hashable (PartialSQLExp b)
instance (Backend b, Hashable (BooleanOperators b (PartialSQLExp b))) => Cacheable (PartialSQLExp b)
data DWithinGeogOp a =
DWithinGeogOp
{ dwgeogDistance :: !a
, dwgeogFrom :: !a
, dwgeogUseSpheroid :: !a
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
instance (NFData a) => NFData (DWithinGeogOp a)
instance (Cacheable a) => Cacheable (DWithinGeogOp a)
instance (Hashable a) => Hashable (DWithinGeogOp a)
$(deriveJSON hasuraJSON ''DWithinGeogOp)
instance Backend b => ToJSON (PartialSQLExp b) where
toJSON = \case
PSESessVar colTy sessVar -> toJSON (colTy, sessVar)
PSESQLExp e -> toJSON $ toSQLTxt e
data STIntersectsNbandGeommin a =
STIntersectsNbandGeommin
{ singNband :: !a
, singGeommin :: !a
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
instance (NFData a) => NFData (STIntersectsNbandGeommin a)
instance (Cacheable a) => Cacheable (STIntersectsNbandGeommin a)
instance (Hashable a) => Hashable (STIntersectsNbandGeommin a)
$(deriveJSON hasuraJSON ''STIntersectsNbandGeommin)
isStaticValue :: PartialSQLExp backend -> Bool
isStaticValue = \case
PSESessVar _ _ -> False
PSESQLExp _ -> True
data STIntersectsGeomminNband a =
STIntersectsGeomminNband
{ signGeommin :: !a
, signNband :: !(Maybe a)
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
instance (NFData a) => NFData (STIntersectsGeomminNband a)
instance (Cacheable a) => Cacheable (STIntersectsGeomminNband a)
instance (Hashable a) => Hashable (STIntersectsGeomminNband a)
$(deriveJSON hasuraJSON ''STIntersectsGeomminNband)
hasStaticExp :: Backend b => OpExpG b (PartialSQLExp b) -> Bool
hasStaticExp = getAny . foldMap (Any . isStaticValue)
----------------------------------------------------------------------------------------------------
-- Boolean expressions in the schema
-- | Operand for cast operator
type CastExp b a = M.HashMap (ScalarType b) [OpExpG b a]
-- | This type represents the boolean operators that can be applied on values of a column. This type
-- only contains the common core, that we expect to be ultimately entirely supported in most if not
-- all backends. Backends can extend this with the @BooleanOperators@ type in @Backend@.
data OpExpG (b :: BackendType) a
= ACast !(CastExp b a)
| AEQ !Bool !a
| ANE !Bool !a
| AIN !a
| ANIN !a
| AGT !a
| ALT !a
| AGT !a
| ALT !a
| AGTE !a
| ALTE !a
| ALIKE !a -- LIKE
| ANLIKE !a -- NOT LIKE
| AILIKE !(XAILIKE b) !a -- ILIKE, case insensitive
| ANILIKE !(XANILIKE b) !a -- NOT ILIKE, case insensitive
| ASIMILAR !a -- similar, regex
| ANSIMILAR !a -- not similar, regex
-- Now that in the RQL code we've started to take a "trees that grow"
-- approach (see PR #6003), we may eventually want to move these
-- recently added constructors, which correspond to newly supported
-- Postgres operators, to the backend-specific extensions of this type.
| AREGEX !a -- match POSIX case sensitive, regex
| AIREGEX !a -- match POSIX case insensitive, regex
| ANREGEX !a -- dont match POSIX case sensitive, regex
| ANIREGEX !a -- dont match POSIX case insensitive, regex
| AContains !a
| AContainedIn !a
| AHasKey !a
| AHasKeysAny !a
| AHasKeysAll !a
| ASTContains !a
| ASTCrosses !a
| ASTDWithinGeom !(DWithinGeomOp a)
| ASTDWithinGeog !(DWithinGeogOp a)
| ASTEquals !a
| ASTIntersects !a
| ASTOverlaps !a
| ASTTouches !a
| ASTWithin !a
| ASTIntersectsRast !a
| ASTIntersectsGeomNband !(STIntersectsGeomminNband a)
| ASTIntersectsNbandGeom !(STIntersectsNbandGeommin a)
| ANISNULL -- IS NULL
| ANISNOTNULL -- IS NOT NULL
| AAncestor !a
| AAncestorAny !a
| ADescendant !a
| ADescendantAny !a
| AMatches !a
| AMatchesAny !a
| AMatchesFulltext !a
| CEQ !(Column b)
| CNE !(Column b)
| CGT !(Column b)
| CLT !(Column b)
| CEQ !(Column b)
| CNE !(Column b)
| CGT !(Column b)
| CLT !(Column b)
| CGTE !(Column b)
| CLTE !(Column b)
deriving (Functor, Foldable, Traversable, Generic)
deriving instance (Backend b, Show a) => Show (OpExpG b a)
deriving instance (Backend b, Eq a) => Eq (OpExpG b a)
instance (Backend b, NFData a) => NFData (OpExpG b a)
instance (Backend b, Cacheable a) => Cacheable (OpExpG b a)
instance (Backend b, Hashable a) => Hashable (OpExpG b a)
| ANISNULL -- IS NULL
| ANISNOTNULL -- IS NOT NULL
| ABackendSpecific !(BooleanOperators b a)
deriving (Generic)
deriving instance (Backend b) => Functor (OpExpG b)
deriving instance (Backend b) => Foldable (OpExpG b)
deriving instance (Backend b) => Traversable (OpExpG b)
deriving instance (Backend b, Show (BooleanOperators b a), Show a) => Show (OpExpG b a)
deriving instance (Backend b, Eq (BooleanOperators b a), Eq a) => Eq (OpExpG b a)
instance (Backend b, NFData (BooleanOperators b a), NFData a) => NFData (OpExpG b a)
instance (Backend b, Cacheable (BooleanOperators b a), Cacheable a) => Cacheable (OpExpG b a)
instance (Backend b, Hashable (BooleanOperators b a), Hashable a) => Hashable (OpExpG b a)
instance (Backend b, ToJSONKeyValue (BooleanOperators b a), ToJSON a) => ToJSONKeyValue (OpExpG b a) where
toJSONKeyValue = \case
ACast a -> ("_cast", toJSON $ object . map toJSONKeyValue <$> a)
AEQ _ a -> ("_eq", toJSON a)
ANE _ a -> ("_ne", toJSON a)
AIN a -> ("_in", toJSON a)
ANIN a -> ("_nin", toJSON a)
AGT a -> ("_gt", toJSON a)
ALT a -> ("_lt", toJSON a)
AGTE a -> ("_gte", toJSON a)
ALTE a -> ("_lte", toJSON a)
ALIKE a -> ("_like", toJSON a)
ANLIKE a -> ("_nlike", toJSON a)
CEQ a -> ("_ceq", toJSON a)
CNE a -> ("_cne", toJSON a)
CGT a -> ("_cgt", toJSON a)
CLT a -> ("_clt", toJSON a)
CGTE a -> ("_cgte", toJSON a)
CLTE a -> ("_clte", toJSON a)
ANISNULL -> ("_is_null", toJSON True)
ANISNOTNULL -> ("_is_null", toJSON False)
ABackendSpecific b -> toJSONKeyValue b
opExpDepCol :: OpExpG backend a -> Maybe (Column backend)
opExpDepCol = \case
@ -308,100 +294,63 @@ opExpDepCol = \case
CLTE c -> Just c
_ -> Nothing
opExpToJPair :: Backend b => (a -> Value) -> OpExpG b a -> (Text, Value)
opExpToJPair f = \case
ACast a -> ("_cast", toJSON $ M.map opExpsToJSON a)
AEQ _ a -> ("_eq", f a)
ANE _ a -> ("_ne", f a)
AIN a -> ("_in", f a)
ANIN a -> ("_nin", f a)
AGT a -> ("_gt", f a)
ALT a -> ("_lt", f a)
AGTE a -> ("_gte", f a)
ALTE a -> ("_lte", f a)
ALIKE a -> ("_like", f a)
ANLIKE a -> ("_nlike", f a)
AILIKE _ a -> ("_ilike", f a)
ANILIKE _ a -> ("_nilike", f a)
ASIMILAR a -> ("_similar", f a)
ANSIMILAR a -> ("_nsimilar", f a)
AREGEX a -> ("_regex", f a)
AIREGEX a -> ("_iregex", f a)
ANREGEX a -> ("_nregex", f a)
ANIREGEX a -> ("_niregex", f a)
AContains a -> ("_contains", f a)
AContainedIn a -> ("_contained_in", f a)
AHasKey a -> ("_has_key", f a)
AHasKeysAny a -> ("_has_keys_any", f a)
AHasKeysAll a -> ("_has_keys_all", f a)
ASTContains a -> ("_st_contains", f a)
ASTCrosses a -> ("_st_crosses", f a)
ASTDWithinGeom o -> ("_st_d_within", toJSON $ f <$> o)
ASTDWithinGeog o -> ("_st_d_within", toJSON $ f <$> o)
ASTEquals a -> ("_st_equals", f a)
ASTIntersects a -> ("_st_intersects", f a)
ASTOverlaps a -> ("_st_overlaps", f a)
ASTTouches a -> ("_st_touches", f a)
ASTWithin a -> ("_st_within", f a)
ASTIntersectsRast a -> ("_st_intersects_rast", f a)
ASTIntersectsNbandGeom a -> ("_st_intersects_nband_geom", toJSON $ f <$> a)
ASTIntersectsGeomNband a -> ("_st_intersects_geom_nband", toJSON $ f <$> a)
AAncestor a -> ("_ancestor", f a)
AAncestorAny a -> ("_ancestor_any", f a)
ADescendant a -> ("_descendant", f a)
ADescendantAny a -> ("_descendant_any", f a)
AMatches a -> ("_matches", f a)
AMatchesAny a -> ("_matches_any", f a)
AMatchesFulltext a -> ("_matches_fulltext", f a)
ANISNULL -> ("_is_null", toJSON True)
ANISNOTNULL -> ("_is_null", toJSON False)
CEQ a -> ("_ceq", toJSON a)
CNE a -> ("_cne", toJSON a)
CGT a -> ("_cgt", toJSON a)
CLT a -> ("_clt", toJSON a)
CGTE a -> ("_cgte", toJSON a)
CLTE a -> ("_clte", toJSON a)
where
opExpsToJSON = object . map (opExpToJPair f)
-- | This type is used for boolean terms in GBoolExp in the schema; there are two kinds boolean
-- terms:
-- - operators on a column of the current table, using the 'OpExpG' kind of operators
-- - arbitrary expressions on columns of tables in relationships (in the same source)
--
-- This type is parametric over the type of leaf values, the values on which we operate.
data AnnBoolExpFld (b :: BackendType) a
= AVCol !(ColumnInfo b) ![OpExpG b a]
| AVRel !(RelInfo b) !(AnnBoolExp b a)
deriving (Functor, Foldable, Traversable, Generic)
deriving instance (Backend b, Eq (ColumnInfo b), Eq a) => Eq (AnnBoolExpFld b a)
instance (Backend b, NFData (ColumnInfo b), NFData a) => NFData (AnnBoolExpFld b a)
instance (Backend b, Cacheable (ColumnInfo b), Cacheable a) => Cacheable (AnnBoolExpFld b a)
instance (Backend b, Hashable (ColumnInfo b), Hashable a) => Hashable (AnnBoolExpFld b a)
deriving instance (Backend b, Eq (BooleanOperators b a), Eq a) => Eq (AnnBoolExpFld b a)
instance (Backend b, NFData (BooleanOperators b a), NFData a) => NFData (AnnBoolExpFld b a)
instance (Backend b, Cacheable (BooleanOperators b a), Cacheable a) => Cacheable (AnnBoolExpFld b a)
instance (Backend b, Hashable (BooleanOperators b a), Hashable a) => Hashable (AnnBoolExpFld b a)
newtype AnnColumnCaseBoolExpField (b :: BackendType) a
= AnnColumnCaseBoolExpField { _accColCaseBoolExpField :: (AnnBoolExpFld b a)}
deriving (Functor, Foldable, Traversable, Generic)
deriving instance (Backend b, Eq (ColumnInfo b), Eq a) => Eq (AnnColumnCaseBoolExpField b a)
instance (Backend b, NFData (ColumnInfo b), NFData a) => NFData (AnnColumnCaseBoolExpField b a)
instance (Backend b, Cacheable (ColumnInfo b), Cacheable a) => Cacheable (AnnColumnCaseBoolExpField b a)
instance (Backend b, Hashable (ColumnInfo b), Hashable a) => Hashable (AnnColumnCaseBoolExpField b a)
instance (Backend b, ToJSONKeyValue (BooleanOperators b a), ToJSON a) => ToJSONKeyValue (AnnBoolExpFld b a) where
toJSONKeyValue = \case
AVCol pci opExps ->
( toTxt $ pgiColumn pci
, toJSON (pci, object . pure . toJSONKeyValue <$> opExps)
)
AVRel ri relBoolExp ->
( relNameToTxt $ riName ri
, toJSON (ri, toJSON relBoolExp)
)
type AnnBoolExp b a
= GBoolExp b (AnnBoolExpFld b a)
-- | A simple alias for the kind of boolean expressions used in the schema, that ties together
-- 'GBoolExp', 'OpExpG', and 'AnnBoolExpFld'.
type AnnBoolExp b a = GBoolExp b (AnnBoolExpFld b a)
type AnnColumnCaseBoolExp b a
= GBoolExp b (AnnColumnCaseBoolExpField b a)
-- Type aliases for common use cases:
type AnnBoolExpFldSQL b = AnnBoolExpFld b (SQLExpression b)
type AnnBoolExpSQL b = AnnBoolExp b (SQLExpression b)
type AnnBoolExpPartialSQL b = AnnBoolExp b (PartialSQLExp b)
annBoolExpTrue :: AnnBoolExp backend a
annBoolExpTrue = gBoolExpTrue
andAnnBoolExps :: AnnBoolExp backend a -> AnnBoolExp backend a -> AnnBoolExp backend a
andAnnBoolExps l r =
BoolAnd [l, r]
-- Traversal functions
fmapAnnBoolExp
:: Backend backend
=> (a -> b)
-> AnnBoolExp backend a
-> AnnBoolExp backend b
fmapAnnBoolExp f =
runIdentity . traverseAnnBoolExp (pure . f)
traverseAnnBoolExpFld
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AnnBoolExpFld backend a
-> f (AnnBoolExpFld backend b)
@ -412,14 +361,101 @@ traverseAnnBoolExpFld f = \case
AVRel relInfo <$> traverseAnnBoolExp f annBoolExp
traverseAnnBoolExp
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AnnBoolExp backend a
-> f (AnnBoolExp backend b)
traverseAnnBoolExp f = traverse (traverseAnnBoolExpFld f)
----------------------------------------------------------------------------------------------------
-- Operands for specific operators
-- Arguably, most of those should be moved elsewhere, since not all of the corresponding operators
-- are part of the common core of operators.
-- | Operand for STDWithin opoerator
data DWithinGeomOp a =
DWithinGeomOp
{ dwgeomDistance :: !a
, dwgeomFrom :: !a
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
instance (NFData a) => NFData (DWithinGeomOp a)
instance (Cacheable a) => Cacheable (DWithinGeomOp a)
instance (Hashable a) => Hashable (DWithinGeomOp a)
$(deriveJSON hasuraJSON ''DWithinGeomOp)
-- | Operand for STDWithin opoerator
data DWithinGeogOp a =
DWithinGeogOp
{ dwgeogDistance :: !a
, dwgeogFrom :: !a
, dwgeogUseSpheroid :: !a
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
instance (NFData a) => NFData (DWithinGeogOp a)
instance (Cacheable a) => Cacheable (DWithinGeogOp a)
instance (Hashable a) => Hashable (DWithinGeogOp a)
$(deriveJSON hasuraJSON ''DWithinGeogOp)
-- | Operand for STIntersect
data STIntersectsNbandGeommin a =
STIntersectsNbandGeommin
{ singNband :: !a
, singGeommin :: !a
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
instance (NFData a) => NFData (STIntersectsNbandGeommin a)
instance (Cacheable a) => Cacheable (STIntersectsNbandGeommin a)
instance (Hashable a) => Hashable (STIntersectsNbandGeommin a)
$(deriveJSON hasuraJSON ''STIntersectsNbandGeommin)
-- | Operand for STIntersect
data STIntersectsGeomminNband a =
STIntersectsGeomminNband
{ signGeommin :: !a
, signNband :: !(Maybe a)
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
instance (NFData a) => NFData (STIntersectsGeomminNband a)
instance (Cacheable a) => Cacheable (STIntersectsGeomminNband a)
instance (Hashable a) => Hashable (STIntersectsGeomminNband a)
$(deriveJSON hasuraJSON ''STIntersectsGeomminNband)
----------------------------------------------------------------------------------------------------
-- Miscellaneous
-- | This is a simple newtype over AnnBoolExpFld. At time of writing, I do not know why we want
-- this, and why it exists. It might be a relic of a needed differentiation, now lost?
-- TODO: can this be removed?
newtype AnnColumnCaseBoolExpField (b :: BackendType) a
= AnnColumnCaseBoolExpField { _accColCaseBoolExpField :: (AnnBoolExpFld b a)}
deriving (Functor, Foldable, Traversable, Generic)
deriving instance (Backend b, Eq (BooleanOperators b a), Eq a) => Eq (AnnColumnCaseBoolExpField b a)
instance (Backend b, NFData (BooleanOperators b a), NFData a) => NFData (AnnColumnCaseBoolExpField b a)
instance (Backend b, Cacheable (BooleanOperators b a), Cacheable a) => Cacheable (AnnColumnCaseBoolExpField b a)
instance (Backend b, Hashable (BooleanOperators b a), Hashable a) => Hashable (AnnColumnCaseBoolExpField b a)
instance (Backend b, ToJSONKeyValue (BooleanOperators b a), ToJSON a) => ToJSONKeyValue (AnnColumnCaseBoolExpField b a) where
toJSONKeyValue = toJSONKeyValue . _accColCaseBoolExpField
-- | Similar to AnnBoolExp, this type alias ties together
-- 'GBoolExp', 'OpExpG', and 'AnnColumnCaseBoolExpFld'.
type AnnColumnCaseBoolExp b a = GBoolExp b (AnnColumnCaseBoolExpField b a)
-- traversal functions
fmapAnnColumnCaseBoolExp
:: Backend backend
=> (a -> b)
-> AnnColumnCaseBoolExp backend a
-> AnnColumnCaseBoolExp backend b
fmapAnnColumnCaseBoolExp f =
runIdentity . traverseAnnColumnCaseBoolExp (pure . f)
traverseAnnColumnCaseBoolExp
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AnnColumnCaseBoolExp backend a
-> f (AnnColumnCaseBoolExp backend b)
@ -428,75 +464,9 @@ traverseAnnColumnCaseBoolExp f = traverse traverseColCaseBoolExp
traverseColCaseBoolExp (AnnColumnCaseBoolExpField annBoolExpField) =
AnnColumnCaseBoolExpField <$> traverseAnnBoolExpFld f annBoolExpField
fmapAnnBoolExp
:: (a -> b)
-> AnnBoolExp backend a
-> AnnBoolExp backend b
fmapAnnBoolExp f =
runIdentity . traverseAnnBoolExp (pure . f)
fmapAnnColumnCaseBoolExp
:: (a -> b)
-> AnnColumnCaseBoolExp backend a
-> AnnColumnCaseBoolExp backend b
fmapAnnColumnCaseBoolExp f =
runIdentity . traverseAnnColumnCaseBoolExp (pure . f)
annBoolExpTrue :: AnnBoolExp backend a
annBoolExpTrue = gBoolExpTrue
andAnnBoolExps :: AnnBoolExp backend a -> AnnBoolExp backend a -> AnnBoolExp backend a
andAnnBoolExps l r =
BoolAnd [l, r]
type AnnBoolExpFldSQL b = AnnBoolExpFld b (SQLExpression b)
type AnnBoolExpSQL b = AnnBoolExp b (SQLExpression b)
type AnnBoolExpFldPartialSQL b = AnnBoolExpFld b (PartialSQLExp b)
type AnnBoolExpPartialSQL b = AnnBoolExp b (PartialSQLExp b)
-- misc type aliases
type AnnColumnCaseBoolExpPartialSQL b = AnnColumnCaseBoolExp b (PartialSQLExp b)
type PreSetColsG b v = M.HashMap (Column b) v
type PreSetColsPartial b = M.HashMap (Column b) (PartialSQLExp b)
-- doesn't resolve the session variable
data PartialSQLExp (b :: BackendType)
= PSESessVar !(SessionVarType b) !SessionVariable
| PSESQLExp !(SQLExpression b)
deriving (Generic)
deriving instance Backend b => Eq (PartialSQLExp b)
deriving instance Backend b => Data (PartialSQLExp b)
instance Backend b => NFData (PartialSQLExp b)
instance Backend b => Cacheable (PartialSQLExp b)
instance Backend b => ToJSON (PartialSQLExp b) where
toJSON = \case
PSESessVar colTy sessVar -> toJSON (colTy, sessVar)
PSESQLExp e -> toJSON $ toSQLTxt e
instance Backend b => ToJSON (AnnBoolExpPartialSQL b) where
toJSON = gBoolExpToJSON annBoolExpMakeKeyValuePair
annBoolExpMakeKeyValuePair :: forall b . Backend b => AnnBoolExpFld b (PartialSQLExp b) -> (Text, Value)
annBoolExpMakeKeyValuePair = \case
AVCol pci opExps ->
( toTxt $ pgiColumn pci
, toJSON (pci, map opExpsToJSON opExps))
AVRel ri relBoolExp ->
( relNameToTxt $ riName ri
, toJSON (ri, toJSON relBoolExp))
where
opExpsToJSON :: OpExpG b (PartialSQLExp b) -> Value
opExpsToJSON = object . pure . opExpToJPair toJSON
instance Backend b => ToJSON (AnnColumnCaseBoolExpPartialSQL b) where
toJSON = gBoolExpToJSON (annBoolExpMakeKeyValuePair . _accColCaseBoolExpField)
isStaticValue :: PartialSQLExp backend -> Bool
isStaticValue = \case
PSESessVar _ _ -> False
PSESQLExp _ -> True
makeLenses ''GExists
makePrisms ''GBoolExp

2
server/src-lib/Hasura/RQL/IR/Delete.hs
View File

@ -20,7 +20,7 @@ data AnnDelG (b :: BackendType) v
type AnnDel b = AnnDelG b (SQLExpression b)
traverseAnnDel
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AnnDelG backend a
-> f (AnnDelG backend b)

6
server/src-lib/Hasura/RQL/IR/Returning.hs
View File

@ -39,7 +39,7 @@ buildEmptyMutResp = \case
MRet _ -> J.toJSON ([] :: [J.Value])
traverseMutFld
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> MutFldG backend a
-> f (MutFldG backend b)
@ -49,7 +49,7 @@ traverseMutFld f = \case
MRet flds -> MRet <$> traverse (traverse (traverseAnnField f)) flds
traverseMutationOutput
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> MutationOutputG backend a -> f (MutationOutputG backend b)
traverseMutationOutput f = \case
@ -59,7 +59,7 @@ traverseMutationOutput f = \case
MOutSinglerowObject <$> traverseAnnFields f annFields
traverseMutFlds
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> MutFldsG backend a
-> f (MutFldsG backend b)

64
server/src-lib/Hasura/RQL/IR/Select.hs
View File

@ -42,7 +42,7 @@ instance (Backend b, Hashable (ColumnInfo b), Hashable v) => Hashable (AnnOrderB
type AnnOrderByElement b v = AnnOrderByElementG b (AnnBoolExp b v)
traverseAnnOrderByElement
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b) -> AnnOrderByElement backend a -> f (AnnOrderByElement backend b)
traverseAnnOrderByElement f = \case
AOCColumn pgColInfo -> pure $ AOCColumn pgColInfo
@ -58,7 +58,7 @@ traverseAnnOrderByElement f = \case
type AnnOrderByItemG b v = OrderByItemG b (AnnOrderByElement b v)
traverseAnnOrderByItem
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b) -> AnnOrderByItemG backend a -> f (AnnOrderByItemG backend b)
traverseAnnOrderByItem f =
traverse (traverseAnnOrderByElement f)
@ -90,7 +90,7 @@ data AnnObjectSelectG (b :: BackendType) v
type AnnObjectSelect b = AnnObjectSelectG b (SQLExpression b)
traverseAnnObjectSelect
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AnnObjectSelectG backend a -> f (AnnObjectSelectG backend b)
traverseAnnObjectSelect f (AnnObjectSelectG fields fromTable permissionFilter) =
@ -125,7 +125,7 @@ data ComputedFieldSelect (b :: BackendType) v
| CFSTable !JsonAggSelect !(AnnSimpleSelG b v)
traverseComputedFieldSelect
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (v -> f w)
-> ComputedFieldSelect backend v -> f (ComputedFieldSelect backend w)
traverseComputedFieldSelect fv = \case
@ -141,7 +141,7 @@ data ArraySelectG (b :: BackendType) v
| ASConnection !(ArrayConnectionSelect b v)
traverseArraySelect
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> ArraySelectG backend a
-> f (ArraySelectG backend b)
@ -184,7 +184,7 @@ data AnnColumnField (b :: BackendType) v
}
traverseAnnColumnField
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AnnColumnField backend a
-> f (AnnColumnField backend b)
@ -234,16 +234,16 @@ mkAnnColumnFieldAsText ci =
AFColumn (AnnColumnField ci True Nothing Nothing)
traverseAnnField
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b) -> AnnFieldG backend a -> f (AnnFieldG backend b)
traverseAnnField f = \case
AFColumn colFld -> AFColumn <$> traverseAnnColumnField f colFld
AFObjectRelation sel -> AFObjectRelation <$> traverse (traverseAnnObjectSelect f) sel
AFArrayRelation sel -> AFArrayRelation <$> traverseArraySelect f sel
AFColumn colFld -> AFColumn <$> traverseAnnColumnField f colFld
AFObjectRelation sel -> AFObjectRelation <$> traverse (traverseAnnObjectSelect f) sel
AFArrayRelation sel -> AFArrayRelation <$> traverseArraySelect f sel
AFComputedField x sel -> AFComputedField x <$> traverseComputedFieldSelect f sel
AFRemote x s -> pure $ AFRemote x s
AFNodeId x qt pKeys -> pure $ AFNodeId x qt pKeys
AFExpression t -> AFExpression <$> pure t
AFExpression t -> pure $ AFExpression t
type AnnField b = AnnFieldG b (SQLExpression b)
@ -255,11 +255,22 @@ data SelectArgsG (b :: BackendType) v
, _saOffset :: !(Maybe (SQLExpression b))
, _saDistinct :: !(Maybe (XDistinct b, NE.NonEmpty (Column b)))
} deriving (Generic)
deriving instance (Backend b, Eq (ColumnInfo b), Eq v) => Eq (SelectArgsG b v)
instance (Backend b, Hashable (ColumnInfo b), Hashable v) => Hashable (SelectArgsG b v)
deriving instance
( Backend b
, Eq (BooleanOperators b v)
, Eq v
) => Eq (SelectArgsG b v)
instance
( Backend b
, Hashable (BooleanOperators b v)
, Hashable v
) => Hashable (SelectArgsG b v)
traverseSelectArgs
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b) -> SelectArgsG backend a -> f (SelectArgsG backend b)
traverseSelectArgs f (SelectArgs wh ordBy lmt ofst distCols) =
SelectArgs
@ -296,7 +307,7 @@ type AggregateFields b = Fields (AggregateField b)
type AnnFieldsG b v = Fields (AnnFieldG b v)
traverseAnnFields
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b) -> AnnFieldsG backend a -> f (AnnFieldsG backend b)
traverseAnnFields f = traverse (traverse (traverseAnnField f))
@ -323,7 +334,7 @@ data EdgeField (b :: BackendType) v
type EdgeFields b v = Fields (EdgeField b v)
traverseEdgeField
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b) -> EdgeField backend a -> f (EdgeField backend b)
traverseEdgeField f = \case
EdgeTypename t -> pure $ EdgeTypename t
@ -337,7 +348,7 @@ data ConnectionField (b :: BackendType) v
type ConnectionFields b v = Fields (ConnectionField b v)
traverseConnectionField
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b) -> ConnectionField backend a -> f (ConnectionField backend b)
traverseConnectionField f = \case
ConnectionTypename t -> pure $ ConnectionTypename t
@ -346,7 +357,7 @@ traverseConnectionField f = \case
ConnectionEdges <$> traverse (traverse (traverseEdgeField f)) fields
traverseTableAggregateField
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b) -> TableAggregateFieldG backend a -> f (TableAggregateFieldG backend b)
traverseTableAggregateField f = \case
TAFAgg aggFlds -> pure $ TAFAgg aggFlds
@ -385,10 +396,15 @@ data TablePermG (b :: BackendType) v
{ _tpFilter :: !(AnnBoolExp b v)
, _tpLimit :: !(Maybe Int)
} deriving (Generic)
instance (Backend b, Hashable (ColumnInfo b), Hashable v) => Hashable (TablePermG b v)
instance
( Backend b
, Hashable (BooleanOperators b v)
, Hashable (ColumnInfo b)
, Hashable v
) => Hashable (TablePermG b v)
traverseTablePerm
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> TablePermG backend a
-> f (TablePermG backend b)
@ -413,20 +429,20 @@ data AnnSelectG (b :: BackendType) a v
}
traverseAnnSimpleSelect
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AnnSimpleSelG backend a -> f (AnnSimpleSelG backend b)
traverseAnnSimpleSelect f = traverseAnnSelect (traverseAnnFields f) f
traverseAnnAggregateSelect
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AnnAggregateSelectG backend a -> f (AnnAggregateSelectG backend b)
traverseAnnAggregateSelect f =
traverseAnnSelect (traverse (traverse (traverseTableAggregateField f))) f
traverseAnnSelect
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b) -> (v -> f w)
-> AnnSelectG backend a v -> f (AnnSelectG backend b w)
traverseAnnSelect f1 f2 (AnnSelectG flds tabFrom perm args strfyNum) =
@ -479,7 +495,7 @@ data ConnectionSelect (b :: BackendType) v
}
traverseConnectionSelect
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> ConnectionSelect backend a -> f (ConnectionSelect backend b)
traverseConnectionSelect f (ConnectionSelect x pkCols cSplit cSlice sel) =

2
server/src-lib/Hasura/RQL/IR/Update.hs
View File

@ -50,7 +50,7 @@ updateOperatorText (UpdDeleteElem _) = "_delete_elem"
updateOperatorText (UpdDeleteAtPath _) = "_delete_at_path"
traverseAnnUpd
:: (Applicative f)
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AnnUpdG backend a
-> f (AnnUpdG backend b)

2
server/src-lib/Hasura/RQL/Instances.hs
View File

@ -22,6 +22,7 @@ import Data.Text
import System.Cron.Parser
import System.Cron.Types
instance NFData G.FragmentDefinition
instance NFData G.GType
instance NFData G.OperationType
@ -125,4 +126,5 @@ instance Q.FromCol CronSchedule where
Left err' -> Left $ "invalid cron schedule " <> pack err'
Right cron -> Right cron
instance J.ToJSONKey Void

6
server/src-lib/Hasura/RQL/Types/Action.hs
View File

@ -306,7 +306,7 @@ data AnnActionExecution (b :: BackendType) v
}
traverseAnnActionExecution
:: Applicative f
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AnnActionExecution backend a
-> f (AnnActionExecution backend b)
@ -327,7 +327,7 @@ data AsyncActionQueryFieldG (b :: BackendType) v
| AsyncErrors
traverseAsyncActionQueryField
:: Applicative f
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AsyncActionQueryFieldG backend a
-> f (AsyncActionQueryFieldG backend b)
@ -352,7 +352,7 @@ data AnnActionAsyncQuery (b :: BackendType) v
}
traverseAnnActionAsyncQuery
:: Applicative f
:: (Applicative f, Backend backend)
=> (a -> f b)
-> AnnActionAsyncQuery backend a
-> f (AnnActionAsyncQuery backend b)

8
server/src-lib/Hasura/RQL/Types/Backend.hs
View File

@ -6,7 +6,7 @@ import Hasura.Prelude
import qualified Language.GraphQL.Draft.Syntax as G
import Data.Aeson
import Data.Aeson.Extended
import Data.Kind (Type)
import Data.Text.Extended
import Data.Typeable (Typeable)
@ -51,8 +51,6 @@ class
, Representable (SQLOperator b)
, Representable (SessionVarType b)
, Representable (SourceConnConfiguration b)
, Representable (XAILIKE b)
, Representable (XANILIKE b)
, Representable (XRelay b)
, Representable (XNodesAgg b)
, Representable (XRemoteField b)
@ -66,6 +64,7 @@ class
, Ord (Column b)
, Data (TableName b)
, Data (ScalarType b)
, Traversable (BooleanOperators b)
, Data (SQLExpression b)
, ToSQL (SQLExpression b)
, FromJSON (BasicOrderType b)
@ -120,12 +119,11 @@ class
type Column b = c | c -> b
type ScalarValue b = sv | sv -> b
type ScalarType b = s | s -> b
type BooleanOperators b :: Type -> Type
type SQLExpression b :: Type
type SQLOperator b :: Type
-- extension types
type XAILIKE b :: Type
type XANILIKE b :: Type
type XComputedField b :: Type
type XRemoteField b :: Type
type XRelay b :: Type

34
server/src-lib/Hasura/RQL/Types/Column.hs
View File

@ -7,13 +7,10 @@ module Hasura.RQL.Types.Column
, ValueParser
, onlyNumCols
, onlyJSONBCols
, onlyComparableCols
, parseScalarValueColumnType
, parseScalarValuesColumnType
, unsafePGColumnToBackend
, parseTxtEncodedPGValue
, ColumnValue(..)
@ -33,20 +30,16 @@ module Hasura.RQL.Types.Column
import Hasura.Prelude
import qualified Data.HashMap.Strict as M
import qualified Language.GraphQL.Draft.Syntax as G
import qualified Data.HashMap.Strict as M
import qualified Language.GraphQL.Draft.Syntax as G
import Control.Lens.TH
import Data.Aeson
import Data.Aeson.TH
import Data.Text.Extended
import Hasura.Backends.Postgres.Instances.Types ()
import Hasura.Backends.Postgres.SQL.Types hiding (TableName, isComparableType,
isNumType)
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Instances ()
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Instances ()
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Error
@ -124,14 +117,6 @@ isScalarColumnWhere f = \case
ColumnScalar scalar -> f scalar
ColumnEnumReference _ -> False
-- | Gets the representation type associated with a 'ColumnType'. Avoid using this if possible.
-- Prefer 'parsePGScalarValue', 'parsePGScalarValues', or
-- 'Hasura.RQL.Types.BoolExp.mkTypedSessionVar'.
unsafePGColumnToBackend :: ColumnType 'Postgres -> ScalarType 'Postgres
unsafePGColumnToBackend = \case
ColumnScalar scalarType -> scalarType
ColumnEnumReference _ -> PGText
-- | Note: Unconditionally accepts null values and returns 'PGNull'.
parseScalarValueColumnType
:: forall m b
@ -158,14 +143,6 @@ parseScalarValuesColumnType
parseScalarValuesColumnType columnType values =
indexedMapM (parseScalarValueColumnType columnType) values
parseTxtEncodedPGValue
:: (MonadError QErr m, Backend b)
=> ColumnType b -> TxtEncodedPGVal -> m (ScalarValue b)
parseTxtEncodedPGValue colTy val =
parseScalarValueColumnType colTy $ case val of
TENull -> Null
TELit t -> String t
-- | “Raw” column info, as stored in the catalog (but not in the schema cache). Instead of
-- containing a 'PGColumnType', it only contains a 'PGScalarType', which is combined with the
-- 'pcirReferences' field and other table data to eventually resolve the type to a 'PGColumnType'.
@ -214,9 +191,6 @@ type PrimaryKeyColumns b = NESeq (ColumnInfo b)
onlyNumCols :: forall b . Backend b => [ColumnInfo b] -> [ColumnInfo b]
onlyNumCols = filter (isScalarColumnWhere (isNumType @b) . pgiType)
onlyJSONBCols :: [ColumnInfo 'Postgres] -> [ColumnInfo 'Postgres]
onlyJSONBCols = filter (isScalarColumnWhere (== PGJSONB) . pgiType)
onlyComparableCols :: forall b. Backend b => [ColumnInfo b] -> [ColumnInfo b]
onlyComparableCols = filter (isScalarColumnWhere (isComparableType @b) . pgiType)

23
server/src-lib/Hasura/RQL/Types/ComputedField.hs
View File

@ -6,19 +6,17 @@ module Hasura.RQL.Types.ComputedField where
import Hasura.Prelude
import qualified Data.Sequence as Seq
import qualified Database.PG.Query as Q
import qualified Data.Sequence as Seq
import qualified Database.PG.Query as Q
import Control.Lens hiding ((.=))
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Data.Text.NonEmpty
import Hasura.Backends.Postgres.Instances.Types ()
import Hasura.Backends.Postgres.SQL.Types hiding (FunctionName, TableName)
import Hasura.Incremental (Cacheable)
import Hasura.Backends.Postgres.SQL.Types hiding (FunctionName, TableName)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Function
@ -91,22 +89,23 @@ instance Backend b => ToJSON (ComputedFieldReturn b) where
}
$(makePrisms ''ComputedFieldReturn)
data ComputedFieldFunction
data ComputedFieldFunction (b :: BackendType)
= ComputedFieldFunction
{ _cffName :: !QualifiedFunction
, _cffInputArgs :: !(Seq.Seq (FunctionArg 'Postgres))
, _cffInputArgs :: !(Seq.Seq (FunctionArg b))
, _cffTableArgument :: !FunctionTableArgument
, _cffSessionArgument :: !(Maybe FunctionSessionArgument)
, _cffDescription :: !(Maybe PGDescription)
} deriving (Show, Eq, Generic)
instance Cacheable ComputedFieldFunction
$(deriveToJSON hasuraJSON ''ComputedFieldFunction)
instance (Backend b) => Cacheable (ComputedFieldFunction b)
instance (Backend b) => ToJSON (ComputedFieldFunction b) where
toJSON = genericToJSON hasuraJSON
data ComputedFieldInfo (b :: BackendType)
= ComputedFieldInfo
{ _cfiXComputedFieldInfo :: !(XComputedField b)
, _cfiName :: !ComputedFieldName
, _cfiFunction :: !ComputedFieldFunction
, _cfiFunction :: !(ComputedFieldFunction b)
, _cfiReturnType :: !(ComputedFieldReturn b)
, _cfiComment :: !(Maybe Text)
} deriving (Generic)

26
server/src-lib/Hasura/RQL/Types/CustomTypes.hs
View File

@ -33,21 +33,22 @@ module Hasura.RQL.Types.CustomTypes
, emptyAnnotatedCustomTypes
) where
import Control.Lens.TH (makeLenses)
import Control.Lens.TH (makeLenses)
import Data.Text.Extended
import qualified Data.Aeson as J
import qualified Data.Aeson.TH as J
import qualified Data.HashMap.Strict as Map
import qualified Data.List.NonEmpty as NEList
import qualified Data.Text as T
import qualified Language.GraphQL.Draft.Parser as GParse
import qualified Language.GraphQL.Draft.Printer as GPrint
import qualified Language.GraphQL.Draft.Syntax as G
import qualified Text.Builder as T
import qualified Data.Aeson as J
import qualified Data.Aeson.TH as J
import qualified Data.HashMap.Strict as Map
import qualified Data.List.NonEmpty as NEList
import qualified Data.Text as T
import qualified Language.GraphQL.Draft.Parser as GParse
import qualified Language.GraphQL.Draft.Printer as GPrint
import qualified Language.GraphQL.Draft.Syntax as G
import qualified Text.Builder as T
import Hasura.Backends.Postgres.Instances.Types ()
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Incremental (Cacheable)
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
@ -55,6 +56,7 @@ import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
newtype GraphQLType
= GraphQLType { unGraphQLType :: G.GType }
deriving (Show, Eq, Generic, NFData, Cacheable)
@ -234,7 +236,7 @@ emptyCustomTypes = CustomTypes Nothing Nothing Nothing Nothing
data AnnotatedScalarType
= ASTCustom !ScalarTypeDefinition
| forall b . (b ~ 'Postgres) => ASTReusedScalar !G.Name !(ScalarType b)
| ASTReusedScalar !G.Name !(ScalarType 'Postgres)
-- | A simple type-level function: `ScalarSet :: Backend b => b -> HashSet (ScalarType b)`

9
server/src-lib/Hasura/RQL/Types/Relationship.hs
View File

@ -2,15 +2,14 @@ module Hasura.RQL.Types.Relationship where
import Hasura.Prelude
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import Control.Lens (makeLenses)
import Control.Lens (makeLenses)
import Data.Aeson.TH
import Data.Aeson.Types
import Hasura.Backends.Postgres.Instances.Types ()
import Hasura.Incremental (Cacheable)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.SQL.Backend

51
server/src-lib/Hasura/RQL/Types/SchemaCache.hs
View File

@ -45,7 +45,6 @@ module Hasura.RQL.Types.SchemaCache
, ViewInfo(..)
, isMutable
, mutableView
, IntrospectionResult(..)
, ParsedIntrospection(..)
@ -116,6 +115,8 @@ module Hasura.RQL.Types.SchemaCache
, FunctionInfo(..)
, FunctionCache
, CronTriggerInfo(..)
, getBoolExpDeps
) where
import Hasura.Prelude
@ -142,6 +143,7 @@ import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.ApiLimit
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.CustomTypes
@ -440,3 +442,50 @@ getDependentObjsWith f sc objId =
go (SOITable tn1) (SOITable tn2) = Just $ tn1 == tn2
go (SOITable tn1) (SOITableObj tn2 _) = Just $ tn1 == tn2
go _ _ = Nothing
-- | Build dependencies from an AnnBoolExpPartialSQL.
getBoolExpDeps
:: Backend b
=> SourceName
-> TableName b
-> AnnBoolExpPartialSQL b
-> [SchemaDependency]
getBoolExpDeps source tn = \case
BoolAnd exps -> procExps exps
BoolOr exps -> procExps exps
BoolNot e -> getBoolExpDeps source tn e
BoolFld fld -> getColExpDeps source tn fld
BoolExists (GExists refqt whereExp) ->
let tableDep = SchemaDependency
(SOSourceObj source
$ AB.mkAnyBackend
$ SOITable refqt)
DRRemoteTable
in tableDep : getBoolExpDeps source refqt whereExp
where
procExps = concatMap (getBoolExpDeps source tn)
getColExpDeps
:: Backend b
=> SourceName
-> TableName b
-> AnnBoolExpFld b (PartialSQLExp b)
-> [SchemaDependency]
getColExpDeps source tn = \case
AVCol colInfo opExps ->
let cn = pgiColumn colInfo
colDepReason = bool DRSessionVariable DROnType $ any hasStaticExp opExps
colDep = mkColDep colDepReason source tn cn
depColsInOpExp = mapMaybe opExpDepCol opExps
colDepsInOpExp = map (mkColDep DROnType source tn) depColsInOpExp
in colDep:colDepsInOpExp
AVRel relInfo relBoolExp ->
let rn = riName relInfo
relTN = riRTable relInfo
pd = SchemaDependency
(SOSourceObj source
$ AB.mkAnyBackend
$ SOITableObj tn (TORel rn))
DROnType
in pd : getBoolExpDeps source relTN relBoolExp

8
server/src-lib/Hasura/RQL/Types/Source.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
module Hasura.RQL.Types.Source where
@ -7,13 +8,14 @@ import Hasura.Prelude
import qualified Data.HashMap.Strict as M
import Control.Lens
import Data.Aeson
import Data.Aeson.Extended
import Data.Aeson.TH
import qualified Hasura.SQL.AnyBackend as AB
import qualified Hasura.Tracing as Tracing
import Hasura.Backends.Postgres.Connection
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Error
@ -33,7 +35,7 @@ data SourceInfo b
, _siConfiguration :: !(SourceConfig b)
} deriving (Generic)
$(makeLenses ''SourceInfo)
instance Backend b => ToJSON (SourceInfo b) where
instance (Backend b, ToJSONKeyValue (BooleanOperators b (PartialSQLExp b))) => ToJSON (SourceInfo b) where
toJSON = genericToJSON hasuraJSON
type BackendSourceInfo = AB.AnyBackend SourceInfo

125
server/src-lib/Hasura/RQL/Types/Table.hs
View File

@ -1,5 +1,4 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}
module Hasura.RQL.Types.Table where
@ -12,13 +11,14 @@ import qualified Data.Text as T
import qualified Language.GraphQL.Draft.Syntax as G
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.Extended
import Data.Aeson.TH
import Data.List.Extended (duplicates)
import Data.Text.Extended
import qualified Hasura.Backends.Postgres.SQL.Types as PG
import qualified Hasura.Backends.Postgres.SQL.Types as PG (PGDescription)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend
@ -159,12 +159,30 @@ data InsPermInfo (b :: BackendType)
, ipiBackendOnly :: !Bool
, ipiRequiredHeaders :: ![Text]
} deriving (Generic)
instance Backend b => NFData (InsPermInfo b)
deriving instance Backend b => Eq (InsPermInfo b)
instance Backend b => Cacheable (InsPermInfo b)
instance Backend b => ToJSON (InsPermInfo b) where
deriving instance
( Backend b
, Eq (BooleanOperators b (PartialSQLExp b))
) => Eq (InsPermInfo b)
instance
( Backend b
, NFData (BooleanOperators b (PartialSQLExp b))
) => NFData (InsPermInfo b)
instance
( Backend b
, Hashable (BooleanOperators b (PartialSQLExp b))
, Cacheable (BooleanOperators b (PartialSQLExp b))
) => Cacheable (InsPermInfo b)
instance
( Backend b
, ToJSONKeyValue (BooleanOperators b (PartialSQLExp b))
) => ToJSON (InsPermInfo b) where
toJSON = genericToJSON hasuraJSON
data SelPermInfo (b :: BackendType)
= SelPermInfo
{ spiCols :: !(M.HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b)))
@ -181,12 +199,30 @@ data SelPermInfo (b :: BackendType)
, spiAllowAgg :: !Bool
, spiRequiredHeaders :: ![Text]
} deriving (Generic)
instance Backend b => NFData (SelPermInfo b)
deriving instance Backend b => Eq (SelPermInfo b)
instance Backend b => Cacheable (SelPermInfo b)
instance Backend b => ToJSON (SelPermInfo b) where
deriving instance
( Backend b
, Eq (BooleanOperators b (PartialSQLExp b))
) => Eq (SelPermInfo b)
instance
( Backend b
, NFData (BooleanOperators b (PartialSQLExp b))
) => NFData (SelPermInfo b)
instance
( Backend b
, Hashable (BooleanOperators b (PartialSQLExp b))
, Cacheable (BooleanOperators b (PartialSQLExp b))
) => Cacheable (SelPermInfo b)
instance
( Backend b
, ToJSONKeyValue (BooleanOperators b (PartialSQLExp b))
) => ToJSON (SelPermInfo b) where
toJSON = genericToJSON hasuraJSON
data UpdPermInfo (b :: BackendType)
= UpdPermInfo
{ upiCols :: !(HS.HashSet (Column b))
@ -196,24 +232,60 @@ data UpdPermInfo (b :: BackendType)
, upiSet :: !(PreSetColsPartial b)
, upiRequiredHeaders :: ![Text]
} deriving (Generic)
instance Backend b => NFData (UpdPermInfo b)
deriving instance Backend b => Eq (UpdPermInfo b)
instance Backend b => Cacheable (UpdPermInfo b)
instance Backend b => ToJSON (UpdPermInfo b) where
deriving instance
( Backend b
, Eq (BooleanOperators b (PartialSQLExp b))
) => Eq (UpdPermInfo b)
instance
( Backend b
, NFData (BooleanOperators b (PartialSQLExp b))
) => NFData (UpdPermInfo b)
instance
( Backend b
, Hashable (BooleanOperators b (PartialSQLExp b))
, Cacheable (BooleanOperators b (PartialSQLExp b))
) => Cacheable (UpdPermInfo b)
instance
( Backend b
, ToJSONKeyValue (BooleanOperators b (PartialSQLExp b))
) => ToJSON (UpdPermInfo b) where
toJSON = genericToJSON hasuraJSON
data DelPermInfo (b :: BackendType)
= DelPermInfo
{ dpiTable :: !(TableName b)
, dpiFilter :: !(AnnBoolExpPartialSQL b)
, dpiRequiredHeaders :: ![Text]
} deriving (Generic)
instance Backend b => NFData (DelPermInfo b)
deriving instance Backend b => Eq (DelPermInfo b)
instance Backend b => Cacheable (DelPermInfo b)
instance Backend b => ToJSON (DelPermInfo b) where
deriving instance
( Backend b
, Eq (BooleanOperators b (PartialSQLExp b))
) => Eq (DelPermInfo b)
instance
( Backend b
, NFData (BooleanOperators b (PartialSQLExp b))
) => NFData (DelPermInfo b)
instance
( Backend b
, Hashable (BooleanOperators b (PartialSQLExp b))
, Cacheable (BooleanOperators b (PartialSQLExp b))
) => Cacheable (DelPermInfo b)
instance
( Backend b
, ToJSONKeyValue (BooleanOperators b (PartialSQLExp b))
) => ToJSON (DelPermInfo b) where
toJSON = genericToJSON hasuraJSON
data RolePermInfo (b :: BackendType)
= RolePermInfo
{ _permIns :: !(Maybe (InsPermInfo b))
@ -221,8 +293,8 @@ data RolePermInfo (b :: BackendType)
, _permUpd :: !(Maybe (UpdPermInfo b))
, _permDel :: !(Maybe (DelPermInfo b))
} deriving (Generic)
instance Backend b => NFData (RolePermInfo b)
instance Backend b => ToJSON (RolePermInfo b) where
instance (Backend b, NFData (BooleanOperators b (PartialSQLExp b))) => NFData (RolePermInfo b)
instance (Backend b, ToJSONKeyValue (BooleanOperators b (PartialSQLExp b))) => ToJSON (RolePermInfo b) where
toJSON = genericToJSON hasuraJSON
makeLenses ''RolePermInfo
@ -317,13 +389,6 @@ isMutable :: (ViewInfo -> Bool) -> Maybe ViewInfo -> Bool
isMutable _ Nothing = True
isMutable f (Just vi) = f vi
mutableView :: (MonadError QErr m) => TableName 'Postgres
-> (ViewInfo -> Bool) -> Maybe ViewInfo
-> Text -> m ()
mutableView qt f mVI operation =
unless (isMutable f mVI) $ throw400 NotSupported $
"view " <> qt <<> " is not " <> operation
type CustomColumnNames b = HashMap (Column b) G.Name
data TableConfig b
@ -435,7 +500,7 @@ data TableInfo (b :: BackendType)
, _tiRolePermInfoMap :: !(RolePermInfoMap b)
, _tiEventTriggerInfoMap :: !EventTriggerInfoMap
} deriving (Generic)
instance Backend b => ToJSON (TableInfo b) where
instance (Backend b, ToJSONKeyValue (BooleanOperators b (PartialSQLExp b))) => ToJSON (TableInfo b) where
toJSON = genericToJSON hasuraJSON
$(makeLenses ''TableInfo)