{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.DDL.Permission.Internal
  ( CreatePerm (..),
    DropPerm (..),
    permissionIsDefined,
    assertPermDefined,
    interpColSpec,
    getDepHeadersFromVal,
    getDependentHeaders,
    annBoolExp,
    procBoolExp,
    procLogicalModelBoolExp,
  )
where

import Control.Lens hiding ((.=))
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.Types
import Data.Has
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as Set
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.LogicalModel.Types (LogicalModelName)
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BoolExp
import Hasura.RQL.Types.Column (ColumnReference (ColumnReferenceColumn), StructuredColumnInfo (..))
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.Roles (RoleName)
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.Server.Utils
import Hasura.Table.Cache

-- | Intrepet a 'PermColSpec' column specification, which can either refer to a
-- list of named columns or all columns.
interpColSpec :: [Column b] -> PermColSpec b -> [Column b]
interpColSpec :: forall (b :: BackendType).
[Column b] -> PermColSpec b -> [Column b]
interpColSpec [Column b]
_ (PCCols [Column b]
cols) = [Column b]
cols
interpColSpec [Column b]
allColumns PermColSpec b
PCStar = [Column b]
allColumns

permissionIsDefined ::
  PermType -> RolePermInfo backend -> Bool
permissionIsDefined :: forall (backend :: BackendType).
PermType -> RolePermInfo backend -> Bool
permissionIsDefined PermType
pt RolePermInfo backend
rpi = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust
  case PermType
pt of
    PermType
PTSelect -> RolePermInfo backend
rpi RolePermInfo backend
-> Getting
     (Maybe (SelPermInfo backend))
     (RolePermInfo backend)
     (Maybe (SelPermInfo backend))
-> Maybe (SelPermInfo backend)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (SelPermInfo backend))
  (RolePermInfo backend)
  (Maybe (SelPermInfo backend))
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Maybe (SelPermInfo b) -> f (Maybe (SelPermInfo b)))
-> RolePermInfo b -> f (RolePermInfo b)
permSel Maybe (SelPermInfo backend) -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
    PermType
PTInsert -> RolePermInfo backend
rpi RolePermInfo backend
-> Getting
     (Maybe (InsPermInfo backend))
     (RolePermInfo backend)
     (Maybe (InsPermInfo backend))
-> Maybe (InsPermInfo backend)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (InsPermInfo backend))
  (RolePermInfo backend)
  (Maybe (InsPermInfo backend))
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Maybe (InsPermInfo b) -> f (Maybe (InsPermInfo b)))
-> RolePermInfo b -> f (RolePermInfo b)
permIns Maybe (InsPermInfo backend) -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
    PermType
PTUpdate -> RolePermInfo backend
rpi RolePermInfo backend
-> Getting
     (Maybe (UpdPermInfo backend))
     (RolePermInfo backend)
     (Maybe (UpdPermInfo backend))
-> Maybe (UpdPermInfo backend)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (UpdPermInfo backend))
  (RolePermInfo backend)
  (Maybe (UpdPermInfo backend))
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Maybe (UpdPermInfo b) -> f (Maybe (UpdPermInfo b)))
-> RolePermInfo b -> f (RolePermInfo b)
permUpd Maybe (UpdPermInfo backend) -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
    PermType
PTDelete -> RolePermInfo backend
rpi RolePermInfo backend
-> Getting
     (Maybe (DelPermInfo backend))
     (RolePermInfo backend)
     (Maybe (DelPermInfo backend))
-> Maybe (DelPermInfo backend)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (DelPermInfo backend))
  (RolePermInfo backend)
  (Maybe (DelPermInfo backend))
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Maybe (DelPermInfo b) -> f (Maybe (DelPermInfo b)))
-> RolePermInfo b -> f (RolePermInfo b)
permDel Maybe (DelPermInfo backend) -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

assertPermDefined ::
  (Backend backend, MonadError QErr m) =>
  RoleName ->
  PermType ->
  TableInfo backend ->
  m ()
assertPermDefined :: forall (backend :: BackendType) (m :: * -> *).
(Backend backend, MonadError QErr m) =>
RoleName -> PermType -> TableInfo backend -> m ()
assertPermDefined RoleName
role PermType
pt TableInfo backend
tableInfo =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((RolePermInfo backend -> Bool)
-> Maybe (RolePermInfo backend) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (PermType -> RolePermInfo backend -> Bool
forall (backend :: BackendType).
PermType -> RolePermInfo backend -> Bool
permissionIsDefined PermType
pt) Maybe (RolePermInfo backend)
rpi)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
PermissionDenied
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"'"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PermType -> Text
forall a. Show a => a -> Text
tshow PermType
pt
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" permission on "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableInfo backend -> TableName backend
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo backend
tableInfo
    TableName backend -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for role "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
