refactor: one entrypoint for Plan/Response/Query
- deduplicates timing calculation for the different steps - enabling query logging later on will be simpler
This commit is contained in:
steve-chavez
committed by
Steve Chavez
Steve Chavez
parent
a66738b892
commit
5ab317caa0
@@ -99,7 +99,7 @@ data DbAction
|
||||
data Action
|
||||
= ActDb DbAction
|
||||
| ActRelationInfo QualifiedIdentifier
|
||||
| ActRoutineInfo QualifiedIdentifier
|
||||
| ActRoutineInfo QualifiedIdentifier InvokeMethod
|
||||
| ActSchemaInfo
|
||||
|
||||
{-|
|
||||
@@ -178,7 +178,7 @@ getAction resource schema method =
|
||||
(ResourceRoutine rout, "HEAD") -> Right . ActDb $ ActRoutine (qi rout) $ InvRead True
|
||||
(ResourceRoutine rout, "GET") -> Right . ActDb $ ActRoutine (qi rout) $ InvRead False
|
||||
(ResourceRoutine rout, "POST") -> Right . ActDb $ ActRoutine (qi rout) Inv
|
||||
(ResourceRoutine rout, "OPTIONS") -> Right $ ActRoutineInfo (qi rout)
|
||||
(ResourceRoutine rout, "OPTIONS") -> Right $ ActRoutineInfo (qi rout) $ InvRead True
|
||||
(ResourceRoutine _, _) -> Left $ InvalidRpcMethod method
|
||||
|
||||
(ResourceRelation rel, "HEAD") -> Right . ActDb $ ActRelationRead (qi rel) True
|
||||
|
||||
+19
-61
@@ -23,10 +23,9 @@ import Data.String (IsString (..))
|
||||
import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
|
||||
setServerName)
|
||||
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Hasql.Transaction.Sessions as SQL
|
||||
import qualified Network.Wai as Wai
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Network.Wai as Wai
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
|
||||
import qualified PostgREST.Admin as Admin
|
||||
import qualified PostgREST.ApiRequest as ApiRequest
|
||||
@@ -40,15 +39,13 @@ import qualified PostgREST.Query as Query
|
||||
import qualified PostgREST.Response as Response
|
||||
import qualified PostgREST.Unix as Unix (installSignalHandlers)
|
||||
|
||||
import PostgREST.ApiRequest (Action (..), ApiRequest (..),
|
||||
DbAction (..))
|
||||
import PostgREST.ApiRequest (ApiRequest (..))
|
||||
import PostgREST.AppState (AppState)
|
||||
import PostgREST.Auth (AuthResult (..))
|
||||
import PostgREST.Config (AppConfig (..), LogLevel (..))
|
||||
import PostgREST.Config.PgVersion (PgVersion (..))
|
||||
import PostgREST.Error (Error)
|
||||
import PostgREST.Observation (Observation (..))
|
||||
import PostgREST.Query (DbHandler)
|
||||
import PostgREST.Response.Performance (ServerTiming (..),
|
||||
serverTimingHeader)
|
||||
import PostgREST.SchemaCache (SchemaCache (..))
|
||||
@@ -143,66 +140,27 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@
|
||||
|
||||
body <- lift $ Wai.strictRequestBody req
|
||||
|
||||
(parseTime, apiRequest) <-
|
||||
calcTiming configServerTimingEnabled $
|
||||
liftEither . mapLeft Error.ApiRequestError $
|
||||
ApiRequest.userApiRequest conf req body sCache
|
||||
|
||||
let jwtTime = if configServerTimingEnabled then Auth.getJwtDur req else Nothing
|
||||
handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache jwtTime parseTime observer
|
||||
|
||||
runDbHandler :: AppState.AppState -> AppConfig -> SQL.IsolationLevel -> SQL.Mode -> Bool -> Bool -> (Observation -> IO ()) -> DbHandler b -> Handler IO b
|
||||
runDbHandler appState config isoLvl mode authenticated prepared observer handler = do
|
||||
dbResp <- lift $ do
|
||||
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
|
||||
AppState.usePool appState config (transaction isoLvl mode $ runExceptT handler) observer
|
||||
(parseTime, apiReq@ApiRequest{..}) <- withTiming $ liftEither . mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf req body 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) observer
|
||||
(respTime, resp) <- withTiming $ liftEither $ Response.actionResponse queryResult apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache iSchema iNegotiatedByProfile
|
||||
|
||||
resp <-
|
||||
liftEither . mapLeft Error.PgErr $
|
||||
mapLeft (Error.PgError authenticated) dbResp
|
||||
|
||||
liftEither resp
|
||||
|
||||
handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache ->
|
||||
Maybe Double -> Maybe Double -> (Observation -> IO ()) -> Handler IO Wai.Response
|
||||
handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache jwtTime parseTime observer =
|
||||
case iAction of
|
||||
ActDb dbAct -> do
|
||||
(planTime', plan) <- withTiming $ liftEither $ Plan.actionPlan dbAct conf apiReq sCache
|
||||
(txTime', queryResult) <- withTiming $ runDbHandler appState conf (Plan.planIsoLvl conf authRole plan) (Plan.planTxMode plan) authenticated prepared observer $ do
|
||||
Query.setPgLocals plan conf authClaims authRole apiReq
|
||||
Query.runPreReq conf
|
||||
Query.actionQuery plan conf apiReq pgVer sCache
|
||||
(respTime', pgrst) <- withTiming $ liftEither $ Response.actionResponse queryResult (dbActQi dbAct) apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache iSchema iNegotiatedByProfile
|
||||
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst
|
||||
|
||||
ActRelationInfo identifier -> do
|
||||
(respTime', pgrst) <- withTiming $ liftEither $ Response.infoIdentResponse identifier sCache
|
||||
return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst
|
||||
|
||||
ActRoutineInfo identifier -> do
|
||||
(planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq $ ApiRequest.InvRead True
|
||||
(respTime', pgrst) <- withTiming $ liftEither $ Response.infoProcResponse (Plan.crProc cPlan)
|
||||
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' Nothing respTime') pgrst
|
||||
|
||||
ActSchemaInfo -> do
|
||||
(respTime', pgrst) <- withTiming $ liftEither Response.infoRootResponse
|
||||
return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst
|
||||
return $ toWaiResponse (ServerTiming jwtTime parseTime planTime queryTime respTime) resp
|
||||
|
||||
where
|
||||
pgrstResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response
|
||||
pgrstResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled conf])) bod
|
||||
toWaiResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response
|
||||
toWaiResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled])) bod
|
||||
|
||||
withTiming = calcTiming $ configServerTimingEnabled conf
|
||||
|
||||
calcTiming :: Bool -> Handler IO a -> Handler IO (Maybe Double, a)
|
||||
calcTiming timingEnabled f = if timingEnabled
|
||||
then do
|
||||
(t, r) <- timeItT f
|
||||
pure (Just t, r)
|
||||
else do
|
||||
r <- f
|
||||
pure (Nothing, r)
|
||||
withTiming :: Handler IO a -> Handler IO (Maybe Double, a)
|
||||
withTiming f = if configServerTimingEnabled
|
||||
then do
|
||||
(t, r) <- timeItT f
|
||||
pure (Just t, r)
|
||||
else do
|
||||
r <- f
|
||||
pure (Nothing, r)
|
||||
|
||||
traceHeaderMiddleware :: AppState -> Wai.Middleware
|
||||
traceHeaderMiddleware appState app req respond = do
|
||||
|
||||
+30
-29
@@ -20,10 +20,9 @@ module PostgREST.Plan
|
||||
, ActionPlan(..)
|
||||
, DbActionPlan(..)
|
||||
, InspectPlan(..)
|
||||
, inspectPlan
|
||||
, callReadPlan
|
||||
, planTxMode
|
||||
, planIsoLvl
|
||||
, InfoPlan(..)
|
||||
, CrudPlan(..)
|
||||
, CallReadPlan(..)
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
@@ -93,13 +92,14 @@ import Protolude hiding (from)
|
||||
-- Setup for doctests
|
||||
-- >>> import Data.Ranged.Ranges (fullRange)
|
||||
|
||||
data DbActionPlan
|
||||
data CrudPlan
|
||||
= WrappedReadPlan
|
||||
{ wrReadPlan :: ReadPlanTree
|
||||
, pTxMode :: SQL.Mode
|
||||
, wrHandler :: MediaHandler
|
||||
, wrMedia :: MediaType
|
||||
, wrHdrsOnly :: Bool
|
||||
, crudQi :: QualifiedIdentifier
|
||||
}
|
||||
| MutateReadPlan {
|
||||
mrReadPlan :: ReadPlanTree
|
||||
@@ -108,15 +108,18 @@ data DbActionPlan
|
||||
, mrHandler :: MediaHandler
|
||||
, mrMedia :: MediaType
|
||||
, mrMutation :: Mutation
|
||||
, crudQi :: QualifiedIdentifier
|
||||
}
|
||||
| CallReadPlan {
|
||||
|
||||
data CallReadPlan = CallReadPlan {
|
||||
crReadPlan :: ReadPlanTree
|
||||
, crCallPlan :: CallPlan
|
||||
, pTxMode :: SQL.Mode
|
||||
, crTxMode :: SQL.Mode
|
||||
, crProc :: Routine
|
||||
, crHandler :: MediaHandler
|
||||
, crMedia :: MediaType
|
||||
, crInvMthd :: InvokeMethod
|
||||
, crQi :: QualifiedIdentifier
|
||||
}
|
||||
|
||||
data InspectPlan = InspectPlan {
|
||||
@@ -126,46 +129,44 @@ data InspectPlan = InspectPlan {
|
||||
, ipSchema :: Schema
|
||||
}
|
||||
|
||||
data ActionPlan = Db DbActionPlan | MaybeDb InspectPlan
|
||||
data DbActionPlan = DbCrud CrudPlan | DbCall CallReadPlan | MaybeDb InspectPlan
|
||||
data InfoPlan = RelInfoPlan QualifiedIdentifier | RoutineInfoPlan CallReadPlan | SchemaInfoPlan
|
||||
data ActionPlan = Db DbActionPlan | NoDb InfoPlan
|
||||
|
||||
planTxMode :: ActionPlan -> SQL.Mode
|
||||
planTxMode (Db x) = pTxMode x
|
||||
planTxMode (MaybeDb x) = ipTxmode x
|
||||
actionPlan :: Action -> AppConfig -> ApiRequest -> SchemaCache -> Either Error ActionPlan
|
||||
actionPlan act conf apiReq sCache = case act of
|
||||
ActDb dbAct -> Db <$> dbActionPlan dbAct conf apiReq sCache
|
||||
ActRelationInfo ident -> pure . NoDb $ RelInfoPlan ident
|
||||
ActRoutineInfo ident inv -> NoDb . RoutineInfoPlan <$> callReadPlan ident conf sCache apiReq inv
|
||||
ActSchemaInfo -> pure $ NoDb SchemaInfoPlan
|
||||
|
||||
planIsoLvl :: AppConfig -> ByteString -> ActionPlan -> SQL.IsolationLevel
|
||||
planIsoLvl AppConfig{configRoleIsoLvl} role actPlan = case actPlan of
|
||||
Db CallReadPlan{crProc} -> fromMaybe roleIsoLvl $ pdIsoLvl crProc
|
||||
_ -> roleIsoLvl
|
||||
where
|
||||
roleIsoLvl = HM.findWithDefault SQL.ReadCommitted role configRoleIsoLvl
|
||||
|
||||
actionPlan :: DbAction -> AppConfig -> ApiRequest -> SchemaCache -> Either Error ActionPlan
|
||||
actionPlan dbAct conf apiReq sCache = case dbAct of
|
||||
dbActionPlan :: DbAction -> AppConfig -> ApiRequest -> SchemaCache -> Either Error DbActionPlan
|
||||
dbActionPlan dbAct conf apiReq sCache = case dbAct of
|
||||
ActRelationRead identifier headersOnly ->
|
||||
Db <$> wrappedReadPlan identifier conf sCache apiReq headersOnly
|
||||
DbCrud <$> wrappedReadPlan identifier conf sCache apiReq headersOnly
|
||||
ActRelationMut identifier mut ->
|
||||
Db <$> mutateReadPlan mut apiReq identifier conf sCache
|
||||
DbCrud <$> mutateReadPlan mut apiReq identifier conf sCache
|
||||
ActRoutine identifier invMethod ->
|
||||
Db <$> callReadPlan identifier conf sCache apiReq invMethod
|
||||
DbCall <$> callReadPlan identifier conf sCache apiReq invMethod
|
||||
ActSchemaRead tSchema headersOnly ->
|
||||
MaybeDb <$> inspectPlan apiReq headersOnly tSchema
|
||||
|
||||
wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Bool -> Either Error DbActionPlan
|
||||
wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Bool -> Either Error CrudPlan
|
||||
wrappedReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} headersOnly = do
|
||||
rPlan <- readPlan identifier conf sCache apiRequest
|
||||
(handler, mediaType) <- mapLeft ApiRequestError $ negotiateContent conf apiRequest identifier iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan)
|
||||
if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestError $ InvalidPreferences invalidPrefs else Right ()
|
||||
return $ WrappedReadPlan rPlan SQL.Read handler mediaType headersOnly
|
||||
return $ WrappedReadPlan rPlan SQL.Read handler mediaType headersOnly identifier
|
||||
|
||||
mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error DbActionPlan
|
||||
mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error CrudPlan
|
||||
mutateReadPlan mutation apiRequest@ApiRequest{iPreferences=Preferences{..},..} identifier conf sCache = do
|
||||
rPlan <- readPlan identifier conf sCache apiRequest
|
||||
mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan
|
||||
if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestError $ InvalidPreferences invalidPrefs else Right ()
|
||||
(handler, mediaType) <- mapLeft ApiRequestError $ negotiateContent conf apiRequest identifier iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan)
|
||||
return $ MutateReadPlan rPlan mPlan SQL.Write handler mediaType mutation
|
||||
return $ MutateReadPlan rPlan mPlan SQL.Write handler mediaType mutation identifier
|
||||
|
||||
callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error DbActionPlan
|
||||
callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan
|
||||
callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} invMethod = do
|
||||
let paramKeys = case invMethod of
|
||||
InvRead _ -> S.fromList $ fst <$> qsParams'
|
||||
@@ -186,7 +187,7 @@ callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferenc
|
||||
cPlan = callPlan proc apiRequest paramKeys args rPlan
|
||||
(handler, mediaType) <- mapLeft ApiRequestError $ negotiateContent conf apiRequest relIdentifier iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan)
|
||||
if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestError $ InvalidPreferences invalidPrefs else Right ()
|
||||
return $ CallReadPlan rPlan cPlan txMode proc handler mediaType invMethod
|
||||
return $ CallReadPlan rPlan cPlan txMode proc handler mediaType invMethod identifier
|
||||
where
|
||||
qsParams' = QueryParams.qsParams iQueryParams
|
||||
|
||||
|
||||
+66
-24
@@ -1,25 +1,26 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module PostgREST.Query
|
||||
( actionQuery
|
||||
, setPgLocals
|
||||
, runPreReq
|
||||
, DbHandler
|
||||
, QueryResult (..)
|
||||
( QueryResult (..)
|
||||
, runQuery
|
||||
) where
|
||||
|
||||
import Control.Monad.Except (liftEither)
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy.Char8 as LBS
|
||||
import Data.Either.Combinators (mapLeft)
|
||||
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 (Snippet)
|
||||
import qualified Hasql.DynamicStatements.Statement as SQL
|
||||
import qualified Hasql.Transaction as SQL
|
||||
import qualified Hasql.Transaction.Sessions as SQL
|
||||
|
||||
import qualified PostgREST.ApiRequest.Types as ApiRequestTypes
|
||||
import qualified PostgREST.AppState as AppState
|
||||
import qualified PostgREST.Error as Error
|
||||
import qualified PostgREST.Query.QueryBuilder as QueryBuilder
|
||||
import qualified PostgREST.Query.Statements as Statements
|
||||
@@ -35,13 +36,18 @@ import PostgREST.ApiRequest.Preferences (PreferCount (..),
|
||||
PreferTransaction (..),
|
||||
Preferences (..),
|
||||
shouldCount)
|
||||
import PostgREST.Auth (AuthResult (..))
|
||||
import PostgREST.Config (AppConfig (..),
|
||||
OpenAPIMode (..))
|
||||
import PostgREST.Config.PgVersion (PgVersion (..))
|
||||
import PostgREST.Error (Error)
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import PostgREST.Observation (Observation (..))
|
||||
import PostgREST.Plan (ActionPlan (..),
|
||||
CallReadPlan (..),
|
||||
CrudPlan (..),
|
||||
DbActionPlan (..),
|
||||
InfoPlan (..),
|
||||
InspectPlan (..))
|
||||
import PostgREST.Plan.MutatePlan (MutatePlan (..))
|
||||
import PostgREST.Plan.ReadPlan (ReadPlanTree)
|
||||
@@ -62,12 +68,48 @@ import Protolude hiding (Handler)
|
||||
type DbHandler = ExceptT Error SQL.Transaction
|
||||
|
||||
data QueryResult
|
||||
= DbResult DbActionPlan ResultSet
|
||||
= DbCrudResult CrudPlan ResultSet
|
||||
| DbCallResult CallReadPlan ResultSet
|
||||
| MaybeDbResult InspectPlan (Maybe (TablesMap, RoutineMap, Maybe Text))
|
||||
| NoDbResult InfoPlan
|
||||
|
||||
actionQuery :: ActionPlan -> AppConfig -> ApiRequest -> PgVersion -> SchemaCache -> DbHandler QueryResult
|
||||
-- TODO This function needs to be free from IO, only App.hs should do IO
|
||||
runQuery :: AppState.AppState -> AppConfig -> AuthResult -> ApiRequest -> ActionPlan -> SchemaCache -> PgVersion -> Bool -> (Observation -> IO ()) -> ExceptT Error IO QueryResult
|
||||
runQuery _ _ _ _ (NoDb x) _ _ _ _ = pure $ NoDbResult x
|
||||
runQuery appState config AuthResult{..} apiReq (Db plan) sCache pgVer authenticated observer = do
|
||||
dbResp <- lift $ do
|
||||
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
|
||||
AppState.usePool appState config (transaction isoLvl txMode $ runExceptT dbHandler) observer
|
||||
|
||||
actionQuery (Db plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ = do
|
||||
resp <-
|
||||
liftEither . mapLeft Error.PgErr $
|
||||
mapLeft (Error.PgError authenticated) dbResp
|
||||
|
||||
liftEither resp
|
||||
where
|
||||
prepared = configDbPreparedStatements config
|
||||
isoLvl = planIsoLvl config authRole plan
|
||||
txMode = planTxMode plan
|
||||
dbHandler = do
|
||||
setPgLocals plan config authClaims authRole apiReq
|
||||
runPreReq config
|
||||
actionQuery plan config apiReq pgVer sCache
|
||||
|
||||
planTxMode :: DbActionPlan -> SQL.Mode
|
||||
planTxMode (DbCrud x) = pTxMode x
|
||||
planTxMode (DbCall x) = crTxMode x
|
||||
planTxMode (MaybeDb x) = ipTxmode x
|
||||
|
||||
planIsoLvl :: AppConfig -> ByteString -> DbActionPlan -> SQL.IsolationLevel
|
||||
planIsoLvl AppConfig{configRoleIsoLvl} role actPlan = case actPlan of
|
||||
DbCall CallReadPlan{crProc} -> fromMaybe roleIsoLvl $ pdIsoLvl crProc
|
||||
_ -> roleIsoLvl
|
||||
where
|
||||
roleIsoLvl = HM.findWithDefault SQL.ReadCommitted role configRoleIsoLvl
|
||||
|
||||
actionQuery :: DbActionPlan -> AppConfig -> ApiRequest -> PgVersion -> SchemaCache -> DbHandler QueryResult
|
||||
|
||||
actionQuery (DbCrud plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ = do
|
||||
let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan
|
||||
resultSet <-
|
||||
lift . SQL.statement mempty $
|
||||
@@ -85,37 +127,37 @@ actionQuery (Db plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{i
|
||||
configDbPreparedStatements
|
||||
failNotSingular wrMedia resultSet
|
||||
optionalRollback conf apiReq
|
||||
DbResult plan <$> resultSetWTotal conf apiReq resultSet countQuery
|
||||
DbCrudResult plan <$> resultSetWTotal conf apiReq resultSet countQuery
|
||||
|
||||
actionQuery (Db plan@MutateReadPlan{mrMutation=MutationCreate, ..}) conf apiReq _ _ = do
|
||||
actionQuery (DbCrud plan@MutateReadPlan{mrMutation=MutationCreate, ..}) conf apiReq _ _ = do
|
||||
resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf
|
||||
failNotSingular mrMedia resultSet
|
||||
optionalRollback conf apiReq
|
||||
pure $ DbResult plan resultSet
|
||||
pure $ DbCrudResult plan resultSet
|
||||
|
||||
actionQuery (Db plan@MutateReadPlan{mrMutation=MutationUpdate, ..}) conf apiReq@ApiRequest{iPreferences=Preferences{..}, ..} _ _ = do
|
||||
actionQuery (DbCrud plan@MutateReadPlan{mrMutation=MutationUpdate, ..}) conf apiReq@ApiRequest{iPreferences=Preferences{..}, ..} _ _ = do
|
||||
resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf
|
||||
failNotSingular mrMedia resultSet
|
||||
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
|
||||
failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
|
||||
optionalRollback conf apiReq
|
||||
pure $ DbResult plan resultSet
|
||||
pure $ DbCrudResult plan resultSet
|
||||
|
||||
actionQuery (Db plan@MutateReadPlan{mrMutation=MutationSingleUpsert, ..}) conf apiReq _ _ = do
|
||||
actionQuery (DbCrud plan@MutateReadPlan{mrMutation=MutationSingleUpsert, ..}) conf apiReq _ _ = do
|
||||
resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf
|
||||
failPut resultSet
|
||||
optionalRollback conf apiReq
|
||||
pure $ DbResult plan resultSet
|
||||
pure $ DbCrudResult plan resultSet
|
||||
|
||||
actionQuery (Db plan@MutateReadPlan{mrMutation=MutationDelete, ..}) conf apiReq@ApiRequest{iPreferences=Preferences{..}, ..} _ _ = do
|
||||
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
|
||||
failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
|
||||
optionalRollback conf apiReq
|
||||
pure $ DbResult plan resultSet
|
||||
pure $ DbCrudResult plan resultSet
|
||||
|
||||
actionQuery (Db plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} pgVer _ = do
|
||||
actionQuery (DbCall plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} pgVer _ = do
|
||||
resultSet <-
|
||||
lift . SQL.statement mempty $
|
||||
Statements.prepareCall
|
||||
@@ -131,7 +173,7 @@ actionQuery (Db plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPre
|
||||
optionalRollback conf apiReq
|
||||
failNotSingular crMedia resultSet
|
||||
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
|
||||
pure $ DbResult plan resultSet
|
||||
pure $ DbCallResult plan resultSet
|
||||
|
||||
actionQuery (MaybeDb plan@InspectPlan{ipSchema=tSchema}) AppConfig{..} _ pgVer sCache =
|
||||
lift $ case configOpenApiMode of
|
||||
@@ -239,8 +281,8 @@ optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} = do
|
||||
preferTransaction == Just Rollback
|
||||
|
||||
-- | Set transaction scoped settings
|
||||
setPgLocals :: ActionPlan -> AppConfig -> KM.KeyMap JSON.Value -> BS.ByteString -> ApiRequest -> DbHandler ()
|
||||
setPgLocals actPlan AppConfig{..} claims role ApiRequest{..} = lift $
|
||||
setPgLocals :: DbActionPlan -> AppConfig -> KM.KeyMap JSON.Value -> BS.ByteString -> ApiRequest -> DbHandler ()
|
||||
setPgLocals dbActPlan AppConfig{..} claims role ApiRequest{..} = lift $
|
||||
SQL.statement mempty $ SQL.dynamicallyParameterized
|
||||
-- To ensure `GRANT SET ON PARAMETER <superuser_setting> TO authenticator` works, the role settings must be set before the impersonated role.
|
||||
-- Otherwise the GRANT SET would have to be applied to the impersonated role. See https://github.com/PostgREST/postgrest/issues/3045
|
||||
@@ -260,9 +302,9 @@ setPgLocals actPlan AppConfig{..} claims role ApiRequest{..} = lift $
|
||||
searchPathSql =
|
||||
let schemas = escapeIdentList (iSchema : configDbExtraSearchPath) in
|
||||
setConfigWithConstantName ("search_path", schemas)
|
||||
funcSettings = case actPlan of
|
||||
Db CallReadPlan{crProc} -> pdFuncSettings crProc
|
||||
_ -> mempty
|
||||
funcSettings = case dbActPlan of
|
||||
DbCall CallReadPlan{crProc} -> pdFuncSettings crProc
|
||||
_ -> mempty
|
||||
|
||||
-- | Runs the pre-request function.
|
||||
runPreReq :: AppConfig -> DbHandler ()
|
||||
|
||||
+17
-21
@@ -5,10 +5,7 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module PostgREST.Response
|
||||
( infoIdentResponse
|
||||
, infoProcResponse
|
||||
, infoRootResponse
|
||||
, actionResponse
|
||||
( actionResponse
|
||||
, PgrstResponse(..)
|
||||
) where
|
||||
|
||||
@@ -38,7 +35,9 @@ import PostgREST.ApiRequest.Preferences (PreferRepresentation (..),
|
||||
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import PostgREST.Plan (DbActionPlan (..),
|
||||
import PostgREST.Plan (CallReadPlan (..),
|
||||
CrudPlan (..),
|
||||
InfoPlan (..),
|
||||
InspectPlan (..))
|
||||
import PostgREST.Plan.MutatePlan (MutatePlan (..))
|
||||
import PostgREST.Query (QueryResult (..))
|
||||
@@ -63,9 +62,9 @@ data PgrstResponse = PgrstResponse {
|
||||
, pgrstBody :: LBS.ByteString
|
||||
}
|
||||
|
||||
actionResponse :: QueryResult -> QualifiedIdentifier -> ApiRequest -> (Text, Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse
|
||||
actionResponse :: QueryResult -> ApiRequest -> (Text, Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse
|
||||
|
||||
actionResponse (DbResult WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly} resultSet) identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ =
|
||||
actionResponse (DbCrudResult WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly, crudQi=identifier} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ =
|
||||
case resultSet of
|
||||
RSStandard{..} -> do
|
||||
let
|
||||
@@ -94,7 +93,7 @@ actionResponse (DbResult WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly} result
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders wrMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
actionResponse (DbResult MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, mrMedia} resultSet) QualifiedIdentifier{..} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} _ _ _ _ _ = case resultSet of
|
||||
actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, mrMedia, crudQi=QualifiedIdentifier{..}} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} _ _ _ _ _ = case resultSet of
|
||||
RSStandard{..} -> do
|
||||
let
|
||||
pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;}
|
||||
@@ -134,7 +133,7 @@ actionResponse (DbResult MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan,
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
actionResponse (DbResult MutateReadPlan{mrMutation=MutationUpdate, mrMedia} resultSet) _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
|
||||
actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationUpdate, mrMedia} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
|
||||
RSStandard{..} -> do
|
||||
let
|
||||
contentRangeHeader =
|
||||
@@ -156,7 +155,7 @@ actionResponse (DbResult MutateReadPlan{mrMutation=MutationUpdate, mrMedia} resu
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
actionResponse (DbResult MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia} resultSet) _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
|
||||
actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
|
||||
RSStandard {..} -> do
|
||||
let
|
||||
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling preferTimezone Nothing []
|
||||
@@ -176,7 +175,7 @@ actionResponse (DbResult MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
actionResponse (DbResult MutateReadPlan{mrMutation=MutationDelete, mrMedia} resultSet) _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
|
||||
actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationDelete, mrMedia} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
|
||||
RSStandard {..} -> do
|
||||
let
|
||||
contentRangeHeader =
|
||||
@@ -198,7 +197,7 @@ actionResponse (DbResult MutateReadPlan{mrMutation=MutationDelete, mrMedia} resu
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
actionResponse (DbResult CallReadPlan{crMedia, crInvMthd=invMethod, crProc=proc} resultSet) _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ = case resultSet of
|
||||
actionResponse (DbCallResult CallReadPlan{crMedia, crInvMthd=invMethod, crProc=proc} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ = case resultSet of
|
||||
RSStandard {..} -> do
|
||||
let
|
||||
(status, contentRange) =
|
||||
@@ -225,14 +224,12 @@ actionResponse (DbResult CallReadPlan{crMedia, crInvMthd=invMethod, crProc=proc}
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders crMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
actionResponse (MaybeDbResult InspectPlan{ipHdrsOnly=headersOnly} body) _ _ versions conf sCache schema negotiatedByProfile =
|
||||
actionResponse (MaybeDbResult InspectPlan{ipHdrsOnly=headersOnly} body) _ versions conf sCache schema negotiatedByProfile =
|
||||
Right $ PgrstResponse HTTP.status200
|
||||
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile))
|
||||
(maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode versions conf sCache x y z) body)
|
||||
|
||||
|
||||
infoIdentResponse :: QualifiedIdentifier -> SchemaCache -> Either Error.Error PgrstResponse
|
||||
infoIdentResponse identifier sCache = do
|
||||
actionResponse (NoDbResult (RelInfoPlan identifier)) _ _ _ sCache _ _ =
|
||||
case HM.lookup identifier (dbTables sCache) of
|
||||
Just tbl -> respondInfo $ allowH tbl
|
||||
Nothing -> Left $ Error.ApiRequestError ApiRequestTypes.NotFound
|
||||
@@ -246,12 +243,11 @@ infoIdentResponse identifier sCache = do
|
||||
["PATCH" | tableUpdatable table] ++
|
||||
["DELETE" | tableDeletable table]
|
||||
|
||||
infoProcResponse :: Routine -> Either Error.Error PgrstResponse
|
||||
infoProcResponse proc | pdVolatility proc == Volatile = respondInfo "OPTIONS,POST"
|
||||
| otherwise = respondInfo "OPTIONS,GET,HEAD,POST"
|
||||
actionResponse (NoDbResult (RoutineInfoPlan CallReadPlan{crProc=proc})) _ _ _ _ _ _
|
||||
| pdVolatility proc == Volatile = respondInfo "OPTIONS,POST"
|
||||
| otherwise = respondInfo "OPTIONS,GET,HEAD,POST"
|
||||
|
||||
infoRootResponse :: Either Error.Error PgrstResponse
|
||||
infoRootResponse = respondInfo "OPTIONS,GET,HEAD"
|
||||
actionResponse (NoDbResult SchemaInfoPlan) _ _ _ _ _ _ = respondInfo "OPTIONS,GET,HEAD"
|
||||
|
||||
respondInfo :: ByteString -> Either Error.Error PgrstResponse
|
||||
respondInfo allowHeader =
|
||||
|
||||
Reference in New Issue
Block a user