jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: remove IO from the Query.hs module

Browse Source 
Will make logging SQL queries to stderr possible
This commit is contained in:
Laurence Isla
2025-02-14 19:52:59 -05:00
parent 7be5782179
commit 8157e6ee0b
2 changed files with 104 additions and 106 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+12 -2
View File
@@ -146,8 +146,18 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@
(parseTime, apiReq@ApiRequest{..}) <- withTiming $ liftEither . mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf req body sCache (parseTime, apiReq@ApiRequest{..}) <- withTiming $ liftEither . mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf req body sCache
(planTime, plan) <- withTiming $ liftEither $ Plan.actionPlan iAction conf apiReq sCache (planTime, plan) <- withTiming $ liftEither $ Plan.actionPlan iAction conf apiReq sCache
(queryTime, queryResult) <- withTiming $ Query.runQuery appState conf authResult apiReq plan sCache pgVer (Just authRole /= configDbAnonRole)
(respTime, resp) <- withTiming $ liftEither $ Response.actionResponse queryResult apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache iSchema iNegotiatedByProfile let query = Query.query conf authResult apiReq plan sCache pgVer
(queryTime, queryResult) <- withTiming $ do
case query of
Query.NoDbQuery r -> pure r
Query.DbQuery{..} -> do
dbRes <- lift $ AppState.usePool appState (dqTransaction dqIsoLevel dqTxMode $ runExceptT dqDbHandler)
err <- liftEither . mapLeft Error.PgErr . mapLeft (Error.PgError (Just authRole /= configDbAnonRole)) $ dbRes
liftEither err
(respTime, resp) <- withTiming $ liftEither $ Response.actionResponse queryResult apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache iSchema iNegotiatedByProfile
return $ toWaiResponse (ServerTiming jwtTime parseTime planTime queryTime respTime) resp return $ toWaiResponse (ServerTiming jwtTime parseTime planTime queryTime respTime) resp
src/PostgREST/Query.hs
+92 -104
View File
@@ -2,25 +2,24 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
-- TODO: This module shouldn't depend on SchemaCache -- TODO: This module shouldn't depend on SchemaCache
module PostgREST.Query module PostgREST.Query
( QueryResult (..) ( Query (..)
, runQuery , QueryResult (..)
, query
) where ) where
import Control.Monad.Except (liftEither)
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.Aeson.KeyMap as KM import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Either.Combinators (mapLeft)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S import qualified Data.Set as S
import qualified Hasql.Decoders as HD import qualified Hasql.Decoders as HD
import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet) import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
import qualified Hasql.DynamicStatements.Statement as 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 as SQL
import qualified Hasql.Transaction.Sessions as SQL import qualified Hasql.Transaction.Sessions as SQL
import qualified PostgREST.AppState as AppState
import qualified PostgREST.Error as Error import qualified PostgREST.Error as Error
import qualified PostgREST.Query.QueryBuilder as QueryBuilder import qualified PostgREST.Query.QueryBuilder as QueryBuilder
import qualified PostgREST.Query.Statements as Statements import qualified PostgREST.Query.Statements as Statements
@@ -49,7 +48,6 @@ import PostgREST.Plan (ActionPlan (..),
InfoPlan (..), InfoPlan (..),
InspectPlan (..)) InspectPlan (..))
import PostgREST.Plan.MutatePlan (MutatePlan (..)) import PostgREST.Plan.MutatePlan (MutatePlan (..))
import PostgREST.Plan.ReadPlan (ReadPlanTree)
import PostgREST.Query.SqlFragment (escapeIdentList, fromQi, import PostgREST.Query.SqlFragment (escapeIdentList, fromQi,
intercalateSnippet, intercalateSnippet,
setConfigWithConstantName, setConfigWithConstantName,
@@ -58,41 +56,41 @@ import PostgREST.Query.SqlFragment (escapeIdentList, fromQi,
import PostgREST.Query.Statements (ResultSet (..)) import PostgREST.Query.Statements (ResultSet (..))
import PostgREST.SchemaCache (SchemaCache (..)) import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..)) import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
import PostgREST.SchemaCache.Routine (MediaHandler, Routine (..), import PostgREST.SchemaCache.Routine (Routine (..), RoutineMap)
RoutineMap)
import PostgREST.SchemaCache.Table (TablesMap) import PostgREST.SchemaCache.Table (TablesMap)
import Protolude hiding (Handler) import Protolude hiding (Handler)
type DbHandler = ExceptT Error SQL.Transaction 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 data QueryResult
= DbCrudResult CrudPlan ResultSet = DbCrudResult CrudPlan ResultSet
| DbCallResult CallReadPlan ResultSet | DbCallResult CallReadPlan ResultSet
| MaybeDbResult InspectPlan (Maybe (TablesMap, RoutineMap, Maybe Text)) | MaybeDbResult InspectPlan (Maybe (TablesMap, RoutineMap, Maybe Text))
| NoDbResult InfoPlan | NoDbResult InfoPlan
-- TODO This function needs to be free from IO, only App.hs should do IO query :: AppConfig -> AuthResult -> ApiRequest -> ActionPlan -> SchemaCache -> PgVersion -> Query
runQuery :: AppState.AppState -> AppConfig -> AuthResult -> ApiRequest -> ActionPlan -> SchemaCache -> PgVersion -> Bool -> ExceptT Error IO QueryResult query _ _ _ (NoDb x) _ _ = NoDbQuery $ NoDbResult x
runQuery _ _ _ _ (NoDb x) _ _ _ = pure $ NoDbResult x query config AuthResult{..} apiReq (Db plan) sCache pgVer =
runQuery appState config AuthResult{..} apiReq (Db plan) sCache pgVer authenticated = do DbQuery isoLvl txMode dbHandler transaction
dbResp <- lift $ do
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
AppState.usePool appState (transaction isoLvl txMode $ runExceptT dbHandler)
resp <-
liftEither . mapLeft Error.PgErr $
mapLeft (Error.PgError authenticated) dbResp
liftEither resp
where where
transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
prepared = configDbPreparedStatements config prepared = configDbPreparedStatements config
isoLvl = planIsoLvl config authRole plan isoLvl = planIsoLvl config authRole plan
txMode = planTxMode plan txMode = planTxMode plan
dbHandler = do dbHandler = do
setPgLocals plan config authClaims authRole apiReq setPgLocals plan config authClaims authRole apiReq
runPreReq config runPreReq config
actionQuery plan config apiReq pgVer sCache actionQuery plan config apiReq pgVer sCache
planTxMode :: DbActionPlan -> SQL.Mode planTxMode :: DbActionPlan -> SQL.Mode
planTxMode (DbCrud x) = pTxMode x planTxMode (DbCrud x) = pTxMode x
@@ -107,70 +105,78 @@ planIsoLvl AppConfig{configRoleIsoLvl} role actPlan = case actPlan of
roleIsoLvl = HM.findWithDefault SQL.ReadCommitted role configRoleIsoLvl roleIsoLvl = HM.findWithDefault SQL.ReadCommitted role configRoleIsoLvl
actionQuery :: DbActionPlan -> AppConfig -> ApiRequest -> PgVersion -> SchemaCache -> DbHandler QueryResult actionQuery :: DbActionPlan -> AppConfig -> ApiRequest -> PgVersion -> SchemaCache -> DbHandler QueryResult
actionQuery (DbCrud plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ =
mainActionQuery
where
countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan
result = Statements.prepareRead
(QueryBuilder.readPlanToQuery wrReadPlan)
(if preferCount == Just EstimatedCount then
-- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
else
countQuery
)
(shouldCount preferCount)
wrMedia
wrHandler
configDbPreparedStatements
mainActionQuery = do
resultSet <- lift $ SQL.statement mempty result
failNotSingular wrMedia resultSet
optionalRollback conf apiReq
DbCrudResult plan <$> resultSetWTotal conf apiReq resultSet countQuery
actionQuery (DbCrud plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ = do actionQuery (DbCrud plan@MutateReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ =
let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan mainActionQuery
resultSet <- where
lift . SQL.statement mempty $ (isPut, isInsert, pkCols) = case mrMutatePlan of {Insert{where_,insPkCols} -> ((not . null) where_, True, insPkCols); _ -> (False,False, mempty);}
Statements.prepareRead result = Statements.prepareWrite
(QueryBuilder.readPlanToQuery wrReadPlan) (QueryBuilder.readPlanToQuery mrReadPlan)
(if preferCount == Just EstimatedCount then (QueryBuilder.mutatePlanToQuery mrMutatePlan)
-- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed isInsert
QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows) isPut
else mrMedia
countQuery mrHandler
) preferRepresentation
(shouldCount preferCount) preferResolution
wrMedia pkCols
wrHandler configDbPreparedStatements
configDbPreparedStatements failMutation resultSet = case mrMutation of
failNotSingular wrMedia resultSet MutationCreate -> do
optionalRollback conf apiReq failNotSingular mrMedia resultSet
DbCrudResult plan <$> resultSetWTotal conf apiReq resultSet countQuery MutationUpdate -> do
failNotSingular mrMedia resultSet
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
MutationSingleUpsert -> do
failPut resultSet
MutationDelete -> do
failNotSingular mrMedia resultSet
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
mainActionQuery = do
resultSet <- lift $ SQL.statement mempty result
failMutation resultSet
optionalRollback conf apiReq
pure $ DbCrudResult plan resultSet
actionQuery (DbCrud plan@MutateReadPlan{mrMutation=MutationCreate, ..}) conf apiReq _ _ = do actionQuery (DbCall plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} pgVer _ =
resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf mainActionQuery
failNotSingular mrMedia resultSet where
optionalRollback conf apiReq result = Statements.prepareCall
pure $ DbCrudResult plan resultSet crProc
(QueryBuilder.callPlanToQuery crCallPlan pgVer)
actionQuery (DbCrud plan@MutateReadPlan{mrMutation=MutationUpdate, ..}) conf apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ = do (QueryBuilder.readPlanToQuery crReadPlan)
resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf (QueryBuilder.readPlanToCountQuery crReadPlan)
failNotSingular mrMedia resultSet (shouldCount preferCount)
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet crMedia
optionalRollback conf apiReq crHandler
pure $ DbCrudResult plan resultSet configDbPreparedStatements
mainActionQuery = do
actionQuery (DbCrud plan@MutateReadPlan{mrMutation=MutationSingleUpsert, ..}) conf apiReq _ _ = do resultSet <- lift $ SQL.statement mempty result
resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf optionalRollback conf apiReq
failPut resultSet failNotSingular crMedia resultSet
optionalRollback conf apiReq failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
pure $ DbCrudResult plan resultSet pure $ DbCallResult plan resultSet
actionQuery (DbCrud plan@MutateReadPlan{mrMutation=MutationDelete, ..}) conf apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ = do
resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf
failNotSingular mrMedia resultSet
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
optionalRollback conf apiReq
pure $ DbCrudResult plan resultSet
actionQuery (DbCall plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} pgVer _ = do
resultSet <-
lift . SQL.statement mempty $
Statements.prepareCall
crProc
(QueryBuilder.callPlanToQuery crCallPlan pgVer)
(QueryBuilder.readPlanToQuery crReadPlan)
(QueryBuilder.readPlanToCountQuery crReadPlan)
(shouldCount preferCount)
crMedia
crHandler
configDbPreparedStatements
optionalRollback conf apiReq
failNotSingular crMedia resultSet
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
pure $ DbCallResult plan resultSet
actionQuery (MaybeDb plan@InspectPlan{ipSchema=tSchema}) AppConfig{..} _ _ sCache = actionQuery (MaybeDb plan@InspectPlan{ipSchema=tSchema}) AppConfig{..} _ _ sCache =
lift $ case configOpenApiMode of lift $ case configOpenApiMode of
@@ -188,24 +194,6 @@ actionQuery (MaybeDb plan@InspectPlan{ipSchema=tSchema}) AppConfig{..} _ _ sCach
OADisabled -> OADisabled ->
pure $ MaybeDbResult plan Nothing pure $ MaybeDbResult plan Nothing
writeQuery :: ReadPlanTree -> MutatePlan -> MediaType -> MediaHandler -> ApiRequest -> AppConfig -> DbHandler ResultSet
writeQuery readPlan mutatePlan mType mHandler ApiRequest{iPreferences=Preferences{..}} conf =
let
(isPut, isInsert, pkCols) = case mutatePlan of {Insert{where_,insPkCols} -> ((not . null) where_, True, insPkCols); _ -> (False,False, mempty);}
in
lift . SQL.statement mempty $
Statements.prepareWrite
(QueryBuilder.readPlanToQuery readPlan)
(QueryBuilder.mutatePlanToQuery mutatePlan)
isInsert
isPut
mType
mHandler
preferRepresentation
preferResolution
pkCols
(configDbPreparedStatements conf)
-- Makes sure the querystring pk matches the payload pk -- Makes sure the querystring pk matches the payload pk
-- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted, -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
-- PUT /items?id=eq.14 { "id" : 2, .. } is rejected. -- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.