role
    RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
  where
    rpi :: Maybe (RolePermInfo backend)
rpi = RoleName
-> HashMap RoleName (RolePermInfo backend)
-> Maybe (RolePermInfo backend)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup RoleName
role (HashMap RoleName (RolePermInfo backend)
 -> Maybe (RolePermInfo backend))
-> HashMap RoleName (RolePermInfo backend)
-> Maybe (RolePermInfo backend)
forall a b. (a -> b) -> a -> b
$ TableInfo backend -> HashMap RoleName (RolePermInfo backend)
forall (b :: BackendType). TableInfo b -> RolePermInfoMap b
_tiRolePermInfoMap TableInfo backend
tableInfo

newtype CreatePerm a b = CreatePerm (WithTable b (PermDef b a))

deriving instance (Backend b, FromJSON (PermDef b a)) => FromJSON (CreatePerm a b)

data CreatePermP1Res a = CreatePermP1Res
  { forall a. CreatePermP1Res a -> a
cprInfo :: a,
    forall a. CreatePermP1Res a -> [SchemaDependency]
cprDeps :: [SchemaDependency]
  }
  deriving (Int -> CreatePermP1Res a -> ShowS
[CreatePermP1Res a] -> ShowS
CreatePermP1Res a -> String
(Int -> CreatePermP1Res a -> ShowS)
-> (CreatePermP1Res a -> String)
-> ([CreatePermP1Res a] -> ShowS)
-> Show (CreatePermP1Res a)
forall a. Show a => Int -> CreatePermP1Res a -> ShowS
forall a. Show a => [CreatePermP1Res a] -> ShowS
forall a. Show a => CreatePermP1Res a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CreatePermP1Res a -> ShowS
showsPrec :: Int -> CreatePermP1Res a -> ShowS
$cshow :: forall a. Show a => CreatePermP1Res a -> String
show :: CreatePermP1Res a -> String
$cshowList :: forall a. Show a => [CreatePermP1Res a] -> ShowS
showList :: [CreatePermP1Res a] -> ShowS
Show, CreatePermP1Res a -> CreatePermP1Res a -> Bool
(CreatePermP1Res a -> CreatePermP1Res a -> Bool)
-> (CreatePermP1Res a -> CreatePermP1Res a -> Bool)
-> Eq (CreatePermP1Res a)
forall a. Eq a => CreatePermP1Res a -> CreatePermP1Res a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CreatePermP1Res a -> CreatePermP1Res a -> Bool
== :: CreatePermP1Res a -> CreatePermP1Res a -> Bool
$c/= :: forall a. Eq a => CreatePermP1Res a -> CreatePermP1Res a -> Bool
/= :: CreatePermP1Res a -> CreatePermP1Res a -> Bool
Eq)

procBoolExp ::
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b,
    MonadReader r m,
    Has (ScalarTypeParsingContext b) r
  ) =>
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  BoolExp b ->
  m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
procBoolExp :: forall (m :: * -> *) (b :: BackendType) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
procBoolExp SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap BoolExp b
be = do
  let rhsParser :: BoolExpRHSParser b m (PartialSQLExp b)
