diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index a58d7b1e0..b89b70da6 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -94,10 +94,10 @@ data DbAction = ActRelationRead {dbActQi :: QualifiedIdentifier, actHeadersOnly :: Bool} | ActRelationMut {dbActQi :: QualifiedIdentifier, actMutation :: Mutation} | ActRoutine {dbActQi :: QualifiedIdentifier, actInvMethod :: InvokeMethod} + | ActSchemaRead Schema Bool data Action = ActDb DbAction - | ActSchemaRead Schema Bool | ActRelationInfo QualifiedIdentifier | ActRoutineInfo QualifiedIdentifier | ActSchemaInfo @@ -189,8 +189,8 @@ getAction resource schema method = (ResourceRelation rel, "DELETE") -> Right . ActDb $ ActRelationMut (qi rel) MutationDelete (ResourceRelation rel, "OPTIONS") -> Right $ ActRelationInfo (qi rel) - (ResourceSchema, "HEAD") -> Right $ ActSchemaRead schema True - (ResourceSchema, "GET") -> Right $ ActSchemaRead schema False + (ResourceSchema, "HEAD") -> Right . ActDb $ ActSchemaRead schema True + (ResourceSchema, "GET") -> Right . ActDb $ ActSchemaRead schema False (ResourceSchema, "OPTIONS") -> Right ActSchemaInfo _ -> Left $ UnsupportedMethod method diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index ccc16bdd3..ebd288fef 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -172,14 +172,8 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A case iAction of ActDb dbAct -> do (planTime', plan) <- withTiming $ liftEither $ Plan.actionPlan dbAct conf apiReq sCache - (txTime', resultSet) <- withTiming $ runQuery (planIsoLvl plan) (planFunSettings plan) (Plan.pTxMode plan) $ Query.actionQuery plan conf apiReq pgVer - (respTime', pgrst) <- withTiming $ liftEither $ Response.actionResponse plan (dbActQi dbAct) apiReq resultSet - return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst - - ActSchemaRead tSchema headersOnly -> do - (planTime', iPlan) <- withTiming $ liftEither $ Plan.inspectPlan apiReq headersOnly tSchema - (txTime', oaiResult) <- withTiming $ runQuery roleIsoLvl mempty (Plan.ipTxmode iPlan) $ Query.openApiQuery iPlan conf sCache pgVer - (respTime', pgrst) <- withTiming $ liftEither $ Response.openApiResponse iPlan (T.decodeUtf8 prettyVersion, docsVersion) oaiResult conf sCache iSchema iNegotiatedByProfile + (txTime', queryResult) <- withTiming $ runQuery (planIsoLvl plan) (planFunSettings plan) (Plan.actionPlanTxMode plan) $ 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 @@ -204,10 +198,10 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A Query.runPreReq conf query - planIsoLvl (Plan.CallReadPlan{crProc}) = fromMaybe roleIsoLvl $ pdIsoLvl crProc + planIsoLvl (Plan.Db Plan.CallReadPlan{crProc}) = fromMaybe roleIsoLvl $ pdIsoLvl crProc planIsoLvl _ = roleIsoLvl - planFunSettings (Plan.CallReadPlan{crProc}) = pdFuncSettings crProc + planFunSettings (Plan.Db Plan.CallReadPlan{crProc}) = pdFuncSettings crProc planFunSettings _ = mempty pgrstResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index 43b67a7ae..25d3013d0 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -18,9 +18,11 @@ resource. module PostgREST.Plan ( actionPlan , ActionPlan(..) + , DbActionPlan(..) , InspectPlan(..) , inspectPlan , callReadPlan + , actionPlanTxMode ) where import qualified Data.ByteString.Lazy as LBS @@ -90,7 +92,7 @@ import Protolude hiding (from) -- Setup for doctests -- >>> import Data.Ranged.Ranges (fullRange) -data ActionPlan +data DbActionPlan = WrappedReadPlan { wrReadPlan :: ReadPlanTree , pTxMode :: SQL.Mode @@ -123,23 +125,31 @@ data InspectPlan = InspectPlan { , ipSchema :: Schema } +data ActionPlan = Db DbActionPlan | MaybeDb InspectPlan + +actionPlanTxMode :: ActionPlan -> SQL.Mode +actionPlanTxMode (Db x) = pTxMode x +actionPlanTxMode (MaybeDb x) = ipTxmode x + actionPlan :: DbAction -> AppConfig -> ApiRequest -> SchemaCache -> Either Error ActionPlan actionPlan dbAct conf apiReq sCache = case dbAct of ActRelationRead identifier headersOnly -> - wrappedReadPlan identifier conf sCache apiReq headersOnly + Db <$> wrappedReadPlan identifier conf sCache apiReq headersOnly ActRelationMut identifier mut -> - mutateReadPlan mut apiReq identifier conf sCache + Db <$> mutateReadPlan mut apiReq identifier conf sCache ActRoutine identifier invMethod -> - callReadPlan identifier conf sCache apiReq invMethod + Db <$> callReadPlan identifier conf sCache apiReq invMethod + ActSchemaRead tSchema headersOnly -> + MaybeDb <$> inspectPlan apiReq headersOnly tSchema -wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Bool -> Either Error ActionPlan +wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Bool -> Either Error DbActionPlan 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 -mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error ActionPlan +mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error DbActionPlan mutateReadPlan mutation apiRequest@ApiRequest{iPreferences=Preferences{..},..} identifier conf sCache = do rPlan <- readPlan identifier conf sCache apiRequest mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan @@ -147,7 +157,7 @@ mutateReadPlan mutation apiRequest@ApiRequest{iPreferences=Preferences{..},..} (handler, mediaType) <- mapLeft ApiRequestError $ negotiateContent conf apiRequest identifier iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan) return $ MutateReadPlan rPlan mPlan SQL.Write handler mediaType mutation -callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error ActionPlan +callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error DbActionPlan callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} invMethod = do let paramKeys = case invMethod of InvRead _ -> S.fromList $ fst <$> qsParams' diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index ae7d12887..b00ea91f2 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -1,11 +1,11 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} module PostgREST.Query - ( openApiQuery - , actionQuery + ( actionQuery , setPgLocals , runPreReq , DbHandler + , QueryResult (..) ) where import qualified Data.Aeson as JSON @@ -41,6 +41,7 @@ import PostgREST.Config.PgVersion (PgVersion (..)) import PostgREST.Error (Error) import PostgREST.MediaType (MediaType (..)) import PostgREST.Plan (ActionPlan (..), + DbActionPlan (..), InspectPlan (..)) import PostgREST.Plan.MutatePlan (MutatePlan (..)) import PostgREST.Plan.ReadPlan (ReadPlanTree) @@ -59,9 +60,13 @@ import Protolude hiding (Handler) type DbHandler = ExceptT Error SQL.Transaction -actionQuery :: ActionPlan -> AppConfig -> ApiRequest -> PgVersion -> DbHandler ResultSet +data QueryResult + = DbResult DbActionPlan ResultSet + | MaybeDbResult InspectPlan (Maybe (TablesMap, RoutineMap, Maybe Text)) -actionQuery WrappedReadPlan{..} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = do +actionQuery :: ActionPlan -> AppConfig -> ApiRequest -> PgVersion -> SchemaCache -> DbHandler QueryResult + +actionQuery (Db plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ = do let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan resultSet <- lift . SQL.statement mempty $ @@ -79,37 +84,37 @@ actionQuery WrappedReadPlan{..} conf@AppConfig{..} apiReq@ApiRequest{iPreference configDbPreparedStatements failNotSingular wrMedia resultSet optionalRollback conf apiReq - resultSetWTotal conf apiReq resultSet countQuery + DbResult plan <$> resultSetWTotal conf apiReq resultSet countQuery -actionQuery MutateReadPlan{mrMutation=MutationCreate, ..} conf apiReq _ = do +actionQuery (Db plan@MutateReadPlan{mrMutation=MutationCreate, ..}) conf apiReq _ _ = do resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf failNotSingular mrMedia resultSet optionalRollback conf apiReq - pure resultSet + pure $ DbResult plan resultSet -actionQuery MutateReadPlan{mrMutation=MutationUpdate, ..} conf apiReq@ApiRequest{iPreferences=Preferences{..}, ..} _ = do +actionQuery (Db 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 resultSet + pure $ DbResult plan resultSet -actionQuery MutateReadPlan{mrMutation=MutationSingleUpsert, ..} conf apiReq _ = do +actionQuery (Db plan@MutateReadPlan{mrMutation=MutationSingleUpsert, ..}) conf apiReq _ _ = do resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf failPut resultSet optionalRollback conf apiReq - pure resultSet + pure $ DbResult plan resultSet -actionQuery MutateReadPlan{mrMutation=MutationDelete, ..} conf apiReq@ApiRequest{iPreferences=Preferences{..}, ..} _ = do +actionQuery (Db 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 resultSet + pure $ DbResult plan resultSet -actionQuery CallReadPlan{..} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} pgVer = do +actionQuery (Db plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} pgVer _ = do resultSet <- lift . SQL.statement mempty $ Statements.prepareCall @@ -125,25 +130,23 @@ actionQuery CallReadPlan{..} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=P optionalRollback conf apiReq failNotSingular crMedia resultSet failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet - pure resultSet + pure $ DbResult plan resultSet -openApiQuery :: InspectPlan -> AppConfig -> SchemaCache -> PgVersion -> DbHandler (Maybe (TablesMap, RoutineMap, Maybe Text)) -openApiQuery InspectPlan{ipSchema=tSchema} AppConfig{..} sCache pgVer = +actionQuery (MaybeDb plan@InspectPlan{ipSchema=tSchema}) AppConfig{..} _ pgVer sCache = lift $ case configOpenApiMode of OAFollowPriv -> do tableAccess <- SQL.statement [tSchema] (SchemaCache.accessibleTables pgVer configDbPreparedStatements) - Just <$> ((,,) + MaybeDbResult plan . Just <$> ((,,) (HM.filterWithKey (\qi _ -> S.member qi tableAccess) $ SchemaCache.dbTables sCache) <$> SQL.statement tSchema (SchemaCache.accessibleFuncs pgVer configDbPreparedStatements) <*> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements)) OAIgnorePriv -> - Just <$> ((,,) + MaybeDbResult plan . Just <$> ((,,) (HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ SchemaCache.dbTables sCache) (HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ SchemaCache.dbRoutines sCache) <$> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements)) OADisabled -> - pure Nothing - + pure $ MaybeDbResult plan Nothing writeQuery :: ReadPlanTree -> MutatePlan -> MediaType -> MediaHandler -> ApiRequest -> AppConfig -> DbHandler ResultSet writeQuery readPlan mutatePlan mType mHandler ApiRequest{iPreferences=Preferences{..}} conf = diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs index da715c8e5..12ff370d9 100644 --- a/src/PostgREST/Response.hs +++ b/src/PostgREST/Response.hs @@ -8,7 +8,6 @@ module PostgREST.Response ( infoIdentResponse , infoProcResponse , infoRootResponse - , openApiResponse , actionResponse , PgrstResponse(..) ) where @@ -39,17 +38,18 @@ import PostgREST.ApiRequest.Preferences (PreferRepresentation (..), import PostgREST.ApiRequest.QueryParams (QueryParams (..)) import PostgREST.Config (AppConfig (..)) import PostgREST.MediaType (MediaType (..)) -import PostgREST.Plan (ActionPlan (..), +import PostgREST.Plan (DbActionPlan (..), InspectPlan (..)) import PostgREST.Plan.MutatePlan (MutatePlan (..)) +import PostgREST.Query (QueryResult (..)) import PostgREST.Query.Statements (ResultSet (..)) import PostgREST.Response.GucHeader (GucHeader, unwrapGucHeader) import PostgREST.SchemaCache (SchemaCache (..)) import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), Schema) import PostgREST.SchemaCache.Routine (FuncVolatility (..), - Routine (..), RoutineMap) -import PostgREST.SchemaCache.Table (Table (..), TablesMap) + Routine (..)) +import PostgREST.SchemaCache.Table (Table (..)) import qualified PostgREST.ApiRequest.Types as ApiRequestTypes import qualified PostgREST.SchemaCache.Routine as Routine @@ -63,9 +63,9 @@ data PgrstResponse = PgrstResponse { , pgrstBody :: LBS.ByteString } -actionResponse :: ActionPlan -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse +actionResponse :: QueryResult -> QualifiedIdentifier -> ApiRequest -> (Text, Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse -actionResponse WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly} identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = +actionResponse (DbResult WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly} resultSet) identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ = case resultSet of RSStandard{..} -> do let @@ -94,7 +94,7 @@ actionResponse WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly} identifier ctxAp RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders wrMedia ctxApiRequest) $ LBS.fromStrict plan -actionResponse MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, mrMedia} QualifiedIdentifier{..} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of +actionResponse (DbResult MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, mrMedia} resultSet) QualifiedIdentifier{..} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} _ _ _ _ _ = case resultSet of RSStandard{..} -> do let pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;} @@ -134,7 +134,7 @@ actionResponse MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, mrMedia} RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan -actionResponse MutateReadPlan{mrMutation=MutationUpdate, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of +actionResponse (DbResult MutateReadPlan{mrMutation=MutationUpdate, mrMedia} resultSet) _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of RSStandard{..} -> do let contentRangeHeader = @@ -156,7 +156,7 @@ actionResponse MutateReadPlan{mrMutation=MutationUpdate, mrMedia} _ ctxApiReques RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan -actionResponse MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of +actionResponse (DbResult 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 +176,7 @@ actionResponse MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia} _ ctxApi RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan -actionResponse MutateReadPlan{mrMutation=MutationDelete, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of +actionResponse (DbResult MutateReadPlan{mrMutation=MutationDelete, mrMedia} resultSet) _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of RSStandard {..} -> do let contentRangeHeader = @@ -198,7 +198,7 @@ actionResponse MutateReadPlan{mrMutation=MutationDelete, mrMedia} _ ctxApiReques RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan -actionResponse CallReadPlan{crMedia, crInvMthd=invMethod, crProc=proc} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = case resultSet of +actionResponse (DbResult CallReadPlan{crMedia, crInvMthd=invMethod, crProc=proc} resultSet) _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ = case resultSet of RSStandard {..} -> do let (status, contentRange) = @@ -225,6 +225,11 @@ actionResponse CallReadPlan{crMedia, crInvMthd=invMethod, crProc=proc} _ ctxApiR RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders crMedia ctxApiRequest) $ LBS.fromStrict plan +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 @@ -253,12 +258,6 @@ respondInfo allowHeader = let allOrigins = ("Access-Control-Allow-Origin", "*") in Right $ PgrstResponse HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty -openApiResponse :: InspectPlan -> (Text, Text) -> Maybe (TablesMap, RoutineMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse -openApiResponse InspectPlan{ipHdrsOnly=headersOnly} versions body 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) - -- Status and headers can be overridden as per https://postgrest.org/en/stable/references/transactions.html#response-headers overrideStatusHeaders :: Maybe Text -> Maybe BS.ByteString -> HTTP.Status -> [HTTP.Header]-> Either Error.Error (HTTP.Status, [HTTP.Header]) overrideStatusHeaders rsGucStatus rsGucHeaders pgrstStatus pgrstHeaders = do