From f0e31dee8bf5dba854e2d5374f8bac12d6d1a065 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Fri, 7 Jul 2023 23:08:43 -0500 Subject: [PATCH 1/2] refactor: add ResultAggregate type --- src/PostgREST/MediaType.hs | 1 + src/PostgREST/Plan.hs | 41 +++++++++++++++++---- src/PostgREST/Query.hs | 11 +++--- src/PostgREST/Query/SqlFragment.hs | 32 ++++++++++------ src/PostgREST/Query/Statements.hs | 55 ++++++++-------------------- src/PostgREST/SchemaCache/Routine.hs | 14 ++++++- 6 files changed, 90 insertions(+), 64 deletions(-) diff --git a/src/PostgREST/MediaType.hs b/src/PostgREST/MediaType.hs index 241572efa7..d5288c693b 100644 --- a/src/PostgREST/MediaType.hs +++ b/src/PostgREST/MediaType.hs @@ -30,6 +30,7 @@ data MediaType | MTOctetStream | MTAny | MTOther ByteString + -- TODO MTPlan should only have its options as [Text]. Its ResultAggregate should have the typed attributes. | MTPlan MediaType MTPlanFormat [MTPlanOption] deriving Show instance Eq MediaType where diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index e3c7ca654b..95fda7bca7 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -59,7 +59,8 @@ import PostgREST.SchemaCache.Relationship (Cardinality (..), relIsToOne) import PostgREST.SchemaCache.Representations (DataRepresentation (..), RepresentationsMap) -import PostgREST.SchemaCache.Routine (Routine (..), +import PostgREST.SchemaCache.Routine (ResultAggregate (..), + Routine (..), RoutineMap, RoutineParam (..), funcReturnsCompositeAlias, @@ -89,13 +90,14 @@ import Protolude hiding (from) data WrappedReadPlan = WrappedReadPlan { wrReadPlan :: ReadPlanTree , wrTxMode :: SQL.Mode -, wrBinField :: Maybe FieldName +, wrResAgg :: ResultAggregate } data MutateReadPlan = MutateReadPlan { mrReadPlan :: ReadPlanTree , mrMutatePlan :: MutatePlan , mrTxMode :: SQL.Mode +, mrResAgg :: ResultAggregate } data CallReadPlan = CallReadPlan { @@ -103,20 +105,21 @@ data CallReadPlan = CallReadPlan { , crCallPlan :: CallPlan , crTxMode :: SQL.Mode , crProc :: Routine -, crBinField :: Maybe FieldName +, crResAgg :: ResultAggregate } wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error WrappedReadPlan wrappedReadPlan identifier conf sCache apiRequest = do rPlan <- readPlan identifier conf sCache apiRequest binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) Nothing rPlan - return $ WrappedReadPlan rPlan SQL.Read binField + return $ WrappedReadPlan rPlan SQL.Read $ mediaToAggregate (iAcceptMediaType apiRequest) binField Nothing mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error MutateReadPlan -mutateReadPlan mutation apiRequest identifier conf sCache = do +mutateReadPlan mutation apiRequest@ApiRequest{iPreferences=Preferences{preferRepresentation}} identifier conf sCache = do rPlan <- readPlan identifier conf sCache apiRequest + binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) Nothing rPlan mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan - return $ MutateReadPlan rPlan mPlan SQL.Write + return $ MutateReadPlan rPlan mPlan SQL.Write $ mediaToAggregate (iAcceptMediaType apiRequest) binField (Just preferRepresentation) callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan callReadPlan identifier conf sCache apiRequest invMethod = do @@ -141,7 +144,7 @@ callReadPlan identifier conf sCache apiRequest invMethod = do (InvPost, Routine.Volatile) -> SQL.Write cPlan = callPlan proc apiRequest paramKeys args rPlan binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) (Just proc) rPlan - return $ CallReadPlan rPlan cPlan txMode proc binField + return $ CallReadPlan rPlan cPlan txMode proc $ mediaToAggregate (iAcceptMediaType apiRequest) binField Nothing where Preferences{..} = iPreferences apiRequest qsParams' = QueryParams.qsParams (iQueryParams apiRequest) @@ -835,3 +838,27 @@ binaryField AppConfig{configRawMediaTypes} acceptMediaType proc rpTree fstFieldName (Node ReadPlan{select=(CoercibleField{cfName="*", cfJsonPath=[]}, _, _):_} []) = Nothing fstFieldName (Node ReadPlan{select=[(CoercibleField{cfName=fld, cfJsonPath=[]}, _, _)]} []) = Just fld fstFieldName _ = Nothing + +mediaToAggregate :: MediaType -> Maybe FieldName -> Maybe PreferRepresentation -> ResultAggregate +mediaToAggregate mt binField rep = + if rep == Just HeadersOnly || rep == Just None + then NoAgg + else case mt of + MTApplicationJSON -> BuiltinAggJson + MTSingularJSON -> BuiltinAggSingleJson + MTGeoJSON -> BuiltinAggGeoJson + MTTextCSV -> BuiltinAggCsv + MTAny -> BuiltinAggJson + MTOpenAPI -> BuiltinAggJson + MTUrlEncoded -> NoAgg -- TODO: unreachable since a previous step (producedMediaTypes) whitelists the media types that can become aggregates. + + -- binary types + MTTextPlain -> BuiltinAggBinary binField + MTTextXML -> BuiltinAggXml binField + MTOctetStream -> BuiltinAggBinary binField + MTOther _ -> BuiltinAggBinary binField + + -- Doing `Accept: application/vnd.pgrst.plan; for="application/vnd.pgrst.plan"` doesn't make sense, so we just empty the body. + -- TODO: fail instead to be more strict + MTPlan (MTPlan{}) _ _ -> NoAgg + MTPlan media _ _ -> mediaToAggregate media binField rep diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index 10694758c5..af77ce9b44 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -65,7 +65,7 @@ import Protolude hiding (Handler) type DbHandler = ExceptT Error SQL.Transaction readQuery :: WrappedReadPlan -> AppConfig -> ApiRequest -> DbHandler ResultSet -readQuery WrappedReadPlan{wrReadPlan, wrBinField} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} = do +readQuery WrappedReadPlan{wrReadPlan, wrResAgg} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} = do let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan resultSet <- lift . SQL.statement mempty $ @@ -79,7 +79,7 @@ readQuery WrappedReadPlan{wrReadPlan, wrBinField} conf@AppConfig{..} apiReq@ApiR ) (shouldCount preferCount) iAcceptMediaType - wrBinField + wrResAgg configDbPreparedStatements failNotSingular iAcceptMediaType resultSet optionalRollback conf apiReq @@ -150,7 +150,7 @@ deleteQuery mrPlan apiReq@ApiRequest{..} conf = do pure resultSet invokeQuery :: Routine -> CallReadPlan -> ApiRequest -> AppConfig -> PgVersion -> DbHandler ResultSet -invokeQuery rout CallReadPlan{crReadPlan, crCallPlan, crBinField} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} conf@AppConfig{..} pgVer = do +invokeQuery rout CallReadPlan{crReadPlan, crCallPlan, crResAgg} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} conf@AppConfig{..} pgVer = do resultSet <- lift . SQL.statement mempty $ Statements.prepareCall @@ -160,7 +160,7 @@ invokeQuery rout CallReadPlan{crReadPlan, crCallPlan, crBinField} apiReq@ApiRequ (QueryBuilder.readPlanToCountQuery crReadPlan) (shouldCount preferCount) iAcceptMediaType - crBinField + crResAgg configDbPreparedStatements optionalRollback conf apiReq @@ -185,7 +185,7 @@ openApiQuery sCache pgVer AppConfig{..} tSchema = pure Nothing writeQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet -writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan} apiReq@ApiRequest{iPreferences=Preferences{..}} conf = +writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan, mrResAgg} apiReq@ApiRequest{iPreferences=Preferences{..}} conf = let (isInsert, pkCols) = case mrMutatePlan of {Insert{insPkCols} -> (True, insPkCols); _ -> (False, mempty);} in @@ -195,6 +195,7 @@ writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan} apiReq@ApiRequest{iPreferenc (QueryBuilder.mutatePlanToQuery mrMutatePlan) isInsert (iAcceptMediaType apiReq) + mrResAgg preferRepresentation pkCols (configDbPreparedStatements conf) diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index 050bcf1aa9..f6b6abab16 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -7,12 +7,7 @@ Description : Helper functions for PostgREST.QueryBuilder. -} module PostgREST.Query.SqlFragment ( noLocationF - , asBinaryF - , asCsvF - , asGeoJsonF - , asJsonF - , asJsonSingleF - , asXmlF + , aggF , countF , fromQi , limitOffsetF @@ -81,7 +76,8 @@ import PostgREST.RangeQuery (NonnegRange, allRange, rangeLimit, rangeOffset) import PostgREST.SchemaCache.Identifiers (FieldName, QualifiedIdentifier (..)) -import PostgREST.SchemaCache.Routine (Routine (..), +import PostgREST.SchemaCache.Routine (ResultAggregate (..), + Routine (..), funcReturnsScalar, funcReturnsSetOfScalar, funcReturnsSingleComposite) @@ -208,14 +204,18 @@ asJsonF rout Just r -> (funcReturnsSingleComposite r, funcReturnsScalar r, funcReturnsSetOfScalar r) Nothing -> (False, False, False) -asXmlF :: FieldName -> SQL.Snippet -asXmlF fieldName = "coalesce(xmlagg(_postgrest_t." <> pgFmtIdent fieldName <> "), '')" +asXmlF :: Maybe FieldName -> SQL.Snippet +asXmlF (Just fieldName) = "coalesce(xmlagg(_postgrest_t." <> pgFmtIdent fieldName <> "), '')" +-- TODO unreachable because a previous step(binaryField) will validate that there's a field. This will be cleared once custom media types are implemented. +asXmlF Nothing = "coalesce(xmlagg(_postgrest_t), '')" asGeoJsonF :: SQL.Snippet asGeoJsonF = "json_build_object('type', 'FeatureCollection', 'features', coalesce(json_agg(ST_AsGeoJSON(_postgrest_t)::json), '[]'))" -asBinaryF :: FieldName -> SQL.Snippet -asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')" +asBinaryF :: Maybe FieldName -> SQL.Snippet +asBinaryF (Just fieldName) = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')" +-- TODO unreachable because a previous step(binaryField) will validate that there's a field. This will be cleared once custom media types are implemented. +asBinaryF Nothing = "coalesce(string_agg(_postgrest_t, ''), '')" locationF :: [Text] -> SQL.Snippet locationF pKeys = [qc|( @@ -491,3 +491,13 @@ setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal k gucJsonVal = LBS.toStrict . JSON.encode . HM.fromList . arrayByteStringToText arrayByteStringToText :: [(ByteString, ByteString)] -> [(Text,Text)] arrayByteStringToText keyVal = (T.decodeUtf8 *** T.decodeUtf8) <$> keyVal + +aggF :: Maybe Routine -> ResultAggregate -> SQL.Snippet +aggF rout = \case + BuiltinAggJson -> asJsonF rout + BuiltinAggSingleJson -> asJsonSingleF rout + BuiltinAggGeoJson -> asGeoJsonF + BuiltinAggCsv -> asCsvF + BuiltinAggXml bField -> asXmlF bField + BuiltinAggBinary bField -> asBinaryF bField + NoAgg -> "''::text" diff --git a/src/PostgREST/Query/Statements.hs b/src/PostgREST/Query/Statements.hs index a1ad4eb0f8..4fc2b76853 100644 --- a/src/PostgREST/Query/Statements.hs +++ b/src/PostgREST/Query/Statements.hs @@ -23,15 +23,13 @@ import qualified Hasql.DynamicStatements.Statement as SQL import qualified Hasql.Statement as SQL import Control.Lens ((^?)) -import Data.Maybe (fromJust) import PostgREST.ApiRequest.Preferences -import PostgREST.MediaType (MTPlanFormat (..), - MediaType (..), - getMediaType) +import PostgREST.MediaType (MTPlanFormat (..), + MediaType (..)) import PostgREST.Query.SqlFragment -import PostgREST.SchemaCache.Identifiers (FieldName) -import PostgREST.SchemaCache.Routine (Routine) +import PostgREST.SchemaCache.Routine (ResultAggregate (..), + Routine) import Protolude @@ -55,9 +53,9 @@ data ResultSet | RSPlan BS.ByteString -- ^ the plan of the query -prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> +prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> ResultAggregate -> PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet -prepareWrite selectQuery mutateQuery isInsert mt rep pKeys = +prepareWrite selectQuery mutateQuery isInsert mt rAgg rep pKeys = SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt where snippet = @@ -66,7 +64,7 @@ prepareWrite selectQuery mutateQuery isInsert mt rep pKeys = "'' AS total_result_set, " <> "pg_catalog.count(_postgrest_t) AS page_total, " <> locF <> " AS header, " <> - bodyF <> " AS body, " <> + aggF Nothing rAgg <> " AS body, " <> responseHeadersF <> " AS response_headers, " <> responseStatusF <> " AS response_status " <> "FROM (" <> selectF <> ") _postgrest_t" @@ -80,25 +78,18 @@ prepareWrite selectQuery mutateQuery isInsert mt rep pKeys = "END" else noLocationF - bodyF - | rep /= Full = "''" - | getMediaType mt == MTTextCSV = asCsvF - | getMediaType mt == MTGeoJSON = asGeoJsonF - | getMediaType mt == MTSingularJSON = asJsonSingleF Nothing - | otherwise = asJsonF Nothing - selectF -- prevent using any of the column names in ?select= when no response is returned from the CTE - | rep /= Full = "SELECT * FROM " <> sourceCTE - | otherwise = selectQuery + | rAgg == NoAgg = "SELECT * FROM " <> sourceCTE + | otherwise = selectQuery decodeIt :: HD.Result ResultSet decodeIt = case mt of MTPlan{} -> planRow _ -> fromMaybe (RSStandard Nothing 0 mempty mempty Nothing Nothing) <$> HD.rowMaybe (standardRow False) -prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> Maybe FieldName -> Bool -> SQL.Statement () ResultSet -prepareRead selectQuery countQuery countTotal mt binaryField = +prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> ResultAggregate -> Bool -> SQL.Statement () ResultSet +prepareRead selectQuery countQuery countTotal mt rAgg = SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt where snippet = @@ -107,30 +98,22 @@ prepareRead selectQuery countQuery countTotal mt binaryField = "SELECT " <> countResultF <> " AS total_result_set, " <> "pg_catalog.count(_postgrest_t) AS page_total, " <> - bodyF <> " AS body, " <> + aggF Nothing rAgg <> " AS body, " <> responseHeadersF <> " AS response_headers, " <> responseStatusF <> " AS response_status " <> "FROM ( SELECT * FROM " <> sourceCTE <> " ) _postgrest_t" (countCTEF, countResultF) = countF countQuery countTotal - bodyF - | getMediaType mt == MTTextCSV = asCsvF - | getMediaType mt == MTSingularJSON = asJsonSingleF Nothing - | getMediaType mt == MTGeoJSON = asGeoJsonF - | isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField - | isJust binaryField = asBinaryF $ fromJust binaryField - | otherwise = asJsonF Nothing - decodeIt :: HD.Result ResultSet decodeIt = case mt of MTPlan{} -> planRow _ -> HD.singleRow $ standardRow True prepareCall :: Routine -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool -> - MediaType -> Maybe FieldName -> Bool -> + MediaType -> ResultAggregate -> Bool -> SQL.Statement () ResultSet -prepareCall rout callProcQuery selectQuery countQuery countTotal mt binaryField = +prepareCall rout callProcQuery selectQuery countQuery countTotal mt rAgg = SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt where snippet = @@ -139,21 +122,13 @@ prepareCall rout callProcQuery selectQuery countQuery countTotal mt binaryField "SELECT " <> countResultF <> " AS total_result_set, " <> "pg_catalog.count(_postgrest_t) AS page_total, " <> - bodyF <> " AS body, " <> + aggF (Just rout) rAgg <> " AS body, " <> responseHeadersF <> " AS response_headers, " <> responseStatusF <> " AS response_status " <> "FROM (" <> selectQuery <> ") _postgrest_t" (countCTEF, countResultF) = countF countQuery countTotal - bodyF - | getMediaType mt == MTSingularJSON = asJsonSingleF $ Just rout - | getMediaType mt == MTTextCSV = asCsvF - | getMediaType mt == MTGeoJSON = asGeoJsonF - | isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField - | isJust binaryField = asBinaryF $ fromJust binaryField - | otherwise = asJsonF $ Just rout - decodeIt :: HD.Result ResultSet decodeIt = case mt of MTPlan{} -> planRow diff --git a/src/PostgREST/SchemaCache/Routine.hs b/src/PostgREST/SchemaCache/Routine.hs index 676c0fa6f8..c25fe47fd2 100644 --- a/src/PostgREST/SchemaCache/Routine.hs +++ b/src/PostgREST/SchemaCache/Routine.hs @@ -14,6 +14,7 @@ module PostgREST.SchemaCache.Routine , funcReturnsVoid , funcTableName , funcReturnsCompositeAlias + , ResultAggregate(..) ) where import Data.Aeson ((.=)) @@ -21,7 +22,8 @@ import qualified Data.Aeson as JSON import qualified Data.HashMap.Strict as HM import qualified Hasql.Transaction.Sessions as SQL -import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), +import PostgREST.SchemaCache.Identifiers (FieldName, + QualifiedIdentifier (..), Schema, TableName) import Protolude @@ -85,6 +87,16 @@ instance Ord Routine where -- | It uses a HashMap for a faster lookup. type RoutineMap = HM.HashMap QualifiedIdentifier [Routine] +data ResultAggregate + = BuiltinAggJson + | BuiltinAggSingleJson + | BuiltinAggGeoJson + | BuiltinAggCsv + | BuiltinAggXml (Maybe FieldName) + | BuiltinAggBinary (Maybe FieldName) + | NoAgg + deriving (Eq, Show) + funcReturnsScalar :: Routine -> Bool funcReturnsScalar proc = case proc of Function{pdReturnType = Single (Scalar{})} -> True From b494b83d27ae2cff934077c08f781613316bfe37 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Sat, 8 Jul 2023 00:17:23 -0500 Subject: [PATCH 2/2] fix: HEAD unnecessarily executing aggregates --- CHANGELOG.md | 1 + src/PostgREST/MediaType.hs | 6 ------ src/PostgREST/Plan.hs | 24 +++++++++++++++--------- 3 files changed, 16 insertions(+), 15 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e0a6cdced4..8527db80f9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -27,6 +27,7 @@ This project adheres to [Semantic Versioning](http://semver.org/). - #2821, Fix OPTIONS not accepting all available media types - @steve-chavez - #2834, Fix compilation on Ubuntu by being compatible with GHC 9.0.2 - @steve-chavez - #2840, Fix `Prefer: missing=default` with DOMAIN default values - @steve-chavez + - #2849, Fix HEAD unnecessarily executing aggregates - @steve-chavez ## [11.1.0] - 2023-06-07 diff --git a/src/PostgREST/MediaType.hs b/src/PostgREST/MediaType.hs index d5288c693b..7ae4566462 100644 --- a/src/PostgREST/MediaType.hs +++ b/src/PostgREST/MediaType.hs @@ -7,7 +7,6 @@ module PostgREST.MediaType , toContentType , toMime , decodeMediaType - , getMediaType ) where import qualified Data.ByteString as BS @@ -143,8 +142,3 @@ decodeMediaType mt = [PlanSettings | inOpts "settings"] ++ [PlanBuffers | inOpts "buffers" ] ++ [PlanWAL | inOpts "wal" ] - -getMediaType :: MediaType -> MediaType -getMediaType mt = case mt of - MTPlan mType _ _ -> mType - other -> other diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index 95fda7bca7..1bc05f7c59 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -112,14 +112,14 @@ wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest wrappedReadPlan identifier conf sCache apiRequest = do rPlan <- readPlan identifier conf sCache apiRequest binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) Nothing rPlan - return $ WrappedReadPlan rPlan SQL.Read $ mediaToAggregate (iAcceptMediaType apiRequest) binField Nothing + return $ WrappedReadPlan rPlan SQL.Read $ mediaToAggregate (iAcceptMediaType apiRequest) binField apiRequest mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error MutateReadPlan -mutateReadPlan mutation apiRequest@ApiRequest{iPreferences=Preferences{preferRepresentation}} identifier conf sCache = do +mutateReadPlan mutation apiRequest identifier conf sCache = do rPlan <- readPlan identifier conf sCache apiRequest binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) Nothing rPlan mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan - return $ MutateReadPlan rPlan mPlan SQL.Write $ mediaToAggregate (iAcceptMediaType apiRequest) binField (Just preferRepresentation) + return $ MutateReadPlan rPlan mPlan SQL.Write $ mediaToAggregate (iAcceptMediaType apiRequest) binField apiRequest callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan callReadPlan identifier conf sCache apiRequest invMethod = do @@ -144,7 +144,7 @@ callReadPlan identifier conf sCache apiRequest invMethod = do (InvPost, Routine.Volatile) -> SQL.Write cPlan = callPlan proc apiRequest paramKeys args rPlan binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) (Just proc) rPlan - return $ CallReadPlan rPlan cPlan txMode proc $ mediaToAggregate (iAcceptMediaType apiRequest) binField Nothing + return $ CallReadPlan rPlan cPlan txMode proc $ mediaToAggregate (iAcceptMediaType apiRequest) binField apiRequest where Preferences{..} = iPreferences apiRequest qsParams' = QueryParams.qsParams (iQueryParams apiRequest) @@ -839,10 +839,10 @@ binaryField AppConfig{configRawMediaTypes} acceptMediaType proc rpTree fstFieldName (Node ReadPlan{select=[(CoercibleField{cfName=fld, cfJsonPath=[]}, _, _)]} []) = Just fld fstFieldName _ = Nothing -mediaToAggregate :: MediaType -> Maybe FieldName -> Maybe PreferRepresentation -> ResultAggregate -mediaToAggregate mt binField rep = - if rep == Just HeadersOnly || rep == Just None - then NoAgg + +mediaToAggregate :: MediaType -> Maybe FieldName -> ApiRequest -> ResultAggregate +mediaToAggregate mt binField apiReq@ApiRequest{iAction=act, iPreferences=Preferences{preferRepresentation=rep}} = + if noAgg then NoAgg else case mt of MTApplicationJSON -> BuiltinAggJson MTSingularJSON -> BuiltinAggSingleJson @@ -861,4 +861,10 @@ mediaToAggregate mt binField rep = -- Doing `Accept: application/vnd.pgrst.plan; for="application/vnd.pgrst.plan"` doesn't make sense, so we just empty the body. -- TODO: fail instead to be more strict MTPlan (MTPlan{}) _ _ -> NoAgg - MTPlan media _ _ -> mediaToAggregate media binField rep + MTPlan media _ _ -> mediaToAggregate media binField apiReq + where + noAgg = case act of + ActionMutate _ -> rep == HeadersOnly || rep == None + ActionRead _isHead -> _isHead -- no need for an aggregate on HEAD https://github.com/PostgREST/postgrest/issues/2849 + ActionInvoke invMethod -> invMethod == InvHead + _ -> False