refactor: put CallReadPlan into CrudPlan

This commit is contained in:
steve-chavez
2025-09-15 17:07:12 -05:00
committed by Steve Chavez
parent 2d3d6256ab
commit a75ec75fff
4 changed files with 73 additions and 85 deletions
+23 -19
View File
@@ -23,7 +23,6 @@ module PostgREST.Plan
, InspectPlan(..) , InspectPlan(..)
, InfoPlan(..) , InfoPlan(..)
, CrudPlan(..) , CrudPlan(..)
, CallReadPlan(..)
) where ) where
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
@@ -97,7 +96,7 @@ data CrudPlan
{ wrReadPlan :: ReadPlanTree { wrReadPlan :: ReadPlanTree
, pTxMode :: SQL.Mode , pTxMode :: SQL.Mode
, wrHandler :: MediaHandler , wrHandler :: MediaHandler
, wrMedia :: MediaType , pMedia :: MediaType
, wrHdrsOnly :: Bool , wrHdrsOnly :: Bool
, crudQi :: QualifiedIdentifier , crudQi :: QualifiedIdentifier
} }
@@ -106,19 +105,17 @@ data CrudPlan
, mrMutatePlan :: MutatePlan , mrMutatePlan :: MutatePlan
, pTxMode :: SQL.Mode , pTxMode :: SQL.Mode
, mrHandler :: MediaHandler , mrHandler :: MediaHandler
, mrMedia :: MediaType , pMedia :: MediaType
, mrMutation :: Mutation , mrMutation :: Mutation
, crudQi :: QualifiedIdentifier , crudQi :: QualifiedIdentifier
} }
| CallReadPlan {
-- Plan for calling a function
data CallReadPlan = CallReadPlan {
crReadPlan :: ReadPlanTree crReadPlan :: ReadPlanTree
, crCallPlan :: CallPlan , crCallPlan :: CallPlan
, crTxMode :: SQL.Mode , pTxMode :: SQL.Mode
, crProc :: Routine , crProc :: Routine
, crHandler :: MediaHandler , crHandler :: MediaHandler
, crMedia :: MediaType , pMedia :: MediaType
, crInvMthd :: InvokeMethod , crInvMthd :: InvokeMethod
, crQi :: QualifiedIdentifier , crQi :: QualifiedIdentifier
} }
@@ -136,35 +133,42 @@ data ActionPlan
= Db DbActionPlan = Db DbActionPlan
| NoDb InfoPlan | NoDb InfoPlan
type IsDbExplain = Bool
-- A db plan can consist on read/write, rpc call or reading metadata (which may use the db or just use cached objects) -- A db plan can consist on read/write, rpc call or reading metadata (which may use the db or just use cached objects)
data DbActionPlan data DbActionPlan
= DbCrud CrudPlan = DbCrud IsDbExplain CrudPlan
| DbCall CallReadPlan
| MayUseDb InspectPlan | MayUseDb InspectPlan
-- Plans that don't use the database -- Plans that don't use the database
data InfoPlan data InfoPlan
= RelInfoPlan QualifiedIdentifier -- info about relation = RelInfoPlan QualifiedIdentifier -- info about relation
| RoutineInfoPlan CallReadPlan -- info about function | RoutineInfoPlan Routine -- info about function
| SchemaInfoPlan -- info about schema cache | SchemaInfoPlan -- info about schema cache
actionPlan :: Action -> AppConfig -> ApiRequest -> SchemaCache -> Either Error ActionPlan actionPlan :: Action -> AppConfig -> ApiRequest -> SchemaCache -> Either Error ActionPlan
actionPlan act conf apiReq sCache = case act of actionPlan act conf apiReq sCache = case act of
ActDb dbAct -> Db <$> dbActionPlan dbAct conf apiReq sCache ActDb dbAct -> Db <$> dbActionPlan dbAct conf apiReq sCache
ActRelationInfo ident -> pure . NoDb $ RelInfoPlan ident ActRelationInfo ident -> pure . NoDb $ RelInfoPlan ident
ActRoutineInfo ident inv -> NoDb . RoutineInfoPlan <$> callReadPlan ident conf sCache apiReq inv ActRoutineInfo ident inv ->
ActSchemaInfo -> pure $ NoDb SchemaInfoPlan let crPln = callReadPlan ident conf sCache apiReq inv in
NoDb . RoutineInfoPlan . crProc <$> crPln
ActSchemaInfo -> pure $ NoDb SchemaInfoPlan
dbActionPlan :: DbAction -> AppConfig -> ApiRequest -> SchemaCache -> Either Error DbActionPlan dbActionPlan :: DbAction -> AppConfig -> ApiRequest -> SchemaCache -> Either Error DbActionPlan
dbActionPlan dbAct conf apiReq sCache = case dbAct of dbActionPlan dbAct conf apiReq sCache = case dbAct of
ActRelationRead identifier headersOnly -> ActRelationRead identifier headersOnly ->
DbCrud <$> wrappedReadPlan identifier conf sCache apiReq headersOnly toDbActPlan <$> wrappedReadPlan identifier conf sCache apiReq headersOnly
ActRelationMut identifier mut -> ActRelationMut identifier mut ->
DbCrud <$> mutateReadPlan mut apiReq identifier conf sCache toDbActPlan <$> mutateReadPlan mut apiReq identifier conf sCache
ActRoutine identifier invMethod -> ActRoutine identifier invMethod ->
DbCall <$> callReadPlan identifier conf sCache apiReq invMethod toDbActPlan <$> callReadPlan identifier conf sCache apiReq invMethod
ActSchemaRead tSchema headersOnly -> ActSchemaRead tSchema headersOnly ->
MayUseDb <$> inspectPlan apiReq headersOnly tSchema MayUseDb <$> inspectPlan apiReq headersOnly tSchema
where
toDbActPlan pl = case pMedia pl of
MTVndPlan{} -> DbCrud True pl
_ -> DbCrud False pl
wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Bool -> Either Error CrudPlan wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Bool -> Either Error CrudPlan
wrappedReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} headersOnly = do wrappedReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} headersOnly = do
@@ -183,7 +187,7 @@ mutateReadPlan mutation apiRequest@ApiRequest{iPreferences=Preferences{..},..}
(handler, mediaType) <- mapLeft ApiRequestError $ negotiateContent conf apiRequest qi iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan) (handler, mediaType) <- mapLeft ApiRequestError $ negotiateContent conf apiRequest qi iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan)
return $ MutateReadPlan rPlan mPlan SQL.Write handler mediaType mutation qi return $ MutateReadPlan rPlan mPlan SQL.Write handler mediaType mutation qi
callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CrudPlan
callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{preferHandling, invalidPrefs, preferMaxAffected},..} invMethod = do callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{preferHandling, invalidPrefs, preferMaxAffected},..} invMethod = do
let paramKeys = case invMethod of let paramKeys = case invMethod of
InvRead _ -> S.fromList $ fst <$> qsParams' InvRead _ -> S.fromList $ fst <$> qsParams'
+33 -48
View File
@@ -54,7 +54,6 @@ import PostgREST.Config (AppConfig (..),
import PostgREST.Error (Error) import PostgREST.Error (Error)
import PostgREST.MediaType (MediaType (..)) import PostgREST.MediaType (MediaType (..))
import PostgREST.Plan (ActionPlan (..), import PostgREST.Plan (ActionPlan (..),
CallReadPlan (..),
CrudPlan (..), CrudPlan (..),
DbActionPlan (..), DbActionPlan (..),
InfoPlan (..), InfoPlan (..),
@@ -79,7 +78,6 @@ data Query
data QueryResult data QueryResult
= DbCrudResult CrudPlan ResultSet = DbCrudResult CrudPlan ResultSet
| DbCallResult CallReadPlan ResultSet
| DbPlanResult MediaType BS.ByteString | DbPlanResult MediaType BS.ByteString
| MaybeDbResult InspectPlan (Maybe (TablesMap, RoutineMap, Maybe Text)) | MaybeDbResult InspectPlan (Maybe (TablesMap, RoutineMap, Maybe Text))
| NoDbResult InfoPlan | NoDbResult InfoPlan
@@ -132,86 +130,73 @@ mainTx genQ@MainQuery{..} conf@AppConfig{..} AuthResult{..} apiReq (Db plan) sCa
mainActionQuery mainActionQuery
planTxMode :: DbActionPlan -> SQL.Mode planTxMode :: DbActionPlan -> SQL.Mode
planTxMode (DbCrud x) = pTxMode x planTxMode (DbCrud _ x) = pTxMode x
planTxMode (DbCall x) = crTxMode x
planTxMode (MayUseDb x) = ipTxmode x planTxMode (MayUseDb x) = ipTxmode x
planIsoLvl :: AppConfig -> ByteString -> DbActionPlan -> SQL.IsolationLevel planIsoLvl :: AppConfig -> ByteString -> DbActionPlan -> SQL.IsolationLevel
planIsoLvl AppConfig{configRoleIsoLvl} role actPlan = case actPlan of planIsoLvl AppConfig{configRoleIsoLvl} role actPlan = case actPlan of
DbCall CallReadPlan{crProc} -> fromMaybe roleIsoLvl $ pdIsoLvl crProc DbCrud _ CallReadPlan{crProc} -> fromMaybe roleIsoLvl $ pdIsoLvl crProc
_ -> roleIsoLvl _ -> roleIsoLvl
where where
roleIsoLvl = HM.findWithDefault SQL.ReadCommitted role configRoleIsoLvl roleIsoLvl = HM.findWithDefault SQL.ReadCommitted role configRoleIsoLvl
mainQuery :: ActionPlan -> AppConfig -> ApiRequest -> AuthResult -> Maybe QualifiedIdentifier -> MainQuery mainQuery :: ActionPlan -> AppConfig -> ApiRequest -> AuthResult -> Maybe QualifiedIdentifier -> MainQuery
mainQuery (NoDb _) _ _ _ _ = MainQuery mempty Nothing mempty mempty (mempty, mempty, mempty) mainQuery (NoDb _) _ _ _ _ = MainQuery mempty Nothing mempty mempty (mempty, mempty, mempty)
mainQuery (Db plan) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} authRes preReq = mainQuery (Db plan) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} authRes preReq =
let genQ = MainQuery (PreQuery.txVarQuery plan conf authRes apiReq) (PreQuery.preReqQuery <$> preReq) in let genQ = MainQuery (PreQuery.txVarQuery plan conf authRes apiReq) (PreQuery.preReqQuery <$> preReq) in
case plan of case plan of
DbCrud WrappedReadPlan{..} -> DbCrud _ WrappedReadPlan{..} ->
let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan in let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan in
genQ countQuery (Statements.mainRead wrReadPlan countQuery preferCount configDbMaxRows wrMedia wrHandler) (mempty, mempty, mempty) genQ countQuery (Statements.mainRead wrReadPlan countQuery preferCount configDbMaxRows pMedia wrHandler) (mempty, mempty, mempty)
DbCrud MutateReadPlan{..} -> DbCrud _ MutateReadPlan{..} ->
genQ mempty (Statements.mainWrite mrReadPlan mrMutatePlan mrMedia mrHandler preferRepresentation preferResolution) (mempty, mempty, mempty) genQ mempty (Statements.mainWrite mrReadPlan mrMutatePlan pMedia mrHandler preferRepresentation preferResolution) (mempty, mempty, mempty)
DbCall CallReadPlan{..} -> DbCrud _ CallReadPlan{..} ->
genQ mempty (Statements.mainCall crProc crCallPlan crReadPlan preferCount crMedia crHandler) (mempty, mempty, mempty) genQ mempty (Statements.mainCall crProc crCallPlan crReadPlan preferCount pMedia crHandler) (mempty, mempty, mempty)
MayUseDb InspectPlan{ipSchema=tSchema} -> MayUseDb InspectPlan{ipSchema=tSchema} ->
genQ mempty mempty (SqlFragment.accessibleTables tSchema, SqlFragment.accessibleFuncs tSchema, SqlFragment.schemaDescription tSchema) genQ mempty mempty (SqlFragment.accessibleTables tSchema, SqlFragment.accessibleFuncs tSchema, SqlFragment.schemaDescription tSchema)
-- TODO: Generate the Hasql Statement in a diferent module after the OpenAPI functionality is removed -- TODO: Generate the Hasql Statement in a diferent module after the OpenAPI functionality is removed
actionQuery :: MainQuery -> DbActionPlan -> AppConfig -> ApiRequest -> SchemaCache -> DbHandler QueryResult actionQuery :: MainQuery -> DbActionPlan -> AppConfig -> ApiRequest -> SchemaCache -> DbHandler QueryResult
actionQuery MainQuery{..} (DbCrud plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq _ = actionQuery MainQuery{..} (DbCrud True plan) conf@AppConfig{..} apiReq _ = do
case wrMedia of explRes <- lift $ SQL.statement mempty $ SQL.dynamicallyParameterized mqMain planRow configDbPreparedStatements
MTVndPlan{} -> do optionalRollback conf apiReq
explRes <- lift $ SQL.statement mempty $ dynStmt planRow pure $ DbPlanResult (pMedia plan) explRes
optionalRollback conf apiReq
pure $ DbPlanResult wrMedia explRes actionQuery MainQuery{..} (DbCrud _ plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq _ = do
_ -> do resultSet <- lift $ SQL.statement mempty $ dynStmt (HD.singleRow $ standardRow True)
resultSet <- lift $ SQL.statement mempty $ dynStmt (HD.singleRow $ standardRow True) failNotSingular pMedia resultSet
failNotSingular wrMedia resultSet optionalRollback conf apiReq
optionalRollback conf apiReq DbCrudResult plan <$> resultSetWTotal conf apiReq resultSet mqCount
DbCrudResult plan <$> resultSetWTotal conf apiReq resultSet mqCount
where where
dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements
actionQuery MainQuery{..} (DbCrud plan@MutateReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = actionQuery MainQuery{..} (DbCrud _ plan@MutateReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = do
case mrMedia of resultSet <- lift $ SQL.statement mempty $ dynStmt decodeRow
MTVndPlan{} -> do failMutation resultSet
explRes <- lift $ SQL.statement mempty $ dynStmt planRow optionalRollback conf apiReq
optionalRollback conf apiReq pure $ DbCrudResult plan resultSet
pure $ DbPlanResult mrMedia explRes
_ -> do
resultSet <- lift $ SQL.statement mempty $ dynStmt decodeRow
failMutation resultSet
optionalRollback conf apiReq
pure $ DbCrudResult plan resultSet
where where
dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements
failMutation resultSet = case mrMutation of failMutation resultSet = case mrMutation of
MutationCreate -> do MutationCreate -> do
failNotSingular mrMedia resultSet failNotSingular pMedia resultSet
MutationUpdate -> do MutationUpdate -> do
failNotSingular mrMedia resultSet failNotSingular pMedia resultSet
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
MutationSingleUpsert -> do MutationSingleUpsert -> do
failPut resultSet failPut resultSet
MutationDelete -> do MutationDelete -> do
failNotSingular mrMedia resultSet failNotSingular pMedia resultSet
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
decodeRow = fromMaybe (RSStandard Nothing 0 mempty mempty Nothing Nothing Nothing) <$> HD.rowMaybe (standardRow False) decodeRow = fromMaybe (RSStandard Nothing 0 mempty mempty Nothing Nothing Nothing) <$> HD.rowMaybe (standardRow False)
actionQuery MainQuery{..} (DbCall plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = actionQuery MainQuery{..} (DbCrud _ plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ = do
case crMedia of resultSet <- lift $ SQL.statement mempty $ dynStmt decodeRow
MTVndPlan{} -> do optionalRollback conf apiReq
explRes <- lift $ SQL.statement mempty $ dynStmt planRow failNotSingular pMedia resultSet
optionalRollback conf apiReq failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
pure $ DbPlanResult crMedia explRes pure $ DbCrudResult plan resultSet
_ -> do
resultSet <- lift $ SQL.statement mempty $ dynStmt decodeRow
optionalRollback conf apiReq
failNotSingular crMedia resultSet
failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
pure $ DbCallResult plan resultSet
where where
dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements dynStmt decod = SQL.dynamicallyParameterized mqMain decod configDbPreparedStatements
decodeRow = fromMaybe (RSStandard (Just 0) 0 mempty mempty Nothing Nothing Nothing) <$> HD.rowMaybe (standardRow True) decodeRow = fromMaybe (RSStandard (Just 0) 0 mempty mempty Nothing Nothing Nothing) <$> HD.rowMaybe (standardRow True)
+3 -3
View File
@@ -21,7 +21,7 @@ import PostgREST.ApiRequest.Preferences (PreferTimezone (..),
Preferences (..)) Preferences (..))
import PostgREST.Auth.Types (AuthResult (..)) import PostgREST.Auth.Types (AuthResult (..))
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.Plan (CallReadPlan (..), import PostgREST.Plan (CrudPlan (..),
DbActionPlan (..)) DbActionPlan (..))
import PostgREST.Query.SqlFragment (escapeIdentList, fromQi, import PostgREST.Query.SqlFragment (escapeIdentList, fromQi,
intercalateSnippet, intercalateSnippet,
@@ -56,8 +56,8 @@ txVarQuery dbActPlan AppConfig{..} AuthResult{..} ApiRequest{..} =
let schemas = escapeIdentList (iSchema : configDbExtraSearchPath) in let schemas = escapeIdentList (iSchema : configDbExtraSearchPath) in
setConfigWithConstantName ("search_path", schemas) setConfigWithConstantName ("search_path", schemas)
funcSettings = case dbActPlan of funcSettings = case dbActPlan of
DbCall CallReadPlan{crProc} -> pdFuncSettings crProc DbCrud _ CallReadPlan{crProc} -> pdFuncSettings crProc
_ -> mempty _ -> mempty
-- runs the pre-request function -- runs the pre-request function
preReqQuery :: QualifiedIdentifier -> SQL.Snippet preReqQuery :: QualifiedIdentifier -> SQL.Snippet
+14 -15
View File
@@ -35,8 +35,7 @@ import PostgREST.ApiRequest.Types (InvokeMethod (..),
Mutation (..)) Mutation (..))
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.MediaType (MediaType (..)) import PostgREST.MediaType (MediaType (..))
import PostgREST.Plan (CallReadPlan (..), import PostgREST.Plan (CrudPlan (..),
CrudPlan (..),
InfoPlan (..), InfoPlan (..),
InspectPlan (..)) InspectPlan (..))
import PostgREST.Plan.MutatePlan (MutatePlan (..)) import PostgREST.Plan.MutatePlan (MutatePlan (..))
@@ -63,7 +62,7 @@ data PgrstResponse = PgrstResponse {
actionResponse :: QueryResult -> ApiRequest -> (Text, Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse actionResponse :: QueryResult -> ApiRequest -> (Text, Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse
actionResponse (DbCrudResult WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly, crudQi=identifier} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ = do actionResponse (DbCrudResult WrappedReadPlan{pMedia, wrHdrsOnly=headersOnly, crudQi=identifier} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ = do
let let
(status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
cLHeader = if headersOnly then mempty else [contentLengthHeaderStrict rsBody] cLHeader = if headersOnly then mempty else [contentLengthHeaderStrict rsBody]
@@ -77,7 +76,7 @@ actionResponse (DbCrudResult WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly, cr
) )
] ]
++ cLHeader ++ cLHeader
++ contentTypeHeaders wrMedia ctxApiRequest ++ contentTypeHeaders pMedia ctxApiRequest
++ prefHeader ++ prefHeader
bod | status == HTTP.status416 = Error.errorPayload $ Error.ApiRequestError $ Error.InvalidRange $ bod | status == HTTP.status416 = Error.errorPayload $ Error.ApiRequestError $ Error.InvalidRange $
Error.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal) Error.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal)
@@ -88,7 +87,7 @@ actionResponse (DbCrudResult WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly, cr
Right $ PgrstResponse ovStatus ovHeaders bod Right $ PgrstResponse ovStatus ovHeaders bod
actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, mrMedia, crudQi=QualifiedIdentifier{..}} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} _ _ _ _ _ = do actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, pMedia, crudQi=QualifiedIdentifier{..}} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} _ _ _ _ _ = do
let let
pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;} pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;}
prefHeader = prefAppliedHeader $ prefHeader = prefAppliedHeader $
@@ -117,7 +116,7 @@ actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationCreate, mrMutateP
HTTP.status201 HTTP.status201
status = maybe HTTP.status200 isInsertIfGTZero rsInserted status = maybe HTTP.status200 isInsertIfGTZero rsInserted
(headers', bod) = case preferRepresentation of (headers', bod) = case preferRepresentation of
Just Full -> (headers ++ contentTypeHeaders mrMedia ctxApiRequest, LBS.fromStrict rsBody) Just Full -> (headers ++ contentTypeHeaders pMedia ctxApiRequest, LBS.fromStrict rsBody)
Just None -> (headers, mempty) Just None -> (headers, mempty)
Just HeadersOnly -> (headers, mempty) Just HeadersOnly -> (headers, mempty)
Nothing -> (headers, mempty) Nothing -> (headers, mempty)
@@ -126,7 +125,7 @@ actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationCreate, mrMutateP
Right $ PgrstResponse ovStatus ovHeaders bod Right $ PgrstResponse ovStatus ovHeaders bod
actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationUpdate, mrMedia} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = do actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationUpdate, pMedia} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = do
let let
contentRangeHeader = contentRangeHeader =
Just . RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $ Just . RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
@@ -136,7 +135,7 @@ actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationUpdate, mrMedia}
let (status, headers', body) = let (status, headers', body) =
case preferRepresentation of case preferRepresentation of
Just Full -> (HTTP.status200, headers ++ [contentLengthHeaderStrict rsBody] ++ contentTypeHeaders mrMedia ctxApiRequest, LBS.fromStrict rsBody) Just Full -> (HTTP.status200, headers ++ [contentLengthHeaderStrict rsBody] ++ contentTypeHeaders pMedia ctxApiRequest, LBS.fromStrict rsBody)
Just None -> (HTTP.status204, headers, mempty) Just None -> (HTTP.status204, headers, mempty)
_ -> (HTTP.status204, headers, mempty) _ -> (HTTP.status204, headers, mempty)
@@ -144,11 +143,11 @@ actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationUpdate, mrMedia}
Right $ PgrstResponse ovStatus ovHeaders body Right $ PgrstResponse ovStatus ovHeaders body
actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = do actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationSingleUpsert, pMedia} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = do
let let
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation preferCount preferTransaction Nothing preferHandling preferTimezone Nothing [] prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation preferCount preferTransaction Nothing preferHandling preferTimezone Nothing []
cLHeader = [contentLengthHeaderStrict rsBody] cLHeader = [contentLengthHeaderStrict rsBody]
cTHeader = contentTypeHeaders mrMedia ctxApiRequest cTHeader = contentTypeHeaders pMedia ctxApiRequest
let isInsertIfGTZero i = if i > 0 then HTTP.status201 else HTTP.status200 let isInsertIfGTZero i = if i > 0 then HTTP.status201 else HTTP.status200
upsertStatus = isInsertIfGTZero $ fromJust rsInserted upsertStatus = isInsertIfGTZero $ fromJust rsInserted
@@ -161,14 +160,14 @@ actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationSingleUpsert, mrM
Right $ PgrstResponse ovStatus ovHeaders body Right $ PgrstResponse ovStatus ovHeaders body
actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationDelete, mrMedia} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = do actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationDelete, pMedia} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = do
let let
contentRangeHeader = RangeQuery.contentRangeH 1 0 $ if shouldCount preferCount then Just rsQueryTotal else Nothing contentRangeHeader = RangeQuery.contentRangeH 1 0 $ if shouldCount preferCount then Just rsQueryTotal else Nothing
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation preferCount preferTransaction Nothing preferHandling preferTimezone preferMaxAffected [] prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation preferCount preferTransaction Nothing preferHandling preferTimezone preferMaxAffected []
headers = contentRangeHeader : prefHeader headers = contentRangeHeader : prefHeader
(status, headers', body) = (status, headers', body) =
case preferRepresentation of case preferRepresentation of
Just Full -> (HTTP.status200, headers ++ [contentLengthHeaderStrict rsBody] ++ contentTypeHeaders mrMedia ctxApiRequest, LBS.fromStrict rsBody) Just Full -> (HTTP.status200, headers ++ [contentLengthHeaderStrict rsBody] ++ contentTypeHeaders pMedia ctxApiRequest, LBS.fromStrict rsBody)
Just None -> (HTTP.status204, headers, mempty) Just None -> (HTTP.status204, headers, mempty)
_ -> (HTTP.status204, headers, mempty) _ -> (HTTP.status204, headers, mempty)
@@ -176,7 +175,7 @@ actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationDelete, mrMedia}
Right $ PgrstResponse ovStatus ovHeaders body Right $ PgrstResponse ovStatus ovHeaders body
actionResponse (DbCallResult CallReadPlan{crMedia, crInvMthd=invMethod, crProc=proc} RSStandard {..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ = do actionResponse (DbCrudResult CallReadPlan{pMedia, crInvMthd=invMethod, crProc=proc} RSStandard {..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ = do
let let
(status, contentRange) = (status, contentRange) =
RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
@@ -193,7 +192,7 @@ actionResponse (DbCallResult CallReadPlan{crMedia, crInvMthd=invMethod, crProc=p
(HTTP.status204, headers, mempty) (HTTP.status204, headers, mempty)
else else
(status, (status,
headers ++ cLHeader ++ contentTypeHeaders crMedia ctxApiRequest, headers ++ cLHeader ++ contentTypeHeaders pMedia ctxApiRequest,
if isHeadMethod then mempty else rsOrErrBody) if isHeadMethod then mempty else rsOrErrBody)
(ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status' headers' (ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status' headers'
@@ -224,7 +223,7 @@ actionResponse (NoDbResult (RelInfoPlan qi@QualifiedIdentifier{..})) _ _ _ Schem
["PATCH" | tableUpdatable table] ++ ["PATCH" | tableUpdatable table] ++
["DELETE" | tableDeletable table] ["DELETE" | tableDeletable table]
actionResponse (NoDbResult (RoutineInfoPlan CallReadPlan{crProc=proc})) _ _ _ _ _ _ actionResponse (NoDbResult (RoutineInfoPlan proc)) _ _ _ _ _ _
| pdVolatility proc == Volatile = respondInfo "OPTIONS,POST" | pdVolatility proc == Volatile = respondInfo "OPTIONS,POST"
| otherwise = respondInfo "OPTIONS,GET,HEAD,POST" | otherwise = respondInfo "OPTIONS,GET,HEAD,POST"