module Hasura.RQL.DML.Internal
  ( SessionVariableBuilder,
    askDelPermInfo,
    askInsPermInfo,
    askPermInfo,
    askSelPermInfo,
    askTableInfoSource,
    askUpdPermInfo,
    binRHSBuilder,
    checkPermOnCol,
    checkRetCols,
    checkSelOnCol,
    convAnnBoolExpPartialSQL,
    convAnnRedactionExpPartialSQL,
    convBoolExp,
    convPartialSQLExp,
    fetchRelDet,
    fetchRelTabInfo,
    isTabUpdatable,
    onlyPositiveInt,
    runDMLP1T,
    sessVarFromCurrentSetting,
    validateHeaders,
    valueParserWithCollectableType,
    verifyAsrns,
  )
where

import Control.Lens
import Data.Aeson.Types
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as HS
import Data.Sequence qualified as DS
import Data.Text qualified as T
import Data.Text.Extended
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Instances.Metadata ()
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Types hiding (TableName)
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Backends.Postgres.Translate.Column
import Hasura.Backends.Postgres.Types.Column
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.DDL.Permission (annBoolExp)
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.BoolExp
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.Roles (RoleName, adminRoleName)
import Hasura.RQL.Types.SchemaCache
import Hasura.SQL.Types
import Hasura.Session (SessionVariable, UserInfoM, askCurRole, askUserInfo, getSessionVariables, sessionVariableToText, _uiSession)
import Hasura.Table.Cache

newtype DMLP1T m a = DMLP1T {forall (m :: * -> *) a. DMLP1T m a -> StateT (Seq PrepArg) m a
unDMLP1T :: StateT (DS.Seq PG.PrepArg) m a}
  deriving
    ( (forall a b. (a -> b) -> DMLP1T m a -> DMLP1T m b)
-> (forall a b. a -> DMLP1T m b -> DMLP1T m a)
-> Functor (DMLP1T m)
forall a b. a -> DMLP1T m b -> DMLP1T m a
forall a b. (a -> b) -> DMLP1T m a -> DMLP1T m b
forall (m :: * -> *) a b.
Functor m =>
a -> DMLP1T m b -> DMLP1T m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> DMLP1T m a -> DMLP1T m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> DMLP1T m a -> DMLP1T m b
fmap :: forall a b. (a -> b) -> DMLP1T m a -> DMLP1T m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> DMLP1T m b -> DMLP1T m a
<$ :: forall a b. a -> DMLP1T m b -> DMLP1T m a
Functor,
      Functor (DMLP1T m)
Functor (DMLP1T m)
-> (forall a. a -> DMLP1T m a)
-> (forall a b. DMLP1T m (a -> b) -> DMLP1T m a -> DMLP1T m b)
-> (forall a b c.
    (a -> b -> c) -> DMLP1T m a -> DMLP1T m b -> DMLP1T m c)
-> (forall a b. DMLP1T m a -> DMLP1T m b -> DMLP1T m b)
-> (forall a b. DMLP1T m a -> DMLP1T m b -> DMLP1T m a)
-> Applicative (DMLP1T m)
forall a. a -> DMLP1T m a
forall a b. DMLP1T m a -> DMLP1T m b -> DMLP1T m a
forall a b. DMLP1T m a -> DMLP1T m b -> DMLP1T m b
forall a b. DMLP1T m (a -> b) -> DMLP1T m a -> DMLP1T m b
forall a b c.
(a -> b -> c) -> DMLP1T m a -> DMLP1T m b -> DMLP1T m c
forall {m :: * -> *}. Monad m => Functor (DMLP1T m)
forall (m :: * -> *) a. Monad m => a -> DMLP1T m a
forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> DMLP1T m b -> DMLP1T m a
forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> DMLP1T m b -> DMLP1T m b
forall (m :: * -> *) a b.
Monad m =>
DMLP1T m (a -> b) -> DMLP1T m a -> DMLP1T m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> DMLP1T m a -> DMLP1T m b -> DMLP1T m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> DMLP1T m a
pure :: forall a. a -> DMLP1T m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
DMLP1T m (a -> b) -> DMLP1T m a -> DMLP1T m b
<*> :: forall a b. DMLP1T m (a -> b) -> DMLP1T m a -> DMLP1T m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> DMLP1T m a -> DMLP1T m b -> DMLP1T m c
liftA2 :: forall a b c.
(a -> b -> c) -> DMLP1T m a -> DMLP1T m b -> DMLP1T m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> DMLP1T m b -> DMLP1T m b
*> :: forall a b. DMLP1T m a -> DMLP1T m b -> DMLP1T m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> DMLP1T m b -> DMLP1T m a
<* :: forall a b. DMLP1T m a -> DMLP1T m b -> DMLP1T m a
Applicative,
      Applicative (DMLP1T m)
Applicative (DMLP1T m)
-> (forall a b. DMLP1T m a -> (a -> DMLP1T m b) -> DMLP1T m b)
-> (forall a b. DMLP1T m a -> DMLP1T m b -> DMLP1T m b)
-> (forall a. a -> DMLP1T m a)
-> Monad (DMLP1T m)
forall a. a -> DMLP1T m a
forall a b. DMLP1T m a -> DMLP1T m b -> DMLP1T m b
forall a b. DMLP1T m a -> (a -> DMLP1T m b) -> DMLP1T m b
forall (m :: * -> *). Monad m => Applicative (DMLP1T m)
forall (m :: * -> *) a. Monad m => a -> DMLP1T m a
forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> DMLP1T m b -> DMLP1T m b
forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> (a -> DMLP1T m b) -> DMLP1T m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> (a -> DMLP1T m b) -> DMLP1T m b
>>= :: forall a b. DMLP1T m a -> (a -> DMLP1T m b) -> DMLP1T m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> DMLP1T m b -> DMLP1T m b
>> :: forall a b. DMLP1T m a -> DMLP1T m b -> DMLP1T m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> DMLP1T m a
return :: forall a. a -> DMLP1T m a
Monad,
      (forall (m :: * -> *) a. Monad m => m a -> DMLP1T m a)
-> MonadTrans DMLP1T
forall (m :: * -> *) a. Monad m => m a -> DMLP1T m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> DMLP1T m a
lift :: forall (m :: * -> *) a. Monad m => m a -> DMLP1T m a
MonadTrans,
      MonadState (DS.Seq PG.PrepArg),
      MonadError e,
      TableCoreInfoRM b,
      TableInfoRM b,
      Monad (DMLP1T m)
DMLP1T m SchemaCache
Monad (DMLP1T m) -> DMLP1T m SchemaCache -> CacheRM (DMLP1T m)
forall (m :: * -> *). Monad m -> m SchemaCache -> CacheRM m
forall {m :: * -> *}. CacheRM m => Monad (DMLP1T m)
forall (m :: * -> *). CacheRM m => DMLP1T m SchemaCache
$caskSchemaCache :: forall (m :: * -> *). CacheRM m => DMLP1T m SchemaCache
askSchemaCache :: DMLP1T m SchemaCache
CacheRM,
      Monad (DMLP1T m)
DMLP1T m UserInfo
Monad (DMLP1T m) -> DMLP1T m UserInfo -> UserInfoM (DMLP1T m)
forall (m :: * -> *). Monad m -> m UserInfo -> UserInfoM m
forall {m :: * -> *}. UserInfoM m => Monad (DMLP1T m)
forall (m :: * -> *). UserInfoM m => DMLP1T m UserInfo
$caskUserInfo :: forall (m :: * -> *). UserInfoM m => DMLP1T m UserInfo
askUserInfo :: DMLP1T m UserInfo
UserInfoM
    )

