diff --git a/postgrest.cabal b/postgrest.cabal index fa28807b4..03efa48db 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -67,6 +67,7 @@ library PostgREST.Error PostgREST.Listener PostgREST.Logger + PostgREST.MainTx PostgREST.MediaType PostgREST.Metrics PostgREST.Network diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 01a29b3a4..e6d6fd037 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -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 diff --git a/src/PostgREST/MainTx.hs b/src/PostgREST/MainTx.hs new file mode 100644 index 000000000..6a072e736 --- /dev/null +++ b/src/PostgREST/MainTx.hs @@ -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) diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index a5655dfb5..69dcbe560 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -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) diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs index 603478a99..065c722f7 100644 --- a/src/PostgREST/Response.hs +++ b/src/PostgREST/Response.hs @@ -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