rhsParser = ValueParser b m (PartialSQLExp b)
-> PartialSQLExp b -> BoolExpRHSParser b m (PartialSQLExp b)
forall (b :: BackendType) (m :: * -> *) v.
ValueParser b m v -> v -> BoolExpRHSParser b m v
BoolExpRHSParser ValueParser b m (PartialSQLExp b)
forall (b :: BackendType) (m :: * -> *) r.
(BackendMetadata b, MonadError QErr m, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
CollectableType (ColumnType b) -> Value -> m (PartialSQLExp b)
forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
CollectableType (ColumnType b) -> Value -> m (PartialSQLExp b)
parseCollectableType PartialSQLExp b
forall (backend :: BackendType). PartialSQLExp backend
PSESession

  FieldInfoMap (FieldInfo b)
rootFieldInfoMap <-
    (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> FieldInfoMap (FieldInfo b))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> m (FieldInfoMap (FieldInfo b))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap
      (m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
 -> m (FieldInfoMap (FieldInfo b)))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> m (FieldInfoMap (FieldInfo b))
forall a b. (a -> b) -> a -> b
$ TableName b
-> m (Maybe (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)))
forall (b :: BackendType) (m :: * -> *).
TableCoreInfoRM b m =>
TableName b -> m (Maybe (TableCoreInfo b))
lookupTableCoreInfo TableName b
tn
      m (Maybe (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
`onNothingM` Text -> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"unexpected: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
tn TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" doesn't exist")

  AnnBoolExpPartialSQL b
abe <- BoolExpRHSParser b m (PartialSQLExp b)
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExpPartialSQL b)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m (PartialSQLExp b)
rhsParser FieldInfoMap (FieldInfo b)
rootFieldInfoMap FieldInfoMap (FieldInfo b)
fieldInfoMap (GBoolExp b ColExp -> m (AnnBoolExpPartialSQL b))
-> GBoolExp b ColExp -> m (AnnBoolExpPartialSQL b)
forall a b. (a -> b) -> a -> b
$ BoolExp b -> GBoolExp b ColExp
forall (b :: BackendType). BoolExp b -> GBoolExp b ColExp
unBoolExp BoolExp b
be
  let deps :: [SchemaDependency]
deps = SourceName
-> TableName b -> AnnBoolExpPartialSQL b -> [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> TableName b -> AnnBoolExpPartialSQL b -> [SchemaDependency]
getBoolExpDeps SourceName
source TableName b
tn AnnBoolExpPartialSQL b
abe
  (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnBoolExpPartialSQL b
abe, [SchemaDependency] -> Seq SchemaDependency
forall a. [a] -> Seq a
Seq.fromList [SchemaDependency]
deps)

-- | Interpret a 'BoolExp' into an 'AnnBoolExp', collecting any dependencies as
-- we go. At the moment, the only dependencies we're likely to encounter are
-- independent dependencies on other tables. For example, "this user can only
-- select from this logical model if their ID is in the @allowed_users@ table".
procLogicalModelBoolExp ::
  forall b m r.
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b,
    MonadReader r m,
    Has (ScalarTypeParsingContext b) r
  ) =>
  SourceName ->
  LogicalModelName ->
  FieldInfoMap (FieldInfo b) ->
  BoolExp b ->
  m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
procLogicalModelBoolExp :: forall (b :: BackendType) (m :: * -> *) r.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b,
 GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> LogicalModelName
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
procLogicalModelBoolExp SourceName
source LogicalModelName
lmn FieldInfoMap (FieldInfo b)
fieldInfoMap BoolExp b
be = do
  let -- The parser for the "right hand side" of operations. We use @rhsParser@
      -- as the name here for ease of grepping, though it's maybe a bit vague.
      -- More specifically, if we think of an operation that combines a field
      -- (such as those in tables or native queries) on the /left/ with a value
      -- or session variable on the /right/, this is a parser for the latter.
      rhsParser :: BoolExpRHSParser b m (PartialSQLExp b)
      rhsParser :: BoolExpRHSParser b m (PartialSQLExp b)
rhsParser = ValueParser b m (PartialSQLExp b)
-> PartialSQLExp b -> BoolExpRHSParser b m (PartialSQLExp b)
forall (b :: BackendType) (m :: * -> *) v.
ValueParser b m v -> v -> BoolExpRHSParser b m v
BoolExpRHSParser ValueParser b m (PartialSQLExp b)
forall (b :: BackendType) (m :: * -> *) r.
(BackendMetadata b, MonadError QErr m, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
CollectableType (ColumnType b) -> Value -> m (PartialSQLExp b)
forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
CollectableType (ColumnType b) -> Value -> m (PartialSQLExp b)
parseCollectableType PartialSQLExp b
forall (backend :: BackendType). PartialSQLExp backend
PSESession

  -- In Native Queries, there are no relationships (unlike tables, where one
  -- table can reference another). This means that our root fieldInfoMap is
  -- always going to be the same as our current fieldInfoMap, so we just pass
  -- the same one in twice.
  AnnBoolExpPartialSQL b
abe <- BoolExpRHSParser b m (PartialSQLExp b)
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExpPartialSQL b)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m (PartialSQLExp b)
rhsParser FieldInfoMap (FieldInfo b)
fieldInfoMap FieldInfoMap (FieldInfo b)
fieldInfoMap (BoolExp b -> GBoolExp b ColExp
forall (b :: BackendType). BoolExp b -> GBoolExp b ColExp
unBoolExp BoolExp b
be)

  let -- What dependencies do we have on the schema cache in order to process
      -- this boolean expression? This dependency system is explained more
      -- thoroughly in the 'buildLogicalModelSelPermInfo' inline comments.
      deps :: [SchemaDependency]
      deps :: [SchemaDependency]