runDMLP1T :: DMLP1T m a -> m (a, DS.Seq PG.PrepArg)
runDMLP1T :: forall (m :: * -> *) a. DMLP1T m a -> m (a, Seq PrepArg)
runDMLP1T = (StateT (Seq PrepArg) m a -> Seq PrepArg -> m (a, Seq PrepArg))
-> Seq PrepArg -> StateT (Seq PrepArg) m a -> m (a, Seq PrepArg)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Seq PrepArg) m a -> Seq PrepArg -> m (a, Seq PrepArg)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Seq PrepArg
forall a. Seq a
DS.empty (StateT (Seq PrepArg) m a -> m (a, Seq PrepArg))
-> (DMLP1T m a -> StateT (Seq PrepArg) m a)
-> DMLP1T m a
-> m (a, Seq PrepArg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMLP1T m a -> StateT (Seq PrepArg) m a
forall (m :: * -> *) a. DMLP1T m a -> StateT (Seq PrepArg) m a
unDMLP1T

askPermInfo ::
  (UserInfoM m) =>
  Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c) ->
  TableInfo ('Postgres 'Vanilla) ->
  m (Maybe c)
askPermInfo :: forall (m :: * -> *) c.
UserInfoM m =>
Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla) -> m (Maybe c)
askPermInfo Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
pa TableInfo ('Postgres 'Vanilla)
tableInfo = do
  RoleName
role <- m RoleName
forall (m :: * -> *). UserInfoM m => m RoleName
askCurRole
  Maybe c -> m (Maybe c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe c -> m (Maybe c)) -> Maybe c -> m (Maybe c)
forall a b. (a -> b) -> a -> b
$ RoleName
-> Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla)
-> Maybe c
forall c.
RoleName
-> Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla)
-> Maybe c
getPermInfoMaybe RoleName
role (Maybe c -> f (Maybe c))
-> RolePermInfo ('Postgres 'Vanilla)
-> f (RolePermInfo ('Postgres 'Vanilla))
Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
pa TableInfo ('Postgres 'Vanilla)
tableInfo

getPermInfoMaybe ::
  RoleName -> Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c) -> TableInfo ('Postgres 'Vanilla) -> Maybe c
getPermInfoMaybe :: forall c.
RoleName
-> Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla)
-> Maybe c
getPermInfoMaybe RoleName
role Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
pa TableInfo ('Postgres 'Vanilla)
tableInfo =
  RoleName
-> TableInfo ('Postgres 'Vanilla)
-> RolePermInfo ('Postgres 'Vanilla)
forall (b :: BackendType).
RoleName -> TableInfo b -> RolePermInfo b
getRolePermInfo RoleName
role TableInfo ('Postgres 'Vanilla)
tableInfo RolePermInfo ('Postgres 'Vanilla)
-> Getting (Maybe c) (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> Maybe c
forall s a. s -> Getting a s a -> a
^. Getting (Maybe c) (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
pa

assertAskPermInfo ::
  (UserInfoM m, QErrM m) =>
  PermType ->
  Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c) ->
  TableInfo ('Postgres 'Vanilla) ->
  m c
assertAskPermInfo :: forall (m :: * -> *) c.
(UserInfoM m, QErrM m) =>
PermType
-> Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla)
-> m c
assertAskPermInfo PermType
pt Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
pa TableInfo ('Postgres 'Vanilla)
tableInfo = do
  RoleName
roleName <- m RoleName
forall (m :: * -> *). UserInfoM m => m RoleName
askCurRole
  Maybe c
mPermInfo <- Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla) -> m (Maybe c)
forall (m :: * -> *) c.
UserInfoM m =>
Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla) -> m (Maybe c)
askPermInfo (Maybe c -> f (Maybe c))
-> RolePermInfo ('Postgres 'Vanilla)
-> f (RolePermInfo ('Postgres 'Vanilla))
Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
pa TableInfo ('Postgres 'Vanilla)
tableInfo
  Maybe c -> m c -> m c
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe c
mPermInfo
    (m c -> m c) -> m c -> m c
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m c
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
PermissionDenied
    (Text -> m c) -> Text -> m c
forall a b. (a -> b) -> a -> b
$ PermType -> Text
permTypeToCode PermType
pt
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" on "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableInfo ('Postgres 'Vanilla) -> TableName ('Postgres 'Vanilla)
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo ('Postgres 'Vanilla)
tableInfo
    QualifiedTable -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for role "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
roleName
    RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not allowed. "

isTabUpdatable :: RoleName -> TableInfo ('Postgres 'Vanilla) -> Bool
isTabUpdatable :: RoleName -> TableInfo ('Postgres 'Vanilla) -> Bool
isTabUpdatable RoleName
role TableInfo ('Postgres 'Vanilla)
ti
  | RoleName
role RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName = Bool
True
  | Bool
otherwise = Maybe (UpdPermInfo ('Postgres 'Vanilla)) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (UpdPermInfo ('Postgres 'Vanilla)) -> Bool)
-> Maybe (UpdPermInfo ('Postgres 'Vanilla)) -> Bool
forall a b. (a -> b) -> a -> b
$ RoleName
-> HashMap RoleName (RolePermInfo ('Postgres 'Vanilla))
-> Maybe (RolePermInfo ('Postgres 'Vanilla))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup RoleName
role HashMap RoleName (RolePermInfo ('Postgres 'Vanilla))
rpim Maybe (RolePermInfo ('Postgres 'Vanilla))
-> (RolePermInfo ('Postgres 'Vanilla)
    -> Maybe (UpdPermInfo ('Postgres 'Vanilla)))
-> Maybe (UpdPermInfo ('Postgres 'Vanilla))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RolePermInfo ('Postgres 'Vanilla)
-> Maybe (UpdPermInfo ('Postgres 'Vanilla))
forall (b :: BackendType). RolePermInfo b -> Maybe (UpdPermInfo b)
_permUpd
  where
    rpim :: HashMap RoleName (RolePermInfo ('Postgres 'Vanilla))
rpim = TableInfo ('Postgres 'Vanilla)
-> HashMap RoleName (RolePermInfo ('Postgres 'Vanilla))
forall (b :: BackendType). TableInfo b -> RolePermInfoMap b
_tiRolePermInfoMap TableInfo ('Postgres 'Vanilla)
ti

askInsPermInfo ::
  (UserInfoM m, QErrM m) =>
  TableInfo ('Postgres 'Vanilla) ->
  m (InsPermInfo ('Postgres 'Vanilla))
askInsPermInfo :: forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
TableInfo ('Postgres 'Vanilla)
-> m (InsPermInfo ('Postgres 'Vanilla))
askInsPermInfo = PermType
-> Lens'
     (RolePermInfo ('Postgres 'Vanilla))
     (Maybe (InsPermInfo ('Postgres 'Vanilla)))
-> TableInfo ('Postgres 'Vanilla)
-> m (InsPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *) c.
(UserInfoM m, QErrM m) =>
PermType
-> Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla)
-> m c
assertAskPermInfo PermType
PTInsert (Maybe (InsPermInfo ('Postgres 'Vanilla))
 -> f (Maybe (InsPermInfo ('Postgres 'Vanilla))))
-> RolePermInfo ('Postgres 'Vanilla)
-> f (RolePermInfo ('Postgres 'Vanilla))
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Maybe (InsPermInfo b) -> f (Maybe (InsPermInfo b)))
-> RolePermInfo b -> f (RolePermInfo b)
Lens'
  (RolePermInfo ('Postgres 'Vanilla))
  (Maybe (InsPermInfo ('Postgres 'Vanilla)))
