From 745e7868b0042bb0c0c2b28c0e72c515af9c18cb Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Mon, 25 Mar 2024 18:24:46 +0100 Subject: [PATCH] refactor: dry some timings calculation --- src/PostgREST/ApiRequest.hs | 78 ++++++------- src/PostgREST/App.hs | 65 ++++------- src/PostgREST/Plan.hs | 127 +++++++++++---------- src/PostgREST/Query.hs | 220 +++++++++++++++++------------------- src/PostgREST/Response.hs | 94 +++++++-------- 5 files changed, 271 insertions(+), 313 deletions(-) diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 9e25389d6..0327bc9ef 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -11,9 +11,7 @@ module PostgREST.ApiRequest , Mutation(..) , MediaType(..) , Action(..) - , ActionRelation(..) - , ActionRoutine(..) - , ActionSchema(..) + , DbAction(..) , Payload(..) , userApiRequest ) where @@ -92,23 +90,17 @@ data Resource | ResourceRoutine Text | ResourceSchema -data ActionRelation - = ActRead Bool - | ActMutate Mutation - | ActRelInfo - -data ActionRoutine - = ActInvoke InvokeMethod - | ActRoutInfo - -data ActionSchema - = ActSchemaRead Bool - | ActSchemaInfo +data DbAction + = ActRelationRead {dbActQi :: QualifiedIdentifier, actHeadersOnly :: Bool} + | ActRelationMut {dbActQi :: QualifiedIdentifier, actMutation :: Mutation} + | ActRoutine {dbActQi :: QualifiedIdentifier, actInvMethod :: InvokeMethod} data Action - = ActRelation QualifiedIdentifier ActionRelation - | ActRoutine QualifiedIdentifier ActionRoutine - | ActSchema Schema ActionSchema + = ActDb DbAction + | ActSchemaRead Schema Bool + | ActRelationInfo QualifiedIdentifier + | ActRoutineInfo QualifiedIdentifier + | ActSchemaInfo Schema {-| Describes what the user wants to do. This data type is a @@ -168,7 +160,7 @@ userApiRequest conf req reqBody sCache = do iHdrs = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie] iCkies = maybe [] parseCookies $ lookupHeader "Cookie" contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type" - actIsInvokeSafe x = case x of {ActRoutine _ (ActInvoke (InvRead _)) -> True; _ -> False} + actIsInvokeSafe x = case x of {ActDb (ActRoutine _ (InvRead _)) -> True; _ -> False} getResource :: AppConfig -> [Text] -> Either ApiRequestError Resource getResource AppConfig{configOpenApiMode, configDbRootSpec} = \case @@ -183,23 +175,23 @@ getResource AppConfig{configOpenApiMode, configDbRootSpec} = \case getAction :: Resource -> Schema -> ByteString -> Either ApiRequestError Action getAction resource schema method = case (resource, method) of - (ResourceRoutine rout, "HEAD") -> Right $ ActRoutine (qi rout) $ ActInvoke $ InvRead True - (ResourceRoutine rout, "GET") -> Right $ ActRoutine (qi rout) $ ActInvoke $ InvRead False - (ResourceRoutine rout, "POST") -> Right $ ActRoutine (qi rout) $ ActInvoke Inv - (ResourceRoutine rout, "OPTIONS") -> Right $ ActRoutine (qi rout) ActRoutInfo + (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 _, _) -> Left $ InvalidRpcMethod method - (ResourceRelation rel, "HEAD") -> Right $ ActRelation (qi rel) $ ActRead True - (ResourceRelation rel, "GET") -> Right $ ActRelation (qi rel) $ ActRead False - (ResourceRelation rel, "POST") -> Right $ ActRelation (qi rel) $ ActMutate MutationCreate - (ResourceRelation rel, "PUT") -> Right $ ActRelation (qi rel) $ ActMutate MutationSingleUpsert - (ResourceRelation rel, "PATCH") -> Right $ ActRelation (qi rel) $ ActMutate MutationUpdate - (ResourceRelation rel, "DELETE") -> Right $ ActRelation (qi rel) $ ActMutate MutationDelete - (ResourceRelation rel, "OPTIONS") -> Right $ ActRelation (qi rel) ActRelInfo + (ResourceRelation rel, "HEAD") -> Right . ActDb $ ActRelationRead (qi rel) True + (ResourceRelation rel, "GET") -> Right . ActDb $ ActRelationRead (qi rel) False + (ResourceRelation rel, "POST") -> Right . ActDb $ ActRelationMut (qi rel) MutationCreate + (ResourceRelation rel, "PUT") -> Right . ActDb $ ActRelationMut (qi rel) MutationSingleUpsert + (ResourceRelation rel, "PATCH") -> Right . ActDb $ ActRelationMut (qi rel) MutationUpdate + (ResourceRelation rel, "DELETE") -> Right . ActDb $ ActRelationMut (qi rel) MutationDelete + (ResourceRelation rel, "OPTIONS") -> Right $ ActRelationInfo (qi rel) - (ResourceSchema, "HEAD") -> Right $ ActSchema schema $ ActSchemaRead True - (ResourceSchema, "GET") -> Right $ ActSchema schema $ ActSchemaRead False - (ResourceSchema, "OPTIONS") -> Right $ ActSchema schema ActSchemaInfo + (ResourceSchema, "HEAD") -> Right $ ActSchemaRead schema True + (ResourceSchema, "GET") -> Right $ ActSchemaRead schema False + (ResourceSchema, "OPTIONS") -> Right $ ActSchemaInfo schema _ -> Left $ UnsupportedMethod method where @@ -279,20 +271,20 @@ getPayload reqBody contentMediaType QueryParams{qsColumns} action = do (ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct shouldParsePayload = case action of - ActRelation _ (ActMutate MutationDelete) -> False - ActRelation _ (ActMutate _) -> True - ActRoutine _ (ActInvoke Inv) -> True - _ -> False + ActDb (ActRelationMut _ MutationDelete) -> False + ActDb (ActRelationMut _ _) -> True + ActDb (ActRoutine _ Inv) -> True + _ -> False columns = case action of - ActRelation _ (ActMutate MutationCreate) -> qsColumns - ActRelation _ (ActMutate MutationUpdate) -> qsColumns - ActRoutine _ (ActInvoke Inv) -> qsColumns - _ -> Nothing + ActDb (ActRelationMut _ MutationCreate) -> qsColumns + ActDb (ActRelationMut _ MutationUpdate) -> qsColumns + ActDb (ActRoutine _ Inv) -> qsColumns + _ -> Nothing isProc = case action of - ActRoutine _ _ -> True - _ -> False + ActDb (ActRoutine _ _) -> True + _ -> False params = (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) type CsvData = V.Vector (M.Map Text LBS.ByteString) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 95716a3f6..62673b1f7 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -41,11 +41,8 @@ import qualified PostgREST.Query as Query import qualified PostgREST.Response as Response import qualified PostgREST.Unix as Unix (installSignalHandlers) -import PostgREST.ApiRequest (Action (..), - ActionRelation (..), - ActionRoutine (..), - ActionSchema (..), - ApiRequest (..), Mutation (..)) +import PostgREST.ApiRequest (Action (..), ApiRequest (..), + DbAction (..)) import PostgREST.AppState (AppState) import PostgREST.Auth (AuthResult (..)) import PostgREST.Config (AppConfig (..), LogLevel (..)) @@ -172,58 +169,28 @@ handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> 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 - ActRelation identifier (ActRead headersOnly) -> do - (planTime', wrPlan) <- withTiming $ liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq - (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq - (respTime', pgrst) <- withTiming $ liftEither $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet + 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 - ActRelation identifier (ActMutate MutationCreate) -> do - (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache - (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.createResponse identifier mrPlan apiReq resultSet + 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 return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst - ActRelation identifier (ActMutate MutationUpdate) -> do - (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache - (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.updateResponse mrPlan apiReq resultSet - return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst - - ActRelation identifier (ActMutate MutationSingleUpsert) -> do - (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache - (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.singleUpsertResponse mrPlan apiReq resultSet - return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst - - ActRelation identifier (ActMutate MutationDelete) -> do - (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache - (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.deleteResponse mrPlan apiReq resultSet - return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst - - ActRoutine identifier (ActInvoke invMethod) -> do - (planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod - (txTime', resultSet) <- withTiming $ runQuery (fromMaybe roleIsoLvl $ pdIsoLvl (Plan.crProc cPlan)) (pdFuncSettings $ Plan.crProc cPlan) (Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer - (respTime', pgrst) <- withTiming $ liftEither $ Response.invokeResponse cPlan invMethod (Plan.crProc cPlan) apiReq resultSet - return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst - - ActSchema tSchema (ActSchemaRead headersOnly) -> do - (planTime', iPlan) <- withTiming $ liftEither $ Plan.inspectPlan apiReq - (txTime', oaiResult) <- withTiming $ runQuery roleIsoLvl mempty (Plan.ipTxmode iPlan) $ Query.openApiQuery sCache pgVer conf tSchema - (respTime', pgrst) <- withTiming $ liftEither $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile - return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst - - ActRelation identifier ActRelInfo -> do + ActRelationInfo identifier -> do (respTime', pgrst) <- withTiming $ liftEither $ Response.infoIdentResponse identifier sCache return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst - ActRoutine identifier ActRoutInfo -> do + 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 - ActSchema _ ActSchemaInfo -> do + ActSchemaInfo _ -> do (respTime', pgrst) <- withTiming $ liftEither Response.infoRootResponse return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst @@ -236,6 +203,12 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A Query.runPreReq conf query + planIsoLvl (Plan.CallReadPlan{crProc}) = fromMaybe roleIsoLvl $ pdIsoLvl crProc + planIsoLvl _ = roleIsoLvl + + planFunSettings (Plan.CallReadPlan{crProc}) = pdFuncSettings crProc + planFunSettings _ = mempty + pgrstResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response pgrstResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled conf])) bod diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index 848303066..43b67a7ae 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -16,14 +16,11 @@ resource. {-# LANGUAGE RecordWildCards #-} module PostgREST.Plan - ( wrappedReadPlan - , mutateReadPlan - , callReadPlan - , inspectPlan - , WrappedReadPlan(..) - , MutateReadPlan(..) - , CallReadPlan(..) + ( actionPlan + , ActionPlan(..) , InspectPlan(..) + , inspectPlan + , callReadPlan ) where import qualified Data.ByteString.Lazy as LBS @@ -38,9 +35,8 @@ import Data.List (delete, lookup) import Data.Tree (Tree (..)) import PostgREST.ApiRequest (Action (..), - ActionRelation (..), - ActionRoutine (..), ApiRequest (..), + DbAction (..), InvokeMethod (..), Mutation (..), Payload (..)) @@ -94,51 +90,64 @@ import Protolude hiding (from) -- Setup for doctests -- >>> import Data.Ranged.Ranges (fullRange) -data WrappedReadPlan = WrappedReadPlan { - wrReadPlan :: ReadPlanTree -, wrTxMode :: SQL.Mode -, wrHandler :: MediaHandler -, wrMedia :: MediaType -} - -data MutateReadPlan = MutateReadPlan { - mrReadPlan :: ReadPlanTree -, mrMutatePlan :: MutatePlan -, mrTxMode :: SQL.Mode -, mrHandler :: MediaHandler -, mrMedia :: MediaType -} - -data CallReadPlan = CallReadPlan { - crReadPlan :: ReadPlanTree -, crCallPlan :: CallPlan -, crTxMode :: SQL.Mode -, crProc :: Routine -, crHandler :: MediaHandler -, crMedia :: MediaType -} +data ActionPlan + = WrappedReadPlan + { wrReadPlan :: ReadPlanTree + , pTxMode :: SQL.Mode + , wrHandler :: MediaHandler + , wrMedia :: MediaType + , wrHdrsOnly :: Bool + } + | MutateReadPlan { + mrReadPlan :: ReadPlanTree + , mrMutatePlan :: MutatePlan + , pTxMode :: SQL.Mode + , mrHandler :: MediaHandler + , mrMedia :: MediaType + , mrMutation :: Mutation + } + | CallReadPlan { + crReadPlan :: ReadPlanTree + , crCallPlan :: CallPlan + , pTxMode :: SQL.Mode + , crProc :: Routine + , crHandler :: MediaHandler + , crMedia :: MediaType + , crInvMthd :: InvokeMethod + } data InspectPlan = InspectPlan { - ipMedia :: MediaType -, ipTxmode :: SQL.Mode -} + ipMedia :: MediaType + , ipTxmode :: SQL.Mode + , ipHdrsOnly :: Bool + , ipSchema :: Schema + } -wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error WrappedReadPlan -wrappedReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} = do +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 + ActRelationMut identifier mut -> + mutateReadPlan mut apiReq identifier conf sCache + ActRoutine identifier invMethod -> + callReadPlan identifier conf sCache apiReq invMethod + +wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Bool -> Either Error ActionPlan +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 + return $ WrappedReadPlan rPlan SQL.Read handler mediaType headersOnly -mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error MutateReadPlan +mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error ActionPlan 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 + return $ MutateReadPlan rPlan mPlan SQL.Write handler mediaType mutation -callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan +callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error ActionPlan callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} invMethod = do let paramKeys = case invMethod of InvRead _ -> S.fromList $ fst <$> qsParams' @@ -159,7 +168,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 + return $ CallReadPlan rPlan cPlan txMode proc handler mediaType invMethod where qsParams' = QueryParams.qsParams iQueryParams @@ -167,14 +176,14 @@ hasDefaultSelect :: ReadPlanTree -> Bool hasDefaultSelect (Node ReadPlan{select=[CoercibleSelectField{csField=CoercibleField{cfName}}]} []) = cfName == "*" hasDefaultSelect _ = False -inspectPlan :: ApiRequest -> Either Error InspectPlan -inspectPlan apiRequest = do +inspectPlan :: ApiRequest -> Bool -> Schema -> Either Error InspectPlan +inspectPlan apiRequest headersOnly schema = do let producedMTs = [MTOpenAPI, MTApplicationJSON, MTAny] accepts = iAcceptMediaType apiRequest mediaType <- if not . null $ L.intersect accepts producedMTs then Right MTOpenAPI else Left . ApiRequestError . MediaTypeError $ MediaType.toMime <$> accepts - return $ InspectPlan mediaType SQL.Read + return $ InspectPlan mediaType SQL.Read headersOnly schema {-| Search a pg proc by matching name and arguments keys to parameters. Since a function can be overloaded, @@ -424,7 +433,7 @@ expandStarsForTable ctx@ResolverContext{representations, outputType} hasAgg rp@R -- | Enforces the `max-rows` config on the result treeRestrictRange :: Maybe Integer -> Action -> ReadPlanTree -> Either ApiRequestError ReadPlanTree -treeRestrictRange _ (ActRelation _ (ActMutate _)) request = Right request +treeRestrictRange _ (ActDb (ActRelationMut _ _)) request = Right request treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> request where nodeRestrictRange :: Maybe Integer -> ReadPlan -> ReadPlan @@ -461,9 +470,9 @@ addRels schema action allRels parentNode (Node rPlan@ReadPlan{relName,relHint,re newReadPlan = case action of -- the CTE for mutations/rpc is used as WITH sourceCTEName .. SELECT .. FROM sourceCTEName as alias, -- we use the table name as an alias so findRel can find the right relationship. - ActRelation _ (ActMutate _) -> rPlan{from=newFrom, fromAlias=newAlias} - ActRoutine _ _ -> rPlan{from=newFrom, fromAlias=newAlias} - _ -> rPlan + ActDb (ActRelationMut _ _) -> rPlan{from=newFrom, fromAlias=newAlias} + ActDb (ActRoutine _ _) -> rPlan{from=newFrom, fromAlias=newAlias} + _ -> rPlan in Node newReadPlan <$> updateForest (Just $ Node newReadPlan forest) where @@ -701,9 +710,9 @@ addFilters ctx ApiRequest{..} rReq = QueryParams.QueryParams{..} = iQueryParams flts = case iAction of - ActRelation _ (ActRead _) -> qsFilters - ActRoutine _ _ -> qsFilters - _ -> qsFiltersNotRoot + ActDb (ActRelationRead _ _) -> qsFilters + ActDb (ActRoutine _ _) -> qsFilters + _ -> qsFiltersNotRoot addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree addFilterToNode = @@ -712,8 +721,8 @@ addFilters ctx ApiRequest{..} rReq = addOrders :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree addOrders ctx ApiRequest{..} rReq = case iAction of - ActRelation _ (ActMutate _) -> Right rReq - _ -> foldr addOrderToNode (Right rReq) qsOrder + ActDb (ActRelationMut _ _) -> Right rReq + _ -> foldr addOrderToNode (Right rReq) qsOrder where QueryParams.QueryParams{..} = iQueryParams @@ -833,8 +842,8 @@ addNullEmbedFilters (Node rp@ReadPlan{where_=curLogic} forest) = do addRanges :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree addRanges ApiRequest{..} rReq = case iAction of - ActRelation _ (ActMutate _) -> Right rReq - _ -> foldr addRangeToNode (Right rReq) =<< ranges + ActDb (ActRelationMut _ _) -> Right rReq + _ -> foldr addRangeToNode (Right rReq) =<< ranges where ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)] ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` HM.toList iRange @@ -997,11 +1006,11 @@ negotiateContent :: AppConfig -> ApiRequest -> QualifiedIdentifier -> [MediaType negotiateContent conf ApiRequest{iAction=act, iPreferences=Preferences{preferRepresentation=rep}} identifier accepts produces defaultSelect = case (act, firstAcceptedPick) of (_, Nothing) -> Left . MediaTypeError $ map MediaType.toMime accepts - (ActRelation _ (ActMutate _), Just (x, mt)) -> Right (if rep == Just Full then x else NoAgg, mt) + (ActDb (ActRelationMut _ _), Just (x, mt)) -> Right (if rep == Just Full then x else NoAgg, mt) -- no need for an aggregate on HEAD https://github.com/PostgREST/postgrest/issues/2849 -- TODO: despite no aggregate, these are responding with a Content-Type, which is not correct. - (ActRelation _ (ActRead True), Just (_, mt)) -> Right (NoAgg, mt) - (ActRoutine _ (ActInvoke (InvRead True)), Just (_, mt)) -> Right (NoAgg, mt) + (ActDb (ActRelationRead _ True), Just (_, mt)) -> Right (NoAgg, mt) + (ActDb (ActRoutine _ (InvRead True)), Just (_, mt)) -> Right (NoAgg, mt) (_, Just (x, mt)) -> Right (x, mt) where firstAcceptedPick = listToMaybe $ mapMaybe matchMT accepts -- If there are multiple accepted media types, pick the first. This is usual in content negotiation. diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index 46b9711b3..ae7d12887 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -1,13 +1,8 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} module PostgREST.Query - ( createQuery - , deleteQuery - , invokeQuery - , openApiQuery - , readQuery - , singleUpsertQuery - , updateQuery + ( openApiQuery + , actionQuery , setPgLocals , runPreReq , DbHandler @@ -31,7 +26,8 @@ import qualified PostgREST.Query.Statements as Statements import qualified PostgREST.RangeQuery as RangeQuery import qualified PostgREST.SchemaCache as SchemaCache -import PostgREST.ApiRequest (ApiRequest (..)) +import PostgREST.ApiRequest (ApiRequest (..), + Mutation (..)) import PostgREST.ApiRequest.Preferences (PreferCount (..), PreferHandling (..), PreferMaxAffected (..), @@ -44,10 +40,10 @@ import PostgREST.Config (AppConfig (..), import PostgREST.Config.PgVersion (PgVersion (..)) import PostgREST.Error (Error) import PostgREST.MediaType (MediaType (..)) -import PostgREST.Plan (CallReadPlan (..), - MutateReadPlan (..), - WrappedReadPlan (..)) +import PostgREST.Plan (ActionPlan (..), + InspectPlan (..)) import PostgREST.Plan.MutatePlan (MutatePlan (..)) +import PostgREST.Plan.ReadPlan (ReadPlanTree) import PostgREST.Query.SqlFragment (escapeIdentList, fromQi, intercalateSnippet, setConfigWithConstantName, @@ -55,17 +51,17 @@ import PostgREST.Query.SqlFragment (escapeIdentList, fromQi, setConfigWithDynamicName) import PostgREST.Query.Statements (ResultSet (..)) import PostgREST.SchemaCache (SchemaCache (..)) -import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), - Schema) -import PostgREST.SchemaCache.Routine (Routine (..), RoutineMap) +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..)) +import PostgREST.SchemaCache.Routine (MediaHandler, RoutineMap) import PostgREST.SchemaCache.Table (TablesMap) import Protolude hiding (Handler) type DbHandler = ExceptT Error SQL.Transaction -readQuery :: WrappedReadPlan -> AppConfig -> ApiRequest -> DbHandler ResultSet -readQuery WrappedReadPlan{..} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} = do +actionQuery :: ActionPlan -> AppConfig -> ApiRequest -> PgVersion -> DbHandler ResultSet + +actionQuery WrappedReadPlan{..} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = do let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan resultSet <- lift . SQL.statement mempty $ @@ -85,6 +81,100 @@ readQuery WrappedReadPlan{..} conf@AppConfig{..} apiReq@ApiRequest{iPreferences= optionalRollback conf apiReq resultSetWTotal conf apiReq resultSet countQuery +actionQuery MutateReadPlan{mrMutation=MutationCreate, ..} conf apiReq _ = do + resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf + failNotSingular mrMedia resultSet + optionalRollback conf apiReq + pure resultSet + +actionQuery 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 + +actionQuery MutateReadPlan{mrMutation=MutationSingleUpsert, ..} conf apiReq _ = do + resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf + failPut resultSet + optionalRollback conf apiReq + pure resultSet + +actionQuery 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 + +actionQuery 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 resultSet + +openApiQuery :: InspectPlan -> AppConfig -> SchemaCache -> PgVersion -> DbHandler (Maybe (TablesMap, RoutineMap, Maybe Text)) +openApiQuery InspectPlan{ipSchema=tSchema} AppConfig{..} sCache pgVer = + lift $ case configOpenApiMode of + OAFollowPriv -> do + tableAccess <- SQL.statement [tSchema] (SchemaCache.accessibleTables pgVer configDbPreparedStatements) + 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 <$> ((,,) + (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 + + +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 +-- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted, +-- PUT /items?id=eq.14 { "id" : 2, .. } is rejected. +-- If this condition is not satisfied then nothing is inserted, +-- check the WHERE for INSERT in QueryBuilder.hs to see how it's done +failPut :: ResultSet -> DbHandler () +failPut RSPlan{} = pure () +failPut RSStandard{rsQueryTotal=queryTotal} = + when (queryTotal /= 1) $ do + lift SQL.condemn + throwError $ Error.ApiRequestError ApiRequestTypes.PutMatchingPkError + resultSetWTotal :: AppConfig -> ApiRequest -> ResultSet -> SQL.Snippet -> DbHandler ResultSet resultSetWTotal _ _ rs@RSPlan{} _ = return rs resultSetWTotal AppConfig{..} ApiRequest{iPreferences=Preferences{..}} rs@RSStandard{rsTableTotal=tableTotal} countQuery = @@ -107,104 +197,6 @@ resultSetWTotal AppConfig{..} ApiRequest{iPreferences=Preferences{..}} rs@RSStan lift . SQL.statement mempty . Statements.preparePlanRows countQuery $ configDbPreparedStatements -createQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet -createQuery mrPlan@MutateReadPlan{mrMedia} apiReq conf = do - resultSet <- writeQuery mrPlan apiReq conf - failNotSingular mrMedia resultSet - optionalRollback conf apiReq - pure resultSet - -updateQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet -updateQuery mrPlan@MutateReadPlan{mrMedia} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} conf = do - resultSet <- writeQuery mrPlan apiReq conf - failNotSingular mrMedia resultSet - failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet - failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet - optionalRollback conf apiReq - pure resultSet - -singleUpsertQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet -singleUpsertQuery mrPlan apiReq conf = do - resultSet <- writeQuery mrPlan apiReq conf - failPut resultSet - optionalRollback conf apiReq - pure resultSet - --- Makes sure the querystring pk matches the payload pk --- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted, --- PUT /items?id=eq.14 { "id" : 2, .. } is rejected. --- If this condition is not satisfied then nothing is inserted, --- check the WHERE for INSERT in QueryBuilder.hs to see how it's done -failPut :: ResultSet -> DbHandler () -failPut RSPlan{} = pure () -failPut RSStandard{rsQueryTotal=queryTotal} = - when (queryTotal /= 1) $ do - lift SQL.condemn - throwError $ Error.ApiRequestError ApiRequestTypes.PutMatchingPkError - -deleteQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet -deleteQuery mrPlan@MutateReadPlan{mrMedia} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} conf = do - resultSet <- writeQuery mrPlan apiReq conf - failNotSingular mrMedia resultSet - failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet - failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet - optionalRollback conf apiReq - pure resultSet - -invokeQuery :: Routine -> CallReadPlan -> ApiRequest -> AppConfig -> PgVersion -> DbHandler ResultSet -invokeQuery rout CallReadPlan{..} apiReq@ApiRequest{iPreferences=Preferences{..}} conf@AppConfig{..} pgVer = do - resultSet <- - lift . SQL.statement mempty $ - Statements.prepareCall - rout - (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 resultSet - -openApiQuery :: SchemaCache -> PgVersion -> AppConfig -> Schema -> DbHandler (Maybe (TablesMap, RoutineMap, Maybe Text)) -openApiQuery sCache pgVer AppConfig{..} tSchema = - lift $ case configOpenApiMode of - OAFollowPriv -> do - tableAccess <- SQL.statement [tSchema] (SchemaCache.accessibleTables pgVer configDbPreparedStatements) - 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 <$> ((,,) - (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 - -writeQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet -writeQuery MutateReadPlan{..} ApiRequest{iPreferences=Preferences{..}} conf = - let - (isPut, isInsert, pkCols) = case mrMutatePlan of {Insert{where_,insPkCols} -> ((not . null) where_, True, insPkCols); _ -> (False,False, mempty);} - in - lift . SQL.statement mempty $ - Statements.prepareWrite - (QueryBuilder.readPlanToQuery mrReadPlan) - (QueryBuilder.mutatePlanToQuery mrMutatePlan) - isInsert - isPut - mrMedia - mrHandler - preferRepresentation - preferResolution - pkCols - (configDbPreparedStatements conf) - -- | -- Fail a response if a single JSON object was requested and not exactly one -- was found. diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs index dfb58639f..da715c8e5 100644 --- a/src/PostgREST/Response.hs +++ b/src/PostgREST/Response.hs @@ -5,16 +5,11 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} module PostgREST.Response - ( createResponse - , deleteResponse - , infoIdentResponse + ( infoIdentResponse , infoProcResponse , infoRootResponse - , invokeResponse , openApiResponse - , readResponse - , singleUpsertResponse - , updateResponse + , actionResponse , PgrstResponse(..) ) where @@ -34,7 +29,8 @@ import qualified PostgREST.RangeQuery as RangeQuery import qualified PostgREST.Response.OpenAPI as OpenAPI import PostgREST.ApiRequest (ApiRequest (..), - InvokeMethod (..)) + InvokeMethod (..), + Mutation (..)) import PostgREST.ApiRequest.Preferences (PreferRepresentation (..), PreferResolution (..), Preferences (..), @@ -43,9 +39,8 @@ import PostgREST.ApiRequest.Preferences (PreferRepresentation (..), import PostgREST.ApiRequest.QueryParams (QueryParams (..)) import PostgREST.Config (AppConfig (..)) import PostgREST.MediaType (MediaType (..)) -import PostgREST.Plan (CallReadPlan (..), - MutateReadPlan (..), - WrappedReadPlan (..)) +import PostgREST.Plan (ActionPlan (..), + InspectPlan (..)) import PostgREST.Plan.MutatePlan (MutatePlan (..)) import PostgREST.Query.Statements (ResultSet (..)) import PostgREST.Response.GucHeader (GucHeader, unwrapGucHeader) @@ -68,8 +63,9 @@ data PgrstResponse = PgrstResponse { , pgrstBody :: LBS.ByteString } -readResponse :: WrappedReadPlan -> Bool -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse -readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = +actionResponse :: ActionPlan -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse + +actionResponse WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly} identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = case resultSet of RSStandard{..} -> do let @@ -98,8 +94,7 @@ readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRe RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders wrMedia ctxApiRequest) $ LBS.fromStrict plan -createResponse :: QualifiedIdentifier -> MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse -createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of +actionResponse MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, mrMedia} QualifiedIdentifier{..} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of RSStandard{..} -> do let pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;} @@ -139,8 +134,7 @@ createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctx RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan -updateResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse -updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of +actionResponse MutateReadPlan{mrMutation=MutationUpdate, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of RSStandard{..} -> do let contentRangeHeader = @@ -162,8 +156,7 @@ updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Pre RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan -singleUpsertResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse -singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of +actionResponse MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of RSStandard {..} -> do let prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling preferTimezone Nothing [] @@ -183,8 +176,7 @@ singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferenc RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan -deleteResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse -deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of +actionResponse MutateReadPlan{mrMutation=MutationDelete, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of RSStandard {..} -> do let contentRangeHeader = @@ -206,6 +198,34 @@ deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Pre 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 + RSStandard {..} -> do + let + (status, contentRange) = + RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal + rsOrErrBody = if status == HTTP.status416 + then Error.errorPayload $ Error.ApiRequestError $ ApiRequestTypes.InvalidRange + $ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal) + else LBS.fromStrict rsBody + prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing preferParameters preferCount preferTransaction Nothing preferHandling preferTimezone preferMaxAffected [] + headers = contentRange : prefHeader + + let (status', headers', body) = + if Routine.funcReturnsVoid proc then + (HTTP.status204, headers, mempty) + else + (status, + headers ++ contentTypeHeaders crMedia ctxApiRequest, + if invMethod == InvRead True then mempty else rsOrErrBody) + + (ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status' headers' + + Right $ PgrstResponse ovStatus ovHeaders body + + RSPlan plan -> + Right $ PgrstResponse HTTP.status200 (contentTypeHeaders crMedia ctxApiRequest) $ LBS.fromStrict plan + + infoIdentResponse :: QualifiedIdentifier -> SchemaCache -> Either Error.Error PgrstResponse infoIdentResponse identifier sCache = do case HM.lookup identifier (dbTables sCache) of @@ -233,36 +253,8 @@ respondInfo allowHeader = let allOrigins = ("Access-Control-Allow-Origin", "*") in Right $ PgrstResponse HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty -invokeResponse :: CallReadPlan -> InvokeMethod -> Routine -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse -invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = case resultSet of - RSStandard {..} -> do - let - (status, contentRange) = - RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal - rsOrErrBody = if status == HTTP.status416 - then Error.errorPayload $ Error.ApiRequestError $ ApiRequestTypes.InvalidRange - $ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal) - else LBS.fromStrict rsBody - prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing preferParameters preferCount preferTransaction Nothing preferHandling preferTimezone preferMaxAffected [] - headers = contentRange : prefHeader - - let (status', headers', body) = - if Routine.funcReturnsVoid proc then - (HTTP.status204, headers, mempty) - else - (status, - headers ++ contentTypeHeaders crMedia ctxApiRequest, - if invMethod == InvRead True then mempty else rsOrErrBody) - - (ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status' headers' - - Right $ PgrstResponse ovStatus ovHeaders body - - RSPlan plan -> - Right $ PgrstResponse HTTP.status200 (contentTypeHeaders crMedia ctxApiRequest) $ LBS.fromStrict plan - -openApiResponse :: (Text, Text) -> Bool -> Maybe (TablesMap, RoutineMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse -openApiResponse versions headersOnly body conf sCache schema negotiatedByProfile = +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)