module Hasura.RQL.DML.Select
( runSelect,
)
where
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty qualified as NE
import Data.Sequence qualified as DS
import Data.Text.Extended
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Connection.MonadTx
import Hasura.Backends.Postgres.Execute.Types
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Types hiding (TableName)
import Hasura.Backends.Postgres.Translate.Select
import Hasura.Backends.Postgres.Translate.Select.Internal.Helpers (selectToSelectWith, toQuery)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DML.Internal
import Hasura.RQL.DML.Types
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.OrderBy
import Hasura.RQL.IR.Select
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.SchemaCache
import Hasura.Session
import Hasura.Table.Cache
import Hasura.Tracing qualified as Tracing
type SelectQExt = SelectG (ExtCol ('Postgres 'Vanilla)) (BoolExp ('Postgres 'Vanilla)) Int
data ExtCol (b :: BackendType)
= ECSimple (Column b)
| ECRel RelName (Maybe RelName) SelectQExt
convSelCol ::
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
SelPermInfo ('Postgres 'Vanilla) ->
SelCol ->
m [ExtCol ('Postgres 'Vanilla)]
convSelCol :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelCol
-> m [ExtCol ('Postgres 'Vanilla)]
convSelCol FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
_ SelPermInfo ('Postgres 'Vanilla)
_ (SCExtSimple PGCol
cn) =
[ExtCol ('Postgres 'Vanilla)] -> m [ExtCol ('Postgres 'Vanilla)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Column ('Postgres 'Vanilla) -> ExtCol ('Postgres 'Vanilla)
forall (b :: BackendType). Column b -> ExtCol b
ECSimple Column ('Postgres 'Vanilla)
PGCol
cn]
convSelCol FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
_ (SCExtRel RelName
rn Maybe RelName
malias SelectQ
selQ) = do
let pgWhenRelErr :: Text
pgWhenRelErr = Text
"only relationships can be expanded"
RelInfo ('Postgres 'Vanilla)
relInfo <-
Text
-> m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"name"
(m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla)))
-> m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> RelName -> Text -> m (RelInfo ('Postgres 'Vanilla))
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> Text -> m (RelInfo backend)
askRelType FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap RelName
rn Text
pgWhenRelErr
case RelInfo ('Postgres 'Vanilla)
relInfo of
(RelInfo {riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget = RelTargetNativeQuery NativeQueryName
_}) -> [Char] -> m [ExtCol ('Postgres 'Vanilla)]
forall a. HasCallStack => [Char] -> a
error [Char]
"convSelCol RelTargetNativeQuery"
(RelInfo {riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget = RelTargetTable TableName ('Postgres 'Vanilla)
relTable}) -> do
(FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
rfim, SelPermInfo ('Postgres 'Vanilla)
rspi) <- 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 RelName
rn TableName ('Postgres 'Vanilla)
relTable
SelectQExt
resolvedSelQ <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla) -> SelectQ -> m SelectQExt
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla) -> SelectQ -> m SelectQExt
resolveStar FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
rfim SelPermInfo ('Postgres 'Vanilla)
rspi SelectQ
selQ
[ExtCol ('Postgres 'Vanilla)] -> m [ExtCol ('Postgres 'Vanilla)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [RelName
-> Maybe RelName -> SelectQExt -> ExtCol ('Postgres 'Vanilla)
forall (b :: BackendType).
RelName -> Maybe RelName -> SelectQExt -> ExtCol b
ECRel RelName
rn Maybe RelName
malias SelectQExt
resolvedSelQ]
convSelCol FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
spi (SCStar Wildcard
wildcard) =
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
convWildcard FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
spi Wildcard
wildcard
convWildcard ::
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
SelPermInfo ('Postgres 'Vanilla) ->
Wildcard ->
m [ExtCol ('Postgres 'Vanilla)]
convWildcard :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
convWildcard FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPermInfo Wildcard
wildcard =
case Wildcard
wildcard of
Wildcard
Star -> [ExtCol ('Postgres 'Vanilla)] -> m [ExtCol ('Postgres 'Vanilla)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ExtCol ('Postgres 'Vanilla)]
simpleCols
(StarDot Wildcard
wc) -> ([ExtCol ('Postgres 'Vanilla)]
simpleCols [ExtCol ('Postgres 'Vanilla)]
-> [ExtCol ('Postgres 'Vanilla)] -> [ExtCol ('Postgres 'Vanilla)]
forall a. [a] -> [a] -> [a]
++) ([ExtCol ('Postgres 'Vanilla)] -> [ExtCol ('Postgres 'Vanilla)])
-> m [ExtCol ('Postgres 'Vanilla)]
-> m [ExtCol ('Postgres 'Vanilla)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Maybe (ExtCol ('Postgres 'Vanilla))]
-> [ExtCol ('Postgres 'Vanilla)]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes ([Maybe (ExtCol ('Postgres 'Vanilla))]
-> [ExtCol ('Postgres 'Vanilla)])
-> m [Maybe (ExtCol ('Postgres 'Vanilla))]
-> m [ExtCol ('Postgres 'Vanilla)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wildcard -> m [Maybe (ExtCol ('Postgres 'Vanilla))]
relExtCols Wildcard
wc)
where
cols :: HashMap
(Column ('Postgres 'Vanilla))
(AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
cols = 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
pgCols :: [PGCol]
pgCols = (StructuredColumnInfo ('Postgres 'Vanilla) -> PGCol)
-> [StructuredColumnInfo ('Postgres 'Vanilla)] -> [PGCol]
forall a b. (a -> b) -> [a] -> [b]
map StructuredColumnInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla)
StructuredColumnInfo ('Postgres 'Vanilla) -> PGCol
forall (b :: BackendType). StructuredColumnInfo b -> Column b
structuredColumnInfoColumn ([StructuredColumnInfo ('Postgres 'Vanilla)] -> [PGCol])
-> [StructuredColumnInfo ('Postgres 'Vanilla)] -> [PGCol]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [StructuredColumnInfo ('Postgres 'Vanilla)]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [StructuredColumnInfo backend]
getCols FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap
relColInfos :: [RelInfo ('Postgres 'Vanilla)]
relColInfos = FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [RelInfo ('Postgres 'Vanilla)]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [RelInfo backend]
getRels FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap
simpleCols :: [ExtCol ('Postgres 'Vanilla)]
simpleCols = (PGCol -> ExtCol ('Postgres 'Vanilla))
-> [PGCol] -> [ExtCol ('Postgres 'Vanilla)]
forall a b. (a -> b) -> [a] -> [b]
map Column ('Postgres 'Vanilla) -> ExtCol ('Postgres 'Vanilla)
PGCol -> ExtCol ('Postgres 'Vanilla)
forall (b :: BackendType). Column b -> ExtCol b
ECSimple ([PGCol] -> [ExtCol ('Postgres 'Vanilla)])
-> [PGCol] -> [ExtCol ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$ (PGCol -> Bool) -> [PGCol] -> [PGCol]
forall a. (a -> Bool) -> [a] -> [a]
filter (Column ('Postgres 'Vanilla)
-> HashMap
(Column ('Postgres 'Vanilla))
(AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HashMap.member` HashMap
(Column ('Postgres 'Vanilla))
(AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
cols) [PGCol]
pgCols
mkRelCol :: Wildcard -> RelInfo b -> m (Maybe (ExtCol b))
mkRelCol Wildcard
_wc (RelInfo {riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget = RelTargetNativeQuery NativeQueryName
_}) =
[Char] -> m (Maybe (ExtCol b))
forall a. HasCallStack => [Char] -> a
error [Char]
"convWildcard RelTargetNativeQuery"
mkRelCol Wildcard
wc (RelInfo {riName :: forall (b :: BackendType). RelInfo b -> RelName
riName = RelName
relName, riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget = RelTargetTable TableName b
relTableName}) = do
TableInfo ('Postgres 'Vanilla)
relTabInfo <- TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
fetchRelTabInfo TableName b
TableName ('Postgres 'Vanilla)
relTableName
Maybe (SelPermInfo ('Postgres 'Vanilla))
mRelSelPerm <- Lens'
(RolePermInfo ('Postgres 'Vanilla))
(Maybe (SelPermInfo ('Postgres 'Vanilla)))
-> TableInfo ('Postgres 'Vanilla)
-> m (Maybe (SelPermInfo ('Postgres 'Vanilla)))
forall (m :: * -> *) c.
UserInfoM m =>
Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla) -> m (Maybe c)
askPermInfo (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 TableInfo ('Postgres 'Vanilla)
relTabInfo
Maybe (SelPermInfo ('Postgres 'Vanilla))
-> (SelPermInfo ('Postgres 'Vanilla) -> m (ExtCol b))
-> m (Maybe (ExtCol b))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (SelPermInfo ('Postgres 'Vanilla))
mRelSelPerm ((SelPermInfo ('Postgres 'Vanilla) -> m (ExtCol b))
-> m (Maybe (ExtCol b)))
-> (SelPermInfo ('Postgres 'Vanilla) -> m (ExtCol b))
-> m (Maybe (ExtCol b))
forall a b. (a -> b) -> a -> b
$ \SelPermInfo ('Postgres 'Vanilla)
relSelPermInfo -> do
[ExtCol ('Postgres 'Vanilla)]
rExtCols <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
convWildcard (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)
relTabInfo) SelPermInfo ('Postgres 'Vanilla)
relSelPermInfo Wildcard
wc
ExtCol b -> m (ExtCol b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(ExtCol b -> m (ExtCol b)) -> ExtCol b -> m (ExtCol b)
forall a b. (a -> b) -> a -> b
$ RelName -> Maybe RelName -> SelectQExt -> ExtCol b
forall (b :: BackendType).
RelName -> Maybe RelName -> SelectQExt -> ExtCol b
ECRel RelName
relName Maybe RelName
forall a. Maybe a
Nothing
(SelectQExt -> ExtCol b) -> SelectQExt -> ExtCol b
forall a b. (a -> b) -> a -> b
$ [ExtCol ('Postgres 'Vanilla)]
-> Maybe (BoolExp ('Postgres 'Vanilla))
-> Maybe OrderByExp
-> Maybe Int
-> Maybe Int
-> SelectQExt
forall a b c.
[a]
-> Maybe b
-> Maybe OrderByExp
-> Maybe c
-> Maybe c
-> SelectG a b c
SelectG [ExtCol ('Postgres 'Vanilla)]
rExtCols Maybe (BoolExp ('Postgres 'Vanilla))
forall a. Maybe a
Nothing Maybe OrderByExp
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing
relExtCols :: Wildcard -> m [Maybe (ExtCol ('Postgres 'Vanilla))]
relExtCols Wildcard
wc = (RelInfo ('Postgres 'Vanilla)
-> m (Maybe (ExtCol ('Postgres 'Vanilla))))
-> [RelInfo ('Postgres 'Vanilla)]
-> m [Maybe (ExtCol ('Postgres 'Vanilla))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Wildcard
-> RelInfo ('Postgres 'Vanilla)
-> m (Maybe (ExtCol ('Postgres 'Vanilla)))
forall {b :: BackendType} {m :: * -> *} {b :: BackendType}.
(TableName b ~ QualifiedTable, MonadError QErr m,
TableInfoRM ('Postgres 'Vanilla) m, UserInfoM m) =>
Wildcard -> RelInfo b -> m (Maybe (ExtCol b))
mkRelCol Wildcard
wc) [RelInfo ('Postgres 'Vanilla)]
relColInfos
resolveStar ::
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
SelPermInfo ('Postgres 'Vanilla) ->
SelectQ ->
m SelectQExt
resolveStar :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla) -> SelectQ -> m SelectQExt
resolveStar FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fim SelPermInfo ('Postgres 'Vanilla)
selPermInfo (SelectG [SelCol]
selCols Maybe (BoolExp ('Postgres 'Vanilla))
mWh Maybe OrderByExp
mOb Maybe Int
mLt Maybe Int
mOf) = do
[ExtCol ('Postgres 'Vanilla)]
procOverrides <- ([Maybe [ExtCol ('Postgres 'Vanilla)]]
-> [ExtCol ('Postgres 'Vanilla)])
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [ExtCol ('Postgres 'Vanilla)]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([[ExtCol ('Postgres 'Vanilla)]] -> [ExtCol ('Postgres 'Vanilla)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ExtCol ('Postgres 'Vanilla)]] -> [ExtCol ('Postgres 'Vanilla)])
-> ([Maybe [ExtCol ('Postgres 'Vanilla)]]
-> [[ExtCol ('Postgres 'Vanilla)]])
-> [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> [ExtCol ('Postgres 'Vanilla)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> [[ExtCol ('Postgres 'Vanilla)]]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes)
(m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [ExtCol ('Postgres 'Vanilla)])
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [ExtCol ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$ Text
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"columns"
(m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]])
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
forall a b. (a -> b) -> a -> b
$ [SelCol]
-> (SelCol -> m (Maybe [ExtCol ('Postgres 'Vanilla)]))
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM [SelCol]
selCols
((SelCol -> m (Maybe [ExtCol ('Postgres 'Vanilla)]))
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]])
-> (SelCol -> m (Maybe [ExtCol ('Postgres 'Vanilla)]))
-> m [Maybe [ExtCol ('Postgres 'Vanilla)]]
forall a b. (a -> b) -> a -> b
$ \SelCol
selCol -> case SelCol
selCol of
(SCStar Wildcard
_) -> Maybe [ExtCol ('Postgres 'Vanilla)]
-> m (Maybe [ExtCol ('Postgres 'Vanilla)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [ExtCol ('Postgres 'Vanilla)]
forall a. Maybe a
Nothing
SelCol
_ -> [ExtCol ('Postgres 'Vanilla)]
-> Maybe [ExtCol ('Postgres 'Vanilla)]
forall a. a -> Maybe a
Just ([ExtCol ('Postgres 'Vanilla)]
-> Maybe [ExtCol ('Postgres 'Vanilla)])
-> m [ExtCol ('Postgres 'Vanilla)]
-> m (Maybe [ExtCol ('Postgres 'Vanilla)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelCol
-> m [ExtCol ('Postgres 'Vanilla)]
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelCol
-> m [ExtCol ('Postgres 'Vanilla)]
convSelCol FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fim SelPermInfo ('Postgres 'Vanilla)
selPermInfo SelCol
selCol
[ExtCol ('Postgres 'Vanilla)]
everything <- case [Wildcard]
wildcards of
[] -> [ExtCol ('Postgres 'Vanilla)] -> m [ExtCol ('Postgres 'Vanilla)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
[Wildcard]
_ -> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> Wildcard
-> m [ExtCol ('Postgres 'Vanilla)]
convWildcard FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fim SelPermInfo ('Postgres 'Vanilla)
selPermInfo (Wildcard -> m [ExtCol ('Postgres 'Vanilla)])
-> Wildcard -> m [ExtCol ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$ [Wildcard] -> Wildcard
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Wildcard]
wildcards
let extCols :: [ExtCol ('Postgres 'Vanilla)]
extCols = (ExtCol ('Postgres 'Vanilla)
-> ExtCol ('Postgres 'Vanilla) -> Bool)
-> [ExtCol ('Postgres 'Vanilla)]
-> [ExtCol ('Postgres 'Vanilla)]
-> [ExtCol ('Postgres 'Vanilla)]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy ExtCol ('Postgres 'Vanilla) -> ExtCol ('Postgres 'Vanilla) -> Bool
forall {b :: BackendType} {b :: BackendType}.
(Column b ~ Column b, Eq (Column b)) =>
ExtCol b -> ExtCol b -> Bool
equals [ExtCol ('Postgres 'Vanilla)]
procOverrides [ExtCol ('Postgres 'Vanilla)]
everything
SelectQExt -> m SelectQExt
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SelectQExt -> m SelectQExt) -> SelectQExt -> m SelectQExt
forall a b. (a -> b) -> a -> b
$ [ExtCol ('Postgres 'Vanilla)]
-> Maybe (BoolExp ('Postgres 'Vanilla))
-> Maybe OrderByExp
-> Maybe Int
-> Maybe Int
-> SelectQExt
forall a b c.
[a]
-> Maybe b
-> Maybe OrderByExp
-> Maybe c
-> Maybe c
-> SelectG a b c
SelectG [ExtCol ('Postgres 'Vanilla)]
extCols Maybe (BoolExp ('Postgres 'Vanilla))
mWh Maybe OrderByExp
mOb Maybe Int
mLt Maybe Int
mOf
where
wildcards :: [Wildcard]
wildcards = [Either Wildcard SelCol] -> [Wildcard]
forall a b. [Either a b] -> [a]
lefts ([Either Wildcard SelCol] -> [Wildcard])
-> [Either Wildcard SelCol] -> [Wildcard]
forall a b. (a -> b) -> a -> b
$ (SelCol -> Either Wildcard SelCol)
-> [SelCol] -> [Either Wildcard SelCol]
forall a b. (a -> b) -> [a] -> [b]
map SelCol -> Either Wildcard SelCol
mkEither [SelCol]
selCols
mkEither :: SelCol -> Either Wildcard SelCol
mkEither (SCStar Wildcard
wc) = Wildcard -> Either Wildcard SelCol
forall a b. a -> Either a b
Left Wildcard
wc
mkEither SelCol
selCol = SelCol -> Either Wildcard SelCol
forall a b. b -> Either a b
Right SelCol
selCol
equals :: ExtCol b -> ExtCol b -> Bool
equals (ECSimple Column b
x) (ECSimple Column b
y) = Column b
x Column b -> Column b -> Bool
forall a. Eq a => a -> a -> Bool
== Column b
Column b
y
equals (ECRel RelName
x Maybe RelName
_ SelectQExt
_) (ECRel RelName
y Maybe RelName
_ SelectQExt
_) = RelName
x RelName -> RelName -> Bool
forall a. Eq a => a -> a -> Bool
== RelName
y
equals ExtCol b
_ ExtCol b
_ = Bool
False
convOrderByElem ::
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m ->
(FieldInfoMap (FieldInfo ('Postgres 'Vanilla)), SelPermInfo ('Postgres 'Vanilla)) ->
OrderByCol ->
m (AnnotatedOrderByElement ('Postgres 'Vanilla) S.SQLExp)
convOrderByElem :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m
-> (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
-> OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
convOrderByElem SessionVariableBuilder m
sessVarBldr (FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
flds, SelPermInfo ('Postgres 'Vanilla)
spi) = \case
OCPG FieldName
fldName -> do
FieldInfo ('Postgres 'Vanilla)
fldInfo <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> FieldName -> m (FieldInfo ('Postgres 'Vanilla))
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
flds FieldName
fldName
case FieldInfo ('Postgres 'Vanilla)
fldInfo of
FIColumn (SCIScalarColumn ColumnInfo ('Postgres 'Vanilla)
colInfo) -> do
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 (ColumnInfo ('Postgres 'Vanilla) -> Column ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres 'Vanilla)
colInfo)
let redactionExp :: AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
redactionExp = AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
-> Maybe (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
forall a. a -> Maybe a -> a
fromMaybe AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
forall (b :: BackendType) v. AnnRedactionExp b v
NoRedaction (Maybe (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> Maybe (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
forall a b. (a -> b) -> a -> b
$ PGCol
-> HashMap PGCol (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> Maybe (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (ColumnInfo ('Postgres 'Vanilla) -> Column ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres 'Vanilla)
colInfo) (SelPermInfo ('Postgres 'Vanilla)
-> HashMap
(Column ('Postgres 'Vanilla))
(AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
forall (b :: BackendType).
SelPermInfo b -> HashMap (Column b) (AnnRedactionExpPartialSQL b)
spiCols SelPermInfo ('Postgres 'Vanilla)
spi)
AnnRedactionExp ('Postgres 'Vanilla) SQLExp
resolvedRedactionExp <- SessionVariableBuilder m
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnRedactionExp
('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnRedactionExp
('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
convAnnRedactionExpPartialSQL SessionVariableBuilder m
sessVarBldr AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
redactionExp
let ty :: ColumnType ('Postgres 'Vanilla)
ty = ColumnInfo ('Postgres 'Vanilla) -> ColumnType ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo ('Postgres 'Vanilla)
colInfo
if (ScalarType ('Postgres 'Vanilla) -> Bool)
-> ColumnType ('Postgres 'Vanilla) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere ScalarType ('Postgres 'Vanilla) -> Bool
PGScalarType -> Bool
isGeoType ColumnType ('Postgres 'Vanilla)
ty
then
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload
(Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ FieldName
fldName
FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has type 'geometry' and cannot be used in order_by"
else AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ ColumnInfo ('Postgres 'Vanilla)
-> AnnRedactionExp ('Postgres 'Vanilla) SQLExp
-> AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
ColumnInfo b -> AnnRedactionExp b v -> AnnotatedOrderByElement b v
AOCColumn ColumnInfo ('Postgres 'Vanilla)
colInfo AnnRedactionExp ('Postgres 'Vanilla) SQLExp
resolvedRedactionExp
FIRelationship RelInfo ('Postgres 'Vanilla)
_ ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload
(Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ FieldName
fldName
FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a relationship and should be expanded"
FIComputedField ComputedFieldInfo ('Postgres 'Vanilla)
_ ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload
(Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ FieldName
fldName
FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a computed field and can't be used in 'order_by'"
FIRemoteRelationship {} ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (FieldName
fldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a remote field")
OCRel FieldName
fldName OrderByCol
rest -> do
FieldInfo ('Postgres 'Vanilla)
fldInfo <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> FieldName -> m (FieldInfo ('Postgres 'Vanilla))
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
flds FieldName
fldName
case FieldInfo ('Postgres 'Vanilla)
fldInfo of
FIColumn StructuredColumnInfo ('Postgres 'Vanilla)
_ ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload
(Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ FieldName
fldName
FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a Postgres column and cannot be chained further"
FIComputedField ComputedFieldInfo ('Postgres 'Vanilla)
_ ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload
(Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ FieldName
fldName
FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a computed field and can't be used in 'order_by'"
FIRelationship RelInfo ('Postgres 'Vanilla)
relInfo -> do
QualifiedTable
relTableName <- case RelInfo ('Postgres 'Vanilla) -> RelTarget ('Postgres 'Vanilla)
forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget RelInfo ('Postgres 'Vanilla)
relInfo of
RelTargetTable TableName ('Postgres 'Vanilla)
tn -> QualifiedTable -> m QualifiedTable
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TableName ('Postgres 'Vanilla)
QualifiedTable
tn
RelTargetNativeQuery NativeQueryName
_ -> [Char] -> m QualifiedTable
forall a. HasCallStack => [Char] -> a
error [Char]
"convOrderByElem RelTargetNativeQuery"
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RelInfo ('Postgres 'Vanilla) -> RelType
forall (b :: BackendType). RelInfo b -> RelType
riType RelInfo ('Postgres 'Vanilla)
relInfo RelType -> RelType -> Bool
forall a. Eq a => a -> a -> Bool
== RelType
ArrRel)
(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
UnexpectedPayload
(Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ FieldName
fldName
FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is an array relationship and can't be used in 'order_by'"
(FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
relFim, SelPermInfo ('Postgres 'Vanilla)
relSelPermInfo) <- 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)
QualifiedTable
relTableName
AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedSelFltr <- SessionVariableBuilder m
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnBoolExpSQL ('Postgres 'Vanilla))
convAnnBoolExpPartialSQL SessionVariableBuilder m
sessVarBldr (AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla)))
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('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)
relSelPermInfo
RelInfo ('Postgres 'Vanilla)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
-> AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
RelInfo b
-> AnnBoolExp b v
-> AnnotatedOrderByElement b v
-> AnnotatedOrderByElement b v
AOCObjectRelation RelInfo ('Postgres 'Vanilla)
relInfo AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedSelFltr (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp
-> AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionVariableBuilder m
-> (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
-> OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m
-> (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
-> OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
convOrderByElem SessionVariableBuilder m
sessVarBldr (FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
relFim, SelPermInfo ('Postgres 'Vanilla)
relSelPermInfo) OrderByCol
rest
FIRemoteRelationship {} ->
Code
-> Text -> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (FieldName
fldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a remote field")
convSelectQ ::
( UserInfoM m,
QErrM m,
TableInfoRM ('Postgres 'Vanilla) m
) =>
SQLGenCtx ->
TableName ('Postgres 'Vanilla) ->
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
SelPermInfo ('Postgres 'Vanilla) ->
SelectQExt ->
SessionVariableBuilder m ->
ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQ :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SQLGenCtx
-> TableName ('Postgres 'Vanilla)
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQ SQLGenCtx
sqlGen TableName ('Postgres 'Vanilla)
table FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPermInfo SelectQExt
selQ SessionVariableBuilder m
sessVarBldr ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr = do
Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
wClause <- Maybe (BoolExp ('Postgres 'Vanilla))
-> (BoolExp ('Postgres 'Vanilla)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> m (Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (SelectQExt -> Maybe (BoolExp ('Postgres 'Vanilla))
forall a b c. SelectG a b c -> Maybe b
sqWhere SelectQExt
selQ) ((BoolExp ('Postgres 'Vanilla)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> m (Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)))
-> (BoolExp ('Postgres 'Vanilla)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> m (Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
forall a b. (a -> b) -> a -> b
$ \BoolExp ('Postgres 'Vanilla)
boolExp ->
Text
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"where"
(m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ 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))
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 (AnnBoolExpSQL ('Postgres 'Vanilla))
convBoolExp FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPermInfo BoolExp ('Postgres 'Vanilla)
boolExp SessionVariableBuilder m
sessVarBldr FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap ValueParser
('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr
[(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
annFlds <- Text
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"columns"
(m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)])
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
forall a b. (a -> b) -> a -> b
$ [ExtCol ('Postgres 'Vanilla)]
-> (ExtCol ('Postgres 'Vanilla)
-> m (FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp))
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM (SelectQExt -> [ExtCol ('Postgres 'Vanilla)]
forall a b c. SelectG a b c -> [a]
sqColumns SelectQExt
selQ)
((ExtCol ('Postgres 'Vanilla)
-> m (FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp))
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)])
-> (ExtCol ('Postgres 'Vanilla)
-> m (FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp))
-> m [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
forall a b. (a -> b) -> a -> b
$ \case
(ECSimple Column ('Postgres 'Vanilla)
pgCol) -> do
(ColumnInfo ('Postgres 'Vanilla)
colInfo, AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
redactionExp) <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> PGCol
-> m (ColumnInfo ('Postgres 'Vanilla),
AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> PGCol
-> m (ColumnInfo ('Postgres 'Vanilla),
AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
convExtSimple FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPermInfo Column ('Postgres 'Vanilla)
PGCol
pgCol
AnnRedactionExp ('Postgres 'Vanilla) SQLExp
resolvedRedactionExp <- SessionVariableBuilder m
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnRedactionExp
('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnRedactionExp
('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
convAnnRedactionExpPartialSQL SessionVariableBuilder m
sessVarBldr AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
redactionExp
(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
-> m (FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (b :: BackendType). Backend b => Column b -> FieldName
fromCol @('Postgres 'Vanilla) Column ('Postgres 'Vanilla)
pgCol, Column ('Postgres 'Vanilla)
-> ColumnType ('Postgres 'Vanilla)
-> AnnRedactionExp ('Postgres 'Vanilla) SQLExp
-> Maybe (ScalarSelectionArguments ('Postgres 'Vanilla))
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp
forall (backend :: BackendType) v r.
Column backend
-> ColumnType backend
-> AnnRedactionExp backend v
-> Maybe (ScalarSelectionArguments backend)
-> AnnFieldG backend r v
mkAnnColumnField (ColumnInfo ('Postgres 'Vanilla) -> Column ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres 'Vanilla)
colInfo) (ColumnInfo ('Postgres 'Vanilla) -> ColumnType ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo ('Postgres 'Vanilla)
colInfo) AnnRedactionExp ('Postgres 'Vanilla) SQLExp
resolvedRedactionExp Maybe (ScalarSelectionArguments ('Postgres 'Vanilla))
Maybe ColumnOp
forall a. Maybe a
Nothing)
(ECRel RelName
relName Maybe RelName
mAlias SelectQExt
relSelQ) -> do
Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
annRel <-
SQLGenCtx
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> RelName
-> Maybe RelName
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (Either
(ObjectRelationSelect ('Postgres 'Vanilla))
(ArraySelect ('Postgres 'Vanilla)))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SQLGenCtx
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> RelName
-> Maybe RelName
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (Either
(ObjectRelationSelect ('Postgres 'Vanilla))
(ArraySelect ('Postgres 'Vanilla)))
convExtRel
SQLGenCtx
sqlGen
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap
RelName
relName
Maybe RelName
mAlias
SelectQExt
relSelQ
SessionVariableBuilder m
sessVarBldr
ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr
(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
-> m (FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( RelName -> FieldName
fromRel (RelName -> FieldName) -> RelName -> FieldName
forall a b. (a -> b) -> a -> b
$ RelName -> Maybe RelName -> RelName
forall a. a -> Maybe a -> a
fromMaybe RelName
relName Maybe RelName
mAlias,
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
-> (ArraySelectG ('Postgres 'Vanilla) Void SQLExp
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp)
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) r v.
ObjectRelationSelectG b r v -> AnnFieldG b r v
AFObjectRelation ArraySelectG ('Postgres 'Vanilla) Void SQLExp
-> AnnFieldG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) r v.
ArraySelectG b r v -> AnnFieldG b r v
AFArrayRelation Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
annRel
)
Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
annOrdByML <- Maybe OrderByExp
-> (OrderByExp
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
-> m (Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (SelectQExt -> Maybe OrderByExp
forall a b c. SelectG a b c -> Maybe OrderByExp
sqOrderBy SelectQExt
selQ) ((OrderByExp
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
-> m (Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]))
-> (OrderByExp
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
-> m (Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
forall a b. (a -> b) -> a -> b
$ \(OrderByExp [OrderByItem ('Postgres 'Vanilla)]
obItems) ->
Text
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"order_by"
(m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
forall a b. (a -> b) -> a -> b
$ [OrderByItem ('Postgres 'Vanilla)]
-> (OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM [OrderByItem ('Postgres 'Vanilla)]
obItems
((OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)])
-> (OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
-> m [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
forall a b. (a -> b) -> a -> b
$ (OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> OrderByItemG ('Postgres 'Vanilla) a
-> m (OrderByItemG ('Postgres 'Vanilla) b)
mapM
((OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
-> (OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
-> OrderByItem ('Postgres 'Vanilla)
-> m (OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))
forall a b. (a -> b) -> a -> b
$ SessionVariableBuilder m
-> (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
-> OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m
-> (FieldInfoMap (FieldInfo ('Postgres 'Vanilla)),
SelPermInfo ('Postgres 'Vanilla))
-> OrderByCol
-> m (AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)
convOrderByElem SessionVariableBuilder m
sessVarBldr (FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap, SelPermInfo ('Postgres 'Vanilla)
selPermInfo)
let annOrdByM :: Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
annOrdByM = [OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp))))
-> Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
-> Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe
[OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)]
annOrdByML
Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"limit" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (Int -> m ()) -> Maybe Int -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> m ()
forall (m :: * -> *). MonadError QErr m => Int -> m ()
onlyPositiveInt Maybe Int
mQueryLimit
Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"offset" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (Int -> m ()) -> Maybe Int -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> m ()
forall (m :: * -> *). MonadError QErr m => Int -> m ()
onlyPositiveInt Maybe Int
mQueryOffset
AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedSelFltr <-
SessionVariableBuilder m
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnBoolExpSQL ('Postgres 'Vanilla))
convAnnBoolExpPartialSQL SessionVariableBuilder m
sessVarBldr
(AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla)))
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('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)
selPermInfo
let tabFrom :: SelectFromG ('Postgres 'Vanilla) SQLExp
tabFrom = TableName ('Postgres 'Vanilla)
-> SelectFromG ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v. TableName b -> SelectFromG b v
FromTable TableName ('Postgres 'Vanilla)
table
tabPerm :: TablePermG ('Postgres 'Vanilla) SQLExp
tabPerm = AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> Maybe Int -> TablePermG ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
AnnBoolExp b v -> Maybe Int -> TablePermG b v
TablePerm AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedSelFltr Maybe Int
mPermLimit
tabArgs :: SelectArgsG ('Postgres 'Vanilla) SQLExp
tabArgs = Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
-> Maybe Int
-> Maybe Int64
-> Maybe (NonEmpty (AnnDistinctColumn ('Postgres 'Vanilla) SQLExp))
-> SelectArgsG ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
Maybe (AnnBoolExp b v)
-> Maybe (NonEmpty (AnnotatedOrderByItemG b v))
-> Maybe Int
-> Maybe Int64
-> Maybe (NonEmpty (AnnDistinctColumn b v))
-> SelectArgsG b v
SelectArgs Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
wClause Maybe
(NonEmpty
(OrderByItemG
('Postgres 'Vanilla)
(AnnotatedOrderByElement ('Postgres 'Vanilla) SQLExp)))
annOrdByM Maybe Int
mQueryLimit (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Maybe Int -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mQueryOffset) Maybe (NonEmpty (AnnDistinctColumn ('Postgres 'Vanilla) SQLExp))
forall a. Maybe a
Nothing
strfyNum :: StringifyNumbers
strfyNum = SQLGenCtx -> StringifyNumbers
stringifyNum SQLGenCtx
sqlGen
AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp))
-> AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp)
forall a b. (a -> b) -> a -> b
$ [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
-> SelectFromG ('Postgres 'Vanilla) SQLExp
-> TablePermG ('Postgres 'Vanilla) SQLExp
-> SelectArgsG ('Postgres 'Vanilla) SQLExp
-> StringifyNumbers
-> Maybe NamingCase
-> AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
forall (b :: BackendType) (f :: * -> *) v.
Fields (f v)
-> SelectFromG b v
-> TablePermG b v
-> SelectArgsG b v
-> StringifyNumbers
-> Maybe NamingCase
-> AnnSelectG b f v
AnnSelectG [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
annFlds SelectFromG ('Postgres 'Vanilla) SQLExp
tabFrom TablePermG ('Postgres 'Vanilla) SQLExp
tabPerm SelectArgsG ('Postgres 'Vanilla) SQLExp
tabArgs StringifyNumbers
strfyNum Maybe NamingCase
forall a. Maybe a
Nothing
where
mQueryOffset :: Maybe Int
mQueryOffset = SelectQExt -> Maybe Int
forall a b c. SelectG a b c -> Maybe c
sqOffset SelectQExt
selQ
mQueryLimit :: Maybe Int
mQueryLimit = SelectQExt -> Maybe Int
forall a b c. SelectG a b c -> Maybe c
sqLimit SelectQExt
selQ
mPermLimit :: Maybe Int
mPermLimit = SelPermInfo ('Postgres 'Vanilla) -> Maybe Int
forall (b :: BackendType). SelPermInfo b -> Maybe Int
spiLimit SelPermInfo ('Postgres 'Vanilla)
selPermInfo
convExtSimple ::
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
SelPermInfo ('Postgres 'Vanilla) ->
PGCol ->
m (ColumnInfo ('Postgres 'Vanilla), AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
convExtSimple :: forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> PGCol
-> m (ColumnInfo ('Postgres 'Vanilla),
AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
convExtSimple FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPermInfo PGCol
pgCol = do
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 Column ('Postgres 'Vanilla)
PGCol
pgCol
ColumnInfo ('Postgres 'Vanilla)
colInfo <- 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
pgCol Text
relWhenPGErr
(ColumnInfo ('Postgres 'Vanilla),
AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> m (ColumnInfo ('Postgres 'Vanilla),
AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColumnInfo ('Postgres 'Vanilla)
colInfo, AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
-> Maybe (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
forall a. a -> Maybe a -> a
fromMaybe AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
forall (b :: BackendType) v. AnnRedactionExp b v
NoRedaction (Maybe (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> Maybe (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> AnnRedactionExpPartialSQL ('Postgres 'Vanilla)
forall a b. (a -> b) -> a -> b
$ PGCol
-> HashMap PGCol (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
-> Maybe (AnnRedactionExpPartialSQL ('Postgres 'Vanilla))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup PGCol
pgCol (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))
where
relWhenPGErr :: Text
relWhenPGErr = Text
"relationships have to be expanded"
convExtRel ::
( UserInfoM m,
QErrM m,
TableInfoRM ('Postgres 'Vanilla) m
) =>
SQLGenCtx ->
FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
RelName ->
Maybe RelName ->
SelectQExt ->
SessionVariableBuilder m ->
ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
m (Either (ObjectRelationSelect ('Postgres 'Vanilla)) (ArraySelect ('Postgres 'Vanilla)))
convExtRel :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SQLGenCtx
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> RelName
-> Maybe RelName
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (Either
(ObjectRelationSelect ('Postgres 'Vanilla))
(ArraySelect ('Postgres 'Vanilla)))
convExtRel SQLGenCtx
sqlGen FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap RelName
relName Maybe RelName
mAlias SelectQExt
selQ SessionVariableBuilder m
sessVarBldr ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr = do
RelInfo ('Postgres 'Vanilla)
relInfo <-
Text
-> m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"name"
(m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla)))
-> m (RelInfo ('Postgres 'Vanilla))
-> m (RelInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> RelName -> Text -> m (RelInfo ('Postgres 'Vanilla))
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> Text -> m (RelInfo backend)
askRelType FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap RelName
relName Text
pgWhenRelErr
let (RelInfo {riType :: forall (b :: BackendType). RelInfo b -> RelType
riType = RelType
relTy, riMapping :: forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping = HashMap (Column ('Postgres 'Vanilla)) (Column ('Postgres 'Vanilla))
colMapping, riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget = RelTarget ('Postgres 'Vanilla)
relTarget}) = RelInfo ('Postgres 'Vanilla)
relInfo
QualifiedTable
relTableName <- case RelTarget ('Postgres 'Vanilla)
relTarget of
RelTargetNativeQuery NativeQueryName
_ -> [Char] -> m QualifiedTable
forall a. HasCallStack => [Char] -> a
error [Char]
"convExtRel RelTargetNativeQuery"
RelTargetTable TableName ('Postgres 'Vanilla)
tn -> QualifiedTable -> m QualifiedTable
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TableName ('Postgres 'Vanilla)
QualifiedTable
tn
(FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
relCIM, SelPermInfo ('Postgres 'Vanilla)
relSPI) <- 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 RelName
relName TableName ('Postgres 'Vanilla)
QualifiedTable
relTableName
AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
annSel <- SQLGenCtx
-> TableName ('Postgres 'Vanilla)
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SQLGenCtx
-> TableName ('Postgres 'Vanilla)
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQ SQLGenCtx
sqlGen TableName ('Postgres 'Vanilla)
QualifiedTable
relTableName FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
relCIM SelPermInfo ('Postgres 'Vanilla)
relSPI SelectQExt
selQ SessionVariableBuilder m
sessVarBldr ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr
case RelType
relTy of
RelType
ObjRel -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
misused (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
UnexpectedPayload Text
objRelMisuseMsg
Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)))
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
forall a b. (a -> b) -> a -> b
$ ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
forall a b. a -> Either a b
Left
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
-> ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
forall a b. (a -> b) -> a -> b
$ RelName
-> HashMap
(Column ('Postgres 'Vanilla)) (Column ('Postgres 'Vanilla))
-> Nullable
-> AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp
-> ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) a.
RelName
-> HashMap (Column b) (Column b)
-> Nullable
-> a
-> AnnRelationSelectG b a
AnnRelationSelectG (RelName -> Maybe RelName -> RelName
forall a. a -> Maybe a -> a
fromMaybe RelName
relName Maybe RelName
mAlias) HashMap (Column ('Postgres 'Vanilla)) (Column ('Postgres 'Vanilla))
colMapping Nullable
Nullable
(AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp
-> ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
-> AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp
-> ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp
forall a b. (a -> b) -> a -> b
$ [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
-> SelectFromG ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) r v.
AnnFieldsG b r v
-> SelectFromG b v -> AnnBoolExp b v -> AnnObjectSelectG b r v
AnnObjectSelectG (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> [(FieldName, AnnFieldG ('Postgres 'Vanilla) Void SQLExp)]
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Fields (f v)
_asnFields AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
annSel) (TableName ('Postgres 'Vanilla)
-> SelectFromG ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v. TableName b -> SelectFromG b v
FromTable TableName ('Postgres 'Vanilla)
QualifiedTable
relTableName)
(AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnObjectSelectG ('Postgres 'Vanilla) Void SQLExp
forall a b. (a -> b) -> a -> b
$ TablePermG ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v. TablePermG b v -> AnnBoolExp b v
_tpFilter
(TablePermG ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> TablePermG ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
forall a b. (a -> b) -> a -> b
$ AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> TablePermG ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> TablePermG b v
_asnPerm AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
annSel
RelType
ArrRel ->
Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)))
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> m (Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
forall a b. (a -> b) -> a -> b
$ ArraySelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
forall a b. b -> Either a b
Right
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp))
-> ArraySelectG ('Postgres 'Vanilla) Void SQLExp
-> Either
(ObjectRelationSelectG ('Postgres 'Vanilla) Void SQLExp)
(ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
forall a b. (a -> b) -> a -> b
$ ArrayRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> ArraySelectG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) r v.
ArrayRelationSelectG b r v -> ArraySelectG b r v
ASSimple
(ArrayRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> ArraySelectG ('Postgres 'Vanilla) Void SQLExp)
-> ArrayRelationSelectG ('Postgres 'Vanilla) Void SQLExp
-> ArraySelectG ('Postgres 'Vanilla) Void SQLExp
forall a b. (a -> b) -> a -> b
$ RelName
-> HashMap
(Column ('Postgres 'Vanilla)) (Column ('Postgres 'Vanilla))
-> Nullable
-> AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
-> ArrayRelationSelectG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) a.
RelName
-> HashMap (Column b) (Column b)
-> Nullable
-> a
-> AnnRelationSelectG b a
AnnRelationSelectG
(RelName -> Maybe RelName -> RelName
forall a. a -> Maybe a -> a
fromMaybe RelName
relName Maybe RelName
mAlias)
HashMap (Column ('Postgres 'Vanilla)) (Column ('Postgres 'Vanilla))
colMapping
Nullable
Nullable
AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp
annSel
where
pgWhenRelErr :: Text
pgWhenRelErr = Text
"only relationships can be expanded"
misused :: Bool
misused =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
[ Maybe (BoolExp ('Postgres 'Vanilla)) -> Bool
forall a. Maybe a -> Bool
isJust (SelectQExt -> Maybe (BoolExp ('Postgres 'Vanilla))
forall a b c. SelectG a b c -> Maybe b
sqWhere SelectQExt
selQ),
Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (SelectQExt -> Maybe Int
forall a b c. SelectG a b c -> Maybe c
sqLimit SelectQExt
selQ),
Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (SelectQExt -> Maybe Int
forall a b c. SelectG a b c -> Maybe c
sqOffset SelectQExt
selQ),
Maybe OrderByExp -> Bool
forall a. Maybe a -> Bool
isJust (SelectQExt -> Maybe OrderByExp
forall a b c. SelectG a b c -> Maybe OrderByExp
sqOrderBy SelectQExt
selQ)
]
objRelMisuseMsg :: Text
objRelMisuseMsg =
Text
"when selecting an 'obj_relationship' 'where', 'order_by', 'limit' and 'offset' can't be used"
convSelectQuery ::
( UserInfoM m,
QErrM m,
TableInfoRM ('Postgres 'Vanilla) m
) =>
SQLGenCtx ->
SessionVariableBuilder m ->
ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
SelectQuery ->
m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQuery :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SQLGenCtx
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> SelectQuery
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQuery SQLGenCtx
sqlGen SessionVariableBuilder m
sessVarBldr ValueParser ('Postgres 'Vanilla) m SQLExp
prepArgBuilder (DMLQuery SourceName
_ QualifiedTable
qt SelectQ
selQ) = do
TableInfo ('Postgres 'Vanilla)
tabInfo <- Text
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"table" (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)
QualifiedTable
qt
SelPermInfo ('Postgres 'Vanilla)
selPermInfo <- TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
askSelPermInfo TableInfo ('Postgres 'Vanilla)
tabInfo
let fieldInfo :: FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfo = 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)
tabInfo
SelectQExt
extSelQ <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla) -> SelectQ -> m SelectQExt
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla) -> SelectQ -> m SelectQExt
resolveStar FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfo SelPermInfo ('Postgres 'Vanilla)
selPermInfo SelectQ
selQ
HashSet Text -> m ()
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
HashSet Text -> m ()
validateHeaders (HashSet Text -> m ()) -> HashSet Text -> m ()
forall a b. (a -> b) -> a -> b
$ SelPermInfo ('Postgres 'Vanilla) -> HashSet Text
forall (b :: BackendType). SelPermInfo b -> HashSet Text
spiRequiredHeaders SelPermInfo ('Postgres 'Vanilla)
selPermInfo
SQLGenCtx
-> TableName ('Postgres 'Vanilla)
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SQLGenCtx
-> TableName ('Postgres 'Vanilla)
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> SelectQExt
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQ SQLGenCtx
sqlGen TableName ('Postgres 'Vanilla)
QualifiedTable
qt FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfo SelPermInfo ('Postgres 'Vanilla)
selPermInfo SelectQExt
extSelQ SessionVariableBuilder m
sessVarBldr ValueParser ('Postgres 'Vanilla) m SQLExp
prepArgBuilder
selectP2 :: JsonAggSelect -> (AnnSimpleSelect ('Postgres 'Vanilla), DS.Seq PG.PrepArg) -> PG.TxE QErr EncJSON
selectP2 :: JsonAggSelect
-> (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg)
-> TxE QErr EncJSON
selectP2 JsonAggSelect
jsonAggSelect (AnnSimpleSelect ('Postgres 'Vanilla)
sel, Seq PrepArg
p) =
Identity EncJSON -> EncJSON
forall a. Identity a -> a
runIdentity
(Identity EncJSON -> EncJSON)
-> (SingleRow (Identity EncJSON) -> Identity EncJSON)
-> SingleRow (Identity EncJSON)
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity EncJSON) -> Identity EncJSON
forall a. SingleRow a -> a
PG.getRow
(SingleRow (Identity EncJSON) -> EncJSON)
-> TxET QErr IO (SingleRow (Identity EncJSON)) -> TxE QErr EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> [PrepArg]
-> Bool
-> TxET QErr IO (SingleRow (Identity EncJSON))
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> [PrepArg] -> Bool -> TxET e m a
PG.rawQE PGTxErr -> QErr
dmlTxErrorHandler Query
selectSQL (Seq PrepArg -> [PrepArg]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq PrepArg
p) Bool
True
where
selectSQL :: Query
selectSQL =
SelectWithG TopLevelCTE -> Query
toQuery
(SelectWithG TopLevelCTE -> Query)
-> SelectWithG TopLevelCTE -> Query
forall a b. (a -> b) -> a -> b
$ Writer CustomSQLCTEs Select -> SelectWithG TopLevelCTE
selectToSelectWith
(Writer CustomSQLCTEs Select -> SelectWithG TopLevelCTE)
-> Writer CustomSQLCTEs Select -> SelectWithG TopLevelCTE
forall a b. (a -> b) -> a -> b
$ JsonAggSelect
-> AnnSimpleSelect ('Postgres 'Vanilla)
-> Writer CustomSQLCTEs Select
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind,
MonadWriter CustomSQLCTEs m) =>
JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> m Select
mkSQLSelect JsonAggSelect
jsonAggSelect AnnSimpleSelect ('Postgres 'Vanilla)
sel
phaseOne ::
(QErrM m, UserInfoM m, CacheRM m) =>
SQLGenCtx ->
SelectQuery ->
m (AnnSimpleSelect ('Postgres 'Vanilla), DS.Seq PG.PrepArg)
phaseOne :: forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m) =>
SQLGenCtx
-> SelectQuery
-> m (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg)
phaseOne SQLGenCtx
sqlGen SelectQuery
query = do
let sourceName :: SourceName
sourceName = SelectQuery -> SourceName
forall a. DMLQuery a -> SourceName
getSourceDMLQuery SelectQuery
query
HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
tableCache :: TableCache ('Postgres 'Vanilla) <- Maybe
(HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla)))
-> HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe
(HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla)))
-> HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla)))
-> m (Maybe
(HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))))
-> m (HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName
-> m (Maybe
(HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))))
forall (b :: BackendType) (m :: * -> *).
(Backend b, CacheRM m) =>
SourceName -> m (Maybe (TableCache b))
askTableCache SourceName
sourceName
(TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg))
-> HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
-> TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
forall (b :: BackendType) (m :: * -> *) a.
TableCacheRT b m a -> TableCache b -> m a
runTableCacheRT HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
tableCache
(TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg))
-> TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
forall a b. (a -> b) -> a -> b
$ DMLP1T
(TableCacheRT ('Postgres 'Vanilla) m)
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp)
-> TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
forall (m :: * -> *) a. DMLP1T m a -> m (a, Seq PrepArg)
runDMLP1T
(DMLP1T
(TableCacheRT ('Postgres 'Vanilla) m)
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp)
-> TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg))
-> DMLP1T
(TableCacheRT ('Postgres 'Vanilla) m)
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp)
-> TableCacheRT
('Postgres 'Vanilla)
m
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
forall a b. (a -> b) -> a -> b
$ SQLGenCtx
-> SessionVariableBuilder
(DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
-> ValueParser
('Postgres 'Vanilla)
(DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
SQLExp
-> SelectQuery
-> DMLP1T
(TableCacheRT ('Postgres 'Vanilla) m)
(AnnSimpleSelect ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SQLGenCtx
-> SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> SelectQuery
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQuery SQLGenCtx
sqlGen SessionVariableBuilder
(DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
forall (f :: * -> *). Applicative f => SessionVariableBuilder f
sessVarFromCurrentSetting ((ColumnType ('Postgres 'Vanilla)
-> Value -> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) SQLExp)
-> ValueParser
('Postgres 'Vanilla)
(DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
SQLExp
forall (m :: * -> *).
MonadError QErr m =>
(ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> CollectableType (ColumnType ('Postgres 'Vanilla))
-> Value
-> m SQLExp
valueParserWithCollectableType ColumnType ('Postgres 'Vanilla)
-> Value -> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) SQLExp
forall (m :: * -> *).
QErrM m =>
ColumnType ('Postgres 'Vanilla) -> Value -> DMLP1T m SQLExp
binRHSBuilder) SelectQuery
query
phaseTwo :: (MonadTx m) => (AnnSimpleSelect ('Postgres 'Vanilla), DS.Seq PG.PrepArg) -> m EncJSON
phaseTwo :: forall (m :: * -> *).
MonadTx m =>
(AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg) -> m EncJSON
phaseTwo =
TxE QErr EncJSON -> m EncJSON
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr EncJSON -> m EncJSON)
-> ((AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> TxE QErr EncJSON)
-> (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonAggSelect
-> (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg)
-> TxE QErr EncJSON
selectP2 JsonAggSelect
JASMultipleRows
runSelect ::
( QErrM m,
UserInfoM m,
CacheRM m,
MonadIO m,
MonadBaseControl IO m,
Tracing.MonadTrace m,
MetadataM m
) =>
SQLGenCtx ->
SelectQuery ->
m EncJSON
runSelect :: forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, MonadIO m, MonadBaseControl IO m,
MonadTrace m, MetadataM m) =>
SQLGenCtx -> SelectQuery -> m EncJSON
runSelect SQLGenCtx
sqlGen SelectQuery
q = do
PGSourceConfig
sourceConfig <- forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @('Postgres 'Vanilla) (SelectQuery -> SourceName
forall a. DMLQuery a -> SourceName
getSourceDMLQuery SelectQuery
q)
SQLGenCtx
-> SelectQuery
-> m (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg)
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m) =>
SQLGenCtx
-> SelectQuery
-> m (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg)
phaseOne SQLGenCtx
sqlGen SelectQuery
q m (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> ((AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m EncJSON)
-> m EncJSON
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PGExecCtx
-> PGExecTxType -> PGExecFrom -> TxET QErr m EncJSON -> m EncJSON
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, MonadTrace m,
UserInfoM m) =>
PGExecCtx -> PGExecTxType -> PGExecFrom -> TxET QErr m a -> m a
runTxWithCtx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
sourceConfig) (TxAccess -> Maybe TxIsolation -> PGExecTxType
Tx TxAccess
PG.ReadOnly Maybe TxIsolation
forall a. Maybe a
Nothing) PGExecFrom
LegacyRQLQuery (TxET QErr m EncJSON -> m EncJSON)
-> ((AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> TxET QErr m EncJSON)
-> (AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg)
-> TxET QErr m EncJSON
(AnnSelectG
('Postgres 'Vanilla) (AnnFieldG ('Postgres 'Vanilla) Void) SQLExp,
Seq PrepArg)
-> TxET QErr m EncJSON
forall (m :: * -> *).
MonadTx m =>
(AnnSimpleSelect ('Postgres 'Vanilla), Seq PrepArg) -> m EncJSON
phaseTwo