module Hasura.RQL.DML.Count
( CountQueryP1 (..),
validateCountQWith,
validateCountQ,
runCount,
countQToTx,
)
where
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.ByteString.Builder qualified as BB
import Data.Sequence qualified as DS
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
import Hasura.Backends.Postgres.Translate.BoolExp
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.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.SchemaCache
import Hasura.SQL.Types
import Hasura.Session
import Hasura.Table.Cache
import Hasura.Tracing qualified as Tracing
data CountQueryP1 = CountQueryP1
{ CountQueryP1 -> QualifiedTable
cqp1Table :: QualifiedTable,
CountQueryP1
-> (AnnBoolExpSQL ('Postgres 'Vanilla),
Maybe (AnnBoolExpSQL ('Postgres 'Vanilla)))
cqp1Where :: (AnnBoolExpSQL ('Postgres 'Vanilla), Maybe (AnnBoolExpSQL ('Postgres 'Vanilla))),
CountQueryP1 -> Maybe [PGCol]
cqp1Distinct :: Maybe [PGCol]
}
deriving (CountQueryP1 -> CountQueryP1 -> Bool
(CountQueryP1 -> CountQueryP1 -> Bool)
-> (CountQueryP1 -> CountQueryP1 -> Bool) -> Eq CountQueryP1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CountQueryP1 -> CountQueryP1 -> Bool
== :: CountQueryP1 -> CountQueryP1 -> Bool
$c/= :: CountQueryP1 -> CountQueryP1 -> Bool
/= :: CountQueryP1 -> CountQueryP1 -> Bool
Eq)
mkSQLCount ::
CountQueryP1 -> S.Select
mkSQLCount :: CountQueryP1 -> Select
mkSQLCount (CountQueryP1 QualifiedTable
tn (AnnBoolExpSQL ('Postgres 'Vanilla)
permFltr, Maybe (AnnBoolExpSQL ('Postgres 'Vanilla))
mWc) Maybe [PGCol]
mDistCols) =
Select
S.mkSelect
{ selExtr :: [Extractor]
S.selExtr = [SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor SQLExp
S.countStar Maybe ColumnAlias
forall a. Maybe a
Nothing],
selFrom :: Maybe FromExp
S.selFrom =
FromExp -> Maybe FromExp
forall a. a -> Maybe a
Just
(FromExp -> Maybe FromExp) -> FromExp -> Maybe FromExp
forall a b. (a -> b) -> a -> b
$ [FromItem] -> FromExp
S.FromExp
[Bool -> Select -> TableName -> FromItem
S.mkSelFromExp Bool
False Select
innerSel (TableName -> FromItem) -> TableName -> FromItem
forall a b. (a -> b) -> a -> b
$ Text -> TableName
TableName Text
"r"]
}
where
finalWC :: BoolExp
finalWC =
Qual -> AnnBoolExpSQL ('Postgres 'Vanilla) -> BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
toSQLBoolExp (QualifiedTable -> Qual
S.QualTable QualifiedTable
tn)
(AnnBoolExpSQL ('Postgres 'Vanilla) -> BoolExp)
-> AnnBoolExpSQL ('Postgres 'Vanilla) -> BoolExp
forall a b. (a -> b) -> a -> b
$ AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> (AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AnnBoolExpSQL ('Postgres 'Vanilla)
AnnBoolExp ('Postgres 'Vanilla) SQLExp
permFltr (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 AnnBoolExpSQL ('Postgres 'Vanilla)
AnnBoolExp ('Postgres 'Vanilla) SQLExp
permFltr) Maybe (AnnBoolExpSQL ('Postgres 'Vanilla))
Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
mWc
innerSel :: Select
innerSel =
Select
partSel
{ selFrom :: Maybe FromExp
S.selFrom = FromExp -> Maybe FromExp
forall a. a -> Maybe a
Just (FromExp -> Maybe FromExp) -> FromExp -> Maybe FromExp
forall a b. (a -> b) -> a -> b
$ QualifiedTable -> FromExp
S.mkSimpleFromExp QualifiedTable
tn,
selWhere :: Maybe WhereFrag
S.selWhere = BoolExp -> WhereFrag
S.WhereFrag (BoolExp -> WhereFrag) -> Maybe BoolExp -> Maybe WhereFrag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BoolExp -> Maybe BoolExp
forall a. a -> Maybe a
Just BoolExp
finalWC
}
partSel :: Select
partSel = case Maybe [PGCol]
mDistCols of
Just [PGCol]
distCols ->
let extrs :: [Extractor]
extrs = ((PGCol -> Extractor) -> [PGCol] -> [Extractor])
-> [PGCol] -> (PGCol -> Extractor) -> [Extractor]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (PGCol -> Extractor) -> [PGCol] -> [Extractor]
forall a b. (a -> b) -> [a] -> [b]
map [PGCol]
distCols ((PGCol -> Extractor) -> [Extractor])
-> (PGCol -> Extractor) -> [Extractor]
forall a b. (a -> b) -> a -> b
$ \PGCol
c -> SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor (PGCol -> SQLExp
forall a. IsIdentifier a => a -> SQLExp
S.mkSIdenExp PGCol
c) Maybe ColumnAlias
forall a. Maybe a
Nothing
in Select
S.mkSelect
{ selDistinct :: Maybe DistinctExpr
S.selDistinct = DistinctExpr -> Maybe DistinctExpr
forall a. a -> Maybe a
Just DistinctExpr
S.DistinctSimple,
selExtr :: [Extractor]
S.selExtr = [Extractor]
extrs
}
Maybe [PGCol]
Nothing ->
Select
S.mkSelect
{ selExtr :: [Extractor]
S.selExtr = [SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor (Maybe Qual -> SQLExp
S.SEStar Maybe Qual
forall a. Maybe a
Nothing) Maybe ColumnAlias
forall a. Maybe a
Nothing]
}
validateCountQWith ::
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m ->
(ColumnType ('Postgres 'Vanilla) -> Value -> m S.SQLExp) ->
CountQuery ->
m CountQueryP1
validateCountQWith :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m
-> (ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> CountQuery
-> m CountQueryP1
validateCountQWith SessionVariableBuilder m
sessVarBldr ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp
prepValBldr (CountQuery QualifiedTable
qt SourceName
_ Maybe [PGCol]
mDistCols Maybe (BoolExp ('Postgres 'Vanilla))
mWhere) = do
TableInfo ('Postgres 'Vanilla)
tableInfo <- 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)
selPerm <-
(Text -> Text)
-> m (SelPermInfo ('Postgres 'Vanilla))
-> m (SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
selNecessaryMsg)
(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
let colInfoMap :: FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
colInfoMap = 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)
tableInfo
Maybe [PGCol] -> ([PGCol] -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe [PGCol]
mDistCols (([PGCol] -> m ()) -> m ()) -> ([PGCol] -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \[PGCol]
distCols -> do
let distColAsrns :: [PGCol -> m ()]
distColAsrns =
[ SelPermInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla) -> m ()
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
SelPermInfo ('Postgres 'Vanilla)
-> Column ('Postgres 'Vanilla) -> m ()
checkSelOnCol SelPermInfo ('Postgres 'Vanilla)
selPerm,
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> Text -> Column ('Postgres 'Vanilla) -> m ()
forall (backend :: BackendType) (m :: * -> *).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend) -> Text -> Column backend -> m ()
assertColumnExists FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
colInfoMap Text
relInDistColsErr
]
Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"distinct" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [PGCol -> m ()] -> [PGCol] -> m ()
forall (m :: * -> *) a.
MonadError QErr m =>
[a -> m ()] -> [a] -> m ()
verifyAsrns [PGCol -> m ()]
distColAsrns [PGCol]
distCols
Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
annSQLBoolExp <- 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 Maybe (BoolExp ('Postgres 'Vanilla))
mWhere ((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)
be ->
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))
colInfoMap SelPermInfo ('Postgres 'Vanilla)
selPerm BoolExp ('Postgres 'Vanilla)
be SessionVariableBuilder m
sessVarBldr FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
colInfoMap ((ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> CollectableType (ColumnType ('Postgres 'Vanilla))
-> Value
-> 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 -> m SQLExp
prepValBldr)
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)
selPerm
CountQueryP1 -> m CountQueryP1
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(CountQueryP1 -> m CountQueryP1) -> CountQueryP1 -> m CountQueryP1
forall a b. (a -> b) -> a -> b
$ QualifiedTable
-> (AnnBoolExpSQL ('Postgres 'Vanilla),
Maybe (AnnBoolExpSQL ('Postgres 'Vanilla)))
-> Maybe [PGCol]
-> CountQueryP1
CountQueryP1
QualifiedTable
qt
(AnnBoolExpSQL ('Postgres 'Vanilla)
AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedSelFltr, Maybe (AnnBoolExpSQL ('Postgres 'Vanilla))
Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
annSQLBoolExp)
Maybe [PGCol]
mDistCols
where
selNecessaryMsg :: Text
selNecessaryMsg =
Text
"; \"count\" is only allowed if the role "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"has \"select\" permissions on the table"
relInDistColsErr :: Text
relInDistColsErr =
Text
"Relationships can't be used in \"distinct\"."
validateCountQ ::
(QErrM m, UserInfoM m, CacheRM m) =>
CountQuery ->
m (CountQueryP1, DS.Seq PG.PrepArg)
validateCountQ :: forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m) =>
CountQuery -> m (CountQueryP1, Seq PrepArg)
validateCountQ CountQuery
query = do
let source :: SourceName
source = CountQuery -> SourceName
cqSource CountQuery
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
source
(TableCacheRT ('Postgres 'Vanilla) m (CountQueryP1, Seq PrepArg)
-> HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
-> m (CountQueryP1, Seq PrepArg))
-> HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
-> TableCacheRT ('Postgres 'Vanilla) m (CountQueryP1, Seq PrepArg)
-> m (CountQueryP1, Seq PrepArg)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TableCacheRT ('Postgres 'Vanilla) m (CountQueryP1, Seq PrepArg)
-> HashMap
(TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
-> m (CountQueryP1, 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 (CountQueryP1, Seq PrepArg)
-> m (CountQueryP1, Seq PrepArg))
-> TableCacheRT ('Postgres 'Vanilla) m (CountQueryP1, Seq PrepArg)
-> m (CountQueryP1, Seq PrepArg)
forall a b. (a -> b) -> a -> b
$ DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) CountQueryP1
-> TableCacheRT ('Postgres 'Vanilla) m (CountQueryP1, Seq PrepArg)
forall (m :: * -> *) a. DMLP1T m a -> m (a, Seq PrepArg)
runDMLP1T
(DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) CountQueryP1
-> TableCacheRT ('Postgres 'Vanilla) m (CountQueryP1, Seq PrepArg))
-> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) CountQueryP1
-> TableCacheRT ('Postgres 'Vanilla) m (CountQueryP1, Seq PrepArg)
forall a b. (a -> b) -> a -> b
$ SessionVariableBuilder
(DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
-> (ColumnType ('Postgres 'Vanilla)
-> Value -> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) SQLExp)
-> CountQuery
-> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) CountQueryP1
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m
-> (ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> CountQuery
-> m CountQueryP1
validateCountQWith SessionVariableBuilder
(DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
forall (f :: * -> *). Applicative f => SessionVariableBuilder f
sessVarFromCurrentSetting ColumnType ('Postgres 'Vanilla)
-> Value -> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) SQLExp
forall (m :: * -> *).
QErrM m =>
ColumnType ('Postgres 'Vanilla) -> Value -> DMLP1T m SQLExp
binRHSBuilder CountQuery
query
countQToTx ::
(MonadTx m) =>
(CountQueryP1, DS.Seq PG.PrepArg) ->
m EncJSON
countQToTx :: forall (m :: * -> *).
MonadTx m =>
(CountQueryP1, Seq PrepArg) -> m EncJSON
countQToTx (CountQueryP1
u, Seq PrepArg
p) = do
SingleRow (Identity Int)
qRes <-
TxE QErr (SingleRow (Identity Int)) -> m (SingleRow (Identity Int))
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx
(TxE QErr (SingleRow (Identity Int))
-> m (SingleRow (Identity Int)))
-> TxE QErr (SingleRow (Identity Int))
-> m (SingleRow (Identity Int))
forall a b. (a -> b) -> a -> b
$ (PGTxErr -> QErr)
-> Query
-> [PrepArg]
-> Bool
-> TxE QErr (SingleRow (Identity Int))
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> [PrepArg] -> Bool -> TxET e m a
PG.rawQE
PGTxErr -> QErr
dmlTxErrorHandler
(Builder -> Query
PG.fromBuilder Builder
countSQL)
(Seq PrepArg -> [PrepArg]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq PrepArg
p)
Bool
True
EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Builder -> EncJSON
encJFromBuilder (Builder -> EncJSON) -> Builder -> EncJSON
forall a b. (a -> b) -> a -> b
$ SingleRow (Identity Int) -> Builder
encodeCount SingleRow (Identity Int)
qRes
where
countSQL :: Builder
countSQL = Select -> Builder
forall a. ToSQL a => a -> Builder
toSQL (Select -> Builder) -> Select -> Builder
forall a b. (a -> b) -> a -> b
$ CountQueryP1 -> Select
mkSQLCount CountQueryP1
u
encodeCount :: SingleRow (Identity Int) -> Builder
encodeCount (PG.SingleRow (Identity Int
c)) =
ByteString -> Builder
BB.byteString ByteString
"{\"count\":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec Int
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'}'
runCount ::
( QErrM m,
UserInfoM m,
CacheRM m,
MonadIO m,
MonadBaseControl IO m,
Tracing.MonadTrace m,
MetadataM m
) =>
CountQuery ->
m EncJSON
runCount :: forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, MonadIO m, MonadBaseControl IO m,
MonadTrace m, MetadataM m) =>
CountQuery -> m EncJSON
runCount CountQuery
q = do
PGSourceConfig
sourceConfig <- forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @('Postgres 'Vanilla) (CountQuery -> SourceName
cqSource CountQuery
q)
CountQuery -> m (CountQueryP1, Seq PrepArg)
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m) =>
CountQuery -> m (CountQueryP1, Seq PrepArg)
validateCountQ CountQuery
q m (CountQueryP1, Seq PrepArg)
-> ((CountQueryP1, 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)
-> ((CountQueryP1, Seq PrepArg) -> TxET QErr m EncJSON)
-> (CountQueryP1, Seq PrepArg)
-> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CountQueryP1, Seq PrepArg) -> TxET QErr m EncJSON
forall (m :: * -> *).
MonadTx m =>
(CountQueryP1, Seq PrepArg) -> m EncJSON
countQToTx