module Hasura.RQL.DML.Internal
  ( SessionVariableBuilder,
    askDelPermInfo,
    askInsPermInfo,
    askPermInfo,
    askSelPermInfo,
    askTableInfoSource,
    askUpdPermInfo,
    binRHSBuilder,
    checkPermOnCol,
    checkRetCols,
    checkSelOnCol,
    convAnnBoolExpPartialSQL,
    convAnnColumnCaseBoolExpPartialSQL,
    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 M
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 Q
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.BoolExp
import Hasura.Backends.Postgres.Translate.Column
import Hasura.Backends.Postgres.Types.Column
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend
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.SchemaCache
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Hasura.SQL.Types
import Hasura.Server.Types
import Hasura.Session

newtype DMLP1T m a = DMLP1T {DMLP1T m a -> StateT (Seq PrepArg) m a
unDMLP1T :: StateT (DS.Seq Q.PrepArg) m a}
  deriving
    ( a -> DMLP1T m b -> DMLP1T m a
(a -> b) -> DMLP1T m a -> DMLP1T m b
(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
<$ :: a -> DMLP1T m b -> DMLP1T m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> DMLP1T m b -> DMLP1T m a
fmap :: (a -> b) -> DMLP1T m a -> DMLP1T m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> DMLP1T m a -> DMLP1T m b
Functor,
      Functor (DMLP1T m)
a -> DMLP1T m a
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)
DMLP1T m a -> DMLP1T m b -> DMLP1T m b
DMLP1T m a -> DMLP1T m b -> DMLP1T m a
DMLP1T m (a -> b) -> DMLP1T m a -> DMLP1T m b
(a -> b -> c) -> DMLP1T m a -> DMLP1T m b -> DMLP1T m c
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
<* :: DMLP1T m a -> DMLP1T m b -> DMLP1T m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> DMLP1T m b -> DMLP1T m a
*> :: DMLP1T m a -> DMLP1T m b -> DMLP1T m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> DMLP1T m b -> DMLP1T m b
liftA2 :: (a -> b -> c) -> DMLP1T m a -> DMLP1T m b -> DMLP1T m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> DMLP1T m a -> DMLP1T m b -> DMLP1T m c
<*> :: DMLP1T m (a -> b) -> DMLP1T m a -> DMLP1T m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
DMLP1T m (a -> b) -> DMLP1T m a -> DMLP1T m b
pure :: a -> DMLP1T m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> DMLP1T m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (DMLP1T m)
Applicative,
      Applicative (DMLP1T m)
a -> DMLP1T m a
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)
DMLP1T m a -> (a -> DMLP1T m b) -> DMLP1T m b
DMLP1T m a -> DMLP1T m b -> DMLP1T m b
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
return :: a -> DMLP1T m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> DMLP1T m a
>> :: DMLP1T m a -> DMLP1T m b -> DMLP1T m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> DMLP1T m b -> DMLP1T m b
>>= :: DMLP1T m a -> (a -> DMLP1T m b) -> DMLP1T m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
DMLP1T m a -> (a -> DMLP1T m b) -> DMLP1T m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (DMLP1T m)
Monad,
      m a -> DMLP1T m a
(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
lift :: m a -> DMLP1T m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> DMLP1T m a
MonadTrans,
      MonadState (DS.Seq Q.PrepArg),
      MonadError e,
      Monad (DMLP1T m)
DMLP1T m SourceName
Monad (DMLP1T m) -> DMLP1T m SourceName -> SourceM (DMLP1T m)
forall (m :: * -> *). Monad m -> m SourceName -> SourceM m
forall (m :: * -> *). SourceM m => Monad (DMLP1T m)
forall (m :: * -> *). SourceM m => DMLP1T m SourceName
askCurrentSource :: DMLP1T m SourceName
$caskCurrentSource :: forall (m :: * -> *). SourceM m => DMLP1T m SourceName
$cp1SourceM :: forall (m :: * -> *). SourceM m => Monad (DMLP1T m)
SourceM,
      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
askSchemaCache :: DMLP1T m SchemaCache
$caskSchemaCache :: forall (m :: * -> *). CacheRM m => DMLP1T m SchemaCache
$cp1CacheRM :: forall (m :: * -> *). CacheRM m => Monad (DMLP1T m)
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
askUserInfo :: DMLP1T m UserInfo
$caskUserInfo :: forall (m :: * -> *). UserInfoM m => DMLP1T m UserInfo
$cp1UserInfoM :: forall (m :: * -> *). UserInfoM m => Monad (DMLP1T m)
UserInfoM,
      Monad (DMLP1T m)
DMLP1T m ServerConfigCtx
Monad (DMLP1T m)
-> DMLP1T m ServerConfigCtx -> HasServerConfigCtx (DMLP1T m)
forall (m :: * -> *).
Monad m -> m ServerConfigCtx -> HasServerConfigCtx m
forall (m :: * -> *). HasServerConfigCtx m => Monad (DMLP1T m)
forall (m :: * -> *).
HasServerConfigCtx m =>
DMLP1T m ServerConfigCtx
askServerConfigCtx :: DMLP1T m ServerConfigCtx
$caskServerConfigCtx :: forall (m :: * -> *).
HasServerConfigCtx m =>
DMLP1T m ServerConfigCtx
$cp1HasServerConfigCtx :: forall (m :: * -> *). HasServerConfigCtx m => Monad (DMLP1T m)
HasServerConfigCtx
    )

runDMLP1T :: DMLP1T m a -> m (a, DS.Seq Q.PrepArg)
runDMLP1T :: 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 :: 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 (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 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 :: 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 :: 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 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
M.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 (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 :: 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 forall (b :: BackendType).
Lens' (RolePermInfo b) (Maybe (InsPermInfo b))
Lens'
  (RolePermInfo ('Postgres 'Vanilla))
  (Maybe (InsPermInfo ('Postgres 'Vanilla)))
permIns

askSelPermInfo ::
  (UserInfoM m, QErrM m) =>
  TableInfo ('Postgres 'Vanilla) ->
  m (SelPermInfo ('Postgres 'Vanilla))
askSelPermInfo :: 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 forall (b :: BackendType).
Lens' (RolePermInfo b) (Maybe (SelPermInfo b))
Lens'
  (RolePermInfo ('Postgres 'Vanilla))
  (Maybe (SelPermInfo ('Postgres 'Vanilla)))
permSel

askUpdPermInfo ::
  (UserInfoM m, QErrM m) =>
  TableInfo ('Postgres 'Vanilla) ->
  m (UpdPermInfo ('Postgres 'Vanilla))
askUpdPermInfo :: 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 forall (b :: BackendType).
Lens' (RolePermInfo b) (Maybe (UpdPermInfo b))
Lens'
  (RolePermInfo ('Postgres 'Vanilla))
  (Maybe (UpdPermInfo ('Postgres 'Vanilla)))
permUpd

askDelPermInfo ::
  (UserInfoM m, QErrM m) =>
  TableInfo ('Postgres 'Vanilla) ->
  m (DelPermInfo ('Postgres 'Vanilla))
askDelPermInfo :: 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 forall (b :: BackendType).
Lens' (RolePermInfo b) (Maybe (DelPermInfo b))
Lens'
  (RolePermInfo ('Postgres 'Vanilla))
  (Maybe (DelPermInfo ('Postgres 'Vanilla)))
permDel

verifyAsrns :: (MonadError QErr m) => [a -> m ()] -> [a] -> m ()
verifyAsrns :: [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 :: 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 :: 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 ([PGCol] -> HashSet PGCol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([PGCol] -> HashSet PGCol) -> [PGCol] -> HashSet PGCol
forall a b. (a -> b) -> a -> b
$ HashMap
  PGCol (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
-> [PGCol]
forall k v. HashMap k v -> [k]
M.keys (HashMap
   PGCol (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
 -> [PGCol])
-> HashMap
     PGCol (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
-> [PGCol]
forall a b. (a -> b) -> a -> b
$ SelPermInfo ('Postgres 'Vanilla)
-> HashMap
     (Column ('Postgres 'Vanilla))
     (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
forall (b :: BackendType).
SelPermInfo b
-> HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiCols SelPermInfo ('Postgres 'Vanilla)
selPermInfo)

checkPermOnCol ::
  (UserInfoM m, QErrM m) =>
  PermType ->
  HS.HashSet (Column ('Postgres 'Vanilla)) ->
  Column ('Postgres 'Vanilla) ->
  m ()
checkPermOnCol :: 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 :: 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
     (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
-> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
M.member ComputedFieldName
computedField (HashMap
   ComputedFieldName
   (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
 -> Bool)
-> HashMap
     ComputedFieldName
     (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
-> Bool
forall a b. (a -> b) -> a -> b
$ SelPermInfo ('Postgres 'Vanilla)
-> HashMap
     ComputedFieldName
     (Maybe (AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)))
forall (b :: BackendType).
SelPermInfo b
-> HashMap
     ComputedFieldName (Maybe (AnnColumnCaseBoolExpPartialSQL 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 :: (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 <- ColumnType ('Postgres 'Vanilla)
-> [Value] -> m [ScalarValue ('Postgres 'Vanilla)]
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ColumnType b -> [Value] -> m [ScalarValue b]
parseScalarValuesColumnType ColumnType ('Postgres 'Vanilla)
ofTy [Value]
vals
    SQLExp -> m SQLExp
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 :: 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 <- ColumnType ('Postgres 'Vanilla)
-> Value -> DMLP1T m (ScalarValue ('Postgres 'Vanilla))
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnType 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 (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 :: 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 :: 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
  { SessionVariableBuilder m -> SQLExpression ('Postgres 'Vanilla)
_svbCurrentSession :: SQLExpression ('Postgres 'Vanilla),
    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 :: 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 (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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return AnnBoolExpFldSQL ('Postgres 'Vanilla)
AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
annFld
  AVRelationship RelInfo ('Postgres 'Vanilla)
relInfo AnnBoolExp
  ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla))
nesAnn -> 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) (RelInfo ('Postgres 'Vanilla) -> TableName ('Postgres 'Vanilla)
forall (b :: BackendType). RelInfo b -> TableName b
riRTable RelInfo ('Postgres 'Vanilla)
relInfo)
    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 (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)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
forall (backend :: BackendType) leaf.
RelInfo backend
-> AnnBoolExp backend leaf -> AnnBoolExpFld backend leaf
AVRelationship RelInfo ('Postgres 'Vanilla)
relInfo (AnnBoolExp ('Postgres 'Vanilla) SQLExp
 -> AnnBoolExpFld ('Postgres 'Vanilla) SQLExp)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnBoolExpFld ('Postgres 'Vanilla) SQLExp
forall a b. (a -> b) -> a -> b
$ 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 (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 (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 :: 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)
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)
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)

convAnnColumnCaseBoolExpPartialSQL ::
  (Applicative f) =>
  SessionVariableBuilder f ->
  AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla) ->
  f (AnnColumnCaseBoolExp ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
convAnnColumnCaseBoolExpPartialSQL :: SessionVariableBuilder f
-> AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnColumnCaseBoolExp
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
convAnnColumnCaseBoolExpPartialSQL SessionVariableBuilder f
f =
  ((AnnColumnCaseBoolExpField
   ('Postgres 'Vanilla) (PartialSQLExp ('Postgres 'Vanilla))
 -> f (AnnColumnCaseBoolExpField ('Postgres 'Vanilla) SQLExp))
-> AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (GBoolExp
        ('Postgres 'Vanilla)
        (AnnColumnCaseBoolExpField ('Postgres 'Vanilla) SQLExp))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((AnnColumnCaseBoolExpField
    ('Postgres 'Vanilla) (PartialSQLExp ('Postgres 'Vanilla))
  -> f (AnnColumnCaseBoolExpField ('Postgres 'Vanilla) SQLExp))
 -> AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)
 -> f (GBoolExp
         ('Postgres 'Vanilla)
         (AnnColumnCaseBoolExpField ('Postgres 'Vanilla) SQLExp)))
-> ((PartialSQLExp ('Postgres 'Vanilla) -> f SQLExp)
    -> AnnColumnCaseBoolExpField
         ('Postgres 'Vanilla) (PartialSQLExp ('Postgres 'Vanilla))
    -> f (AnnColumnCaseBoolExpField ('Postgres 'Vanilla) SQLExp))
-> (PartialSQLExp ('Postgres 'Vanilla) -> f SQLExp)
-> AnnColumnCaseBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (GBoolExp
        ('Postgres 'Vanilla)
        (AnnColumnCaseBoolExpField ('Postgres 'Vanilla) SQLExp))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PartialSQLExp ('Postgres 'Vanilla) -> f SQLExp)
-> AnnColumnCaseBoolExpField
     ('Postgres 'Vanilla) (PartialSQLExp ('Postgres 'Vanilla))
-> f (AnnColumnCaseBoolExpField ('Postgres 'Vanilla) SQLExp)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 :: SessionVariableBuilder f
-> PartialSQLExp ('Postgres 'Vanilla)
-> f (SQLExpression ('Postgres 'Vanilla))
convPartialSQLExp SessionVariableBuilder f
sessVarBldr = \case
  PSESQLExp SQLExpression ('Postgres 'Vanilla)
sqlExp -> SQLExp -> f SQLExp
forall (f :: * -> *) a. Applicative f => a -> f a
pure SQLExpression ('Postgres 'Vanilla)
SQLExp
sqlExp
  PartialSQLExp ('Postgres 'Vanilla)
PSESession -> SQLExp -> f SQLExp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SQLExp -> f SQLExp) -> SQLExp -> f SQLExp
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 :: 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 (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 :: 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)
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 ->
  TableName ('Postgres 'Vanilla) ->
  ValueParser ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla)) ->
  m (AnnBoolExpSQL ('Postgres 'Vanilla))
convBoolExp :: FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> BoolExp ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> TableName ('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 TableName ('Postgres 'Vanilla)
rootTable ValueParser
  ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
rhsParser = do
  let boolExpRHSParser :: BoolExpRHSParser ('Postgres 'Vanilla) m SQLExp
boolExpRHSParser = ValueParser ('Postgres 'Vanilla) m SQLExp
-> SQLExp -> BoolExpRHSParser ('Postgres 'Vanilla) m SQLExp
forall (b :: BackendType) (m :: * -> *) v.
ValueParser b m v -> v -> BoolExpRHSParser b m v
BoolExpRHSParser ValueParser
  ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
ValueParser ('Postgres 'Vanilla) m SQLExp
rhsParser (SQLExp -> BoolExpRHSParser ('Postgres 'Vanilla) m SQLExp)
-> SQLExp -> BoolExpRHSParser ('Postgres 'Vanilla) m SQLExp
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
-> TableName ('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
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser ('Postgres 'Vanilla) m SQLExp
boolExpRHSParser TableName ('Postgres 'Vanilla)
rootTable 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 :: 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 (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 :: 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"