mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-14 17:02:49 +03:00
server: generalize BoolExp (#6082)
https://github.com/hasura/graphql-engine/pull/6082
This commit is contained in:
Antoine Leblanc
GitHub
parent
b869e9c086
commit
88bd2ed022
@ -304,6 +304,7 @@ library
|
||||
, Hasura.Backends.Postgres.Connection
|
||||
, Hasura.Backends.Postgres.Execute.Mutation
|
||||
, Hasura.Backends.Postgres.Execute.RemoteJoin
|
||||
, Hasura.Backends.Postgres.Translate.BoolExp
|
||||
, Hasura.Backends.Postgres.Translate.Delete
|
||||
, Hasura.Backends.Postgres.Translate.Insert
|
||||
, Hasura.Backends.Postgres.Translate.Mutation
|
||||
@ -373,7 +374,6 @@ library
|
||||
, Hasura.RQL.Types.Table
|
||||
, Hasura.RQL.Types.SchemaCache.Build
|
||||
, Hasura.RQL.Types.SchemaCacheTypes
|
||||
, Hasura.RQL.Types.BoolExp
|
||||
, Hasura.RQL.Types.Function
|
||||
, Hasura.RQL.Types.Catalog
|
||||
, Hasura.RQL.Types.Column
|
||||
@ -427,13 +427,13 @@ library
|
||||
, Hasura.RQL.DML.Insert
|
||||
, Hasura.RQL.DML.Internal
|
||||
, Hasura.RQL.DML.Update
|
||||
, Hasura.RQL.IR.BoolExp
|
||||
, Hasura.RQL.IR.Delete
|
||||
, Hasura.RQL.IR.Insert
|
||||
, Hasura.RQL.IR.RemoteJoin
|
||||
, Hasura.RQL.IR.Returning
|
||||
, Hasura.RQL.IR.Select
|
||||
, Hasura.RQL.IR.Update
|
||||
, Hasura.RQL.GBoolExp
|
||||
, Hasura.GraphQL.Explain
|
||||
, Hasura.GraphQL.Execute.Action
|
||||
, Hasura.GraphQL.Execute.Inline
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
module Hasura.RQL.GBoolExp
|
||||
module Hasura.Backends.Postgres.Translate.BoolExp
|
||||
( toSQLBoolExp
|
||||
, getBoolExpDeps
|
||||
, annBoolExp
|
||||
@ -276,7 +276,7 @@ annBoolExp
|
||||
:: (QErrM m, TableCoreInfoRM m)
|
||||
=> OpRhsParser m v
|
||||
-> FieldInfoMap (FieldInfo 'Postgres)
|
||||
-> GBoolExp ColExp
|
||||
-> GBoolExp 'Postgres ColExp
|
||||
-> m (AnnBoolExp 'Postgres v)
|
||||
annBoolExp rhsParser fim boolExp =
|
||||
case boolExp of
|
||||
@ -354,7 +354,7 @@ convColRhs tableQual = \case
|
||||
where
|
||||
mkQCol q = S.SEQIdentifier . S.QIdentifier q . toIdentifier
|
||||
|
||||
foldExists :: GExists (AnnBoolExpFldSQL 'Postgres) -> State Word64 S.BoolExp
|
||||
foldExists :: GExists 'Postgres (AnnBoolExpFldSQL 'Postgres) -> State Word64 S.BoolExp
|
||||
foldExists (GExists qt wh) = do
|
||||
whereExp <- foldBoolExp (convColRhs (S.QualTable qt)) wh
|
||||
return $ S.mkExists (S.FISimple qt Nothing) whereExp
|
||||
@ -4,11 +4,11 @@ module Hasura.Backends.Postgres.Translate.Delete
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import Instances.TH.Lift ()
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.Backends.Postgres.Translate.BoolExp
|
||||
import Hasura.RQL.IR.Delete
|
||||
import Hasura.RQL.Types
|
||||
|
||||
|
||||
@ -8,16 +8,16 @@ module Hasura.Backends.Postgres.Translate.Insert
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.HashSet as HS
|
||||
import qualified Data.HashSet as HS
|
||||
|
||||
import Data.Text.Extended
|
||||
import Instances.TH.Lift ()
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
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.Translate.BoolExp
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.RQL.IR.Insert
|
||||
import Hasura.RQL.Types
|
||||
|
||||
|
||||
@ -10,24 +10,24 @@ module Hasura.Backends.Postgres.Translate.Select
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
|
||||
import Control.Lens hiding (op)
|
||||
import Control.Lens hiding (op)
|
||||
import Control.Monad.Writer.Strict
|
||||
import Data.Text.Extended
|
||||
import Instances.TH.Lift ()
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Rewrite
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.Translate.BoolExp
|
||||
import Hasura.EncJSON
|
||||
import Hasura.GraphQL.Schema.Common
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.RQL.IR.Select
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.SQL.Types
|
||||
|
||||
@ -4,15 +4,15 @@ module Hasura.Backends.Postgres.Translate.Update
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import Instances.TH.Lift ()
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
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.Translate.BoolExp
|
||||
import Hasura.Backends.Postgres.Translate.Insert
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.RQL.IR.Update
|
||||
import Hasura.RQL.Instances ()
|
||||
import Hasura.RQL.Instances ()
|
||||
import Hasura.RQL.Types
|
||||
|
||||
|
||||
|
||||
@ -17,10 +17,10 @@ import Data.Text.Extended
|
||||
import qualified Hasura.Backends.Postgres.Execute.Mutation as RQL
|
||||
import qualified Hasura.Backends.Postgres.Execute.RemoteJoin as RQL
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Backends.Postgres.Translate.BoolExp as RQL
|
||||
import qualified Hasura.Backends.Postgres.Translate.Insert as RQL
|
||||
import qualified Hasura.Backends.Postgres.Translate.Mutation as RQL
|
||||
import qualified Hasura.Backends.Postgres.Translate.Returning as RQL
|
||||
import qualified Hasura.RQL.GBoolExp as RQL
|
||||
import qualified Hasura.RQL.IR.Insert as RQL
|
||||
import qualified Hasura.RQL.IR.Returning as RQL
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
|
||||
@ -6,7 +6,7 @@ import qualified Hasura.RQL.IR.Insert as RQL
|
||||
import qualified Hasura.RQL.IR.Returning as RQL
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.IR.BoolExp
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
@ -41,8 +41,8 @@ import qualified Hasura.Backends.Postgres.SQL.DML as SQL
|
||||
import qualified Hasura.GraphQL.Execute.Types as ET
|
||||
import qualified Hasura.GraphQL.Parser as P
|
||||
import qualified Hasura.GraphQL.Parser.Internal.Parser as P
|
||||
import qualified Hasura.RQL.IR.BoolExp as RQL
|
||||
import qualified Hasura.RQL.IR.Select as RQL
|
||||
import qualified Hasura.RQL.Types.BoolExp as RQL
|
||||
|
||||
import Data.Text.Extended
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
|
||||
@ -112,28 +112,28 @@ instance Arbitrary J.Value where
|
||||
instance Arbitrary ColExp where
|
||||
arbitrary = genericArbitrary
|
||||
|
||||
instance Arbitrary (GExists ColExp) where
|
||||
instance Arbitrary (GExists b ColExp) where
|
||||
arbitrary = genericArbitrary
|
||||
|
||||
instance Arbitrary (GBoolExp ColExp) where
|
||||
instance Arbitrary (GBoolExp b ColExp) where
|
||||
arbitrary = genericArbitrary
|
||||
|
||||
instance Arbitrary BoolExp where
|
||||
instance Arbitrary (BoolExp b) where
|
||||
arbitrary = genericArbitrary
|
||||
|
||||
instance Arbitrary Permission.PermColSpec where
|
||||
arbitrary = genericArbitrary
|
||||
|
||||
instance Arbitrary Permission.InsPerm where
|
||||
instance Arbitrary (Permission.InsPerm b) where
|
||||
arbitrary = genericArbitrary
|
||||
|
||||
instance Arbitrary Permission.SelPerm where
|
||||
instance Arbitrary (Permission.SelPerm b) where
|
||||
arbitrary = genericArbitrary
|
||||
|
||||
instance Arbitrary Permission.UpdPerm where
|
||||
instance Arbitrary (Permission.UpdPerm b) where
|
||||
arbitrary = genericArbitrary
|
||||
|
||||
instance Arbitrary Permission.DelPerm where
|
||||
instance Arbitrary (Permission.DelPerm b) where
|
||||
arbitrary = genericArbitrary
|
||||
|
||||
instance Arbitrary SubscribeColumns where
|
||||
|
||||
@ -100,10 +100,10 @@ data TableMeta
|
||||
, _tmArrayRelationships :: ![Relationship.ArrRelDef]
|
||||
, _tmComputedFields :: ![ComputedFieldMeta]
|
||||
, _tmRemoteRelationships :: ![RemoteRelationshipMeta]
|
||||
, _tmInsertPermissions :: ![Permission.InsPermDef]
|
||||
, _tmSelectPermissions :: ![Permission.SelPermDef]
|
||||
, _tmUpdatePermissions :: ![Permission.UpdPermDef]
|
||||
, _tmDeletePermissions :: ![Permission.DelPermDef]
|
||||
, _tmInsertPermissions :: ![Permission.InsPermDef 'Postgres]
|
||||
, _tmSelectPermissions :: ![Permission.SelPermDef 'Postgres]
|
||||
, _tmUpdatePermissions :: ![Permission.UpdPermDef 'Postgres]
|
||||
, _tmDeletePermissions :: ![Permission.DelPermDef 'Postgres]
|
||||
, _tmEventTriggers :: ![EventTriggerConf]
|
||||
} deriving (Show, Eq, Lift, Generic)
|
||||
$(makeLenses ''TableMeta)
|
||||
@ -355,7 +355,7 @@ replaceMetadataToOrdJSON ( ReplaceMetadata
|
||||
, ("definition", AO.toOrdered definition)
|
||||
] <> catMaybes [maybeCommentToMaybeOrdPair comment]
|
||||
|
||||
insPermDefToOrdJSON :: Permission.InsPermDef -> AO.Value
|
||||
insPermDefToOrdJSON :: Permission.InsPermDef 'Postgres -> AO.Value
|
||||
insPermDefToOrdJSON = permDefToOrdJSON insPermToOrdJSON
|
||||
where
|
||||
insPermToOrdJSON (Permission.InsPerm check set columns mBackendOnly) =
|
||||
@ -364,7 +364,7 @@ replaceMetadataToOrdJSON ( ReplaceMetadata
|
||||
in AO.object $ [("check", AO.toOrdered check)]
|
||||
<> catMaybes [maybeSetToMaybeOrdPair set, columnsPair, backendOnlyPair]
|
||||
|
||||
selPermDefToOrdJSON :: Permission.SelPermDef -> AO.Value
|
||||
selPermDefToOrdJSON :: Permission.SelPermDef 'Postgres -> AO.Value
|
||||
selPermDefToOrdJSON = permDefToOrdJSON selPermToOrdJSON
|
||||
where
|
||||
selPermToOrdJSON (Permission.SelPerm columns fltr limit allowAgg computedFieldsPerm) =
|
||||
@ -383,7 +383,7 @@ replaceMetadataToOrdJSON ( ReplaceMetadata
|
||||
then Just ("allow_aggregations", AO.toOrdered allowAgg)
|
||||
else Nothing
|
||||
|
||||
updPermDefToOrdJSON :: Permission.UpdPermDef -> AO.Value
|
||||
updPermDefToOrdJSON :: Permission.UpdPermDef 'Postgres -> AO.Value
|
||||
updPermDefToOrdJSON = permDefToOrdJSON updPermToOrdJSON
|
||||
where
|
||||
updPermToOrdJSON (Permission.UpdPerm columns set fltr check) =
|
||||
@ -392,7 +392,7 @@ replaceMetadataToOrdJSON ( ReplaceMetadata
|
||||
, ("check", AO.toOrdered check)
|
||||
] <> catMaybes [maybeSetToMaybeOrdPair set]
|
||||
|
||||
delPermDefToOrdJSON :: Permission.DelPermDef -> AO.Value
|
||||
delPermDefToOrdJSON :: Permission.DelPermDef 'Postgres -> AO.Value
|
||||
delPermDefToOrdJSON = permDefToOrdJSON AO.toOrdered
|
||||
|
||||
permDefToOrdJSON :: (a -> AO.Value) -> Permission.PermDef a -> AO.Value
|
||||
|
||||
@ -88,18 +88,21 @@ TRUE TRUE (OR NOT-SET) TRUE
|
||||
-}
|
||||
|
||||
-- Insert permission
|
||||
data InsPerm
|
||||
data InsPerm (b :: Backend)
|
||||
= InsPerm
|
||||
{ ipCheck :: !BoolExp
|
||||
{ ipCheck :: !(BoolExp b)
|
||||
, ipSet :: !(Maybe (ColumnValues Value))
|
||||
, ipColumns :: !(Maybe PermColSpec)
|
||||
, ipBackendOnly :: !(Maybe Bool) -- see Note [Backend only permissions]
|
||||
} deriving (Show, Eq, Lift, Generic)
|
||||
instance Cacheable InsPerm
|
||||
$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''InsPerm)
|
||||
instance Cacheable (InsPerm 'Postgres)
|
||||
instance FromJSON (InsPerm 'Postgres) where
|
||||
parseJSON = genericParseJSON $ aesonDrop 2 snakeCase
|
||||
instance ToJSON (InsPerm 'Postgres) where
|
||||
toJSON = genericToJSON (aesonDrop 2 snakeCase) {omitNothingFields=True}
|
||||
|
||||
type InsPermDef = PermDef InsPerm
|
||||
type CreateInsPerm = CreatePerm InsPerm
|
||||
type InsPermDef b = PermDef (InsPerm b)
|
||||
type CreateInsPerm b = CreatePerm (InsPerm b)
|
||||
|
||||
procSetObj
|
||||
:: (QErrM m)
|
||||
@ -127,7 +130,7 @@ buildInsPermInfo
|
||||
:: (QErrM m, TableCoreInfoRM m)
|
||||
=> QualifiedTable
|
||||
-> FieldInfoMap (FieldInfo 'Postgres)
|
||||
-> PermDef InsPerm
|
||||
-> PermDef (InsPerm 'Postgres)
|
||||
-> m (WithDeps (InsPermInfo 'Postgres))
|
||||
buildInsPermInfo tn fieldInfoMap (PermDef _rn (InsPerm checkCond set mCols mBackendOnly) _) =
|
||||
withPathK "permission" $ do
|
||||
@ -149,27 +152,26 @@ buildInsPermInfo tn fieldInfoMap (PermDef _rn (InsPerm checkCond set mCols mBack
|
||||
-- TODO this is a dirty hack, hardcoding permissions to postgres. When
|
||||
-- implementing support for other backends, the type family 'PermInfo' probably
|
||||
-- needs to be refactored.
|
||||
type instance PermInfo InsPerm = InsPermInfo 'Postgres
|
||||
|
||||
instance IsPerm InsPerm where
|
||||
type instance PermInfo (InsPerm b) = InsPermInfo b
|
||||
|
||||
instance IsPerm (InsPerm 'Postgres) where
|
||||
permAccessor = PAInsert
|
||||
|
||||
buildPermInfo = buildInsPermInfo
|
||||
|
||||
-- Select constraint
|
||||
data SelPerm
|
||||
data SelPerm (b :: Backend)
|
||||
= SelPerm
|
||||
{ spColumns :: !PermColSpec -- ^ Allowed columns
|
||||
, spFilter :: !BoolExp -- ^ Filter expression
|
||||
, spFilter :: !(BoolExp b) -- ^ Filter expression
|
||||
, spLimit :: !(Maybe Int) -- ^ Limit value
|
||||
, spAllowAggregations :: !Bool -- ^ Allow aggregation
|
||||
, spComputedFields :: ![ComputedFieldName] -- ^ Allowed computed fields
|
||||
} deriving (Show, Eq, Lift, Generic)
|
||||
instance Cacheable SelPerm
|
||||
$(deriveToJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''SelPerm)
|
||||
instance Cacheable (SelPerm 'Postgres)
|
||||
instance ToJSON (SelPerm 'Postgres) where
|
||||
toJSON = genericToJSON (aesonDrop 2 snakeCase) {omitNothingFields=True}
|
||||
|
||||
instance FromJSON SelPerm where
|
||||
instance FromJSON (SelPerm 'Postgres) where
|
||||
parseJSON = withObject "SelPerm" $ \o ->
|
||||
SelPerm
|
||||
<$> o .: "columns"
|
||||
@ -182,7 +184,7 @@ buildSelPermInfo
|
||||
:: (QErrM m, TableCoreInfoRM m)
|
||||
=> QualifiedTable
|
||||
-> FieldInfoMap (FieldInfo 'Postgres)
|
||||
-> SelPerm
|
||||
-> SelPerm 'Postgres
|
||||
-> m (WithDeps (SelPermInfo 'Postgres))
|
||||
buildSelPermInfo tn fieldInfoMap sp = withPathK "permission" $ do
|
||||
let pgCols = convColSpec fieldInfoMap $ spColumns sp
|
||||
@ -221,43 +223,44 @@ buildSelPermInfo tn fieldInfoMap sp = withPathK "permission" $ do
|
||||
computedFields = spComputedFields sp
|
||||
autoInferredErr = "permissions for relationships are automatically inferred"
|
||||
|
||||
type SelPermDef = PermDef SelPerm
|
||||
type CreateSelPerm = CreatePerm SelPerm
|
||||
type SelPermDef b = PermDef (SelPerm b)
|
||||
type CreateSelPerm b = CreatePerm (SelPerm b)
|
||||
|
||||
-- TODO see TODO for PermInfo above.
|
||||
type instance PermInfo SelPerm = SelPermInfo 'Postgres
|
||||
|
||||
instance IsPerm SelPerm where
|
||||
type instance PermInfo (SelPerm b) = SelPermInfo b
|
||||
|
||||
instance IsPerm (SelPerm 'Postgres) where
|
||||
permAccessor = PASelect
|
||||
|
||||
buildPermInfo tn fieldInfoMap (PermDef _ a _) =
|
||||
buildSelPermInfo tn fieldInfoMap a
|
||||
|
||||
-- Update constraint
|
||||
data UpdPerm
|
||||
data UpdPerm b
|
||||
= UpdPerm
|
||||
{ ucColumns :: !PermColSpec -- Allowed columns
|
||||
, ucSet :: !(Maybe (ColumnValues Value)) -- Preset columns
|
||||
, ucFilter :: !BoolExp -- Filter expression (applied before update)
|
||||
, ucCheck :: !(Maybe BoolExp)
|
||||
, ucFilter :: !(BoolExp b) -- Filter expression (applied before update)
|
||||
, ucCheck :: !(Maybe (BoolExp b))
|
||||
-- ^ Check expression, which must be true after update.
|
||||
-- This is optional because we don't want to break the v1 API
|
||||
-- but Nothing should be equivalent to the expression which always
|
||||
-- returns true.
|
||||
} deriving (Show, Eq, Lift, Generic)
|
||||
instance Cacheable UpdPerm
|
||||
$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''UpdPerm)
|
||||
instance Cacheable (UpdPerm 'Postgres)
|
||||
instance FromJSON (UpdPerm 'Postgres) where
|
||||
parseJSON = genericParseJSON $ aesonDrop 2 snakeCase
|
||||
instance ToJSON (UpdPerm 'Postgres) where
|
||||
toJSON = genericToJSON (aesonDrop 2 snakeCase) {omitNothingFields=True}
|
||||
|
||||
type UpdPermDef = PermDef UpdPerm
|
||||
type CreateUpdPerm = CreatePerm UpdPerm
|
||||
type UpdPermDef b = PermDef (UpdPerm b)
|
||||
type CreateUpdPerm b = CreatePerm (UpdPerm b)
|
||||
|
||||
|
||||
buildUpdPermInfo
|
||||
:: (QErrM m, TableCoreInfoRM m)
|
||||
=> QualifiedTable
|
||||
-> FieldInfoMap (FieldInfo 'Postgres)
|
||||
-> UpdPerm
|
||||
-> UpdPerm 'Postgres
|
||||
-> m (WithDeps (UpdPermInfo 'Postgres))
|
||||
buildUpdPermInfo tn fieldInfoMap (UpdPerm colSpec set fltr check) = do
|
||||
(be, beDeps) <- withPathK "filter" $
|
||||
@ -284,30 +287,31 @@ buildUpdPermInfo tn fieldInfoMap (UpdPerm colSpec set fltr check) = do
|
||||
relInUpdErr = "relationships can't be used in update"
|
||||
|
||||
-- TODO see TODO for PermInfo above
|
||||
type instance PermInfo UpdPerm = UpdPermInfo 'Postgres
|
||||
|
||||
instance IsPerm UpdPerm where
|
||||
type instance PermInfo (UpdPerm b) = UpdPermInfo b
|
||||
|
||||
instance IsPerm (UpdPerm 'Postgres) where
|
||||
permAccessor = PAUpdate
|
||||
|
||||
buildPermInfo tn fieldInfoMap (PermDef _ a _) =
|
||||
buildUpdPermInfo tn fieldInfoMap a
|
||||
|
||||
-- Delete permission
|
||||
data DelPerm
|
||||
= DelPerm { dcFilter :: !BoolExp }
|
||||
data DelPerm (b :: Backend)
|
||||
= DelPerm { dcFilter :: !(BoolExp b) }
|
||||
deriving (Show, Eq, Lift, Generic)
|
||||
instance Cacheable DelPerm
|
||||
$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''DelPerm)
|
||||
instance Cacheable (DelPerm 'Postgres)
|
||||
instance FromJSON (DelPerm 'Postgres) where
|
||||
parseJSON = genericParseJSON $ aesonDrop 2 snakeCase
|
||||
instance ToJSON (DelPerm 'Postgres) where
|
||||
toJSON = genericToJSON (aesonDrop 2 snakeCase) {omitNothingFields=True}
|
||||
|
||||
type DelPermDef = PermDef DelPerm
|
||||
type CreateDelPerm = CreatePerm DelPerm
|
||||
type DelPermDef b = PermDef (DelPerm b)
|
||||
type CreateDelPerm b = CreatePerm (DelPerm b)
|
||||
|
||||
buildDelPermInfo
|
||||
:: (QErrM m, TableCoreInfoRM m)
|
||||
=> QualifiedTable
|
||||
-> FieldInfoMap (FieldInfo 'Postgres)
|
||||
-> DelPerm
|
||||
-> DelPerm 'Postgres
|
||||
-> m (WithDeps (DelPermInfo 'Postgres))
|
||||
buildDelPermInfo tn fieldInfoMap (DelPerm fltr) = do
|
||||
(be, beDeps) <- withPathK "filter" $
|
||||
@ -317,12 +321,10 @@ buildDelPermInfo tn fieldInfoMap (DelPerm fltr) = do
|
||||
return (DelPermInfo tn be depHeaders, deps)
|
||||
|
||||
-- TODO see TODO for PermInfo above
|
||||
type instance PermInfo DelPerm = DelPermInfo 'Postgres
|
||||
|
||||
instance IsPerm DelPerm where
|
||||
type instance PermInfo (DelPerm b) = DelPermInfo b
|
||||
|
||||
instance IsPerm (DelPerm 'Postgres) where
|
||||
permAccessor = PADelete
|
||||
|
||||
buildPermInfo tn fieldInfoMap (PermDef _ a _) =
|
||||
buildDelPermInfo tn fieldInfoMap a
|
||||
|
||||
@ -375,10 +377,10 @@ setPermCommentTx (SetPermComment (QualifiedObject sn tn) rn pt comment) =
|
||||
purgePerm :: MonadTx m => QualifiedTable -> RoleName -> PermType -> m ()
|
||||
purgePerm qt rn pt =
|
||||
case pt of
|
||||
PTInsert -> dropPermP2 @InsPerm dp
|
||||
PTSelect -> dropPermP2 @SelPerm dp
|
||||
PTUpdate -> dropPermP2 @UpdPerm dp
|
||||
PTDelete -> dropPermP2 @DelPerm dp
|
||||
PTInsert -> dropPermP2 @(InsPerm 'Postgres) dp
|
||||
PTSelect -> dropPermP2 @(SelPerm 'Postgres) dp
|
||||
PTUpdate -> dropPermP2 @(UpdPerm 'Postgres) dp
|
||||
PTDelete -> dropPermP2 @(DelPerm 'Postgres) dp
|
||||
where
|
||||
dp :: DropPerm a
|
||||
dp = DropPerm qt rn
|
||||
|
||||
@ -5,24 +5,24 @@ module Hasura.RQL.DDL.Permission.Internal where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Control.Lens hiding ((.=))
|
||||
import Control.Lens hiding ((.=))
|
||||
import Data.Aeson.Casing
|
||||
import Data.Aeson.TH
|
||||
import Data.Aeson.Types
|
||||
import Data.Text.Extended
|
||||
import Instances.TH.Lift ()
|
||||
import Language.Haskell.TH.Syntax (Lift)
|
||||
import Instances.TH.Lift ()
|
||||
import Language.Haskell.TH.Syntax (Lift)
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.SQL.Value
|
||||
import Hasura.Backends.Postgres.Translate.BoolExp
|
||||
import Hasura.EncJSON
|
||||
import Hasura.Incremental (Cacheable)
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.Incremental (Cacheable)
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Utils
|
||||
import Hasura.Session
|
||||
@ -163,7 +163,7 @@ procBoolExp
|
||||
:: (QErrM m, TableCoreInfoRM m)
|
||||
=> QualifiedTable
|
||||
-> FieldInfoMap (FieldInfo 'Postgres)
|
||||
-> BoolExp
|
||||
-> BoolExp 'Postgres
|
||||
-> m (AnnBoolExpPartialSQL 'Postgres, [SchemaDependency])
|
||||
procBoolExp tn fieldInfoMap be = do
|
||||
abe <- annBoolExp valueParser fieldInfoMap $ unBoolExp be
|
||||
@ -187,7 +187,7 @@ getDepHeadersFromVal val = case val of
|
||||
parseObject o =
|
||||
concatMap getDepHeadersFromVal (M.elems o)
|
||||
|
||||
getDependentHeaders :: BoolExp -> [Text]
|
||||
getDependentHeaders :: BoolExp b -> [Text]
|
||||
getDependentHeaders (BoolExp boolExp) =
|
||||
flip foldMap boolExp $ \(ColExp _ v) -> getDepHeadersFromVal v
|
||||
|
||||
|
||||
@ -218,7 +218,7 @@ updatePermFlds refQT rn pt rename = do
|
||||
|
||||
updateInsPermFlds
|
||||
:: (MonadTx m, CacheRM m)
|
||||
=> QualifiedTable -> Rename -> RoleName -> InsPerm -> m ()
|
||||
=> QualifiedTable -> Rename -> RoleName -> InsPerm 'Postgres -> m ()
|
||||
updateInsPermFlds refQT rename rn (InsPerm chk preset cols mBackendOnly) = do
|
||||
updatedPerm <- case rename of
|
||||
RTable rt -> do
|
||||
@ -233,7 +233,7 @@ updateInsPermFlds refQT rename rn (InsPerm chk preset cols mBackendOnly) = do
|
||||
|
||||
updateSelPermFlds
|
||||
:: (MonadTx m, CacheRM m)
|
||||
=> QualifiedTable -> Rename -> RoleName -> SelPerm -> m ()
|
||||
=> QualifiedTable -> Rename -> RoleName -> SelPerm 'Postgres -> m ()
|
||||
updateSelPermFlds refQT rename rn (SelPerm cols fltr limit aggAllwd computedFields) = do
|
||||
updatedPerm <- case rename of
|
||||
RTable rt -> do
|
||||
@ -247,7 +247,7 @@ updateSelPermFlds refQT rename rn (SelPerm cols fltr limit aggAllwd computedFiel
|
||||
|
||||
updateUpdPermFlds
|
||||
:: (MonadTx m, CacheRM m)
|
||||
=> QualifiedTable -> Rename -> RoleName -> UpdPerm -> m ()
|
||||
=> QualifiedTable -> Rename -> RoleName -> UpdPerm 'Postgres -> m ()
|
||||
updateUpdPermFlds refQT rename rn (UpdPerm cols preset fltr check) = do
|
||||
updatedPerm <- case rename of
|
||||
RTable rt -> do
|
||||
@ -264,7 +264,7 @@ updateUpdPermFlds refQT rename rn (UpdPerm cols preset fltr check) = do
|
||||
|
||||
updateDelPermFlds
|
||||
:: (MonadTx m, CacheRM m)
|
||||
=> QualifiedTable -> Rename -> RoleName -> DelPerm -> m ()
|
||||
=> QualifiedTable -> Rename -> RoleName -> DelPerm 'Postgres -> m ()
|
||||
updateDelPermFlds refQT rename rn (DelPerm fltr) = do
|
||||
updFltr <- case rename of
|
||||
RTable rt -> return $ updateTableInBoolExp rt fltr
|
||||
@ -304,14 +304,14 @@ updateCols qt rf permSpec =
|
||||
PCCols c -> PCCols $ flip map c $
|
||||
\col -> if col == oCol then nCol else col
|
||||
|
||||
updateTableInBoolExp :: RenameTable -> BoolExp -> BoolExp
|
||||
updateTableInBoolExp :: RenameTable -> BoolExp 'Postgres -> BoolExp 'Postgres
|
||||
updateTableInBoolExp (oldQT, newQT) =
|
||||
over _Wrapped . transform $ (_BoolExists . geTable) %~ \rqfQT ->
|
||||
if rqfQT == oldQT then newQT else rqfQT
|
||||
|
||||
updateFieldInBoolExp
|
||||
:: (QErrM m, CacheRM m)
|
||||
=> QualifiedTable -> RenameField -> BoolExp -> m BoolExp
|
||||
=> QualifiedTable -> RenameField -> BoolExp 'Postgres -> m (BoolExp 'Postgres)
|
||||
updateFieldInBoolExp qt rf be = BoolExp <$>
|
||||
case unBoolExp be of
|
||||
BoolAnd exps -> BoolAnd <$> procExps exps
|
||||
|
||||
@ -8,19 +8,19 @@ module Hasura.RQL.DML.Count
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.ByteString.Builder as BB
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Data.ByteString.Builder as BB
|
||||
import qualified Data.Sequence as DS
|
||||
|
||||
import Data.Aeson
|
||||
import Instances.TH.Lift ()
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.Translate.BoolExp
|
||||
import Hasura.EncJSON
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.SQL.Types
|
||||
|
||||
|
||||
@ -5,22 +5,22 @@ module Hasura.RQL.DML.Internal where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.HashSet as HS
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.HashSet as HS
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
|
||||
import Control.Lens
|
||||
import Data.Aeson.Types
|
||||
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.Error
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.SQL.Value
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.Backends.Postgres.Translate.BoolExp
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Session
|
||||
|
||||
@ -247,7 +247,7 @@ convBoolExp
|
||||
:: (UserInfoM m, QErrM m, CacheRM m)
|
||||
=> FieldInfoMap (FieldInfo 'Postgres)
|
||||
-> SelPermInfo 'Postgres
|
||||
-> BoolExp
|
||||
-> BoolExp 'Postgres
|
||||
-> SessVarBldr 'Postgres m
|
||||
-> (PGColumnType -> Value -> m S.SQLExp)
|
||||
-> m (AnnBoolExpSQL 'Postgres)
|
||||
|
||||
@ -28,7 +28,7 @@ import Hasura.RQL.Types
|
||||
import Hasura.SQL.Types
|
||||
|
||||
|
||||
type SelectQExt b = SelectG (ExtCol b) BoolExp Int
|
||||
type SelectQExt b = SelectG (ExtCol b) (BoolExp b) Int
|
||||
|
||||
-- Columns in RQL
|
||||
-- This technically doesn't need to be generalized to all backends as
|
||||
@ -64,7 +64,7 @@ instance FromJSON (ExtCol 'Postgres) where
|
||||
convSelCol :: (UserInfoM m, QErrM m, CacheRM m)
|
||||
=> FieldInfoMap (FieldInfo 'Postgres)
|
||||
-> SelPermInfo 'Postgres
|
||||
-> SelCol
|
||||
-> SelCol 'Postgres
|
||||
-> m [ExtCol 'Postgres]
|
||||
convSelCol _ _ (SCExtSimple cn) =
|
||||
return [ECSimple cn]
|
||||
@ -113,7 +113,7 @@ convWildcard fieldInfoMap selPermInfo wildcard =
|
||||
resolveStar :: (UserInfoM m, QErrM m, CacheRM m)
|
||||
=> FieldInfoMap (FieldInfo 'Postgres)
|
||||
-> SelPermInfo 'Postgres
|
||||
-> SelectQ
|
||||
-> SelectQ 'Postgres
|
||||
-> m (SelectQExt 'Postgres)
|
||||
resolveStar fim spi (SelectG selCols mWh mOb mLt mOf) = do
|
||||
procOverrides <- fmap (concat . catMaybes) $ withPathK "columns" $
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Hasura.RQL.Types.BoolExp
|
||||
module Hasura.RQL.IR.BoolExp
|
||||
( GBoolExp(..)
|
||||
, gBoolExpTrue
|
||||
, gBoolExpToJSON
|
||||
@ -33,7 +33,6 @@ module Hasura.RQL.Types.BoolExp
|
||||
, AnnBoolExpFldPartialSQL
|
||||
, AnnBoolExpPartialSQL
|
||||
|
||||
, PreSetCols
|
||||
, PreSetColsG
|
||||
, PreSetColsPartial
|
||||
) where
|
||||
@ -64,24 +63,24 @@ import Hasura.SQL.Types
|
||||
import Hasura.Session
|
||||
|
||||
|
||||
data GExists a
|
||||
data GExists (b :: Backend) a
|
||||
= GExists
|
||||
{ _geTable :: !QualifiedTable
|
||||
, _geWhere :: !(GBoolExp a)
|
||||
, _geWhere :: !(GBoolExp b a)
|
||||
} deriving (Show, Eq, Lift, Functor, Foldable, Traversable, Data, Generic)
|
||||
instance (NFData a) => NFData (GExists a)
|
||||
instance (Data a) => Plated (GExists a)
|
||||
instance (Cacheable a) => Cacheable (GExists a)
|
||||
instance (Hashable a) => Hashable (GExists a)
|
||||
instance (NFData a) => NFData (GExists b a)
|
||||
instance (Data a, Typeable b) => Plated (GExists b a)
|
||||
instance (Cacheable a) => Cacheable (GExists b a)
|
||||
instance (Hashable a) => Hashable (GExists b a)
|
||||
|
||||
gExistsToJSON :: (a -> (Text, Value)) -> GExists a -> Value
|
||||
gExistsToJSON :: (a -> (Text, Value)) -> GExists 'Postgres a -> Value
|
||||
gExistsToJSON f (GExists qt wh) =
|
||||
object [ "_table" .= qt
|
||||
, "_where" .= gBoolExpToJSON f wh
|
||||
]
|
||||
|
||||
parseGExists
|
||||
:: ((Text, Value) -> J.Parser a) -> Value -> J.Parser (GExists a)
|
||||
:: ((Text, Value) -> J.Parser a) -> Value -> J.Parser (GExists 'Postgres a)
|
||||
parseGExists f = \case
|
||||
Object o -> do
|
||||
qt <- o .: "_table"
|
||||
@ -89,22 +88,22 @@ parseGExists f = \case
|
||||
GExists qt <$> parseGBoolExp f wh
|
||||
_ -> fail "expecting an Object for _exists expression"
|
||||
|
||||
data GBoolExp a
|
||||
= BoolAnd ![GBoolExp a]
|
||||
| BoolOr ![GBoolExp a]
|
||||
| BoolNot !(GBoolExp a)
|
||||
| BoolExists !(GExists a)
|
||||
data GBoolExp (b :: Backend) a
|
||||
= BoolAnd ![GBoolExp b a]
|
||||
| BoolOr ![GBoolExp b a]
|
||||
| BoolNot !(GBoolExp b a)
|
||||
| BoolExists !(GExists b a)
|
||||
| BoolFld !a
|
||||
deriving (Show, Eq, Lift, Functor, Foldable, Traversable, Data, Generic)
|
||||
instance (NFData a) => NFData (GBoolExp a)
|
||||
instance (Data a) => Plated (GBoolExp a)
|
||||
instance (Cacheable a) => Cacheable (GBoolExp a)
|
||||
instance (Hashable a) => Hashable (GBoolExp a)
|
||||
instance (NFData a) => NFData (GBoolExp b a)
|
||||
instance (Data a, Typeable b) => Plated (GBoolExp b a)
|
||||
instance (Cacheable a) => Cacheable (GBoolExp b a)
|
||||
instance (Hashable a) => Hashable (GBoolExp b a)
|
||||
|
||||
gBoolExpTrue :: GBoolExp a
|
||||
gBoolExpTrue :: GBoolExp b a
|
||||
gBoolExpTrue = BoolAnd []
|
||||
|
||||
gBoolExpToJSON :: (a -> (Text, Value)) -> GBoolExp a -> Value
|
||||
gBoolExpToJSON :: (a -> (Text, Value)) -> GBoolExp 'Postgres a -> Value
|
||||
gBoolExpToJSON f be = case be of
|
||||
-- special encoding for _and
|
||||
BoolAnd bExps ->
|
||||
@ -125,7 +124,7 @@ gBoolExpToJSON f be = case be of
|
||||
|
||||
|
||||
parseGBoolExp
|
||||
:: ((Text, Value) -> J.Parser a) -> Value -> J.Parser (GBoolExp a)
|
||||
:: ((Text, Value) -> J.Parser a) -> Value -> J.Parser (GBoolExp 'Postgres a)
|
||||
parseGBoolExp f = \case
|
||||
Object o -> do
|
||||
boolExps <- forM (M.toList o) $ \(k, v) -> if
|
||||
@ -327,7 +326,7 @@ instance (Cacheable a) => Cacheable (AnnBoolExpFld 'Postgres a)
|
||||
instance (Hashable a) => Hashable (AnnBoolExpFld 'Postgres a)
|
||||
|
||||
type AnnBoolExp b a
|
||||
= GBoolExp (AnnBoolExpFld b a)
|
||||
= GBoolExp b (AnnBoolExpFld b a)
|
||||
|
||||
traverseAnnBoolExp
|
||||
:: (Applicative f)
|
||||
@ -363,7 +362,6 @@ type AnnBoolExpPartialSQL b = AnnBoolExp b (PartialSQLExp b)
|
||||
|
||||
type PreSetColsG b v = M.HashMap (Column b) v
|
||||
type PreSetColsPartial b = M.HashMap (Column b) (PartialSQLExp b)
|
||||
type PreSetCols = M.HashMap PGCol S.SQLExp
|
||||
|
||||
-- doesn't resolve the session variable
|
||||
data PartialSQLExp (b :: Backend)
|
||||
@ -5,8 +5,8 @@ import Hasura.Prelude
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.IR.BoolExp
|
||||
import Hasura.RQL.IR.Returning
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
|
||||
@ -6,8 +6,8 @@ import Hasura.Prelude
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.IR.BoolExp
|
||||
import Hasura.RQL.IR.Returning
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
@ -17,7 +17,7 @@ import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.GraphQL.Parser.Schema
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.IR.BoolExp
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.DML
|
||||
@ -26,6 +26,7 @@ import Hasura.RQL.Types.RemoteRelationship
|
||||
import Hasura.RQL.Types.RemoteSchema
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
|
||||
data JsonAggSelect
|
||||
= JASMultipleRows
|
||||
| JASSingleObject
|
||||
|
||||
@ -6,8 +6,8 @@ import Hasura.Prelude
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.IR.BoolExp
|
||||
import Hasura.RQL.IR.Returning
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
@ -48,8 +48,8 @@ import Data.Text.Extended
|
||||
|
||||
import Hasura.Backends.Postgres.Connection as R
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.IR.BoolExp as R
|
||||
import Hasura.RQL.Types.Action as R
|
||||
import Hasura.RQL.Types.BoolExp as R
|
||||
import Hasura.RQL.Types.Column as R
|
||||
import Hasura.RQL.Types.Common as R
|
||||
import Hasura.RQL.Types.ComputedField as R
|
||||
|
||||
@ -84,7 +84,10 @@ import Hasura.SQL.Backend
|
||||
type family ScalarType (b :: Backend) where
|
||||
ScalarType 'Postgres = PGScalarType
|
||||
|
||||
type family Column (b :: Backend) where
|
||||
type family ColumnType (b :: Backend) where
|
||||
ColumnType 'Postgres = PGType
|
||||
|
||||
type family Column (b :: Backend) where
|
||||
Column 'Postgres = PGCol
|
||||
|
||||
|
||||
@ -198,6 +201,7 @@ data MutateResp a
|
||||
} deriving (Show, Eq)
|
||||
$(deriveJSON (aesonDrop 3 snakeCase) ''MutateResp)
|
||||
|
||||
|
||||
type ColMapping = HM.HashMap PGCol PGCol
|
||||
|
||||
-- | Postgres OIDs. <https://www.postgresql.org/docs/12/datatype-oid.html>
|
||||
|
||||
@ -57,9 +57,11 @@ import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Incremental (Cacheable)
|
||||
import Hasura.RQL.IR.BoolExp
|
||||
import Hasura.RQL.Instances ()
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
|
||||
data ColExp
|
||||
= ColExp
|
||||
@ -69,20 +71,20 @@ data ColExp
|
||||
instance NFData ColExp
|
||||
instance Cacheable ColExp
|
||||
|
||||
newtype BoolExp
|
||||
= BoolExp { unBoolExp :: GBoolExp ColExp }
|
||||
newtype BoolExp (b :: Backend)
|
||||
= BoolExp { unBoolExp :: GBoolExp b ColExp }
|
||||
deriving (Show, Eq, Lift, Generic, NFData, Cacheable)
|
||||
|
||||
$(makeWrapped ''BoolExp)
|
||||
|
||||
instance ToJSON BoolExp where
|
||||
instance ToJSON (BoolExp 'Postgres) where
|
||||
toJSON (BoolExp gBoolExp) =
|
||||
gBoolExpToJSON f gBoolExp
|
||||
where
|
||||
f (ColExp k v) =
|
||||
(getFieldNameTxt k, v)
|
||||
|
||||
instance FromJSON BoolExp where
|
||||
instance FromJSON (BoolExp 'Postgres) where
|
||||
parseJSON =
|
||||
fmap BoolExp . parseGBoolExp f
|
||||
where
|
||||
@ -263,13 +265,15 @@ parseWildcard =
|
||||
fromList = foldr1 (\_ x -> StarDot x)
|
||||
|
||||
-- Columns in RQL
|
||||
data SelCol
|
||||
data SelCol b
|
||||
= SCStar !Wildcard
|
||||
| SCExtSimple !PGCol
|
||||
| SCExtRel !RelName !(Maybe RelName) !SelectQ
|
||||
deriving (Show, Eq, Lift)
|
||||
| SCExtSimple !(Column b)
|
||||
| SCExtRel !RelName !(Maybe RelName) !(SelectQ b)
|
||||
deriving instance Eq (SelCol 'Postgres)
|
||||
deriving instance Lift (SelCol 'Postgres)
|
||||
deriving instance Show (SelCol 'Postgres)
|
||||
|
||||
instance FromJSON SelCol where
|
||||
instance FromJSON (SelCol 'Postgres) where
|
||||
parseJSON (String s) =
|
||||
case AT.parseOnly parseWildcard s of
|
||||
Left _ -> SCExtSimple <$> parseJSON (String s)
|
||||
@ -285,7 +289,7 @@ instance FromJSON SelCol where
|
||||
, "object (relationship)"
|
||||
]
|
||||
|
||||
instance ToJSON SelCol where
|
||||
instance ToJSON (SelCol 'Postgres) where
|
||||
toJSON (SCStar wc) = String $ wcToText wc
|
||||
toJSON (SCExtSimple s) = toJSON s
|
||||
toJSON (SCExtRel rn mrn selq) =
|
||||
@ -293,17 +297,13 @@ instance ToJSON SelCol where
|
||||
, "alias" .= mrn
|
||||
] ++ selectGToPairs selq
|
||||
|
||||
type SelectQ = SelectG SelCol BoolExp Int
|
||||
type SelectQT = SelectG SelCol BoolExp Value
|
||||
type SelectQ b = SelectG (SelCol b) (BoolExp b) Int
|
||||
type SelectQT b = SelectG (SelCol b) (BoolExp b) Value
|
||||
|
||||
type SelectQuery = DMLQuery SelectQ
|
||||
type SelectQueryT = DMLQuery SelectQT
|
||||
type SelectQuery = DMLQuery (SelectQ 'Postgres)
|
||||
type SelectQueryT = DMLQuery (SelectQT 'Postgres)
|
||||
|
||||
instance ToJSON SelectQuery where
|
||||
toJSON (DMLQuery qt selQ) =
|
||||
object $ "table" .= qt : selectGToPairs selQ
|
||||
|
||||
instance ToJSON SelectQueryT where
|
||||
instance ToJSON a => ToJSON (DMLQuery (SelectG (SelCol 'Postgres) (BoolExp 'Postgres) a)) where
|
||||
toJSON (DMLQuery qt selQ) =
|
||||
object $ "table" .= qt : selectGToPairs selQ
|
||||
|
||||
@ -367,7 +367,7 @@ type UpdVals = ColumnValues Value
|
||||
data UpdateQuery
|
||||
= UpdateQuery
|
||||
{ uqTable :: !QualifiedTable
|
||||
, uqWhere :: !BoolExp
|
||||
, uqWhere :: !(BoolExp 'Postgres)
|
||||
, uqSet :: !UpdVals
|
||||
, uqInc :: !UpdVals
|
||||
, uqMul :: !UpdVals
|
||||
@ -402,7 +402,7 @@ instance ToJSON UpdateQuery where
|
||||
data DeleteQuery
|
||||
= DeleteQuery
|
||||
{ doTable :: !QualifiedTable
|
||||
, doWhere :: !BoolExp -- where clause
|
||||
, doWhere :: !(BoolExp 'Postgres) -- where clause
|
||||
, doReturning :: !(Maybe [PGCol]) -- columns returning
|
||||
} deriving (Show, Eq, Lift)
|
||||
|
||||
@ -412,7 +412,7 @@ data CountQuery
|
||||
= CountQuery
|
||||
{ cqTable :: !QualifiedTable
|
||||
, cqDistinct :: !(Maybe [PGCol])
|
||||
, cqWhere :: !(Maybe BoolExp)
|
||||
, cqWhere :: !(Maybe (BoolExp 'Postgres))
|
||||
} deriving (Show, Eq, Lift)
|
||||
|
||||
$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''CountQuery)
|
||||
@ -422,8 +422,8 @@ data QueryT
|
||||
| QTSelect !SelectQueryT
|
||||
| QTUpdate !UpdateQuery
|
||||
| QTDelete !DeleteQuery
|
||||
| QTCount !CountQuery
|
||||
| QTBulk ![QueryT]
|
||||
| QTCount !CountQuery
|
||||
| QTBulk ![QueryT]
|
||||
deriving (Show, Eq, Lift)
|
||||
|
||||
$(deriveJSON
|
||||
|
||||
@ -134,8 +134,8 @@ import Hasura.Backends.Postgres.Connection
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.GraphQL.Context (GQLContext, RemoteField, RoleContext)
|
||||
import Hasura.Incremental (Dependency, MonadDepend (..), selectKeyD)
|
||||
import Hasura.RQL.IR.BoolExp
|
||||
import Hasura.RQL.Types.Action
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.ComputedField
|
||||
import Hasura.RQL.Types.CustomTypes
|
||||
|
||||
@ -98,7 +98,7 @@ import Language.Haskell.TH.Syntax (Lift)
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Incremental (Cacheable)
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.IR.BoolExp
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.ComputedField
|
||||
|
||||
@ -67,15 +67,15 @@ data RQLQueryV1
|
||||
| RQUpdateRemoteRelationship !RemoteRelationship
|
||||
| RQDeleteRemoteRelationship !DeleteRemoteRelationship
|
||||
|
||||
| RQCreateInsertPermission !CreateInsPerm
|
||||
| RQCreateSelectPermission !CreateSelPerm
|
||||
| RQCreateUpdatePermission !CreateUpdPerm
|
||||
| RQCreateDeletePermission !CreateDelPerm
|
||||
| RQCreateInsertPermission !(CreateInsPerm 'Postgres)
|
||||
| RQCreateSelectPermission !(CreateSelPerm 'Postgres)
|
||||
| RQCreateUpdatePermission !(CreateUpdPerm 'Postgres)
|
||||
| RQCreateDeletePermission !(CreateDelPerm 'Postgres)
|
||||
|
||||
| RQDropInsertPermission !(DropPerm InsPerm)
|
||||
| RQDropSelectPermission !(DropPerm SelPerm)
|
||||
| RQDropUpdatePermission !(DropPerm UpdPerm)
|
||||
| RQDropDeletePermission !(DropPerm DelPerm)
|
||||
| RQDropInsertPermission !(DropPerm (InsPerm 'Postgres))
|
||||
| RQDropSelectPermission !(DropPerm (SelPerm 'Postgres))
|
||||
| RQDropUpdatePermission !(DropPerm (UpdPerm 'Postgres))
|
||||
| RQDropDeletePermission !(DropPerm (DelPerm 'Postgres))
|
||||
| RQSetPermissionComment !SetPermComment
|
||||
|
||||
| RQGetInconsistentMetadata !GetInconsistentMetadata
|
||||
@ -363,88 +363,88 @@ runQueryM env rq = withPathK "args" $ case rq of
|
||||
RQV2 q -> runQueryV2M q
|
||||
where
|
||||
runQueryV1M = \case
|
||||
RQAddExistingTableOrView q -> runTrackTableQ q
|
||||
RQTrackTable q -> runTrackTableQ q
|
||||
RQUntrackTable q -> runUntrackTableQ q
|
||||
RQSetTableIsEnum q -> runSetExistingTableIsEnumQ q
|
||||
RQAddExistingTableOrView q -> runTrackTableQ q
|
||||
RQTrackTable q -> runTrackTableQ q
|
||||
RQUntrackTable q -> runUntrackTableQ q
|
||||
RQSetTableIsEnum q -> runSetExistingTableIsEnumQ q
|
||||
|
||||
RQTrackFunction q -> runTrackFunc q
|
||||
RQUntrackFunction q -> runUntrackFunc q
|
||||
RQTrackFunction q -> runTrackFunc q
|
||||
RQUntrackFunction q -> runUntrackFunc q
|
||||
|
||||
RQCreateObjectRelationship q -> runCreateRelationship ObjRel q
|
||||
RQCreateArrayRelationship q -> runCreateRelationship ArrRel q
|
||||
RQDropRelationship q -> runDropRel q
|
||||
RQSetRelationshipComment q -> runSetRelComment q
|
||||
RQRenameRelationship q -> runRenameRel q
|
||||
RQCreateObjectRelationship q -> runCreateRelationship ObjRel q
|
||||
RQCreateArrayRelationship q -> runCreateRelationship ArrRel q
|
||||
RQDropRelationship q -> runDropRel q
|
||||
RQSetRelationshipComment q -> runSetRelComment q
|
||||
RQRenameRelationship q -> runRenameRel q
|
||||
|
||||
RQAddComputedField q -> runAddComputedField q
|
||||
RQDropComputedField q -> runDropComputedField q
|
||||
RQAddComputedField q -> runAddComputedField q
|
||||
RQDropComputedField q -> runDropComputedField q
|
||||
|
||||
RQCreateInsertPermission q -> runCreatePerm q
|
||||
RQCreateSelectPermission q -> runCreatePerm q
|
||||
RQCreateUpdatePermission q -> runCreatePerm q
|
||||
RQCreateDeletePermission q -> runCreatePerm q
|
||||
RQCreateInsertPermission q -> runCreatePerm q
|
||||
RQCreateSelectPermission q -> runCreatePerm q
|
||||
RQCreateUpdatePermission q -> runCreatePerm q
|
||||
RQCreateDeletePermission q -> runCreatePerm q
|
||||
|
||||
RQDropInsertPermission q -> runDropPerm q
|
||||
RQDropSelectPermission q -> runDropPerm q
|
||||
RQDropUpdatePermission q -> runDropPerm q
|
||||
RQDropDeletePermission q -> runDropPerm q
|
||||
RQSetPermissionComment q -> runSetPermComment q
|
||||
RQDropInsertPermission q -> runDropPerm q
|
||||
RQDropSelectPermission q -> runDropPerm q
|
||||
RQDropUpdatePermission q -> runDropPerm q
|
||||
RQDropDeletePermission q -> runDropPerm q
|
||||
RQSetPermissionComment q -> runSetPermComment q
|
||||
|
||||
RQGetInconsistentMetadata q -> runGetInconsistentMetadata q
|
||||
RQDropInconsistentMetadata q -> runDropInconsistentMetadata q
|
||||
RQGetInconsistentMetadata q -> runGetInconsistentMetadata q
|
||||
RQDropInconsistentMetadata q -> runDropInconsistentMetadata q
|
||||
|
||||
RQInsert q -> runInsert env q
|
||||
RQSelect q -> runSelect q
|
||||
RQUpdate q -> runUpdate env q
|
||||
RQDelete q -> runDelete env q
|
||||
RQCount q -> runCount q
|
||||
RQInsert q -> runInsert env q
|
||||
RQSelect q -> runSelect q
|
||||
RQUpdate q -> runUpdate env q
|
||||
RQDelete q -> runDelete env q
|
||||
RQCount q -> runCount q
|
||||
|
||||
RQAddRemoteSchema q -> runAddRemoteSchema env q
|
||||
RQRemoveRemoteSchema q -> runRemoveRemoteSchema q
|
||||
RQReloadRemoteSchema q -> runReloadRemoteSchema q
|
||||
RQIntrospectRemoteSchema q -> runIntrospectRemoteSchema q
|
||||
RQAddRemoteSchema q -> runAddRemoteSchema env q
|
||||
RQRemoveRemoteSchema q -> runRemoveRemoteSchema q
|
||||
RQReloadRemoteSchema q -> runReloadRemoteSchema q
|
||||
RQIntrospectRemoteSchema q -> runIntrospectRemoteSchema q
|
||||
|
||||
RQCreateRemoteRelationship q -> runCreateRemoteRelationship q
|
||||
RQUpdateRemoteRelationship q -> runUpdateRemoteRelationship q
|
||||
RQDeleteRemoteRelationship q -> runDeleteRemoteRelationship q
|
||||
RQCreateRemoteRelationship q -> runCreateRemoteRelationship q
|
||||
RQUpdateRemoteRelationship q -> runUpdateRemoteRelationship q
|
||||
RQDeleteRemoteRelationship q -> runDeleteRemoteRelationship q
|
||||
|
||||
RQCreateEventTrigger q -> runCreateEventTriggerQuery q
|
||||
RQDeleteEventTrigger q -> runDeleteEventTriggerQuery q
|
||||
RQRedeliverEvent q -> runRedeliverEvent q
|
||||
RQInvokeEventTrigger q -> runInvokeEventTrigger q
|
||||
RQCreateEventTrigger q -> runCreateEventTriggerQuery q
|
||||
RQDeleteEventTrigger q -> runDeleteEventTriggerQuery q
|
||||
RQRedeliverEvent q -> runRedeliverEvent q
|
||||
RQInvokeEventTrigger q -> runInvokeEventTrigger q
|
||||
|
||||
RQCreateCronTrigger q -> runCreateCronTrigger q
|
||||
RQDeleteCronTrigger q -> runDeleteCronTrigger q
|
||||
RQCreateCronTrigger q -> runCreateCronTrigger q
|
||||
RQDeleteCronTrigger q -> runDeleteCronTrigger q
|
||||
|
||||
RQCreateScheduledEvent q -> runCreateScheduledEvent q
|
||||
RQCreateScheduledEvent q -> runCreateScheduledEvent q
|
||||
|
||||
RQCreateQueryCollection q -> runCreateCollection q
|
||||
RQDropQueryCollection q -> runDropCollection q
|
||||
RQAddQueryToCollection q -> runAddQueryToCollection q
|
||||
RQDropQueryFromCollection q -> runDropQueryFromCollection q
|
||||
RQAddCollectionToAllowlist q -> runAddCollectionToAllowlist q
|
||||
RQDropCollectionFromAllowlist q -> runDropCollectionFromAllowlist q
|
||||
RQCreateQueryCollection q -> runCreateCollection q
|
||||
RQDropQueryCollection q -> runDropCollection q
|
||||
RQAddQueryToCollection q -> runAddQueryToCollection q
|
||||
RQDropQueryFromCollection q -> runDropQueryFromCollection q
|
||||
RQAddCollectionToAllowlist q -> runAddCollectionToAllowlist q
|
||||
RQDropCollectionFromAllowlist q -> runDropCollectionFromAllowlist q
|
||||
|
||||
RQReplaceMetadata q -> runReplaceMetadata q
|
||||
RQClearMetadata q -> runClearMetadata q
|
||||
RQExportMetadata q -> runExportMetadata q
|
||||
RQReloadMetadata q -> runReloadMetadata q
|
||||
RQReplaceMetadata q -> runReplaceMetadata q
|
||||
RQClearMetadata q -> runClearMetadata q
|
||||
RQExportMetadata q -> runExportMetadata q
|
||||
RQReloadMetadata q -> runReloadMetadata q
|
||||
|
||||
RQCreateAction q -> runCreateAction q
|
||||
RQDropAction q -> runDropAction q
|
||||
RQUpdateAction q -> runUpdateAction q
|
||||
RQCreateActionPermission q -> runCreateActionPermission q
|
||||
RQDropActionPermission q -> runDropActionPermission q
|
||||
RQCreateAction q -> runCreateAction q
|
||||
RQDropAction q -> runDropAction q
|
||||
RQUpdateAction q -> runUpdateAction q
|
||||
RQCreateActionPermission q -> runCreateActionPermission q
|
||||
RQDropActionPermission q -> runDropActionPermission q
|
||||
|
||||
RQDumpInternalState q -> runDumpInternalState q
|
||||
RQDumpInternalState q -> runDumpInternalState q
|
||||
|
||||
RQRunSql q -> runRunSQL q
|
||||
RQRunSql q -> runRunSQL q
|
||||
|
||||
RQSetCustomTypes q -> runSetCustomTypes q
|
||||
RQSetTableCustomization q -> runSetTableCustomization q
|
||||
RQSetCustomTypes q -> runSetCustomTypes q
|
||||
RQSetTableCustomization q -> runSetTableCustomization q
|
||||
|
||||
RQBulk qs -> encJFromList <$> indexedMapM (runQueryM env) qs
|
||||
RQBulk qs -> encJFromList <$> indexedMapM (runQueryM env) qs
|
||||
|
||||
runQueryV2M = \case
|
||||
RQV2TrackTable q -> runTrackTableV2Q q
|
||||
|
||||
Loading…
Reference in New Issue
Block a user