diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index b89b70da6f..bf272c6bd6 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -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 diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 3c13aff8c1..fa405f153b 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -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 - - 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 + + (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 + + 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 - - 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) + toWaiResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response + toWaiResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled])) bod + + 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 diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index 69ad178231..4639149eb9 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -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 - -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 :: 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 -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 diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index dee6f9c270..0673756d89 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -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 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 () diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs index 12ff370d99..d50f825ba2 100644 --- a/src/PostgREST/Response.hs +++ b/src/PostgREST/Response.hs @@ -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 =