refactor: make Query module pure
This splits off the transaction concerns into a MainTx module It's just moving some functions inside the Query module to the MainTx module. Some types names were also changed so they don't have the "Query" prefix, to avoid confusion.
This commit is contained in:
steve-chavez
committed by
Steve Chavez
Steve Chavez
parent
15e04903b1
commit
baea47bc85
@@ -67,6 +67,7 @@ library
|
||||
PostgREST.Error
|
||||
PostgREST.Listener
|
||||
PostgREST.Logger
|
||||
PostgREST.MainTx
|
||||
PostgREST.MediaType
|
||||
PostgREST.Metrics
|
||||
PostgREST.Network
|
||||
|
||||
@@ -35,6 +35,7 @@ import qualified PostgREST.Cors as Cors
|
||||
import qualified PostgREST.Error as Error
|
||||
import qualified PostgREST.Listener as Listener
|
||||
import qualified PostgREST.Logger as Logger
|
||||
import qualified PostgREST.MainTx as MainTx
|
||||
import qualified PostgREST.Plan as Plan
|
||||
import qualified PostgREST.Query as Query
|
||||
import qualified PostgREST.Response as Response
|
||||
@@ -143,14 +144,14 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache authResult@AuthRe
|
||||
(planTime, plan) <- withTiming $ liftEither $ Plan.actionPlan iAction conf apiReq sCache
|
||||
|
||||
let mainQ = Query.mainQuery plan conf apiReq authResult configDbPreRequest
|
||||
query = Query.mainTx mainQ conf authResult apiReq plan sCache
|
||||
tx = MainTx.mainTx mainQ conf authResult apiReq plan sCache
|
||||
observer = AppState.getObserver appState
|
||||
obsQuery s = when (configLogQuery /= LogQueryDisabled) $ observer $ QueryObs mainQ s
|
||||
|
||||
(queryTime, queryResult) <- withTiming $ do
|
||||
case query of
|
||||
Query.NoDbQuery r -> pure r
|
||||
Query.DbQuery{..} -> do
|
||||
(txTime, txResult) <- withTiming $ do
|
||||
case tx of
|
||||
MainTx.NoDbTx r -> pure r
|
||||
MainTx.DbTx{..} -> do
|
||||
dbRes <- lift $ AppState.usePool appState (dqTransaction dqIsoLevel dqTxMode $ runExceptT dqDbHandler)
|
||||
let eitherResp = join $ mapLeft (Error.PgErr . Error.PgError (Just authRole /= configDbAnonRole)) dbRes
|
||||
|
||||
@@ -161,14 +162,14 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache authResult@AuthRe
|
||||
liftEither eitherResp
|
||||
|
||||
(respTime, resp) <- withTiming $ do
|
||||
let response = Response.actionResponse queryResult apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache iSchema iNegotiatedByProfile
|
||||
let response = Response.actionResponse txResult apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache iSchema iNegotiatedByProfile
|
||||
status' = either Error.status Response.pgrstStatus response
|
||||
|
||||
-- TODO: see above obsQuery, only this obsQuery should remain after refactoring (because the QueryObs depends on the status)
|
||||
lift $ obsQuery status'
|
||||
liftEither response
|
||||
|
||||
return $ toWaiResponse (ServerTiming jwtTime parseTime planTime queryTime respTime) resp
|
||||
return $ toWaiResponse (ServerTiming jwtTime parseTime planTime txTime respTime) resp
|
||||
|
||||
where
|
||||
toWaiResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response
|
||||
|
||||
@@ -0,0 +1,279 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-|
|
||||
Module : PostgREST.MainTx
|
||||
Description : PostgREST transaction executor
|
||||
|
||||
This module parametrizes, prepares, executes SQL queries and decodes their results.
|
||||
-}
|
||||
module PostgREST.MainTx
|
||||
( MainTx (..)
|
||||
, DbResult (..)
|
||||
, ResultSet (..)
|
||||
, mainTx
|
||||
) where
|
||||
|
||||
import Control.Lens ((^?))
|
||||
import Control.Monad.Extra (whenJust)
|
||||
import qualified Data.Aeson.Lens as L
|
||||
import qualified Data.ByteString as BS hiding
|
||||
(break)
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Set as S
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.DynamicStatements.Statement as SQL
|
||||
import qualified Hasql.Session as SQL (Session)
|
||||
import qualified Hasql.Transaction as SQL
|
||||
import qualified Hasql.Transaction.Sessions as SQL
|
||||
|
||||
import qualified PostgREST.Error as Error
|
||||
import qualified PostgREST.SchemaCache as SchemaCache
|
||||
|
||||
|
||||
import PostgREST.ApiRequest (ApiRequest (..))
|
||||
import PostgREST.ApiRequest.Preferences (PreferCount (..),
|
||||
PreferHandling (..),
|
||||
PreferMaxAffected (..),
|
||||
PreferTransaction (..),
|
||||
Preferences (..))
|
||||
import PostgREST.ApiRequest.Types (Mutation (..))
|
||||
import PostgREST.Auth.Types (AuthResult (..))
|
||||
import PostgREST.Config (AppConfig (..),
|
||||
OpenAPIMode (..))
|
||||
import PostgREST.Error (Error)
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import PostgREST.Plan (ActionPlan (..),
|
||||
CrudPlan (..),
|
||||
DbActionPlan (..),
|
||||
InfoPlan (..),
|
||||
InspectPlan (..))
|
||||
import PostgREST.Query (MainQuery (..))
|
||||
import PostgREST.SchemaCache (SchemaCache (..))
|
||||
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
|
||||
import PostgREST.SchemaCache.Routine (Routine (..), RoutineMap)
|
||||
import PostgREST.SchemaCache.Table (TablesMap)
|
||||
|
||||
import Protolude hiding (Handler)
|
||||
|
||||
type DbHandler = ExceptT Error SQL.Transaction
|
||||
|
||||
data MainTx
|
||||
= DbTx {
|
||||
dqIsoLevel :: SQL.IsolationLevel
|
||||
, dqTxMode :: SQL.Mode
|
||||
, dqDbHandler :: DbHandler DbResult
|
||||
, dqTransaction :: SQL.IsolationLevel -> SQL.Mode -> SQL.Transaction (Either Error DbResult) -> SQL.Session (Either Error DbResult)
|
||||
}
|
||||
| NoDbTx DbResult
|
||||
|
||||
data DbResult
|
||||
= DbCrudResult CrudPlan ResultSet
|
||||
| DbPlanResult MediaType BS.ByteString
|
||||
| MaybeDbResult InspectPlan (Maybe (TablesMap, RoutineMap, Maybe Text))
|
||||
| NoDbResult InfoPlan
|
||||
|
||||
-- | Standard result set format used for the mqMain query
|
||||
data ResultSet
|
||||
= RSStandard
|
||||
{ rsTableTotal :: Maybe Int64
|
||||
-- ^ count of all the table rows
|
||||
, rsQueryTotal :: Int64
|
||||
-- ^ count of the query rows
|
||||
, rsLocation :: [(BS.ByteString, BS.ByteString)]
|
||||
-- ^ The Location header(only used for inserts) is represented as a list of strings containing
|
||||
-- variable bindings like @"k1=eq.42"@, or the empty list if there is no location header.
|
||||
, rsBody :: BS.ByteString
|
||||
-- ^ the aggregated body of the query
|
||||
, rsGucHeaders :: Maybe BS.ByteString
|
||||
-- ^ the HTTP headers to be added to the response
|
||||
, rsGucStatus :: Maybe Text
|
||||
-- ^ the HTTP status to be added to the response
|
||||
, rsInserted :: Maybe Int64
|
||||
-- ^ the number of rows inserted (Only used for upserts)
|
||||
}
|
||||
|
||||
mainTx :: MainQuery -> AppConfig -> AuthResult -> ApiRequest -> ActionPlan -> SchemaCache -> MainTx
|
||||
mainTx _ _ _ _ (NoDb x) _ = NoDbTx $ NoDbResult x
|
||||
mainTx genQ@MainQuery{..} conf@AppConfig{..} AuthResult{..} apiReq (Db plan) sCache =
|
||||
DbTx isoLvl txMode dbHandler transaction
|
||||
where
|
||||
transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction
|
||||
isoLvl = planIsoLvl conf authRole plan
|
||||
txMode = planTxMode plan
|
||||
dbHandler = do
|
||||
lift $ SQL.statement mempty $ SQL.dynamicallyParameterized mqTxVars
|
||||
HD.noResult configDbPreparedStatements
|
||||
lift $ whenJust mqPreReq $ \q ->
|
||||
SQL.statement mempty $ SQL.dynamicallyParameterized q
|
||||
HD.noResult configDbPreparedStatements
|
||||
actionResult genQ plan conf apiReq sCache
|
||||
|
||||
planTxMode :: DbActionPlan -> SQL.Mode
|
||||
planTxMode (DbCrud _ x) = pTxMode x
|
||||
planTxMode (MayUseDb x) = ipTxmode x
|
||||
|
||||
planIsoLvl :: AppConfig -> ByteString -> DbActionPlan -> SQL.IsolationLevel
|
||||
planIsoLvl AppConfig{configRoleIsoLvl} role actPlan = case actPlan of
|
||||
DbCrud _ CallReadPlan{crProc} -> fromMaybe roleIsoLvl $ pdIsoLvl crProc
|
||||
_ -> roleIsoLvl
|
||||
where
|
||||
roleIsoLvl = HM.findWithDefault SQL.ReadCommitted role configRoleIsoLvl
|
||||
|
||||
actionResult :: MainQuery -> DbActionPlan -> AppConfig -> ApiRequest -> SchemaCache -> ExceptT Error SQL.Transaction DbResult
|
||||
actionResult MainQuery{..} (DbCrud True plan) conf@AppConfig{..} apiReq _ = do
|
||||
explRes <- lift $ SQL.statement mempty $ SQL.dynamicallyParameterized mqMain planRow configDbPreparedStatements
|
||||
optionalRollback conf apiReq
|
||||
pure $ DbPlanResult (pMedia plan) explRes
|
||||
|
||||
actionResult MainQuery{..} (DbCrud _ plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = do
|
||||
resultSet@RSStandard{rsTableTotal=tableTotal} <- lift $ SQL.statement mempty $ dynStmt (HD.singleRow $ standardRow True)
|
||||
failNotSingular pMedia resultSet
|
||||
optionalRollback conf apiReq
|
||||
explainTotal <- lift . fmap join $ traverse (\snip ->
|
||||
SQL.statement mempty $ SQL.dynamicallyParameterized snip decodeExplain configDbPreparedStatements)
|
||||
mqExplain
|
||||
|
||||
pure $ DbCrudResult plan
|
||||
resultSet{rsTableTotal=case preferCount of
|
||||
Just PlannedCount -> explainTotal
|
||||
Just EstimatedCount -> if tableTotal > (fromIntegral <$> configDbMaxRows)
|
||||
then max <$> tableTotal <*> explainTotal
|
||||
else tableTotal
|
||||
_ -> tableTotal}
|
||||
where
|
||||
dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements
|
||||
|
||||
decodeExplain :: HD.Result (Maybe Int64)
|
||||
decodeExplain =
|
||||
let row = HD.singleRow $ column HD.bytea in
|
||||
(^? L.nth 0 . L.key "Plan" . L.key "Plan Rows" . L._Integral) <$> row
|
||||
|
||||
actionResult MainQuery{..} (DbCrud _ plan@MutateReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = do
|
||||
resultSet <- lift $ SQL.statement mempty $ dynStmt decodeRow
|
||||
failMutation resultSet
|
||||
optionalRollback conf apiReq
|
||||
pure $ DbCrudResult plan resultSet
|
||||
where
|
||||
dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements
|
||||
failMutation resultSet = case mrMutation of
|
||||
MutationCreate -> do
|
||||
failNotSingular pMedia resultSet
|
||||
MutationUpdate -> do
|
||||
failNotSingular pMedia resultSet
|
||||
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
|
||||
MutationSingleUpsert -> do
|
||||
failPut resultSet
|
||||
MutationDelete -> do
|
||||
failNotSingular pMedia resultSet
|
||||
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
|
||||
decodeRow = fromMaybe (RSStandard Nothing 0 mempty mempty Nothing Nothing Nothing) <$> HD.rowMaybe (standardRow False)
|
||||
|
||||
actionResult MainQuery{..} (DbCrud _ plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = do
|
||||
resultSet <- lift $ SQL.statement mempty $ dynStmt decodeRow
|
||||
optionalRollback conf apiReq
|
||||
failNotSingular pMedia resultSet
|
||||
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
|
||||
pure $ DbCrudResult plan resultSet
|
||||
where
|
||||
dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements
|
||||
decodeRow = fromMaybe (RSStandard (Just 0) 0 mempty mempty Nothing Nothing Nothing) <$> HD.rowMaybe (standardRow True)
|
||||
|
||||
actionResult MainQuery{mqOpenAPI=(tblsQ, funcsQ, schQ)} (MayUseDb plan@InspectPlan{ipSchema=tSchema}) AppConfig{..} _ sCache =
|
||||
mainActionQuery
|
||||
where
|
||||
mainActionQuery = lift $
|
||||
case configOpenApiMode of
|
||||
OAFollowPriv -> do
|
||||
tableAccess <- SQL.statement mempty $ SQL.dynamicallyParameterized tblsQ decodeAccessibleIdentifiers configDbPreparedStatements
|
||||
accFuncs <- SQL.statement mempty $ SQL.dynamicallyParameterized funcsQ SchemaCache.decodeFuncs configDbPreparedStatements
|
||||
schDesc <- SQL.statement mempty $ SQL.dynamicallyParameterized schQ decodeSchemaDesc configDbPreparedStatements
|
||||
let tbls = HM.filterWithKey (\qi _ -> S.member qi tableAccess) $ SchemaCache.dbTables sCache
|
||||
|
||||
pure $ MaybeDbResult plan (Just (tbls, accFuncs, schDesc))
|
||||
OAIgnorePriv -> do
|
||||
schDesc <- SQL.statement mempty (SQL.dynamicallyParameterized schQ decodeSchemaDesc configDbPreparedStatements)
|
||||
|
||||
let tbls = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) (SchemaCache.dbTables sCache)
|
||||
routs = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) (SchemaCache.dbRoutines sCache)
|
||||
|
||||
pure $ MaybeDbResult plan (Just (tbls, routs, schDesc))
|
||||
OADisabled ->
|
||||
pure $ MaybeDbResult plan Nothing
|
||||
|
||||
decodeSchemaDesc :: HD.Result (Maybe Text)
|
||||
decodeSchemaDesc = join <$> HD.rowMaybe (nullableColumn HD.text)
|
||||
|
||||
decodeAccessibleIdentifiers :: HD.Result (S.Set QualifiedIdentifier)
|
||||
decodeAccessibleIdentifiers =
|
||||
let
|
||||
row = QualifiedIdentifier
|
||||
<$> column HD.text
|
||||
<*> column HD.text
|
||||
in
|
||||
S.fromList <$> HD.rowList row
|
||||
|
||||
-- Makes sure the querystring pk matches the payload pk
|
||||
-- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
|
||||
-- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.
|
||||
-- If this condition is not satisfied then nothing is inserted,
|
||||
-- check the WHERE for INSERT in QueryBuilder.hs to see how it's done
|
||||
failPut :: ResultSet -> DbHandler ()
|
||||
failPut RSStandard{rsQueryTotal=queryTotal} =
|
||||
when (queryTotal /= 1) $ do
|
||||
lift SQL.condemn
|
||||
throwError $ Error.ApiRequestError Error.PutMatchingPkError
|
||||
|
||||
-- |
|
||||
-- Fail a response if a single JSON object was requested and not exactly one
|
||||
-- was found.
|
||||
failNotSingular :: MediaType -> ResultSet -> DbHandler ()
|
||||
failNotSingular mediaType RSStandard{rsQueryTotal=queryTotal} =
|
||||
when (elem mediaType [MTVndSingularJSON True, MTVndSingularJSON False] && queryTotal /= 1) $ do
|
||||
lift SQL.condemn
|
||||
throwError $ Error.ApiRequestError . Error.SingularityError $ toInteger queryTotal
|
||||
|
||||
failExceedsMaxAffectedPref :: (Maybe PreferMaxAffected, Maybe PreferHandling) -> ResultSet -> DbHandler ()
|
||||
failExceedsMaxAffectedPref (Nothing,_) _ = pure ()
|
||||
failExceedsMaxAffectedPref (Just (PreferMaxAffected n), handling) RSStandard{rsQueryTotal=queryTotal} = when ((queryTotal > n) && (handling == Just Strict)) $ do
|
||||
lift SQL.condemn
|
||||
throwError $ Error.ApiRequestError . Error.MaxAffectedViolationError $ toInteger queryTotal
|
||||
|
||||
-- | Set a transaction to roll back if requested
|
||||
optionalRollback :: AppConfig -> ApiRequest -> DbHandler ()
|
||||
optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} = do
|
||||
lift $ when (shouldRollback || (configDbTxRollbackAll && not shouldCommit)) $ do
|
||||
SQL.sql "SET CONSTRAINTS ALL IMMEDIATE"
|
||||
SQL.condemn
|
||||
where
|
||||
shouldCommit =
|
||||
preferTransaction == Just Commit
|
||||
shouldRollback =
|
||||
preferTransaction == Just Rollback
|
||||
|
||||
-- | We use rowList because when doing EXPLAIN (FORMAT TEXT), the result comes as many rows. FORMAT JSON comes as one.
|
||||
planRow :: HD.Result BS.ByteString
|
||||
planRow = BS.unlines <$> HD.rowList (column HD.bytea)
|
||||
|
||||
column :: HD.Value a -> HD.Row a
|
||||
column = HD.column . HD.nonNullable
|
||||
|
||||
nullableColumn :: HD.Value a -> HD.Row (Maybe a)
|
||||
nullableColumn = HD.column . HD.nullable
|
||||
|
||||
arrayColumn :: HD.Value a -> HD.Row [a]
|
||||
arrayColumn = column . HD.listArray . HD.nonNullable
|
||||
|
||||
standardRow :: Bool -> HD.Row ResultSet
|
||||
standardRow noLocation =
|
||||
RSStandard <$> nullableColumn HD.int8 <*> column HD.int8
|
||||
<*> (if noLocation then pure mempty else fmap splitKeyValue <$> arrayColumn HD.bytea)
|
||||
<*> (fromMaybe mempty <$> nullableColumn HD.bytea)
|
||||
<*> nullableColumn HD.bytea
|
||||
<*> nullableColumn HD.text
|
||||
<*> nullableColumn HD.int8
|
||||
where
|
||||
splitKeyValue :: ByteString -> (ByteString, ByteString)
|
||||
splitKeyValue kv =
|
||||
let (k, v) = BS.break (== '=') kv in
|
||||
(k, BS.tail v)
|
||||
+5
-265
@@ -1,88 +1,36 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-|
|
||||
Module : PostgREST.Query
|
||||
Description : PostgREST query executor
|
||||
|
||||
This module parametrizes, prepares, executes SQL queries and decodes their results.
|
||||
Description : PostgREST query building
|
||||
|
||||
TODO: This module shouldn't depend on SchemaCache: once OpenAPI is removed, this can be done
|
||||
TOOD: Split the SQL transaction concerns module into another one so Query.hs is pure
|
||||
-}
|
||||
module PostgREST.Query
|
||||
( Query (..)
|
||||
, QueryResult (..)
|
||||
, ResultSet (..)
|
||||
, mainTx
|
||||
, mainQuery
|
||||
( mainQuery
|
||||
, MainQuery (..)
|
||||
) where
|
||||
|
||||
import Control.Lens ((^?))
|
||||
import Control.Monad.Extra (whenJust)
|
||||
import qualified Data.Aeson.Lens as L
|
||||
import qualified Data.ByteString as BS hiding
|
||||
(break)
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Set as S
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.DynamicStatements.Snippet as SQL hiding (sql)
|
||||
import qualified Hasql.DynamicStatements.Statement as SQL
|
||||
import qualified Hasql.Session as SQL (Session)
|
||||
import qualified Hasql.Transaction as SQL
|
||||
import qualified Hasql.Transaction.Sessions as SQL
|
||||
import qualified Hasql.DynamicStatements.Snippet as SQL hiding (sql)
|
||||
|
||||
import qualified PostgREST.Error as Error
|
||||
import qualified PostgREST.Query.PreQuery as PreQuery
|
||||
import qualified PostgREST.Query.QueryBuilder as QueryBuilder
|
||||
import qualified PostgREST.Query.SqlFragment as SqlFragment
|
||||
import qualified PostgREST.Query.Statements as Statements
|
||||
import qualified PostgREST.SchemaCache as SchemaCache
|
||||
|
||||
|
||||
import PostgREST.ApiRequest (ApiRequest (..))
|
||||
import PostgREST.ApiRequest.Preferences (PreferCount (..),
|
||||
PreferHandling (..),
|
||||
PreferMaxAffected (..),
|
||||
PreferTransaction (..),
|
||||
Preferences (..),
|
||||
import PostgREST.ApiRequest.Preferences (Preferences (..),
|
||||
shouldExplainCount)
|
||||
import PostgREST.ApiRequest.Types (Mutation (..))
|
||||
import PostgREST.Auth.Types (AuthResult (..))
|
||||
import PostgREST.Config (AppConfig (..),
|
||||
OpenAPIMode (..))
|
||||
import PostgREST.Error (Error)
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.Plan (ActionPlan (..),
|
||||
CrudPlan (..),
|
||||
DbActionPlan (..),
|
||||
InfoPlan (..),
|
||||
InspectPlan (..))
|
||||
import PostgREST.SchemaCache (SchemaCache (..))
|
||||
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
|
||||
import PostgREST.SchemaCache.Routine (Routine (..), RoutineMap)
|
||||
import PostgREST.SchemaCache.Table (TablesMap)
|
||||
|
||||
import Protolude hiding (Handler)
|
||||
|
||||
type DbHandler = ExceptT Error SQL.Transaction
|
||||
|
||||
data Query
|
||||
= DbQuery {
|
||||
dqIsoLevel :: SQL.IsolationLevel
|
||||
, dqTxMode :: SQL.Mode
|
||||
, dqDbHandler :: DbHandler QueryResult
|
||||
, dqTransaction :: SQL.IsolationLevel -> SQL.Mode -> SQL.Transaction (Either Error QueryResult) -> SQL.Session (Either Error QueryResult)
|
||||
}
|
||||
| NoDbQuery QueryResult
|
||||
|
||||
data QueryResult
|
||||
= DbCrudResult CrudPlan ResultSet
|
||||
| DbPlanResult MediaType BS.ByteString
|
||||
| MaybeDbResult InspectPlan (Maybe (TablesMap, RoutineMap, Maybe Text))
|
||||
| NoDbResult InfoPlan
|
||||
|
||||
-- The Queries that run on every request
|
||||
data MainQuery = MainQuery
|
||||
{ mqTxVars :: SQL.Snippet -- ^ the transaction variables that always run on each query
|
||||
@@ -93,55 +41,6 @@ data MainQuery = MainQuery
|
||||
, mqExplain :: Maybe SQL.Snippet -- ^ the explain query that gets generated for the "Prefer: count=estimated" case
|
||||
}
|
||||
|
||||
-- | Standard result set format used for the mqMain query
|
||||
data ResultSet
|
||||
= RSStandard
|
||||
{ rsTableTotal :: Maybe Int64
|
||||
-- ^ count of all the table rows
|
||||
, rsQueryTotal :: Int64
|
||||
-- ^ count of the query rows
|
||||
, rsLocation :: [(BS.ByteString, BS.ByteString)]
|
||||
-- ^ The Location header(only used for inserts) is represented as a list of strings containing
|
||||
-- variable bindings like @"k1=eq.42"@, or the empty list if there is no location header.
|
||||
, rsBody :: BS.ByteString
|
||||
-- ^ the aggregated body of the query
|
||||
, rsGucHeaders :: Maybe BS.ByteString
|
||||
-- ^ the HTTP headers to be added to the response
|
||||
, rsGucStatus :: Maybe Text
|
||||
-- ^ the HTTP status to be added to the response
|
||||
, rsInserted :: Maybe Int64
|
||||
-- ^ the number of rows inserted (Only used for upserts)
|
||||
}
|
||||
|
||||
mainTx :: MainQuery -> AppConfig -> AuthResult -> ApiRequest -> ActionPlan -> SchemaCache -> Query
|
||||
mainTx _ _ _ _ (NoDb x) _ = NoDbQuery $ NoDbResult x
|
||||
mainTx genQ@MainQuery{..} conf@AppConfig{..} AuthResult{..} apiReq (Db plan) sCache =
|
||||
DbQuery isoLvl txMode dbHandler transaction
|
||||
where
|
||||
transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction
|
||||
isoLvl = planIsoLvl conf authRole plan
|
||||
txMode = planTxMode plan
|
||||
mainActionQuery = actionQuery genQ plan conf apiReq sCache
|
||||
dbHandler = do
|
||||
lift $ SQL.statement mempty $ SQL.dynamicallyParameterized mqTxVars
|
||||
HD.noResult configDbPreparedStatements
|
||||
lift $ whenJust mqPreReq $ \q ->
|
||||
SQL.statement mempty $ SQL.dynamicallyParameterized q
|
||||
HD.noResult configDbPreparedStatements
|
||||
mainActionQuery
|
||||
|
||||
planTxMode :: DbActionPlan -> SQL.Mode
|
||||
planTxMode (DbCrud _ x) = pTxMode x
|
||||
planTxMode (MayUseDb x) = ipTxmode x
|
||||
|
||||
planIsoLvl :: AppConfig -> ByteString -> DbActionPlan -> SQL.IsolationLevel
|
||||
planIsoLvl AppConfig{configRoleIsoLvl} role actPlan = case actPlan of
|
||||
DbCrud _ CallReadPlan{crProc} -> fromMaybe roleIsoLvl $ pdIsoLvl crProc
|
||||
_ -> roleIsoLvl
|
||||
where
|
||||
roleIsoLvl = HM.findWithDefault SQL.ReadCommitted role configRoleIsoLvl
|
||||
|
||||
|
||||
mainQuery :: ActionPlan -> AppConfig -> ApiRequest -> AuthResult -> Maybe QualifiedIdentifier -> MainQuery
|
||||
mainQuery (NoDb _) _ _ _ _ = MainQuery mempty Nothing mempty (mempty, mempty, mempty) mempty
|
||||
mainQuery (Db plan) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} authRes preReq =
|
||||
@@ -157,162 +56,3 @@ mainQuery (Db plan) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preference
|
||||
genQ (Statements.mainCall crProc crCallPlan crReadPlan preferCount pMedia crHandler) (mempty, mempty, mempty) mempty
|
||||
MayUseDb InspectPlan{ipSchema=tSchema} ->
|
||||
genQ mempty (SqlFragment.accessibleTables tSchema, SqlFragment.accessibleFuncs tSchema, SqlFragment.schemaDescription tSchema) mempty
|
||||
|
||||
-- TODO: Generate the Hasql Statement in a diferent module after the OpenAPI functionality is removed
|
||||
actionQuery :: MainQuery -> DbActionPlan -> AppConfig -> ApiRequest -> SchemaCache -> ExceptT Error SQL.Transaction QueryResult
|
||||
actionQuery MainQuery{..} (DbCrud True plan) conf@AppConfig{..} apiReq _ = do
|
||||
explRes <- lift $ SQL.statement mempty $ SQL.dynamicallyParameterized mqMain planRow configDbPreparedStatements
|
||||
optionalRollback conf apiReq
|
||||
pure $ DbPlanResult (pMedia plan) explRes
|
||||
|
||||
actionQuery MainQuery{..} (DbCrud _ plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = do
|
||||
resultSet@RSStandard{rsTableTotal=tableTotal} <- lift $ SQL.statement mempty $ dynStmt (HD.singleRow $ standardRow True)
|
||||
failNotSingular pMedia resultSet
|
||||
optionalRollback conf apiReq
|
||||
explainTotal <- lift . fmap join $ traverse (\snip ->
|
||||
SQL.statement mempty $ SQL.dynamicallyParameterized snip decodeExplain configDbPreparedStatements)
|
||||
mqExplain
|
||||
|
||||
pure $ DbCrudResult plan
|
||||
resultSet{rsTableTotal=case preferCount of
|
||||
Just PlannedCount -> explainTotal
|
||||
Just EstimatedCount -> if tableTotal > (fromIntegral <$> configDbMaxRows)
|
||||
then max <$> tableTotal <*> explainTotal
|
||||
else tableTotal
|
||||
_ -> tableTotal}
|
||||
where
|
||||
dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements
|
||||
|
||||
decodeExplain :: HD.Result (Maybe Int64)
|
||||
decodeExplain =
|
||||
let row = HD.singleRow $ column HD.bytea in
|
||||
(^? L.nth 0 . L.key "Plan" . L.key "Plan Rows" . L._Integral) <$> row
|
||||
|
||||
actionQuery MainQuery{..} (DbCrud _ plan@MutateReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = do
|
||||
resultSet <- lift $ SQL.statement mempty $ dynStmt decodeRow
|
||||
failMutation resultSet
|
||||
optionalRollback conf apiReq
|
||||
pure $ DbCrudResult plan resultSet
|
||||
where
|
||||
dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements
|
||||
failMutation resultSet = case mrMutation of
|
||||
MutationCreate -> do
|
||||
failNotSingular pMedia resultSet
|
||||
MutationUpdate -> do
|
||||
failNotSingular pMedia resultSet
|
||||
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
|
||||
MutationSingleUpsert -> do
|
||||
failPut resultSet
|
||||
MutationDelete -> do
|
||||
failNotSingular pMedia resultSet
|
||||
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
|
||||
decodeRow = fromMaybe (RSStandard Nothing 0 mempty mempty Nothing Nothing Nothing) <$> HD.rowMaybe (standardRow False)
|
||||
|
||||
actionQuery MainQuery{..} (DbCrud _ plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = do
|
||||
resultSet <- lift $ SQL.statement mempty $ dynStmt decodeRow
|
||||
optionalRollback conf apiReq
|
||||
failNotSingular pMedia resultSet
|
||||
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
|
||||
pure $ DbCrudResult plan resultSet
|
||||
where
|
||||
dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements
|
||||
decodeRow = fromMaybe (RSStandard (Just 0) 0 mempty mempty Nothing Nothing Nothing) <$> HD.rowMaybe (standardRow True)
|
||||
|
||||
actionQuery MainQuery{mqOpenAPI=(tblsQ, funcsQ, schQ)} (MayUseDb plan@InspectPlan{ipSchema=tSchema}) AppConfig{..} _ sCache =
|
||||
mainActionQuery
|
||||
where
|
||||
mainActionQuery = lift $
|
||||
case configOpenApiMode of
|
||||
OAFollowPriv -> do
|
||||
tableAccess <- SQL.statement mempty $ SQL.dynamicallyParameterized tblsQ decodeAccessibleIdentifiers configDbPreparedStatements
|
||||
accFuncs <- SQL.statement mempty $ SQL.dynamicallyParameterized funcsQ SchemaCache.decodeFuncs configDbPreparedStatements
|
||||
schDesc <- SQL.statement mempty $ SQL.dynamicallyParameterized schQ decodeSchemaDesc configDbPreparedStatements
|
||||
let tbls = HM.filterWithKey (\qi _ -> S.member qi tableAccess) $ SchemaCache.dbTables sCache
|
||||
|
||||
pure $ MaybeDbResult plan (Just (tbls, accFuncs, schDesc))
|
||||
OAIgnorePriv -> do
|
||||
schDesc <- SQL.statement mempty (SQL.dynamicallyParameterized (SqlFragment.schemaDescription tSchema) decodeSchemaDesc configDbPreparedStatements)
|
||||
|
||||
let tbls = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) (SchemaCache.dbTables sCache)
|
||||
routs = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) (SchemaCache.dbRoutines sCache)
|
||||
|
||||
pure $ MaybeDbResult plan (Just (tbls, routs, schDesc))
|
||||
OADisabled ->
|
||||
pure $ MaybeDbResult plan Nothing
|
||||
|
||||
decodeSchemaDesc :: HD.Result (Maybe Text)
|
||||
decodeSchemaDesc = join <$> HD.rowMaybe (nullableColumn HD.text)
|
||||
|
||||
decodeAccessibleIdentifiers :: HD.Result (S.Set QualifiedIdentifier)
|
||||
decodeAccessibleIdentifiers =
|
||||
let
|
||||
row = QualifiedIdentifier
|
||||
<$> column HD.text
|
||||
<*> column HD.text
|
||||
in
|
||||
S.fromList <$> HD.rowList row
|
||||
|
||||
-- Makes sure the querystring pk matches the payload pk
|
||||
-- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
|
||||
-- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.
|
||||
-- If this condition is not satisfied then nothing is inserted,
|
||||
-- check the WHERE for INSERT in QueryBuilder.hs to see how it's done
|
||||
failPut :: ResultSet -> DbHandler ()
|
||||
failPut RSStandard{rsQueryTotal=queryTotal} =
|
||||
when (queryTotal /= 1) $ do
|
||||
lift SQL.condemn
|
||||
throwError $ Error.ApiRequestError Error.PutMatchingPkError
|
||||
|
||||
-- |
|
||||
-- Fail a response if a single JSON object was requested and not exactly one
|
||||
-- was found.
|
||||
failNotSingular :: MediaType -> ResultSet -> DbHandler ()
|
||||
failNotSingular mediaType RSStandard{rsQueryTotal=queryTotal} =
|
||||
when (elem mediaType [MTVndSingularJSON True, MTVndSingularJSON False] && queryTotal /= 1) $ do
|
||||
lift SQL.condemn
|
||||
throwError $ Error.ApiRequestError . Error.SingularityError $ toInteger queryTotal
|
||||
|
||||
failExceedsMaxAffectedPref :: (Maybe PreferMaxAffected, Maybe PreferHandling) -> ResultSet -> DbHandler ()
|
||||
failExceedsMaxAffectedPref (Nothing,_) _ = pure ()
|
||||
failExceedsMaxAffectedPref (Just (PreferMaxAffected n), handling) RSStandard{rsQueryTotal=queryTotal} = when ((queryTotal > n) && (handling == Just Strict)) $ do
|
||||
lift SQL.condemn
|
||||
throwError $ Error.ApiRequestError . Error.MaxAffectedViolationError $ toInteger queryTotal
|
||||
|
||||
-- | Set a transaction to roll back if requested
|
||||
optionalRollback :: AppConfig -> ApiRequest -> DbHandler ()
|
||||
optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} = do
|
||||
lift $ when (shouldRollback || (configDbTxRollbackAll && not shouldCommit)) $ do
|
||||
SQL.sql "SET CONSTRAINTS ALL IMMEDIATE"
|
||||
SQL.condemn
|
||||
where
|
||||
shouldCommit =
|
||||
preferTransaction == Just Commit
|
||||
shouldRollback =
|
||||
preferTransaction == Just Rollback
|
||||
|
||||
-- | We use rowList because when doing EXPLAIN (FORMAT TEXT), the result comes as many rows. FORMAT JSON comes as one.
|
||||
planRow :: HD.Result BS.ByteString
|
||||
planRow = BS.unlines <$> HD.rowList (column HD.bytea)
|
||||
|
||||
column :: HD.Value a -> HD.Row a
|
||||
column = HD.column . HD.nonNullable
|
||||
|
||||
nullableColumn :: HD.Value a -> HD.Row (Maybe a)
|
||||
nullableColumn = HD.column . HD.nullable
|
||||
|
||||
arrayColumn :: HD.Value a -> HD.Row [a]
|
||||
arrayColumn = column . HD.listArray . HD.nonNullable
|
||||
|
||||
standardRow :: Bool -> HD.Row ResultSet
|
||||
standardRow noLocation =
|
||||
RSStandard <$> nullableColumn HD.int8 <*> column HD.int8
|
||||
<*> (if noLocation then pure mempty else fmap splitKeyValue <$> arrayColumn HD.bytea)
|
||||
<*> (fromMaybe mempty <$> nullableColumn HD.bytea)
|
||||
<*> nullableColumn HD.bytea
|
||||
<*> nullableColumn HD.text
|
||||
<*> nullableColumn HD.int8
|
||||
where
|
||||
splitKeyValue :: ByteString -> (ByteString, ByteString)
|
||||
splitKeyValue kv =
|
||||
let (k, v) = BS.break (== '=') kv in
|
||||
(k, BS.tail v)
|
||||
|
||||
@@ -34,13 +34,13 @@ import PostgREST.ApiRequest.QueryParams (QueryParams (..))
|
||||
import PostgREST.ApiRequest.Types (InvokeMethod (..),
|
||||
Mutation (..))
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.MainTx (DbResult (..),
|
||||
ResultSet (..))
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import PostgREST.Plan (CrudPlan (..),
|
||||
InfoPlan (..),
|
||||
InspectPlan (..))
|
||||
import PostgREST.Plan.MutatePlan (MutatePlan (..))
|
||||
import PostgREST.Query (QueryResult (..),
|
||||
ResultSet (..))
|
||||
import PostgREST.Response.GucHeader (GucHeader, unwrapGucHeader)
|
||||
import PostgREST.SchemaCache (SchemaCache (..))
|
||||
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
|
||||
@@ -60,7 +60,7 @@ data PgrstResponse = PgrstResponse {
|
||||
, pgrstBody :: LBS.ByteString
|
||||
}
|
||||
|
||||
actionResponse :: QueryResult -> ApiRequest -> (Text, Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse
|
||||
actionResponse :: DbResult -> ApiRequest -> (Text, Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse
|
||||
|
||||
actionResponse (DbCrudResult WrappedReadPlan{pMedia, wrHdrsOnly=headersOnly, crudQi=identifier} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ = do
|
||||
let
|
||||
|
||||
Reference in New Issue
Block a user