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 Q
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.Column
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Hasura.SQL.Types
import Hasura.Session
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
/= :: CountQueryP1 -> CountQueryP1 -> Bool
$c/= :: CountQueryP1 -> CountQueryP1 -> Bool
== :: CountQueryP1 -> CountQueryP1 -> Bool
$c== :: 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]
          }

-- SELECT count(*) FROM (SELECT DISTINCT c1, .. cn FROM .. WHERE ..) r;
-- SELECT count(*) FROM (SELECT * FROM .. WHERE ..) r;
validateCountQWith ::
  (UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
  SessionVariableBuilder m ->
  (ColumnType ('Postgres 'Vanilla) -> Value -> m S.SQLExp) ->
  CountQuery ->
  m CountQueryP1
validateCountQWith :: 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

  -- Check if select is allowed
  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

  -- convert the where clause
  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
-> TableName ('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
-> TableName ('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 TableName ('Postgres 'Vanilla)
QualifiedTable
qt ((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 (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 Q.PrepArg)
validateCountQ :: CountQuery -> m (CountQueryP1, Seq PrepArg)
validateCountQ CountQuery
query = do
  let source :: SourceName
source = CountQuery -> SourceName
cqSource CountQuery
query
  tableCache :: TableCache ('Postgres 'Vanilla) <- Maybe (HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla))
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe (HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
 -> HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> m (Maybe
        (HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla))))
-> m (HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName -> m (Maybe (TableCache ('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)
 -> (SourceName,
     HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
 -> m (CountQueryP1, Seq PrepArg))
-> (SourceName,
    HashMap QualifiedTable (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)
-> (SourceName,
    HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> m (CountQueryP1, Seq PrepArg)
forall (b :: BackendType) (m :: * -> *) a.
TableCacheRT b m a -> (SourceName, TableCache b) -> m a
runTableCacheRT (SourceName
source, TableCache ('Postgres 'Vanilla)
HashMap QualifiedTable (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 ::
  (QErrM m, MonadTx m) =>
  (CountQueryP1, DS.Seq Q.PrepArg) ->
  m EncJSON
countQToTx :: (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 (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
Q.rawQE
        PGTxErr -> QErr
dmlTxErrorHandler
        (Builder -> Query
Q.fromBuilder Builder
countSQL)
        (Seq PrepArg -> [PrepArg]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq PrepArg
p)
        Bool
True
  EncJSON -> m EncJSON
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 (Q.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 :: CountQuery -> m EncJSON
runCount CountQuery
q = do
  PGSourceConfig
sourceConfig <- SourceName -> m (SourceConfig ('Postgres 'Vanilla))
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PGExecCtx -> TxAccess -> TxET QErr m EncJSON -> m EncJSON
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, MonadTrace m,
 UserInfoM m) =>
PGExecCtx -> TxAccess -> TxET QErr m a -> m a
runTxWithCtx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
sourceConfig) TxAccess
Q.ReadOnly (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 :: * -> *).
(QErrM m, MonadTx m) =>
(CountQueryP1, Seq PrepArg) -> m EncJSON
countQToTx