permIns

askSelPermInfo ::
  (UserInfoM m, QErrM m) =>
  TableInfo ('Postgres 'Vanilla) ->
  m (SelPermInfo ('Postgres 'Vanilla))
askSelPermInfo :: forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
askSelPermInfo = PermType
-> Lens'
     (RolePermInfo ('Postgres 'Vanilla))
     (Maybe (SelPermInfo ('Postgres 'Vanilla)))
-> TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *) c.
(UserInfoM m, QErrM m) =>
PermType
-> Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla)
-> m c
assertAskPermInfo PermType
PTSelect (Maybe (SelPermInfo ('Postgres 'Vanilla))
 -> f (Maybe (SelPermInfo ('Postgres 'Vanilla))))
-> RolePermInfo ('Postgres 'Vanilla)
-> f (RolePermInfo ('Postgres 'Vanilla))
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Maybe (SelPermInfo b) -> f (Maybe (SelPermInfo b)))
-> RolePermInfo b -> f (RolePermInfo b)
Lens'
  (RolePermInfo ('Postgres 'Vanilla))
  (Maybe (SelPermInfo ('Postgres 'Vanilla)))
permSel

askUpdPermInfo ::
  (UserInfoM m, QErrM m) =>
  TableInfo ('Postgres 'Vanilla) ->
  m (UpdPermInfo ('Postgres 'Vanilla))
askUpdPermInfo :: forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
TableInfo ('Postgres 'Vanilla)
-> m (UpdPermInfo ('Postgres 'Vanilla))
askUpdPermInfo = PermType
-> Lens'
     (RolePermInfo ('Postgres 'Vanilla))
     (Maybe (UpdPermInfo ('Postgres 'Vanilla)))
-> TableInfo ('Postgres 'Vanilla)
-> m (UpdPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *) c.
(UserInfoM m, QErrM m) =>
PermType
-> Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla)
-> m c
assertAskPermInfo PermType
PTUpdate (Maybe (UpdPermInfo ('Postgres 'Vanilla))
 -> f (Maybe (UpdPermInfo ('Postgres 'Vanilla))))
-> RolePermInfo ('Postgres 'Vanilla)
-> f (RolePermInfo ('Postgres 'Vanilla))
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Maybe (UpdPermInfo b) -> f (Maybe (UpdPermInfo b)))
-> RolePermInfo b -> f (RolePermInfo b)
Lens'
  (RolePermInfo ('Postgres 'Vanilla))
  (Maybe (UpdPermInfo ('Postgres 'Vanilla)))
permUpd

askDelPermInfo ::
  (UserInfoM m, QErrM m) =>
  TableInfo ('Postgres 'Vanilla) ->
  m (DelPermInfo ('Postgres 'Vanilla))
askDelPermInfo :: forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
TableInfo ('Postgres 'Vanilla)
-> m (DelPermInfo ('Postgres 'Vanilla))
askDelPermInfo = PermType
-> Lens'
     (RolePermInfo ('Postgres 'Vanilla))
     (Maybe (DelPermInfo ('Postgres 'Vanilla)))
-> TableInfo ('Postgres 'Vanilla)
-> m (DelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *) c.
(UserInfoM m, QErrM m) =>
PermType
-> Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla)
-> m c
assertAskPermInfo PermType
PTDelete (Maybe (DelPermInfo ('Postgres 'Vanilla))
 -> f (Maybe (DelPermInfo ('Postgres 'Vanilla))))
-> RolePermInfo ('Postgres 'Vanilla)
-> f (RolePermInfo ('Postgres 'Vanilla))
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Maybe (DelPermInfo b) -> f (Maybe (DelPermInfo b)))
-> RolePermInfo b -> f (RolePermInfo b)
Lens'
  (RolePermInfo ('Postgres 'Vanilla))
  (Maybe (DelPermInfo ('Postgres 'Vanilla)))
permDel

verifyAsrns :: (MonadError QErr m) => [a -> m ()] -> [a] -> m ()
verifyAsrns :: forall (m :: * -> *) a.
MonadError QErr m =>
[a -> m ()] -> [a] -> m ()
verifyAsrns [a -> m ()]
preds [a]
xs = [a] -> (a -> m ()) -> m ()
forall (m :: * -> *) (t :: * -> *) a b.
(QErrM m, Foldable t) =>
t a -> (a -> m b) -> m ()
indexedForM_ [a]
xs ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
a -> ((a -> m ()) -> m ()) -> [a -> m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((a -> m ()) -> a -> m ()
forall a b. (a -> b) -> a -> b
$ a
a) [a -> m ()]
preds

checkRetCols ::
  (UserInfoM m, QErrM m) =>
  FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
  SelPermInfo ('Postgres 'Vanilla) ->
  [PGCol] ->
  m [ColumnInfo ('Postgres 'Vanilla)]
checkRetCols :: forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> [PGCol]
-> m [ColumnInfo ('Postgres 'Vanilla)]
checkRetCols FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPermInfo [PGCol]
cols = do
  (PGCol -> m ()) -> [PGCol] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SelPermInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla) -> m ()
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
SelPermInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla) -> m ()
checkSelOnCol SelPermInfo ('Postgres 'Vanilla)
selPermInfo) [PGCol]
cols
  [PGCol]
-> (PGCol -> m (ColumnInfo ('Postgres 'Vanilla)))
-> m [ColumnInfo ('Postgres 'Vanilla)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [PGCol]
cols ((PGCol -> m (ColumnInfo ('Postgres 'Vanilla)))
 -> m [ColumnInfo ('Postgres 'Vanilla)])
-> (PGCol -> m (ColumnInfo ('Postgres 'Vanilla)))
-> m [ColumnInfo ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$ \PGCol
col -> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> Column ('Postgres 'Vanilla)
-> Text
-> m (ColumnInfo ('Postgres 'Vanilla))
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnInfo backend)
askColInfo FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap Column ('Postgres 'Vanilla)
PGCol
col Text
relInRetErr
  where
    relInRetErr :: Text
relInRetErr = Text
"Relationships can't be used in \"returning\"."

checkSelOnCol ::
  (UserInfoM m, QErrM m) =>
  SelPermInfo ('Postgres 'Vanilla) ->
  Column ('Postgres 'Vanilla) ->
  m ()
checkSelOnCol :: forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
SelPermInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla) -> m ()
checkSelOnCol SelPermInfo ('Postgres 'Vanilla)
selPermInfo =
  PermType
