refactor: dry some timings calculation
This commit is contained in:
steve-chavez
committed by
Steve Chavez
Steve Chavez
parent
378c11104b
commit
745e7868b0
+35
-43
@@ -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)
|
||||
|
||||
+19
-46
@@ -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
|
||||
|
||||
|
||||
+68
-59
@@ -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.
|
||||
|
||||
+106
-114
@@ -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.
|
||||
|
||||
+43
-51
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user