deps = SourceName
-> LogicalModelName -> AnnBoolExpPartialSQL b -> [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> LogicalModelName -> AnnBoolExpPartialSQL b -> [SchemaDependency]
getLogicalModelBoolExpDeps SourceName
source LogicalModelName
lmn AnnBoolExpPartialSQL b
abe

  (AnnBoolExpPartialSQL b, Seq SchemaDependency)
-> m (AnnBoolExpPartialSQL b, Seq SchemaDependency)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnBoolExpPartialSQL b
abe, [SchemaDependency] -> Seq SchemaDependency
forall a. [a] -> Seq a
Seq.fromList [SchemaDependency]
deps)

annBoolExp ::
  (QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
  BoolExpRHSParser b m v ->
  FieldInfoMap (FieldInfo b) ->
  FieldInfoMap (FieldInfo b) ->
  GBoolExp b ColExp ->
  m (AnnBoolExp b v)
annBoolExp :: forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m v
rhsParser FieldInfoMap (FieldInfo b)
rootFieldInfoMap FieldInfoMap (FieldInfo b)
fim GBoolExp b ColExp
boolExp =
  case GBoolExp b ColExp
boolExp of
    BoolAnd [GBoolExp b ColExp]
exps -> [AnnBoolExp b v] -> AnnBoolExp b v
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
BoolAnd ([AnnBoolExp b v] -> AnnBoolExp b v)
-> m [AnnBoolExp b v] -> m (AnnBoolExp b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GBoolExp b ColExp] -> m [AnnBoolExp b v]
procExps [GBoolExp b ColExp]
exps
    BoolOr [GBoolExp b ColExp]
exps -> [AnnBoolExp b v] -> AnnBoolExp b v
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
BoolOr ([AnnBoolExp b v] -> AnnBoolExp b v)
-> m [AnnBoolExp b v] -> m (AnnBoolExp b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GBoolExp b ColExp] -> m [AnnBoolExp b v]
procExps [GBoolExp b ColExp]
exps
    BoolNot GBoolExp b ColExp
e -> AnnBoolExp b v -> AnnBoolExp b v
forall (backend :: BackendType) field.
GBoolExp backend field -> GBoolExp backend field
BoolNot (AnnBoolExp b v -> AnnBoolExp b v)
-> m (AnnBoolExp b v) -> m (AnnBoolExp b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m v
rhsParser FieldInfoMap (FieldInfo b)
rootFieldInfoMap FieldInfoMap (FieldInfo b)
fim GBoolExp b ColExp
e
    BoolExists (GExists TableName b
refqt GBoolExp b ColExp
whereExp) ->
      Text -> m (AnnBoolExp b v) -> m (AnnBoolExp b v)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"_exists" (m (AnnBoolExp b v) -> m (AnnBoolExp b v))
-> m (AnnBoolExp b v) -> m (AnnBoolExp b v)
forall a b. (a -> b) -> a -> b
$ do
        FieldInfoMap (FieldInfo b)
refFields <- Text
-> m (FieldInfoMap (FieldInfo b)) -> m (FieldInfoMap (FieldInfo b))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"_table" (m (FieldInfoMap (FieldInfo b)) -> m (FieldInfoMap (FieldInfo b)))
-> m (FieldInfoMap (FieldInfo b)) -> m (FieldInfoMap (FieldInfo b))
forall a b. (a -> b) -> a -> b
$ TableName b -> m (FieldInfoMap (FieldInfo b))
forall (m :: * -> *) (b :: BackendType).
(QErrM m, Backend b, TableCoreInfoRM b m) =>
TableName b -> m (FieldInfoMap (FieldInfo b))
askFieldInfoMapSource TableName b
refqt
        AnnBoolExp b v
annWhereExp <- Text -> m (AnnBoolExp b v) -> m (AnnBoolExp b v)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"_where" (m (AnnBoolExp b v) -> m (AnnBoolExp b v))
-> m (AnnBoolExp b v) -> m (AnnBoolExp b v)
forall a b. (a -> b) -> a -> b
$ BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m v
rhsParser FieldInfoMap (FieldInfo b)
rootFieldInfoMap FieldInfoMap (FieldInfo b)
refFields GBoolExp b ColExp
whereExp
        AnnBoolExp b v -> m (AnnBoolExp b v)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnBoolExp b v -> m (AnnBoolExp b v))
-> AnnBoolExp b v -> m (AnnBoolExp b v)
forall a b. (a -> b) -> a -> b
$ GExists b (AnnBoolExpFld b v) -> AnnBoolExp b v
forall (backend :: BackendType) field.
GExists backend field -> GBoolExp backend field
BoolExists (GExists b (AnnBoolExpFld b v) -> AnnBoolExp b v)
-> GExists b (AnnBoolExpFld b v) -> AnnBoolExp b v
forall a b. (a -> b) -> a -> b
$ TableName b -> AnnBoolExp b v -> GExists b (AnnBoolExpFld b v)
forall (backend :: BackendType) field.
TableName backend
-> GBoolExp backend field -> GExists backend field
GExists TableName b
refqt AnnBoolExp b v
annWhereExp
    BoolField ColExp
fld -> AnnBoolExpFld b v -> AnnBoolExp b v
forall (backend :: BackendType) field.
field -> GBoolExp backend field
BoolField (AnnBoolExpFld b v -> AnnBoolExp b v)
-> m (AnnBoolExpFld b v) -> m (AnnBoolExp b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> ColExp
-> m (AnnBoolExpFld b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> ColExp
-> m (AnnBoolExpFld b v)
annColExp BoolExpRHSParser b m v
rhsParser FieldInfoMap (FieldInfo b)
rootFieldInfoMap FieldInfoMap (FieldInfo b)
fim ColExp
fld
  where
    procExps :: [GBoolExp b ColExp] -> m [AnnBoolExp b v]
procExps = (GBoolExp b ColExp -> m (AnnBoolExp b v))
-> [GBoolExp b ColExp] -> m [AnnBoolExp b v]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m v
rhsParser FieldInfoMap (FieldInfo b)
rootFieldInfoMap FieldInfoMap (FieldInfo b)
fim)

annColExp ::
  (QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
  BoolExpRHSParser b m v ->
  FieldInfoMap (FieldInfo b) ->
  FieldInfoMap (FieldInfo b) ->
  ColExp ->
  m (AnnBoolExpFld b v)
annColExp :: forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> ColExp
-> m (AnnBoolExpFld b v)
annColExp BoolExpRHSParser b m v
rhsParser FieldInfoMap (FieldInfo b)
rootFieldInfoMap FieldInfoMap (FieldInfo b)
colInfoMap (ColExp FieldName
fieldName Value
colVal) = do
  FieldInfo b
colInfo <- FieldInfoMap (FieldInfo b) -> FieldName -> m (FieldInfo b)
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (FieldInfo b)
colInfoMap FieldName
fieldName
  case FieldInfo b
colInfo of
    FIColumn (SCIScalarColumn ColumnInfo b
pgi) -> ColumnInfo b -> [OpExpG b v] -> AnnBoolExpFld b v
forall (backend :: BackendType) leaf.
ColumnInfo backend
-> [OpExpG backend leaf] -> AnnBoolExpFld backend leaf
AVColumn ColumnInfo b
pgi ([OpExpG b v] -> AnnBoolExpFld b v)
-> m [OpExpG b v] -> m (AnnBoolExpFld b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> ColumnReference b
-> Value
-> m [OpExpG b v]
forall (b :: BackendType) (m :: * -> *) v.
(BackendMetadata b, MonadError QErr m) =>
ValueParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> ColumnReference b
-> Value
-> m [OpExpG b v]
forall (m :: * -> *) v.
MonadError QErr m =>
ValueParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> ColumnReference b
-> Value
-> m [OpExpG b v]
parseBoolExpOperations (BoolExpRHSParser b m v -> ValueParser b m v
forall (b :: BackendType) (m :: * -> *) v.
BoolExpRHSParser b m v -> ValueParser b m v
_berpValueParser BoolExpRHSParser b m v
rhsParser) FieldInfoMap (FieldInfo b)
rootFieldInfoMap FieldInfoMap (FieldInfo b)
colInfoMap (ColumnInfo b -> ColumnReference b
forall (b :: BackendType). ColumnInfo b -> ColumnReference b
ColumnReferenceColumn ColumnInfo b
pgi) Value
colVal
    FIColumn (SCIObjectColumn {}) ->
      Code -> Text -> m (AnnBoolExpFld b v)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"nested object not supported"
    FIColumn (SCIArrayColumn {}) ->
      Code -> Text -> m (AnnBoolExpFld b v)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"nested array not supported"
    FIRelationship RelInfo b
relInfo -> do
      case RelInfo b -> RelTarget b
forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget RelInfo b
relInfo of
        RelTargetNativeQuery NativeQueryName
_ -> String -> m (AnnBoolExpFld b v)
forall a. HasCallStack => String -> a
error String
"annColExp RelTargetNativeQuery"
        RelTargetTable TableName b
rhsTableName -> do
          BoolExp b
relBoolExp <- Value -> m (BoolExp b)
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue Value
colVal
          FieldInfoMap (FieldInfo b)
relFieldInfoMap <- TableName b -> m (FieldInfoMap (FieldInfo b))
forall (m :: * -> *) (b :: BackendType).
(QErrM m, Backend b, TableCoreInfoRM b m) =>
TableName b -> m (FieldInfoMap (FieldInfo b))
askFieldInfoMapSource TableName b
rhsTableName
          AnnBoolExp b v
annRelBoolExp <- BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m v
rhsParser FieldInfoMap (FieldInfo b)
rootFieldInfoMap FieldInfoMap (FieldInfo b)
relFieldInfoMap (GBoolExp b ColExp -> m (AnnBoolExp b v))
-> GBoolExp b ColExp -> m (AnnBoolExp b v)
forall a b. (a -> b) -> a -> b
$ BoolExp b -> GBoolExp b ColExp
forall (b :: BackendType). BoolExp b -> GBoolExp b ColExp
unBoolExp BoolExp b
relBoolExp
          AnnBoolExpFld b v -> m (AnnBoolExpFld b v)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (AnnBoolExpFld b v -> m (AnnBoolExpFld b v))
-> AnnBoolExpFld b v -> m (AnnBoolExpFld b v)
forall a b. (a -> b) -> a -> b
$ RelInfo b -> RelationshipFilters b v -> AnnBoolExpFld b v
forall (backend :: BackendType) leaf.
RelInfo backend
-> RelationshipFilters backend leaf -> AnnBoolExpFld backend leaf
AVRelationship
              RelInfo b
relInfo
              ( RelationshipFilters
                  { --  Note that what we are building here are the permissions of the _current_ table.
                    --  Therefore, they need to go into `rfFilter`.  `rfTargetTablePermissions` refers
                    -- to the permissions of the _target_ table, which do not apply to the permissions
                    -- definition of the _current_ table.
                    rfTargetTablePermissions :: AnnBoolExp b v
rfTargetTablePermissions = [AnnBoolExp b v] -> AnnBoolExp b v
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
BoolAnd [],
                    rfFilter :: AnnBoolExp b v
rfFilter = AnnBoolExp b v
annRelBoolExp
                  }
              )
    FIComputedField ComputedFieldInfo b
computedFieldInfo ->
      AnnComputedFieldBoolExp b v -> AnnBoolExpFld b v
forall (backend :: BackendType) leaf.
AnnComputedFieldBoolExp backend leaf -> AnnBoolExpFld backend leaf
AVComputedField (AnnComputedFieldBoolExp b v -> AnnBoolExpFld b v)
-> m (AnnComputedFieldBoolExp b v) -> m (AnnBoolExpFld b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BoolExpResolver b m v
-> BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> ComputedFieldInfo b
-> Value
-> m (AnnComputedFieldBoolExp b v)
forall (b :: BackendType) (m :: * -> *) v.
(BackendMetadata b, MonadError QErr m, TableCoreInfoRM b m) =>
BoolExpResolver b m v
-> BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> ComputedFieldInfo b
-> Value
-> m (AnnComputedFieldBoolExp b v)
forall (m :: * -> *) v.
(MonadError QErr m, TableCoreInfoRM b m) =>
BoolExpResolver b m v
-> BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> ComputedFieldInfo b
-> Value
-> m (AnnComputedFieldBoolExp b v)
buildComputedFieldBooleanExp ((BoolExpRHSParser b m v
 -> FieldInfoMap (FieldInfo b)
 -> FieldInfoMap (FieldInfo b)
 -> GBoolExp b ColExp
 -> m (AnnBoolExp b v))
-> BoolExpResolver b m v
forall (b :: BackendType) (m :: * -> *) v.
(BoolExpRHSParser b m v
 -> FieldInfoMap (FieldInfo b)
 -> FieldInfoMap (FieldInfo b)
 -> GBoolExp b ColExp
 -> m (AnnBoolExp b v))
-> BoolExpResolver b m v
BoolExpResolver BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> FieldInfoMap (FieldInfo b)
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp) BoolExpRHSParser b m v
rhsParser FieldInfoMap (FieldInfo b)
rootFieldInfoMap FieldInfoMap (FieldInfo b)
colInfoMap ComputedFieldInfo b
computedFieldInfo Value
colVal
    -- Using remote fields in the boolean expression is not supported.
    FIRemoteRelationship {} ->
      Code -> Text -> m (AnnBoolExpFld b v)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload Text
"remote field unsupported"

getDepHeadersFromVal :: Value -> [Text]
getDepHeadersFromVal :: Value -> [Text]
getDepHeadersFromVal Value
val = case Value
val of
  Object Object
o -> Object -> [Text]
parseObject Object
o
  Value
_ -> Value -> [Text]
parseOnlyString Value
val
  where
    parseOnlyString :: Value -> [Text]
parseOnlyString Value
v = case Value
v of
      (String Text
t)
        | Text -> Bool
isSessionVariable Text
t -> [Text -> Text
T.toLower Text
t]
        | Text -> Bool
isReqUserId Text
t -> [Text
forall a. IsString a => a
userIdHeader]
        | Bool
otherwise -> []
      Value
_ -> []
    parseObject :: Object -> [Text]
parseObject Object
o =
      (Value -> [Text]) -> [Value] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> [Text]
getDepHeadersFromVal (Object -> [Value]
forall v. KeyMap v -> [v]
KM.elems Object
o)

getDependentHeaders :: BoolExp b -> HashSet Text
getDependentHeaders :: forall (b :: BackendType). BoolExp b -> HashSet Text
getDependentHeaders (BoolExp GBoolExp b ColExp
boolExp) =
  [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([Text] -> HashSet Text) -> [Text] -> HashSet Text
forall a b. (a -> b) -> a -> b
$ ((ColExp -> [Text]) -> GBoolExp b ColExp -> [Text])
-> GBoolExp b ColExp -> (ColExp -> [Text]) -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ColExp -> [Text]) -> GBoolExp b ColExp -> [Text]
forall m a. Monoid m => (a -> m) -> GBoolExp b a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GBoolExp b ColExp
boolExp ((ColExp -> [Text]) -> [Text]) -> (ColExp -> [Text]) -> [Text]
forall a b. (a -> b) -> a -> b
$ \(ColExp FieldName
_ Value
v) -> Value -> [Text]
getDepHeadersFromVal Value
v

data DropPerm b = DropPerm
  { forall (b :: BackendType). DropPerm b -> SourceName
dipSource :: SourceName,
    forall (b :: BackendType). DropPerm b -> TableName b
dipTable :: TableName b,
    forall (b :: BackendType). DropPerm b -> RoleName
dipRole :: RoleName
  }

instance (Backend b) => FromJSON (DropPerm b) where
  parseJSON :: Value -> Parser (DropPerm b)
parseJSON = String
-> (Object -> Parser (DropPerm b)) -> Value -> Parser (DropPerm b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DropPerm" ((Object -> Parser (DropPerm b)) -> Value -> Parser (DropPerm b))
-> (Object -> Parser (DropPerm b)) -> Value -> Parser (DropPerm b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName -> TableName b -> RoleName -> DropPerm b
forall (b :: BackendType).
SourceName -> TableName b -> RoleName -> DropPerm b
DropPerm
      (SourceName -> TableName b -> RoleName -> DropPerm b)
-> Parser SourceName
-> Parser (TableName b -> RoleName -> DropPerm b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
      Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser (TableName b -> RoleName -> DropPerm b)
-> Parser (TableName b) -> Parser (RoleName -> DropPerm b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser (RoleName -> DropPerm b)
-> Parser RoleName -> Parser (DropPerm b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser RoleName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role"