-> HashSet (Column ('Postgres 'Vanilla))
-> Column ('Postgres 'Vanilla)
-> m ()
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
PermType
-> HashSet (Column ('Postgres 'Vanilla))
-> Column ('Postgres 'Vanilla)
-> m ()
checkPermOnCol PermType
PTSelect ([Column ('Postgres 'Vanilla)]
-> HashSet (Column ('Postgres 'Vanilla))
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([Column ('Postgres 'Vanilla)]
 -> HashSet (Column ('Postgres 'Vanilla)))
-> [Column ('Postgres 'Vanilla)]
-> HashSet (Column ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ HashMap
  (Column ('Postgres 'Vanilla))
  (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> [Column ('Postgres 'Vanilla)]
forall k v. HashMap k v -> [k]
HashMap.keys (HashMap
   (Column ('Postgres 'Vanilla))
   (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
 -> [Column ('Postgres 'Vanilla)])
-> HashMap
     (Column ('Postgres 'Vanilla))
     (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> [Column ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$ SelPermInfo ('Postgres 'Vanilla)
-> HashMap
     (Column ('Postgres 'Vanilla))
     (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
forall (b :: BackendType).
SelPermInfo b -> HashMap (Column b) (AnnRedactionExpPartialSQL b)
spiCols SelPermInfo ('Postgres 'Vanilla)
selPermInfo)

checkPermOnCol ::
  (UserInfoM m, QErrM m) =>
  PermType ->
  HS.HashSet (Column ('Postgres 'Vanilla)) ->
  Column ('Postgres 'Vanilla) ->
  m ()
checkPermOnCol :: forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
PermType
-> HashSet (Column ('Postgres 'Vanilla))
-> Column ('Postgres 'Vanilla)
-> m ()
checkPermOnCol PermType
pt HashSet (Column ('Postgres 'Vanilla))
allowedCols Column ('Postgres 'Vanilla)
col = do
  RoleName
role <- m RoleName
forall (m :: * -> *). UserInfoM m => m RoleName
askCurRole
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PGCol -> HashSet PGCol -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member Column ('Postgres 'Vanilla)
PGCol
col HashSet (Column ('Postgres 'Vanilla))
HashSet PGCol
allowedCols)
    (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
$ RoleName -> Text
permErrMsg RoleName
role
  where
    permErrMsg :: RoleName -> Text
permErrMsg RoleName
role
      | RoleName
role RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName = Text
"no such column exists: " Text -> PGCol -> Text
forall t. ToTxt t => Text -> t -> Text
<>> Column ('Postgres 'Vanilla)
PGCol
col
      | Bool
otherwise =
          Text
"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 have permission to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PermType -> Text
permTypeToCode PermType
pt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" column " Text -> PGCol -> Text
forall t. ToTxt t => Text -> t -> Text
<>> Column ('Postgres 'Vanilla)
PGCol
col

checkSelectPermOnScalarComputedField ::
  (UserInfoM m, QErrM m) =>
  SelPermInfo ('Postgres 'Vanilla) ->
  ComputedFieldName ->
  m ()
checkSelectPermOnScalarComputedField :: forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
SelPermInfo ('Postgres 'Vanilla) -> ComputedFieldName -> m ()
checkSelectPermOnScalarComputedField SelPermInfo ('Postgres 'Vanilla)
selPermInfo ComputedFieldName
computedField = do
  RoleName
role <- m RoleName
forall (m :: * -> *). UserInfoM m => m RoleName
askCurRole
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ComputedFieldName
-> HashMap
     ComputedFieldName (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member ComputedFieldName
computedField (HashMap
   ComputedFieldName (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
 -> Bool)
-> HashMap
     ComputedFieldName (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> Bool
forall a b. (a -> b) -> a -> b
$ SelPermInfo ('Postgres 'Vanilla)
-> HashMap
     ComputedFieldName (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
forall (b :: BackendType).
SelPermInfo b
-> HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
spiComputedFields SelPermInfo ('Postgres 'Vanilla)
selPermInfo)
    (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
$ RoleName -> Text
permErrMsg RoleName
role
  where
    permErrMsg :: RoleName -> Text
permErrMsg RoleName
role
      | RoleName
role RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName = Text
"no such computed field exists: " Text -> ComputedFieldName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> ComputedFieldName
computedField
      | Bool
otherwise =
          Text
"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 have permission to select computed field" Text -> ComputedFieldName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> ComputedFieldName
computedField

valueParserWithCollectableType ::
  (MonadError QErr m) =>
  (ColumnType ('Postgres 'Vanilla) -> Value -> m S.SQLExp) ->
  CollectableType (ColumnType ('Postgres 'Vanilla)) ->
  Value ->
  m S.SQLExp
valueParserWithCollectableType :: forall (m :: * -> *).
MonadError QErr m =>
(ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> CollectableType (ColumnType ('Postgres 'Vanilla))
-> Value
-> m SQLExp
valueParserWithCollectableType ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp
valBldr CollectableType (ColumnType ('Postgres 'Vanilla))
pgType Value
val = case CollectableType (ColumnType ('Postgres 'Vanilla))
pgType of
  CollectableTypeScalar ColumnType ('Postgres 'Vanilla)
ty -> ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp
valBldr ColumnType ('Postgres 'Vanilla)
ty Value
val
  CollectableTypeArray ColumnType ('Postgres 'Vanilla)
ofTy -> do
    -- for arrays, we don't use the prepared builder
    [Value]
vals <- (Value -> Parser [Value]) -> Value -> m [Value]
forall (m :: * -> *) v a. QErrM m => (v -> Parser a) -> v -> m a
runAesonParser Value -> Parser [Value]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
    [PGScalarValue]
scalarValues <- ScalarTypeParsingContext ('Postgres 'Vanilla)
-> ColumnType ('Postgres 'Vanilla)
-> [Value]
-> m [ScalarValue ('Postgres 'Vanilla)]
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ScalarTypeParsingContext b
-> ColumnType b -> [Value] -> m [ScalarValue b]
parseScalarValuesColumnTypeWithContext () ColumnType ('Postgres 'Vanilla)
ofTy [Value]
vals
    SQLExp -> m SQLExp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
      (SQLExp -> m SQLExp) -> SQLExp -> m SQLExp
forall a b. (a -> b) -> a -> b
$ SQLExp -> TypeAnn -> SQLExp
S.SETyAnn
        ([SQLExp] -> SQLExp
S.SEArray ([SQLExp] -> SQLExp) -> [SQLExp] -> SQLExp
forall a b. (a -> b) -> a -> b
$ (PGScalarValue -> SQLExp) -> [PGScalarValue] -> [SQLExp]
forall a b. (a -> b) -> [a] -> [b]
map (ColumnValue ('Postgres 'Vanilla) -> SQLExp
forall (pgKind :: PostgresKind).
ColumnValue ('Postgres pgKind) -> SQLExp
toTxtValue (ColumnValue ('Postgres 'Vanilla) -> SQLExp)
-> (PGScalarValue -> ColumnValue ('Postgres 'Vanilla))
-> PGScalarValue
-> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType ('Postgres 'Vanilla)
-> ScalarValue ('Postgres 'Vanilla)
-> ColumnValue ('Postgres 'Vanilla)
forall (b :: BackendType).
ColumnType b -> ScalarValue b -> ColumnValue b
ColumnValue ColumnType ('Postgres 'Vanilla)
ofTy) [PGScalarValue]
scalarValues)
        (CollectableType PGScalarType -> TypeAnn
S.mkTypeAnn (CollectableType PGScalarType -> TypeAnn)
-> CollectableType PGScalarType -> TypeAnn
forall a b. (a -> b) -> a -> b
$ PGScalarType -> CollectableType PGScalarType
forall a. a -> CollectableType a
CollectableTypeArray (ColumnType ('Postgres 'Vanilla) -> PGScalarType
forall (pgKind :: PostgresKind).
ColumnType ('Postgres pgKind) -> PGScalarType
unsafePGColumnToBackend ColumnType ('Postgres 'Vanilla)
ofTy))

binRHSBuilder ::
  (QErrM m) =>
  ColumnType ('Postgres 'Vanilla) ->
  Value ->
  DMLP1T m S.SQLExp
binRHSBuilder :: forall (m :: * -> *).
QErrM m =>
ColumnType ('Postgres 'Vanilla) -> Value -> DMLP1T m SQLExp
binRHSBuilder ColumnType ('Postgres 'Vanilla)
colType Value
val = do
  Seq PrepArg
preparedArgs <- DMLP1T m (Seq PrepArg)
forall s (m :: * -> *). MonadState s m => m s
get
  PGScalarValue
scalarValue <- ScalarTypeParsingContext ('Postgres 'Vanilla)
-> ColumnType ('Postgres 'Vanilla)
-> Value
-> DMLP1T m (ScalarValue ('Postgres 'Vanilla))
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ScalarTypeParsingContext b
-> ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnTypeWithContext () ColumnType ('Postgres 'Vanilla)
colType Value
val
  Seq PrepArg -> DMLP1T m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Seq PrepArg
preparedArgs Seq PrepArg -> PrepArg -> Seq PrepArg
forall a. Seq a -> a -> Seq a
DS.|> PGScalarValue -> PrepArg
binEncoder PGScalarValue
scalarValue)
  SQLExp -> DMLP1T m SQLExp
forall a. a -> DMLP1T m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SQLExp -> DMLP1T m SQLExp) -> SQLExp -> DMLP1T m SQLExp
forall a b. (a -> b) -> a -> b
$ Int -> PGScalarType -> SQLExp
toPrepParam (Seq PrepArg -> Int
forall a. Seq a -> Int
DS.length Seq PrepArg
preparedArgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ColumnType ('Postgres 'Vanilla) -> PGScalarType
forall (pgKind :: PostgresKind).
ColumnType ('Postgres pgKind) -> PGScalarType
unsafePGColumnToBackend ColumnType ('Postgres 'Vanilla)
colType)

fetchRelTabInfo ::
  (QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
  TableName ('Postgres 'Vanilla) ->
  m (TableInfo ('Postgres 'Vanilla))
fetchRelTabInfo :: forall (m :: * -> *).
(QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
fetchRelTabInfo TableName ('Postgres 'Vanilla)
refTabName =
  -- Internal error
  (Text -> Text)
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErrAndSet500 (Text
"foreign " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
    (m (TableInfo ('Postgres 'Vanilla))
 -> m (TableInfo ('Postgres 'Vanilla)))
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
askTableInfoSource TableName ('Postgres 'Vanilla)
refTabName

askTableInfoSource ::
  (QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
  TableName ('Postgres 'Vanilla) ->
  m (TableInfo ('Postgres 'Vanilla))
askTableInfoSource :: forall (m :: * -> *).
(QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
askTableInfoSource TableName ('Postgres 'Vanilla)
tableName = do
  m (Maybe (TableInfo ('Postgres 'Vanilla)))
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
onNothingM (TableName ('Postgres 'Vanilla)
-> m (Maybe (TableInfo ('Postgres 'Vanilla)))
forall (b :: BackendType) (m :: * -> *).
TableInfoRM b m =>
TableName b -> m (Maybe (TableInfo b))
lookupTableInfo TableName ('Postgres 'Vanilla)
tableName)
    (m (TableInfo ('Postgres 'Vanilla))
 -> m (TableInfo ('Postgres 'Vanilla)))
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m (TableInfo ('Postgres 'Vanilla)))
-> Text -> m (TableInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ Text
"table "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName ('Postgres 'Vanilla)
QualifiedTable
tableName
    QualifiedTable -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"

data SessionVariableBuilder m = SessionVariableBuilder
  { forall (m :: * -> *).
SessionVariableBuilder m -> SQLExpression ('Postgres 'Vanilla)
_svbCurrentSession :: SQLExpression ('Postgres 'Vanilla),
    forall (m :: * -> *).
SessionVariableBuilder m
-> SessionVarType ('Postgres 'Vanilla)
-> SessionVariable
-> m (SQLExpression ('Postgres 'Vanilla))
_svbVariableParser :: SessionVarType ('Postgres 'Vanilla) -> SessionVariable -> m (SQLExpression ('Postgres 'Vanilla))
  }

fetchRelDet ::
  (UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
  RelName ->
  TableName ('Postgres 'Vanilla) ->
  m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)), SelPermInfo ('Postgres 'Vanilla))
fetchRelDet :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
RelName
-> TableName ('Postgres 'Vanilla)
-> m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
      SelPermInfo ('Postgres 'Vanilla))
fetchRelDet RelName
relName TableName ('Postgres 'Vanilla)
refTabName = do
  RoleName
roleName <- m RoleName
forall (m :: * -> *). UserInfoM m => m RoleName
askCurRole
  -- Internal error
  TableInfo ('Postgres 'Vanilla)
refTabInfo <- TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
fetchRelTabInfo TableName ('Postgres 'Vanilla)
refTabName
  -- Get the correct constraint that applies to the given relationship
  SelPermInfo ('Postgres 'Vanilla)
refSelPerm <-
    (Text -> Text)
-> m (SelPermInfo ('Postgres 'Vanilla))
-> m (SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr (QualifiedTable -> RoleName -> Text -> Text
relPermErr TableName ('Postgres 'Vanilla)
QualifiedTable
refTabName RoleName
roleName)
      (m (SelPermInfo ('Postgres 'Vanilla))
 -> m (SelPermInfo ('Postgres 'Vanilla)))
-> m (SelPermInfo ('Postgres 'Vanilla))
-> m (SelPermInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
askSelPermInfo TableInfo ('Postgres 'Vanilla)
refTabInfo

  (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
 SelPermInfo ('Postgres 'Vanilla))
-> m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
      SelPermInfo ('Postgres 'Vanilla))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TableCoreInfoG
  ('Postgres 'Vanilla)
  (FieldInfo ('Postgres 'Vanilla))
  (ColumnInfo ('Postgres 'Vanilla))
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap (TableCoreInfoG
   ('Postgres 'Vanilla)
   (FieldInfo ('Postgres 'Vanilla))
   (ColumnInfo ('Postgres 'Vanilla))
 -> FieldInfoMap (FieldInfo ('Postgres 'Vanilla)))
-> TableCoreInfoG
     ('Postgres 'Vanilla)
     (FieldInfo ('Postgres 'Vanilla))
     (ColumnInfo ('Postgres 'Vanilla))
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres 'Vanilla)
-> TableCoreInfoG
     ('Postgres 'Vanilla)
     (FieldInfo ('Postgres 'Vanilla))
     (ColumnInfo ('Postgres 'Vanilla))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Vanilla)
refTabInfo, SelPermInfo ('Postgres 'Vanilla)
refSelPerm)
  where
    relPermErr :: QualifiedTable -> RoleName -> Text -> Text
relPermErr QualifiedTable
rTable RoleName
roleName Text
_ =
      Text
"role "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
roleName
        RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not have permission to read relationship "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName
relName
        RelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
"; no permission on table "
        Text -> QualifiedTable -> Text
forall t. ToTxt t => Text -> t -> Text
<>> QualifiedTable
rTable

checkOnColExp ::
  (UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
  SelPermInfo ('Postgres 'Vanilla) ->
  SessionVariableBuilder m ->
  AnnBoolExpFldSQL ('Postgres 'Vanilla) ->
  m (AnnBoolExpFldSQL ('Postgres 'Vanilla))
checkOnColExp :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SelPermInfo ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> AnnBoolExpFldSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpFldSQL ('Postgres 'Vanilla))
checkOnColExp SelPermInfo ('Postgres 'Vanilla)
spi SessionVariableBuilder m
sessVarBldr AnnBoolExpFldSQL ('Postgres 'Vanilla)
annFld = case AnnBoolExpFldSQL ('Postgres 'Vanilla)
annFld of
  AVColumn ColumnInfo ('Postgres 'Vanilla)
colInfo [OpExpG ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))]
_ -> do
    let cn :: Column ('Postgres 'Vanilla)
cn = ColumnInfo ('Postgres 'Vanilla) -> Column ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres 'Vanilla)
colInfo
    SelPermInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla) -> m ()
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
SelPermInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla) -> m ()
checkSelOnCol SelPermInfo ('Postgres 'Vanilla)
spi Column ('Postgres 'Vanilla)
cn
    AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
-> m (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return AnnBoolExpFldSQL ('Postgres 'Vanilla)
AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
annFld
  AVRelationship RelInfo ('Postgres 'Vanilla)
relInfo (RelationshipFilters AnnBoolExp
  ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
targetPerm AnnBoolExp
  ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
nesAnn) ->
    case RelInfo ('Postgres 'Vanilla) -> RelTarget ('Postgres 'Vanilla)
forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget RelInfo ('Postgres 'Vanilla)
relInfo of
      RelTargetNativeQuery NativeQueryName
_ -> [Char] -> m (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp)
forall a. HasCallStack => [Char] -> a
error [Char]
"checkOnColExp RelTargetNativeQuery"
      RelTargetTable TableName ('Postgres 'Vanilla)
tableName -> do
        SelPermInfo ('Postgres 'Vanilla)
relSPI <- (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
 SelPermInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
forall a b. (a, b) -> b
snd ((FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
  SelPermInfo ('Postgres 'Vanilla))
 -> SelPermInfo ('Postgres 'Vanilla))
-> m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
      SelPermInfo ('Postgres 'Vanilla))
-> m (SelPermInfo ('Postgres 'Vanilla))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelName
-> TableName ('Postgres 'Vanilla)
-> m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
      SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
RelName
-> TableName ('Postgres 'Vanilla)
-> m (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
      SelPermInfo ('Postgres 'Vanilla))
fetchRelDet (RelInfo ('Postgres 'Vanilla) -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo ('Postgres 'Vanilla)
relInfo) TableName ('Postgres 'Vanilla)
tableName
        AnnBoolExp ('Postgres 'Vanilla) SQLExp
modAnn <- SelPermInfo ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> AnnBoolExp
     ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SelPermInfo ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> AnnBoolExp
     ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
checkSelPerm SelPermInfo ('Postgres 'Vanilla)
relSPI SessionVariableBuilder m
sessVarBldr AnnBoolExp
  ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
nesAnn
        AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedFltr <- SessionVariableBuilder m
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
convAnnBoolExpPartialSQL SessionVariableBuilder m
sessVarBldr (AnnBoolExpPartialSQL ('Postgres 'Vanilla)
 -> m (AnnBoolExp
         ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))))
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
forall a b. (a -> b) -> a -> b
$ SelPermInfo ('Postgres 'Vanilla)
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
forall (b :: BackendType). SelPermInfo b -> AnnBoolExpPartialSQL b
spiFilter SelPermInfo ('Postgres 'Vanilla)
relSPI
        AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
-> m (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
 -> m (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp))
-> AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
-> m (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ RelInfo ('Postgres 'Vanilla)
-> RelationshipFilters ('Postgres 'Vanilla) SQLExp
-> AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
forall (backend :: BackendType) leaf.
RelInfo backend
-> RelationshipFilters backend leaf -> AnnBoolExpFld backend leaf
AVRelationship RelInfo ('Postgres 'Vanilla)
relInfo (AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> RelationshipFilters ('Postgres 'Vanilla) SQLExp
forall (backend :: BackendType) leaf.
AnnBoolExp backend leaf
-> AnnBoolExp backend leaf -> RelationshipFilters backend leaf
RelationshipFilters AnnBoolExp
  ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
AnnBoolExp ('Postgres 'Vanilla) SQLExp
targetPerm (AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
forall (backend :: BackendType) scalar.
AnnBoolExp backend scalar
-> AnnBoolExp backend scalar -> AnnBoolExp backend scalar
andAnnBoolExps AnnBoolExp ('Postgres 'Vanilla) SQLExp
modAnn AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedFltr))
  AVComputedField AnnComputedFieldBoolExp
  ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
cfBoolExp -> do
    RoleName
roleName <- m RoleName
forall (m :: * -> *). UserInfoM m => m RoleName
askCurRole
    let fieldName :: ComputedFieldName
fieldName = AnnComputedFieldBoolExp ('Postgres 'Vanilla) SQLExp
-> ComputedFieldName
forall (backend :: BackendType) scalar.
AnnComputedFieldBoolExp backend scalar -> ComputedFieldName
_acfbName AnnComputedFieldBoolExp
  ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
AnnComputedFieldBoolExp ('Postgres 'Vanilla) SQLExp
cfBoolExp
    case AnnComputedFieldBoolExp ('Postgres 'Vanilla) SQLExp
-> ComputedFieldBoolExp ('Postgres 'Vanilla) SQLExp
forall (backend :: BackendType) scalar.
AnnComputedFieldBoolExp backend scalar
-> ComputedFieldBoolExp backend scalar
_acfbBoolExp AnnComputedFieldBoolExp
  ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
AnnComputedFieldBoolExp ('Postgres 'Vanilla) SQLExp
cfBoolExp of
      CFBEScalar [OpExpG ('Postgres 'Vanilla) SQLExp]
_ -> do
        SelPermInfo ('Postgres 'Vanilla) -> ComputedFieldName -> m ()
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
SelPermInfo ('Postgres 'Vanilla) -> ComputedFieldName -> m ()
checkSelectPermOnScalarComputedField SelPermInfo ('Postgres 'Vanilla)
spi ComputedFieldName
fieldName
        AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
-> m (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnnBoolExpFldSQL ('Postgres 'Vanilla)
AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
annFld
      CFBETable TableName ('Postgres 'Vanilla)
table AnnBoolExp ('Postgres 'Vanilla) SQLExp
nesBoolExp -> do
        TableInfo ('Postgres 'Vanilla)
tableInfo <- (Text -> Text)
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErrAndSet500 (Text
"function " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (m (TableInfo ('Postgres 'Vanilla))
 -> m (TableInfo ('Postgres 'Vanilla)))
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
askTableInfoSource TableName ('Postgres 'Vanilla)
table
        let errMsg :: Text -> Text
errMsg Text
_ =
              Text
"role "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
roleName
                RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not have permission to read "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" computed field "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ComputedFieldName
fieldName
                ComputedFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
"; no permission on table "
                Text -> QualifiedTable -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName ('Postgres 'Vanilla)
QualifiedTable
table
        SelPermInfo ('Postgres 'Vanilla)
tableSPI <- (Text -> Text)
-> m (SelPermInfo ('Postgres 'Vanilla))
-> m (SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr Text -> Text
errMsg (m (SelPermInfo ('Postgres 'Vanilla))
 -> m (SelPermInfo ('Postgres 'Vanilla)))
-> m (SelPermInfo ('Postgres 'Vanilla))
-> m (SelPermInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
askSelPermInfo TableInfo ('Postgres 'Vanilla)
tableInfo
        AnnBoolExp ('Postgres 'Vanilla) SQLExp
modBoolExp <- SelPermInfo ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> AnnBoolExp
     ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SelPermInfo ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> AnnBoolExp
     ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
checkSelPerm SelPermInfo ('Postgres 'Vanilla)
tableSPI SessionVariableBuilder m
sessVarBldr AnnBoolExp
  ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
AnnBoolExp ('Postgres 'Vanilla) SQLExp
nesBoolExp
        AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedFltr <- SessionVariableBuilder m
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
convAnnBoolExpPartialSQL SessionVariableBuilder m
sessVarBldr (AnnBoolExpPartialSQL ('Postgres 'Vanilla)
 -> m (AnnBoolExp
         ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))))
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
forall a b. (a -> b) -> a -> b
$ SelPermInfo ('Postgres 'Vanilla)
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
forall (b :: BackendType). SelPermInfo b -> AnnBoolExpPartialSQL b
spiFilter SelPermInfo ('Postgres 'Vanilla)
tableSPI
        -- Including table permission filter; "input condition" AND "permission filter condition"
        let finalBoolExp :: AnnBoolExp ('Postgres 'Vanilla) SQLExp
finalBoolExp = AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
forall (backend :: BackendType) scalar.
AnnBoolExp backend scalar
-> AnnBoolExp backend scalar -> AnnBoolExp backend scalar
andAnnBoolExps AnnBoolExp ('Postgres 'Vanilla) SQLExp
modBoolExp AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedFltr
        AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
-> m (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
 -> m (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp))
-> AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
-> m (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ AnnComputedFieldBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
forall (backend :: BackendType) leaf.
AnnComputedFieldBoolExp backend leaf -> AnnBoolExpFld backend leaf
AVComputedField AnnComputedFieldBoolExp
  ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
AnnComputedFieldBoolExp ('Postgres 'Vanilla) SQLExp
cfBoolExp {_acfbBoolExp :: ComputedFieldBoolExp ('Postgres 'Vanilla) SQLExp
_acfbBoolExp = TableName ('Postgres 'Vanilla)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> ComputedFieldBoolExp ('Postgres 'Vanilla) SQLExp
forall (backend :: BackendType) scalar.
TableName backend
-> AnnBoolExp backend scalar -> ComputedFieldBoolExp backend scalar
CFBETable TableName ('Postgres 'Vanilla)
table AnnBoolExp ('Postgres 'Vanilla) SQLExp
finalBoolExp}
  AVAggregationPredicates {} -> Code -> Text -> m (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists Text
"Aggregation Predicates cannot appear in permission checks"

convAnnBoolExpPartialSQL ::
  (Applicative f) =>
  SessionVariableBuilder f ->
  AnnBoolExpPartialSQL ('Postgres 'Vanilla) ->
  f (AnnBoolExpSQL ('Postgres 'Vanilla))
convAnnBoolExpPartialSQL :: forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
convAnnBoolExpPartialSQL SessionVariableBuilder f
f =
  ((AnnBoolExpFld
   ('Postgres 'Vanilla) (PartialSQLExp ('Postgres 'Vanilla))
 -> f (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp))
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GBoolExp ('Postgres 'Vanilla) a
-> f (GBoolExp ('Postgres 'Vanilla) b)
traverse ((AnnBoolExpFld
    ('Postgres 'Vanilla) (PartialSQLExp ('Postgres 'Vanilla))
  -> f (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp))
 -> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
 -> f (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> ((PartialSQLExp ('Postgres 'Vanilla) -> f SQLExp)
    -> AnnBoolExpFld
         ('Postgres 'Vanilla) (PartialSQLExp ('Postgres 'Vanilla))
    -> f (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp))
-> (PartialSQLExp ('Postgres 'Vanilla) -> f SQLExp)
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PartialSQLExp ('Postgres 'Vanilla) -> f SQLExp)
-> AnnBoolExpFld
     ('Postgres 'Vanilla) (PartialSQLExp ('Postgres 'Vanilla))
-> f (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> AnnBoolExpFld ('Postgres 'Vanilla) a
-> f (AnnBoolExpFld ('Postgres 'Vanilla) b)
traverse) (SessionVariableBuilder f
-> PartialSQLExp ('Postgres 'Vanilla)
-> f (SQLExpression ('Postgres 'Vanilla))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> PartialSQLExp ('Postgres 'Vanilla)
-> f (SQLExpression ('Postgres 'Vanilla))
convPartialSQLExp SessionVariableBuilder f
f)

convAnnRedactionExpPartialSQL ::
  (Applicative f) =>
  SessionVariableBuilder f ->
  AnnRedactionExpPartialSQL ('Postgres 'Vanilla) ->
  f (AnnRedactionExp ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
convAnnRedactionExpPartialSQL :: forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnRedactionExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
convAnnRedactionExpPartialSQL SessionVariableBuilder f
f =
  (PartialSQLExp ('Postgres 'Vanilla) -> f SQLExp)
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnRedactionExp ('Postgres 'Vanilla) SQLExp)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> AnnRedactionExp ('Postgres 'Vanilla) a
-> f (AnnRedactionExp ('Postgres 'Vanilla) b)
traverse (SessionVariableBuilder f
-> PartialSQLExp ('Postgres 'Vanilla)
-> f (SQLExpression ('Postgres 'Vanilla))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> PartialSQLExp ('Postgres 'Vanilla)
-> f (SQLExpression ('Postgres 'Vanilla))
convPartialSQLExp SessionVariableBuilder f
f)

convPartialSQLExp ::
  (Applicative f) =>
  SessionVariableBuilder f ->
  PartialSQLExp ('Postgres 'Vanilla) ->
  f (SQLExpression ('Postgres 'Vanilla))
convPartialSQLExp :: forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> PartialSQLExp ('Postgres 'Vanilla)
-> f (SQLExpression ('Postgres 'Vanilla))
convPartialSQLExp SessionVariableBuilder f
sessVarBldr = \case
  PSESQLExp SQLExpression ('Postgres 'Vanilla)
sqlExp -> SQLExp -> f SQLExp
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SQLExpression ('Postgres 'Vanilla)
SQLExp
sqlExp
  PartialSQLExp ('Postgres 'Vanilla)
PSESession -> SQLExpression ('Postgres 'Vanilla)
-> f (SQLExpression ('Postgres 'Vanilla))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SQLExpression ('Postgres 'Vanilla)
 -> f (SQLExpression ('Postgres 'Vanilla)))
-> SQLExpression ('Postgres 'Vanilla)
-> f (SQLExpression ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ SessionVariableBuilder f -> SQLExpression ('Postgres 'Vanilla)
forall (m :: * -> *).
SessionVariableBuilder m -> SQLExpression ('Postgres 'Vanilla)
_svbCurrentSession SessionVariableBuilder f
sessVarBldr
  PSESessVar SessionVarType ('Postgres 'Vanilla)
colTy SessionVariable
sessionVariable -> (SessionVariableBuilder f
-> SessionVarType ('Postgres 'Vanilla)
-> SessionVariable
-> f (SQLExpression ('Postgres 'Vanilla))
forall (m :: * -> *).
SessionVariableBuilder m
-> SessionVarType ('Postgres 'Vanilla)
-> SessionVariable
-> m (SQLExpression ('Postgres 'Vanilla))
_svbVariableParser SessionVariableBuilder f
sessVarBldr) SessionVarType ('Postgres 'Vanilla)
colTy SessionVariable
sessionVariable

sessVarFromCurrentSetting ::
  (Applicative f) => SessionVariableBuilder f
sessVarFromCurrentSetting :: forall (f :: * -> *). Applicative f => SessionVariableBuilder f
sessVarFromCurrentSetting =
  SQLExpression ('Postgres 'Vanilla)
-> (SessionVarType ('Postgres 'Vanilla)
    -> SessionVariable -> f (SQLExpression ('Postgres 'Vanilla)))
-> SessionVariableBuilder f
forall (m :: * -> *).
SQLExpression ('Postgres 'Vanilla)
-> (SessionVarType ('Postgres 'Vanilla)
    -> SessionVariable -> m (SQLExpression ('Postgres 'Vanilla)))
-> SessionVariableBuilder m
SessionVariableBuilder SQLExpression ('Postgres 'Vanilla)
SQLExp
currentSession ((SessionVarType ('Postgres 'Vanilla)
  -> SessionVariable -> f (SQLExpression ('Postgres 'Vanilla)))
 -> SessionVariableBuilder f)
-> (SessionVarType ('Postgres 'Vanilla)
    -> SessionVariable -> f (SQLExpression ('Postgres 'Vanilla)))
-> SessionVariableBuilder f
forall a b. (a -> b) -> a -> b
$ \SessionVarType ('Postgres 'Vanilla)
ty SessionVariable
var -> SQLExp -> f SQLExp
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SQLExp -> f SQLExp) -> SQLExp -> f SQLExp
forall a b. (a -> b) -> a -> b
$ CollectableType PGScalarType -> SessionVariable -> SQLExp
sessVarFromCurrentSetting' SessionVarType ('Postgres 'Vanilla)
CollectableType PGScalarType
ty SessionVariable
var

sessVarFromCurrentSetting' :: CollectableType PGScalarType -> SessionVariable -> S.SQLExp
sessVarFromCurrentSetting' :: CollectableType PGScalarType -> SessionVariable -> SQLExp
sessVarFromCurrentSetting' CollectableType PGScalarType
ty SessionVariable
sessVar =
  CollectableType PGScalarType -> SQLExp -> SQLExp
withTypeAnn CollectableType PGScalarType
ty (SQLExp -> SQLExp) -> SQLExp -> SQLExp
forall a b. (a -> b) -> a -> b
$ SQLExp -> SessionVariable -> SQLExp
fromCurrentSession SQLExp
currentSession SessionVariable
sessVar

fromCurrentSession ::
  S.SQLExp ->
  SessionVariable ->
  S.SQLExp
fromCurrentSession :: SQLExp -> SessionVariable -> SQLExp
fromCurrentSession SQLExp
currentSessionExp SessionVariable
sessVar =
  SQLOp -> [SQLExp] -> SQLExp
S.SEOpApp
    (Text -> SQLOp
S.SQLOp Text
"->>")
    [SQLExp
currentSessionExp, Text -> SQLExp
S.SELit (Text -> SQLExp) -> Text -> SQLExp
forall a b. (a -> b) -> a -> b
$ SessionVariable -> Text
sessionVariableToText SessionVariable
sessVar]

currentSession :: S.SQLExp
currentSession :: SQLExp
currentSession = Text -> SQLExp
S.SEUnsafe Text
"current_setting('hasura.user')::json"

checkSelPerm ::
  (UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
  SelPermInfo ('Postgres 'Vanilla) ->
  SessionVariableBuilder m ->
  AnnBoolExpSQL ('Postgres 'Vanilla) ->
  m (AnnBoolExpSQL ('Postgres 'Vanilla))
checkSelPerm :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SelPermInfo ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> AnnBoolExp
     ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
checkSelPerm SelPermInfo ('Postgres 'Vanilla)
spi SessionVariableBuilder m
sessVarBldr =
  (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
 -> m (AnnBoolExpFld ('Postgres 'Vanilla) SQLExp))
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GBoolExp ('Postgres 'Vanilla) a
-> f (GBoolExp ('Postgres 'Vanilla) b)
traverse (SelPermInfo ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> AnnBoolExpFldSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpFldSQL ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SelPermInfo ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> AnnBoolExpFldSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpFldSQL ('Postgres 'Vanilla))
checkOnColExp SelPermInfo ('Postgres 'Vanilla)
spi SessionVariableBuilder m
sessVarBldr)

convBoolExp ::
  (UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
  FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
  SelPermInfo ('Postgres 'Vanilla) ->
  BoolExp ('Postgres 'Vanilla) ->
  SessionVariableBuilder m ->
  FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
  ValueParser ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla)) ->
  m (AnnBoolExpSQL ('Postgres 'Vanilla))
convBoolExp :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> BoolExp ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> ValueParser
     ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
convBoolExp FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
cim SelPermInfo ('Postgres 'Vanilla)
spi BoolExp ('Postgres 'Vanilla)
be SessionVariableBuilder m
sessVarBldr FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
rootFieldInfoMap ValueParser
  ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
rhsParser = do
  let boolExpRHSParser :: BoolExpRHSParser
  ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
boolExpRHSParser = ValueParser
  ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
-> SQLExpression ('Postgres 'Vanilla)
-> BoolExpRHSParser
     ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
forall (b :: BackendType) (m :: * -> *) v.
ValueParser b m v -> v -> BoolExpRHSParser b m v
BoolExpRHSParser ValueParser
  ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
rhsParser (SQLExpression ('Postgres 'Vanilla)
 -> BoolExpRHSParser
      ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla)))
-> SQLExpression ('Postgres 'Vanilla)
-> BoolExpRHSParser
     ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ SessionVariableBuilder m -> SQLExpression ('Postgres 'Vanilla)
forall (m :: * -> *).
SessionVariableBuilder m -> SQLExpression ('Postgres 'Vanilla)
_svbCurrentSession SessionVariableBuilder m
sessVarBldr
  AnnBoolExp ('Postgres 'Vanilla) SQLExp
abe <- BoolExpRHSParser ('Postgres 'Vanilla) m SQLExp
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> GBoolExp ('Postgres 'Vanilla) ColExp
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
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
  ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
BoolExpRHSParser ('Postgres 'Vanilla) m SQLExp
boolExpRHSParser FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
rootFieldInfoMap FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
cim (GBoolExp ('Postgres 'Vanilla) ColExp
 -> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> GBoolExp ('Postgres 'Vanilla) ColExp
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ BoolExp ('Postgres 'Vanilla)
-> GBoolExp ('Postgres 'Vanilla) ColExp
forall (b :: BackendType). BoolExp b -> GBoolExp b ColExp
unBoolExp BoolExp ('Postgres 'Vanilla)
be
  SelPermInfo ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> AnnBoolExp
     ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SelPermInfo ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> AnnBoolExp
     ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
checkSelPerm SelPermInfo ('Postgres 'Vanilla)
spi SessionVariableBuilder m
sessVarBldr AnnBoolExp
  ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
AnnBoolExp ('Postgres 'Vanilla) SQLExp
abe

-- validate headers
validateHeaders :: (UserInfoM m, QErrM m) => HashSet Text -> m ()
validateHeaders :: forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
HashSet Text -> m ()
validateHeaders HashSet Text
depHeaders = do
  [Text]
headers <- SessionVariables -> [Text]
getSessionVariables (SessionVariables -> [Text])
-> (UserInfo -> SessionVariables) -> UserInfo -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo -> SessionVariables
_uiSession (UserInfo -> [Text]) -> m UserInfo -> m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UserInfo
forall (m :: * -> *). UserInfoM m => m UserInfo
askUserInfo
  HashSet Text -> (Text -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ HashSet Text
depHeaders ((Text -> m ()) -> m ()) -> (Text -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Text
hdr ->
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
hdr Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.toLower [Text]
headers)
      (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
NotFound
      (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
hdr
      Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" header is expected but not found"

-- validate limit and offset int values
onlyPositiveInt :: (MonadError QErr m) => Int -> m ()
onlyPositiveInt :: forall (m :: * -> *). MonadError QErr m => Int -> m ()
onlyPositiveInt Int
i =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0)
    (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
NotSupported
      Text
"unexpected negative value"