From cae1c67b00d48f52b4273191d7661f3bc06bab0c Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Thu, 9 Mar 2023 14:00:48 -0500 Subject: [PATCH] refactor: add iPreferences to ApiRequest It avoids adding a new iPrefer.. to the ApiRequest every time a preference is added. --- src/PostgREST/ApiRequest.hs | 48 +++++++++---------------- src/PostgREST/ApiRequest/Preferences.hs | 12 +++---- src/PostgREST/Plan.hs | 15 ++++---- src/PostgREST/Query.hs | 27 +++++++------- src/PostgREST/Response.hs | 31 ++++++++-------- 5 files changed, 61 insertions(+), 72 deletions(-) diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index f7582225a..5da127cc8 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -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" diff --git a/src/PostgREST/ApiRequest/Preferences.hs b/src/PostgREST/ApiRequest/Preferences.hs index 8d208c1b8..aba31f987 100644 --- a/src/PostgREST/ApiRequest/Preferences.hs +++ b/src/PostgREST/ApiRequest/Preferences.hs @@ -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] diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index 26faa833b..c15f50be8 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -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 diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index d16a214e3..81842b576 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -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 -> diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs index bdbfa14bf..44c7fc111 100644 --- a/src/PostgREST/Response.hs +++ b/src/PostgREST/Response.hs @@ -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