refactor: add iPreferences to ApiRequest

It avoids adding a new iPrefer.. to the ApiRequest every time a
preference is added.
This commit is contained in:
steve-chavez
2023-03-09 14:40:32 -05:00
committed by Steve Chavez
parent b05ea14122
commit cae1c67b00
5 changed files with 61 additions and 72 deletions
+17 -31
View File
@@ -46,11 +46,6 @@ import Network.Wai (Request (..))
import Network.Wai.Parse (parseHttpAccept)
import Web.Cookie (parseCookies)
import PostgREST.ApiRequest.Preferences (PreferCount (..),
PreferParameters (..),
PreferRepresentation (..),
PreferResolution (..),
PreferTransaction (..))
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
import PostgREST.ApiRequest.Types (ApiRequestError (..),
RangeError (..))
@@ -123,26 +118,22 @@ data Target = TargetIdent QualifiedIdentifier
if it is an action we are able to perform.
-}
data ApiRequest = ApiRequest {
iAction :: Action -- ^ Similar but not identical to HTTP method, e.g. Create/Invoke both POST
, iRange :: HM.HashMap Text NonnegRange -- ^ Requested range of rows within response
, iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level
, iTarget :: Target -- ^ The target, be it calling a proc or accessing a table
, iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions
, iPreferRepresentation :: PreferRepresentation -- ^ If client wants created items echoed back
, iPreferParameters :: Maybe PreferParameters -- ^ How to pass parameters to a stored procedure
, iPreferCount :: Maybe PreferCount -- ^ Whether the client wants a result count
, iPreferResolution :: Maybe PreferResolution -- ^ Whether the client wants to UPSERT or ignore records on PK conflict
, iPreferTransaction :: Maybe PreferTransaction -- ^ Whether the clients wants to commit or rollback the transaction
, iQueryParams :: QueryParams.QueryParams
, iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload
, iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers
, iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies
, iPath :: ByteString -- ^ Raw request path
, iMethod :: ByteString -- ^ Raw request method
, iSchema :: Schema -- ^ The request schema. Can vary depending on profile headers.
, iNegotiatedByProfile :: Bool -- ^ If schema was was chosen according to the profile spec https://www.w3.org/TR/dx-prof-conneg/
, iAcceptMediaType :: MediaType -- ^ The media type in the Accept header
, iContentMediaType :: MediaType -- ^ The media type in the Content-Type header
iAction :: Action -- ^ Similar but not identical to HTTP method, e.g. Create/Invoke both POST
, iRange :: HM.HashMap Text NonnegRange -- ^ Requested range of rows within response
, iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level
, iTarget :: Target -- ^ The target, be it calling a proc or accessing a table
, iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions
, iPreferences :: Preferences.Preferences -- ^ Prefer header values
, iQueryParams :: QueryParams.QueryParams
, iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload
, iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers
, iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies
, iPath :: ByteString -- ^ Raw request path
, iMethod :: ByteString -- ^ Raw request method
, iSchema :: Schema -- ^ The request schema. Can vary depending on profile headers.
, iNegotiatedByProfile :: Bool -- ^ If schema was was chosen according to the profile spec https://www.w3.org/TR/dx-prof-conneg/
, iAcceptMediaType :: MediaType -- ^ The media type in the Accept header
, iContentMediaType :: MediaType -- ^ The media type in the Content-Type header
}
-- | Examines HTTP request and translates it into user intent.
@@ -163,11 +154,7 @@ userApiRequest conf req reqBody = do
, iRange = ranges
, iTopLevelRange = topLevelRange
, iPayload = payload
, iPreferRepresentation = fromMaybe None preferRepresentation
, iPreferParameters = preferParameters
, iPreferCount = preferCount
, iPreferResolution = preferResolution
, iPreferTransaction = preferTransaction
, iPreferences = Preferences.fromHeaders hdrs
, iQueryParams = qPrms
, iColumns = columns
, iHeaders = iHdrs
@@ -183,7 +170,6 @@ userApiRequest conf req reqBody = do
method = requestMethod req
hdrs = requestHeaders req
lookupHeader = flip lookup hdrs
Preferences.Preferences{..} = Preferences.fromHeaders hdrs
iHdrs = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
iCkies = maybe [] parseCookies $ lookupHeader "Cookie"
+6 -6
View File
@@ -39,7 +39,7 @@ import Protolude
data Preferences
= Preferences
{ preferResolution :: Maybe PreferResolution
, preferRepresentation :: Maybe PreferRepresentation
, preferRepresentation :: PreferRepresentation
, preferParameters :: Maybe PreferParameters
, preferCount :: Maybe PreferCount
, preferTransaction :: Maybe PreferTransaction
@@ -53,7 +53,7 @@ data Preferences
-- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates, count=exact")]
-- Preferences
-- { preferResolution = Just IgnoreDuplicates
-- , preferRepresentation = Nothing
-- , preferRepresentation = None
-- , preferParameters = Nothing
-- , preferCount = Just ExactCount
-- , preferTransaction = Nothing
@@ -64,7 +64,7 @@ data Preferences
-- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates"), ("Prefer", "count=exact")]
-- Preferences
-- { preferResolution = Just IgnoreDuplicates
-- , preferRepresentation = Nothing
-- , preferRepresentation = None
-- , preferParameters = Nothing
-- , preferCount = Just ExactCount
-- , preferTransaction = Nothing
@@ -92,10 +92,10 @@ data Preferences
--
-- Preferences can be separated by arbitrary amounts of space, lower-case header is also recognized:
--
-- >>> pPrint $ fromHeaders [("prefer", "count=exact, tx=commit ,return=minimal")]
-- >>> pPrint $ fromHeaders [("prefer", "count=exact, tx=commit ,return=representation")]
-- Preferences
-- { preferResolution = Nothing
-- , preferRepresentation = Just None
-- , preferRepresentation = Full
-- , preferParameters = Nothing
-- , preferCount = Just ExactCount
-- , preferTransaction = Just Commit
@@ -105,7 +105,7 @@ fromHeaders :: [HTTP.Header] -> Preferences
fromHeaders headers =
Preferences
{ preferResolution = parsePrefs [MergeDuplicates, IgnoreDuplicates]
, preferRepresentation = parsePrefs [Full, None, HeadersOnly]
, preferRepresentation = fromMaybe None $ parsePrefs [Full, None, HeadersOnly]
, preferParameters = parsePrefs [SingleObject, MultipleObjects]
, preferCount = parsePrefs [ExactCount, PlannedCount, EstimatedCount]
, preferTransaction = parsePrefs [Commit, Rollback]
+8 -7
View File
@@ -115,7 +115,7 @@ callReadPlan identifier conf sCache apiRequest invMethod = do
InvHead -> S.fromList $ fst <$> qsParams'
InvPost -> iColumns apiRequest
proc@ProcDescription{..} <- mapLeft ApiRequestError $
findProc identifier paramKeys (iPreferParameters apiRequest == Just SingleObject) (dbProcs sCache) (iContentMediaType apiRequest) (invMethod == InvPost)
findProc identifier paramKeys (preferParameters == Just SingleObject) (dbProcs sCache) (iContentMediaType apiRequest) (invMethod == InvPost)
let relIdentifier = QualifiedIdentifier pdSchema (fromMaybe pdName $ Proc.procTableName proc) -- done so a set returning function can embed other relations
rPlan <- readPlan relIdentifier conf sCache apiRequest
let args = case (invMethod, iContentMediaType apiRequest) of
@@ -133,6 +133,7 @@ callReadPlan identifier conf sCache apiRequest invMethod = do
binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) (Just proc) rPlan
return $ CallReadPlan rPlan cPlan txMode proc binField
where
Preferences{..} = iPreferences apiRequest
qsParams' = QueryParams.qsParams (iQueryParams apiRequest)
{-|
@@ -500,10 +501,10 @@ updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
findNode = find (\(Node ReadPlan{relName, relAlias} _) -> relName == targetNodeName || relAlias == Just targetNodeName) forest
mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> SchemaCache -> ReadPlanTree -> Either Error MutatePlan
mutatePlan mutation qi ApiRequest{..} sCache readReq = mapLeft ApiRequestError $
mutatePlan mutation qi ApiRequest{iPreferences=Preferences{..}, ..} sCache readReq = mapLeft ApiRequestError $
case mutation of
MutationCreate ->
mapRight (\typedColumns -> Insert qi typedColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings pkCols) typedColumnsOrError
mapRight (\typedColumns -> Insert qi typedColumns body ((,) <$> preferResolution <*> Just confCols) [] returnings pkCols) typedColumnsOrError
MutationUpdate ->
mapRight (\typedColumns -> Update qi typedColumns body combinedLogic iTopLevelRange rootOrder returnings) typedColumnsOrError
MutationSingleUpsert ->
@@ -521,7 +522,7 @@ mutatePlan mutation qi ApiRequest{..} sCache readReq = mapLeft ApiRequestError $
confCols = fromMaybe pkCols qsOnConflict
QueryParams.QueryParams{..} = iQueryParams
returnings =
if iPreferRepresentation == None
if preferRepresentation == None
then []
else inferColsEmbedNeeds readReq pkCols
pkCols = maybe mempty tablePKCols $ HM.lookup qi $ dbTables sCache
@@ -540,16 +541,16 @@ resolveOrError (Just table) field =
Just typedField -> Right typedField
callPlan :: ProcDescription -> ApiRequest -> S.Set FieldName -> LBS.ByteString -> ReadPlanTree -> CallPlan
callPlan proc apiReq paramKeys args readReq = FunctionCall {
callPlan proc ApiRequest{iPreferences=Preferences{..}} paramKeys args readReq = FunctionCall {
funCQi = QualifiedIdentifier (pdSchema proc) (pdName proc)
, funCParams = callParams
, funCArgs = Just args
, funCScalar = procReturnsScalar proc
, funCMultipleCall = iPreferParameters apiReq == Just MultipleObjects
, funCMultipleCall = preferParameters == Just MultipleObjects
, funCReturning = inferColsEmbedNeeds readReq []
}
where
paramsAsSingleObject = iPreferParameters apiReq == Just SingleObject
paramsAsSingleObject = preferParameters == Just SingleObject
specifiedParams = filter (\x -> ppName x `S.member` paramKeys)
callParams = case pdParams proc of
[prm] | paramsAsSingleObject -> OnePosParam prm
+14 -13
View File
@@ -38,6 +38,7 @@ import PostgREST.ApiRequest (ApiRequest (..))
import PostgREST.ApiRequest.Preferences (PreferCount (..),
PreferParameters (..),
PreferTransaction (..),
Preferences (..),
shouldCount)
import PostgREST.Config (AppConfig (..),
OpenAPIMode (..))
@@ -66,19 +67,19 @@ import Protolude hiding (Handler)
type DbHandler = ExceptT Error SQL.Transaction
readQuery :: WrappedReadPlan -> AppConfig -> ApiRequest -> DbHandler ResultSet
readQuery WrappedReadPlan{wrReadPlan, wrBinField} conf@AppConfig{..} apiReq@ApiRequest{..} = do
readQuery WrappedReadPlan{wrReadPlan, wrBinField} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} = do
let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan
resultSet <-
lift . SQL.statement mempty $
Statements.prepareRead
(QueryBuilder.readPlanToQuery wrReadPlan)
(if iPreferCount == Just EstimatedCount then
(if preferCount == Just EstimatedCount then
-- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
else
countQuery
)
(shouldCount iPreferCount)
(shouldCount preferCount)
iAcceptMediaType
wrBinField
configDbPreparedStatements
@@ -88,8 +89,8 @@ readQuery WrappedReadPlan{wrReadPlan, wrBinField} conf@AppConfig{..} apiReq@ApiR
resultSetWTotal :: AppConfig -> ApiRequest -> ResultSet -> SQL.Snippet -> DbHandler ResultSet
resultSetWTotal _ _ rs@RSPlan{} _ = return rs
resultSetWTotal AppConfig{..} ApiRequest{..} rs@RSStandard{rsTableTotal=tableTotal} countQuery =
case iPreferCount of
resultSetWTotal AppConfig{..} ApiRequest{iPreferences=Preferences{..}} rs@RSStandard{rsTableTotal=tableTotal} countQuery =
case preferCount of
Just PlannedCount -> do
total <- explain
return rs{rsTableTotal=total}
@@ -151,7 +152,7 @@ deleteQuery mrPlan apiReq@ApiRequest{..} conf = do
pure resultSet
invokeQuery :: ProcDescription -> CallReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
invokeQuery proc CallReadPlan{crReadPlan, crCallPlan, crBinField} apiReq@ApiRequest{..} conf@AppConfig{..} = do
invokeQuery proc CallReadPlan{crReadPlan, crCallPlan, crBinField} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} conf@AppConfig{..} = do
resultSet <-
lift . SQL.statement mempty $
Statements.prepareCall
@@ -160,9 +161,9 @@ invokeQuery proc CallReadPlan{crReadPlan, crCallPlan, crBinField} apiReq@ApiRequ
(QueryBuilder.callPlanToQuery crCallPlan)
(QueryBuilder.readPlanToQuery crReadPlan)
(QueryBuilder.readPlanToCountQuery crReadPlan)
(shouldCount iPreferCount)
(shouldCount preferCount)
iAcceptMediaType
(iPreferParameters == Just MultipleObjects)
(preferParameters == Just MultipleObjects)
crBinField
configDbPreparedStatements
@@ -188,7 +189,7 @@ openApiQuery sCache pgVer AppConfig{..} tSchema =
pure Nothing
writeQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan} apiReq conf =
writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan} apiReq@ApiRequest{iPreferences=Preferences{..}} conf =
let
(isInsert, pkCols) = case mrMutatePlan of {Insert{insPkCols} -> (True, insPkCols); _ -> (False, mempty);}
in
@@ -198,7 +199,7 @@ writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan} apiReq conf =
(QueryBuilder.mutatePlanToQuery mrMutatePlan)
isInsert
(iAcceptMediaType apiReq)
(iPreferRepresentation apiReq)
preferRepresentation
pkCols
(configDbPreparedStatements conf)
@@ -222,15 +223,15 @@ failsChangesOffLimits (Just maxChanges) RSStandard{rsQueryTotal=queryTotal} =
-- | Set a transaction to roll back if requested
optionalRollback :: AppConfig -> ApiRequest -> DbHandler ()
optionalRollback AppConfig{..} ApiRequest{..} = do
optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} = do
lift $ when (shouldRollback || (configDbTxRollbackAll && not shouldCommit)) $ do
SQL.sql "SET CONSTRAINTS ALL IMMEDIATE"
SQL.condemn
where
shouldCommit =
configDbTxAllowOverride && iPreferTransaction == Just Commit
configDbTxAllowOverride && preferTransaction == Just Commit
shouldRollback =
configDbTxAllowOverride && iPreferTransaction == Just Rollback
configDbTxAllowOverride && preferTransaction == Just Rollback
-- | Runs local (transaction scoped) GUCs for every request.
setPgLocals :: AppConfig -> KM.KeyMap JSON.Value -> Text ->
+16 -15
View File
@@ -37,6 +37,7 @@ import PostgREST.ApiRequest (ApiRequest (..),
InvokeMethod (..))
import PostgREST.ApiRequest.Preferences (PreferRepresentation (..),
PreferTransaction (..),
Preferences (..),
shouldCount,
toAppliedHeader)
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
@@ -86,7 +87,7 @@ readResponse headersOnly identifier ctxApiRequest@ApiRequest{..} resultSet = cas
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
createResponse :: QualifiedIdentifier -> MutateReadPlan -> ApiRequest -> ResultSet -> Wai.Response
createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan} ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of
RSStandard{..} -> do
let
pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;}
@@ -103,14 +104,14 @@ createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan} ctxApiReques
<> HTTP.renderSimpleQuery True rsLocation
)
, Just . RangeQuery.contentRangeH 1 0 $
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
if shouldCount preferCount then Just rsQueryTotal else Nothing
, if null pkCols && isNothing (qsOnConflict iQueryParams) then
Nothing
else
toAppliedHeader <$> iPreferResolution
toAppliedHeader <$> preferResolution
]
if iPreferRepresentation == Full then
if preferRepresentation == Full then
response HTTP.status201 (headers ++ contentTypeHeaders ctxApiRequest) (LBS.fromStrict rsBody)
else
response HTTP.status201 headers mempty
@@ -119,16 +120,16 @@ createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan} ctxApiReques
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
updateResponse :: ApiRequest -> ResultSet -> Wai.Response
updateResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
updateResponse ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard{..} -> do
let
response = gucResponse rsGucStatus rsGucHeaders
contentRangeHeader =
RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
if shouldCount preferCount then Just rsQueryTotal else Nothing
headers = [contentRangeHeader]
if iPreferRepresentation == Full then
if preferRepresentation == Full then
response HTTP.status200
(headers ++ contentTypeHeaders ctxApiRequest)
(LBS.fromStrict rsBody)
@@ -139,12 +140,12 @@ updateResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
singleUpsertResponse :: ApiRequest -> ResultSet -> Wai.Response
singleUpsertResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
singleUpsertResponse ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard {..} -> do
let
response = gucResponse rsGucStatus rsGucHeaders
if iPreferRepresentation == Full then
if preferRepresentation == Full then
response HTTP.status200 (contentTypeHeaders ctxApiRequest) (LBS.fromStrict rsBody)
else
response HTTP.status204 [] mempty
@@ -153,16 +154,16 @@ singleUpsertResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
deleteResponse :: ApiRequest -> ResultSet -> Wai.Response
deleteResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
deleteResponse ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard {..} -> do
let
response = gucResponse rsGucStatus rsGucHeaders
contentRangeHeader =
RangeQuery.contentRangeH 1 0 $
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
if shouldCount preferCount then Just rsQueryTotal else Nothing
headers = [contentRangeHeader]
if iPreferRepresentation == Full then
if preferRepresentation == Full then
response HTTP.status200
(headers ++ contentTypeHeaders ctxApiRequest)
(LBS.fromStrict rsBody)
@@ -270,14 +271,14 @@ isServiceUnavailable :: Wai.Response -> Bool
isServiceUnavailable response = Wai.responseStatus response == HTTP.status503
optionalRollback :: AppConfig -> ApiRequest -> ExceptT Error.Error IO Wai.Response -> ExceptT Error.Error IO Wai.Response
optionalRollback AppConfig{..} ApiRequest{..} resp = do
optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} resp = do
newRes <- catchError resp $ return . Error.errorResponseFor
return $ Wai.mapResponseHeaders preferenceApplied newRes
where
shouldCommit =
configDbTxAllowOverride && iPreferTransaction == Just Commit
configDbTxAllowOverride && preferTransaction == Just Commit
shouldRollback =
configDbTxAllowOverride && iPreferTransaction == Just Rollback
configDbTxAllowOverride && preferTransaction == Just Rollback
preferenceApplied
| shouldCommit =
addHeadersIfNotIncluded