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

refactor: dry some timings calculation

Browse Source
This commit is contained in:
steve-chavez
2024-03-27 18:22:34 -05:00
committed by Steve Chavez
parent 378c11104b
commit 745e7868b0
5 changed files with 271 additions and 313 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/ApiRequest.hs
+35 -43
View File
@@ -11,9 +11,7 @@ module PostgREST.ApiRequest
, Mutation(..) , Mutation(..)
, MediaType(..) , MediaType(..)
, Action(..) , Action(..)
, ActionRelation(..) , DbAction(..)
, ActionRoutine(..)
, ActionSchema(..)
, Payload(..) , Payload(..)
, userApiRequest , userApiRequest
) where ) where
@@ -92,23 +90,17 @@ data Resource
| ResourceRoutine Text | ResourceRoutine Text
| ResourceSchema | ResourceSchema
data ActionRelation data DbAction
= ActRead Bool = ActRelationRead {dbActQi :: QualifiedIdentifier, actHeadersOnly :: Bool}
| ActMutate Mutation | ActRelationMut {dbActQi :: QualifiedIdentifier, actMutation :: Mutation}
| ActRelInfo | ActRoutine {dbActQi :: QualifiedIdentifier, actInvMethod :: InvokeMethod}
data ActionRoutine
= ActInvoke InvokeMethod
| ActRoutInfo
data ActionSchema
= ActSchemaRead Bool
| ActSchemaInfo
data Action data Action
= ActRelation QualifiedIdentifier ActionRelation = ActDb DbAction
| ActRoutine QualifiedIdentifier ActionRoutine | ActSchemaRead Schema Bool
| ActSchema Schema ActionSchema | ActRelationInfo QualifiedIdentifier
| ActRoutineInfo QualifiedIdentifier
| ActSchemaInfo Schema
{-| {-|
Describes what the user wants to do. This data type is a 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] iHdrs = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
iCkies = maybe [] parseCookies $ lookupHeader "Cookie" iCkies = maybe [] parseCookies $ lookupHeader "Cookie"
contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type" 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 -> [Text] -> Either ApiRequestError Resource
getResource AppConfig{configOpenApiMode, configDbRootSpec} = \case getResource AppConfig{configOpenApiMode, configDbRootSpec} = \case
@@ -183,23 +175,23 @@ getResource AppConfig{configOpenApiMode, configDbRootSpec} = \case
getAction :: Resource -> Schema -> ByteString -> Either ApiRequestError Action getAction :: Resource -> Schema -> ByteString -> Either ApiRequestError Action
getAction resource schema method = getAction resource schema method =
case (resource, method) of case (resource, method) of
(ResourceRoutine rout, "HEAD") -> Right $ ActRoutine (qi rout) $ ActInvoke $ InvRead True (ResourceRoutine rout, "HEAD") -> Right . ActDb $ ActRoutine (qi rout) $ InvRead True
(ResourceRoutine rout, "GET") -> Right $ ActRoutine (qi rout) $ ActInvoke $ InvRead False (ResourceRoutine rout, "GET") -> Right . ActDb $ ActRoutine (qi rout) $ InvRead False
(ResourceRoutine rout, "POST") -> Right $ ActRoutine (qi rout) $ ActInvoke Inv (ResourceRoutine rout, "POST") -> Right . ActDb $ ActRoutine (qi rout) Inv
(ResourceRoutine rout, "OPTIONS") -> Right $ ActRoutine (qi rout) ActRoutInfo (ResourceRoutine rout, "OPTIONS") -> Right $ ActRoutineInfo (qi rout)
(ResourceRoutine _, _) -> Left $ InvalidRpcMethod method (ResourceRoutine _, _) -> Left $ InvalidRpcMethod method
(ResourceRelation rel, "HEAD") -> Right $ ActRelation (qi rel) $ ActRead True (ResourceRelation rel, "HEAD") -> Right . ActDb $ ActRelationRead (qi rel) True
(ResourceRelation rel, "GET") -> Right $ ActRelation (qi rel) $ ActRead False (ResourceRelation rel, "GET") -> Right . ActDb $ ActRelationRead (qi rel) False
(ResourceRelation rel, "POST") -> Right $ ActRelation (qi rel) $ ActMutate MutationCreate (ResourceRelation rel, "POST") -> Right . ActDb $ ActRelationMut (qi rel) MutationCreate
(ResourceRelation rel, "PUT") -> Right $ ActRelation (qi rel) $ ActMutate MutationSingleUpsert (ResourceRelation rel, "PUT") -> Right . ActDb $ ActRelationMut (qi rel) MutationSingleUpsert
(ResourceRelation rel, "PATCH") -> Right $ ActRelation (qi rel) $ ActMutate MutationUpdate (ResourceRelation rel, "PATCH") -> Right . ActDb $ ActRelationMut (qi rel) MutationUpdate
(ResourceRelation rel, "DELETE") -> Right $ ActRelation (qi rel) $ ActMutate MutationDelete (ResourceRelation rel, "DELETE") -> Right . ActDb $ ActRelationMut (qi rel) MutationDelete
(ResourceRelation rel, "OPTIONS") -> Right $ ActRelation (qi rel) ActRelInfo (ResourceRelation rel, "OPTIONS") -> Right $ ActRelationInfo (qi rel)
(ResourceSchema, "HEAD") -> Right $ ActSchema schema $ ActSchemaRead True (ResourceSchema, "HEAD") -> Right $ ActSchemaRead schema True
(ResourceSchema, "GET") -> Right $ ActSchema schema $ ActSchemaRead False (ResourceSchema, "GET") -> Right $ ActSchemaRead schema False
(ResourceSchema, "OPTIONS") -> Right $ ActSchema schema ActSchemaInfo (ResourceSchema, "OPTIONS") -> Right $ ActSchemaInfo schema
_ -> Left $ UnsupportedMethod method _ -> Left $ UnsupportedMethod method
where where
@@ -279,20 +271,20 @@ getPayload reqBody contentMediaType QueryParams{qsColumns} action = do
(ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct (ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct
shouldParsePayload = case action of shouldParsePayload = case action of
ActRelation _ (ActMutate MutationDelete) -> False ActDb (ActRelationMut _ MutationDelete) -> False
ActRelation _ (ActMutate _) -> True ActDb (ActRelationMut _ _) -> True
ActRoutine _ (ActInvoke Inv) -> True ActDb (ActRoutine _ Inv) -> True
_ -> False _ -> False
columns = case action of columns = case action of
ActRelation _ (ActMutate MutationCreate) -> qsColumns ActDb (ActRelationMut _ MutationCreate) -> qsColumns
ActRelation _ (ActMutate MutationUpdate) -> qsColumns ActDb (ActRelationMut _ MutationUpdate) -> qsColumns
ActRoutine _ (ActInvoke Inv) -> qsColumns ActDb (ActRoutine _ Inv) -> qsColumns
_ -> Nothing _ -> Nothing
isProc = case action of isProc = case action of
ActRoutine _ _ -> True ActDb (ActRoutine _ _) -> True
_ -> False _ -> False
params = (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) params = (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
type CsvData = V.Vector (M.Map Text LBS.ByteString) type CsvData = V.Vector (M.Map Text LBS.ByteString)
src/PostgREST/App.hs
+19 -46
View File
@@ -41,11 +41,8 @@ import qualified PostgREST.Query as Query
import qualified PostgREST.Response as Response import qualified PostgREST.Response as Response
import qualified PostgREST.Unix as Unix (installSignalHandlers) import qualified PostgREST.Unix as Unix (installSignalHandlers)
import PostgREST.ApiRequest (Action (..), import PostgREST.ApiRequest (Action (..), ApiRequest (..),
ActionRelation (..), DbAction (..))
ActionRoutine (..),
ActionSchema (..),
ApiRequest (..), Mutation (..))
import PostgREST.AppState (AppState) import PostgREST.AppState (AppState)
import PostgREST.Auth (AuthResult (..)) import PostgREST.Auth (AuthResult (..))
import PostgREST.Config (AppConfig (..), LogLevel (..)) 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 Maybe Double -> Maybe Double -> (Observation -> IO ()) -> Handler IO Wai.Response
handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache jwtTime parseTime observer = handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache jwtTime parseTime observer =
case iAction of case iAction of
ActRelation identifier (ActRead headersOnly) -> do ActDb dbAct -> do
(planTime', wrPlan) <- withTiming $ liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq (planTime', plan) <- withTiming $ liftEither $ Plan.actionPlan dbAct conf apiReq sCache
(txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq (txTime', resultSet) <- withTiming $ runQuery (planIsoLvl plan) (planFunSettings plan) (Plan.pTxMode plan) $ Query.actionQuery plan conf apiReq pgVer
(respTime', pgrst) <- withTiming $ liftEither $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet (respTime', pgrst) <- withTiming $ liftEither $ Response.actionResponse plan (dbActQi dbAct) apiReq resultSet
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst
ActRelation identifier (ActMutate MutationCreate) -> do ActSchemaRead tSchema headersOnly -> do
(planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache (planTime', iPlan) <- withTiming $ liftEither $ Plan.inspectPlan apiReq headersOnly tSchema
(txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf (txTime', oaiResult) <- withTiming $ runQuery roleIsoLvl mempty (Plan.ipTxmode iPlan) $ Query.openApiQuery iPlan conf sCache pgVer
(respTime', pgrst) <- withTiming $ liftEither $ Response.createResponse identifier mrPlan apiReq resultSet (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 return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst
ActRelation identifier (ActMutate MutationUpdate) -> do ActRelationInfo identifier -> 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
(respTime', pgrst) <- withTiming $ liftEither $ Response.infoIdentResponse identifier sCache (respTime', pgrst) <- withTiming $ liftEither $ Response.infoIdentResponse identifier sCache
return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst 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 (planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq $ ApiRequest.InvRead True
(respTime', pgrst) <- withTiming $ liftEither $ Response.infoProcResponse (Plan.crProc cPlan) (respTime', pgrst) <- withTiming $ liftEither $ Response.infoProcResponse (Plan.crProc cPlan)
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' Nothing respTime') pgrst return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' Nothing respTime') pgrst
ActSchema _ ActSchemaInfo -> do ActSchemaInfo _ -> do
(respTime', pgrst) <- withTiming $ liftEither Response.infoRootResponse (respTime', pgrst) <- withTiming $ liftEither Response.infoRootResponse
return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst 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.runPreReq conf
query 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 :: ServerTiming -> Response.PgrstResponse -> Wai.Response
pgrstResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled conf])) bod pgrstResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled conf])) bod
src/PostgREST/Plan.hs
+68 -59
View File
@@ -16,14 +16,11 @@ resource.
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
module PostgREST.Plan module PostgREST.Plan
( wrappedReadPlan ( actionPlan
, mutateReadPlan , ActionPlan(..)
, callReadPlan
, inspectPlan
, WrappedReadPlan(..)
, MutateReadPlan(..)
, CallReadPlan(..)
, InspectPlan(..) , InspectPlan(..)
, inspectPlan
, callReadPlan
) where ) where
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
@@ -38,9 +35,8 @@ import Data.List (delete, lookup)
import Data.Tree (Tree (..)) import Data.Tree (Tree (..))
import PostgREST.ApiRequest (Action (..), import PostgREST.ApiRequest (Action (..),
ActionRelation (..),
ActionRoutine (..),
ApiRequest (..), ApiRequest (..),
DbAction (..),
InvokeMethod (..), InvokeMethod (..),
Mutation (..), Mutation (..),
Payload (..)) Payload (..))
@@ -94,51 +90,64 @@ import Protolude hiding (from)
-- Setup for doctests -- Setup for doctests
-- >>> import Data.Ranged.Ranges (fullRange) -- >>> import Data.Ranged.Ranges (fullRange)
data WrappedReadPlan = WrappedReadPlan { data ActionPlan
wrReadPlan :: ReadPlanTree = WrappedReadPlan
, wrTxMode :: SQL.Mode { wrReadPlan :: ReadPlanTree
, wrHandler :: MediaHandler , pTxMode :: SQL.Mode
, wrMedia :: MediaType , wrHandler :: MediaHandler
} , wrMedia :: MediaType
, wrHdrsOnly :: Bool
data MutateReadPlan = MutateReadPlan { }
mrReadPlan :: ReadPlanTree | MutateReadPlan {
, mrMutatePlan :: MutatePlan mrReadPlan :: ReadPlanTree
, mrTxMode :: SQL.Mode , mrMutatePlan :: MutatePlan
, mrHandler :: MediaHandler , pTxMode :: SQL.Mode
, mrMedia :: MediaType , mrHandler :: MediaHandler
} , mrMedia :: MediaType
, mrMutation :: Mutation
data CallReadPlan = CallReadPlan { }
crReadPlan :: ReadPlanTree | CallReadPlan {
, crCallPlan :: CallPlan crReadPlan :: ReadPlanTree
, crTxMode :: SQL.Mode , crCallPlan :: CallPlan
, crProc :: Routine , pTxMode :: SQL.Mode
, crHandler :: MediaHandler , crProc :: Routine
, crMedia :: MediaType , crHandler :: MediaHandler
} , crMedia :: MediaType
, crInvMthd :: InvokeMethod
}
data InspectPlan = InspectPlan { data InspectPlan = InspectPlan {
ipMedia :: MediaType ipMedia :: MediaType
, ipTxmode :: SQL.Mode , ipTxmode :: SQL.Mode
} , ipHdrsOnly :: Bool
, ipSchema :: Schema
}
wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error WrappedReadPlan actionPlan :: DbAction -> AppConfig -> ApiRequest -> SchemaCache -> Either Error ActionPlan
wrappedReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} = do 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 rPlan <- readPlan identifier conf sCache apiRequest
(handler, mediaType) <- mapLeft ApiRequestError $ negotiateContent conf apiRequest identifier iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan) (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 () 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 mutateReadPlan mutation apiRequest@ApiRequest{iPreferences=Preferences{..},..} identifier conf sCache = do
rPlan <- readPlan identifier conf sCache apiRequest rPlan <- readPlan identifier conf sCache apiRequest
mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan
if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestError $ InvalidPreferences invalidPrefs else Right () 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) (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 callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} invMethod = do
let paramKeys = case invMethod of let paramKeys = case invMethod of
InvRead _ -> S.fromList $ fst <$> qsParams' InvRead _ -> S.fromList $ fst <$> qsParams'
@@ -159,7 +168,7 @@ callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferenc
cPlan = callPlan proc apiRequest paramKeys args rPlan cPlan = callPlan proc apiRequest paramKeys args rPlan
(handler, mediaType) <- mapLeft ApiRequestError $ negotiateContent conf apiRequest relIdentifier iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect 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 () 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 where
qsParams' = QueryParams.qsParams iQueryParams qsParams' = QueryParams.qsParams iQueryParams
@@ -167,14 +176,14 @@ hasDefaultSelect :: ReadPlanTree -> Bool
hasDefaultSelect (Node ReadPlan{select=[CoercibleSelectField{csField=CoercibleField{cfName}}]} []) = cfName == "*" hasDefaultSelect (Node ReadPlan{select=[CoercibleSelectField{csField=CoercibleField{cfName}}]} []) = cfName == "*"
hasDefaultSelect _ = False hasDefaultSelect _ = False
inspectPlan :: ApiRequest -> Either Error InspectPlan inspectPlan :: ApiRequest -> Bool -> Schema -> Either Error InspectPlan
inspectPlan apiRequest = do inspectPlan apiRequest headersOnly schema = do
let producedMTs = [MTOpenAPI, MTApplicationJSON, MTAny] let producedMTs = [MTOpenAPI, MTApplicationJSON, MTAny]
accepts = iAcceptMediaType apiRequest accepts = iAcceptMediaType apiRequest
mediaType <- if not . null $ L.intersect accepts producedMTs mediaType <- if not . null $ L.intersect accepts producedMTs
then Right MTOpenAPI then Right MTOpenAPI
else Left . ApiRequestError . MediaTypeError $ MediaType.toMime <$> accepts 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, 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 -- | Enforces the `max-rows` config on the result
treeRestrictRange :: Maybe Integer -> Action -> ReadPlanTree -> Either ApiRequestError ReadPlanTree 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 treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> request
where where
nodeRestrictRange :: Maybe Integer -> ReadPlan -> ReadPlan nodeRestrictRange :: Maybe Integer -> ReadPlan -> ReadPlan
@@ -461,9 +470,9 @@ addRels schema action allRels parentNode (Node rPlan@ReadPlan{relName,relHint,re
newReadPlan = case action of newReadPlan = case action of
-- the CTE for mutations/rpc is used as WITH sourceCTEName .. SELECT .. FROM sourceCTEName as alias, -- 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. -- we use the table name as an alias so findRel can find the right relationship.
ActRelation _ (ActMutate _) -> rPlan{from=newFrom, fromAlias=newAlias} ActDb (ActRelationMut _ _) -> rPlan{from=newFrom, fromAlias=newAlias}
ActRoutine _ _ -> rPlan{from=newFrom, fromAlias=newAlias} ActDb (ActRoutine _ _) -> rPlan{from=newFrom, fromAlias=newAlias}
_ -> rPlan _ -> rPlan
in in
Node newReadPlan <$> updateForest (Just $ Node newReadPlan forest) Node newReadPlan <$> updateForest (Just $ Node newReadPlan forest)
where where
@@ -701,9 +710,9 @@ addFilters ctx ApiRequest{..} rReq =
QueryParams.QueryParams{..} = iQueryParams QueryParams.QueryParams{..} = iQueryParams
flts = flts =
case iAction of case iAction of
ActRelation _ (ActRead _) -> qsFilters ActDb (ActRelationRead _ _) -> qsFilters
ActRoutine _ _ -> qsFilters ActDb (ActRoutine _ _) -> qsFilters
_ -> qsFiltersNotRoot _ -> qsFiltersNotRoot
addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
addFilterToNode = addFilterToNode =
@@ -712,8 +721,8 @@ addFilters ctx ApiRequest{..} rReq =
addOrders :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree addOrders :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
addOrders ctx ApiRequest{..} rReq = addOrders ctx ApiRequest{..} rReq =
case iAction of case iAction of
ActRelation _ (ActMutate _) -> Right rReq ActDb (ActRelationMut _ _) -> Right rReq
_ -> foldr addOrderToNode (Right rReq) qsOrder _ -> foldr addOrderToNode (Right rReq) qsOrder
where where
QueryParams.QueryParams{..} = iQueryParams QueryParams.QueryParams{..} = iQueryParams
@@ -833,8 +842,8 @@ addNullEmbedFilters (Node rp@ReadPlan{where_=curLogic} forest) = do
addRanges :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree addRanges :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
addRanges ApiRequest{..} rReq = addRanges ApiRequest{..} rReq =
case iAction of case iAction of
ActRelation _ (ActMutate _) -> Right rReq ActDb (ActRelationMut _ _) -> Right rReq
_ -> foldr addRangeToNode (Right rReq) =<< ranges _ -> foldr addRangeToNode (Right rReq) =<< ranges
where where
ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)] ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` HM.toList iRange 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 = negotiateContent conf ApiRequest{iAction=act, iPreferences=Preferences{preferRepresentation=rep}} identifier accepts produces defaultSelect =
case (act, firstAcceptedPick) of case (act, firstAcceptedPick) of
(_, Nothing) -> Left . MediaTypeError $ map MediaType.toMime accepts (_, 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 -- 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. -- TODO: despite no aggregate, these are responding with a Content-Type, which is not correct.
(ActRelation _ (ActRead True), Just (_, mt)) -> Right (NoAgg, mt) (ActDb (ActRelationRead _ True), Just (_, mt)) -> Right (NoAgg, mt)
(ActRoutine _ (ActInvoke (InvRead True)), Just (_, mt)) -> Right (NoAgg, mt) (ActDb (ActRoutine _ (InvRead True)), Just (_, mt)) -> Right (NoAgg, mt)
(_, Just (x, mt)) -> Right (x, mt) (_, Just (x, mt)) -> Right (x, mt)
where where
firstAcceptedPick = listToMaybe $ mapMaybe matchMT accepts -- If there are multiple accepted media types, pick the first. This is usual in content negotiation. firstAcceptedPick = listToMaybe $ mapMaybe matchMT accepts -- If there are multiple accepted media types, pick the first. This is usual in content negotiation.
src/PostgREST/Query.hs
+106 -114
View File
@@ -1,13 +1,8 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
module PostgREST.Query module PostgREST.Query
( createQuery ( openApiQuery
, deleteQuery , actionQuery
, invokeQuery
, openApiQuery
, readQuery
, singleUpsertQuery
, updateQuery
, setPgLocals , setPgLocals
, runPreReq , runPreReq
, DbHandler , DbHandler
@@ -31,7 +26,8 @@ import qualified PostgREST.Query.Statements as Statements
import qualified PostgREST.RangeQuery as RangeQuery import qualified PostgREST.RangeQuery as RangeQuery
import qualified PostgREST.SchemaCache as SchemaCache import qualified PostgREST.SchemaCache as SchemaCache
import PostgREST.ApiRequest (ApiRequest (..)) import PostgREST.ApiRequest (ApiRequest (..),
Mutation (..))
import PostgREST.ApiRequest.Preferences (PreferCount (..), import PostgREST.ApiRequest.Preferences (PreferCount (..),
PreferHandling (..), PreferHandling (..),
PreferMaxAffected (..), PreferMaxAffected (..),
@@ -44,10 +40,10 @@ import PostgREST.Config (AppConfig (..),
import PostgREST.Config.PgVersion (PgVersion (..)) import PostgREST.Config.PgVersion (PgVersion (..))
import PostgREST.Error (Error) import PostgREST.Error (Error)
import PostgREST.MediaType (MediaType (..)) import PostgREST.MediaType (MediaType (..))
import PostgREST.Plan (CallReadPlan (..), import PostgREST.Plan (ActionPlan (..),
MutateReadPlan (..), InspectPlan (..))
WrappedReadPlan (..))
import PostgREST.Plan.MutatePlan (MutatePlan (..)) import PostgREST.Plan.MutatePlan (MutatePlan (..))
import PostgREST.Plan.ReadPlan (ReadPlanTree)
import PostgREST.Query.SqlFragment (escapeIdentList, fromQi, import PostgREST.Query.SqlFragment (escapeIdentList, fromQi,
intercalateSnippet, intercalateSnippet,
setConfigWithConstantName, setConfigWithConstantName,
@@ -55,17 +51,17 @@ import PostgREST.Query.SqlFragment (escapeIdentList, fromQi,
setConfigWithDynamicName) setConfigWithDynamicName)
import PostgREST.Query.Statements (ResultSet (..)) import PostgREST.Query.Statements (ResultSet (..))
import PostgREST.SchemaCache (SchemaCache (..)) import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
Schema) import PostgREST.SchemaCache.Routine (MediaHandler, RoutineMap)
import PostgREST.SchemaCache.Routine (Routine (..), RoutineMap)
import PostgREST.SchemaCache.Table (TablesMap) import PostgREST.SchemaCache.Table (TablesMap)
import Protolude hiding (Handler) import Protolude hiding (Handler)
type DbHandler = ExceptT Error SQL.Transaction type DbHandler = ExceptT Error SQL.Transaction
readQuery :: WrappedReadPlan -> AppConfig -> ApiRequest -> DbHandler ResultSet actionQuery :: ActionPlan -> AppConfig -> ApiRequest -> PgVersion -> DbHandler ResultSet
readQuery WrappedReadPlan{..} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} = do
actionQuery WrappedReadPlan{..} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = do
let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan
resultSet <- resultSet <-
lift . SQL.statement mempty $ lift . SQL.statement mempty $
@@ -85,6 +81,100 @@ readQuery WrappedReadPlan{..} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=
optionalRollback conf apiReq optionalRollback conf apiReq
resultSetWTotal conf apiReq resultSet countQuery 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 :: AppConfig -> ApiRequest -> ResultSet -> SQL.Snippet -> DbHandler ResultSet
resultSetWTotal _ _ rs@RSPlan{} _ = return rs resultSetWTotal _ _ rs@RSPlan{} _ = return rs
resultSetWTotal AppConfig{..} ApiRequest{iPreferences=Preferences{..}} rs@RSStandard{rsTableTotal=tableTotal} countQuery = 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 $ lift . SQL.statement mempty . Statements.preparePlanRows countQuery $
configDbPreparedStatements 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 -- Fail a response if a single JSON object was requested and not exactly one
-- was found. -- was found.
src/PostgREST/Response.hs
+43 -51
View File
@@ -5,16 +5,11 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
module PostgREST.Response module PostgREST.Response
( createResponse ( infoIdentResponse
, deleteResponse
, infoIdentResponse
, infoProcResponse , infoProcResponse
, infoRootResponse , infoRootResponse
, invokeResponse
, openApiResponse , openApiResponse
, readResponse , actionResponse
, singleUpsertResponse
, updateResponse
, PgrstResponse(..) , PgrstResponse(..)
) where ) where
@@ -34,7 +29,8 @@ import qualified PostgREST.RangeQuery as RangeQuery
import qualified PostgREST.Response.OpenAPI as OpenAPI import qualified PostgREST.Response.OpenAPI as OpenAPI
import PostgREST.ApiRequest (ApiRequest (..), import PostgREST.ApiRequest (ApiRequest (..),
InvokeMethod (..)) InvokeMethod (..),
Mutation (..))
import PostgREST.ApiRequest.Preferences (PreferRepresentation (..), import PostgREST.ApiRequest.Preferences (PreferRepresentation (..),
PreferResolution (..), PreferResolution (..),
Preferences (..), Preferences (..),
@@ -43,9 +39,8 @@ import PostgREST.ApiRequest.Preferences (PreferRepresentation (..),
import PostgREST.ApiRequest.QueryParams (QueryParams (..)) import PostgREST.ApiRequest.QueryParams (QueryParams (..))
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.MediaType (MediaType (..)) import PostgREST.MediaType (MediaType (..))
import PostgREST.Plan (CallReadPlan (..), import PostgREST.Plan (ActionPlan (..),
MutateReadPlan (..), InspectPlan (..))
WrappedReadPlan (..))
import PostgREST.Plan.MutatePlan (MutatePlan (..)) import PostgREST.Plan.MutatePlan (MutatePlan (..))
import PostgREST.Query.Statements (ResultSet (..)) import PostgREST.Query.Statements (ResultSet (..))
import PostgREST.Response.GucHeader (GucHeader, unwrapGucHeader) import PostgREST.Response.GucHeader (GucHeader, unwrapGucHeader)
@@ -68,8 +63,9 @@ data PgrstResponse = PgrstResponse {
, pgrstBody :: LBS.ByteString , pgrstBody :: LBS.ByteString
} }
readResponse :: WrappedReadPlan -> Bool -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse actionResponse :: ActionPlan -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet =
actionResponse WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly} identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet =
case resultSet of case resultSet of
RSStandard{..} -> do RSStandard{..} -> do
let let
@@ -98,8 +94,7 @@ readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRe
RSPlan plan -> RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders wrMedia ctxApiRequest) $ LBS.fromStrict plan Right $ PgrstResponse HTTP.status200 (contentTypeHeaders wrMedia ctxApiRequest) $ LBS.fromStrict plan
createResponse :: QualifiedIdentifier -> MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse actionResponse MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, mrMedia} QualifiedIdentifier{..} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of
createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of
RSStandard{..} -> do RSStandard{..} -> do
let let
pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;} pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;}
@@ -139,8 +134,7 @@ createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctx
RSPlan plan -> RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
updateResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse actionResponse MutateReadPlan{mrMutation=MutationUpdate, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard{..} -> do RSStandard{..} -> do
let let
contentRangeHeader = contentRangeHeader =
@@ -162,8 +156,7 @@ updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Pre
RSPlan plan -> RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
singleUpsertResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse actionResponse MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard {..} -> do RSStandard {..} -> do
let let
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling preferTimezone Nothing [] 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 -> RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
deleteResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse actionResponse MutateReadPlan{mrMutation=MutationDelete, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard {..} -> do RSStandard {..} -> do
let let
contentRangeHeader = contentRangeHeader =
@@ -206,6 +198,34 @@ deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Pre
RSPlan plan -> RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict 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 :: QualifiedIdentifier -> SchemaCache -> Either Error.Error PgrstResponse
infoIdentResponse identifier sCache = do infoIdentResponse identifier sCache = do
case HM.lookup identifier (dbTables sCache) of case HM.lookup identifier (dbTables sCache) of
@@ -233,36 +253,8 @@ respondInfo allowHeader =
let allOrigins = ("Access-Control-Allow-Origin", "*") in let allOrigins = ("Access-Control-Allow-Origin", "*") in
Right $ PgrstResponse HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty Right $ PgrstResponse HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty
invokeResponse :: CallReadPlan -> InvokeMethod -> Routine -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse openApiResponse :: InspectPlan -> (Text, Text) -> Maybe (TablesMap, RoutineMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse
invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = case resultSet of openApiResponse InspectPlan{ipHdrsOnly=headersOnly} versions body conf sCache schema negotiatedByProfile =
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 =
Right $ PgrstResponse HTTP.status200 Right $ PgrstResponse HTTP.status200
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile)) (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) (maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode versions conf sCache x y z) body)