diff --git a/postgrest.cabal b/postgrest.cabal index 233db51c7..090855431 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -81,6 +81,7 @@ library PostgREST.Plan PostgREST.Plan.CallPlan PostgREST.Plan.MutatePlan + PostgREST.Plan.Negotiate PostgREST.Plan.ReadPlan PostgREST.Plan.Types PostgREST.RangeQuery diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index 73836b264..e5e588991 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -43,6 +43,7 @@ import PostgREST.Error (ApiRequestError (..), Error (..), SchemaCacheError (..)) import PostgREST.MediaType (MediaType (..)) +import PostgREST.Plan.Negotiate (negotiateContent) import PostgREST.Query.SqlFragment (sourceCTEName) import PostgREST.RangeQuery (NonnegRange, allRange, convertToLimitZeroRange, @@ -50,7 +51,6 @@ import PostgREST.RangeQuery (NonnegRange, allRange, import PostgREST.SchemaCache (SchemaCache (..)) import PostgREST.SchemaCache.Identifiers (FieldName, QualifiedIdentifier (..), - RelIdentifier (..), Schema) import PostgREST.SchemaCache.Relationship (Cardinality (..), Junction (..), @@ -60,8 +60,6 @@ import PostgREST.SchemaCache.Relationship (Cardinality (..), import PostgREST.SchemaCache.Representations (DataRepresentation (..), RepresentationsMap) import PostgREST.SchemaCache.Routine (MediaHandler (..), - MediaHandlerMap, - ResolvedHandler, Routine (..), RoutineMap, RoutineParam (..), @@ -1116,35 +1114,3 @@ inferColsEmbedNeeds (Node ReadPlan{select} forest) pkCols -- they are later concatenated with AND in the QueryBuilder addFilterToLogicForest :: CoercibleFilter -> [CoercibleLogicTree] -> [CoercibleLogicTree] addFilterToLogicForest flt lf = CoercibleStmnt flt : lf - --- | Do content negotiation. i.e. choose a media type based on the intersection of accepted/produced media types. -negotiateContent :: AppConfig -> ApiRequest -> QualifiedIdentifier -> [MediaType] -> MediaHandlerMap -> Bool -> Either ApiRequestError ResolvedHandler -negotiateContent conf ApiRequest{iAction=act, iPreferences=Preferences{preferRepresentation=rep}} identifier accepts produces defaultSelect = - case (act, firstAcceptedPick) of - (_, Nothing) -> Left . MediaTypeError $ map MediaType.toMime accepts - (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. - (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. - matchMT mt = case mt of - -- all the vendored media types have special handling as they have media type parameters, they cannot be overridden - m@(MTVndSingularJSON strip) -> Just (BuiltinAggSingleJson strip, m) - m@MTVndArrayJSONStrip -> Just (BuiltinAggArrayJsonStrip, m) - m@(MTVndPlan (MTVndSingularJSON strip) _ _) -> mtPlanToNothing $ Just (BuiltinAggSingleJson strip, m) - m@(MTVndPlan MTVndArrayJSONStrip _ _) -> mtPlanToNothing $ Just (BuiltinAggArrayJsonStrip, m) - -- TODO the plan should have its own MediaHandler instead of relying on MediaType - m@(MTVndPlan mType _ _) -> mtPlanToNothing $ ((,) . fst <$> lookupHandler mType) <*> pure m - -- all the other media types can be overridden - x -> lookupHandler x - mtPlanToNothing x = if configDbPlanEnabled conf then x else Nothing -- don't find anything if the plan media type is not allowed - lookupHandler mt = - when' defaultSelect (HM.lookup (RelId identifier, MTAny) produces) <|> -- lookup for identifier and `*/*` - when' defaultSelect (HM.lookup (RelId identifier, mt) produces) <|> -- lookup for identifier and a particular media type - HM.lookup (RelAnyElement, mt) produces -- lookup for anyelement and a particular media type - when' :: Bool -> Maybe a -> Maybe a - when' True (Just a) = Just a - when' _ _ = Nothing diff --git a/src/PostgREST/Plan/Negotiate.hs b/src/PostgREST/Plan/Negotiate.hs new file mode 100644 index 000000000..3224b4c74 --- /dev/null +++ b/src/PostgREST/Plan/Negotiate.hs @@ -0,0 +1,82 @@ +{-| +Module : PostgREST.Plan.Negotiate +Description : PostgREST Content Negotiation + +This module contains logic for content negotiation. +RFC: https://datatracker.ietf.org/doc/html/rfc7231#section-3.4 +-} + +module PostgREST.Plan.Negotiate + ( negotiateContent + ) where + +import qualified Data.HashMap.Strict as HM + +import PostgREST.ApiRequest (ApiRequest (..)) +import PostgREST.Config (AppConfig (..)) +import PostgREST.Error (ApiRequestError (..)) +import PostgREST.MediaType (MediaType (..)) +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), + RelIdentifier (..)) +import PostgREST.SchemaCache.Routine (MediaHandler (..), + MediaHandlerMap, + ResolvedHandler) + +import PostgREST.ApiRequest.Preferences +import PostgREST.ApiRequest.Types +import qualified PostgREST.MediaType as MediaType + +import Protolude hiding (from) + +-- We have two general cases of return values from database objects +-- (tables/views/functions): +-- +-- 1. "un-mime-typed" values, in most of the cases this is a composite/row +-- value, for example for tables or views, but also often for functions. +-- It can be simple integer values or text or bytea as well. +-- +-- For this, we need handlers to transform the "non-mime-typed" values +-- into "mimetypes". We have a default builtin handler that does +-- "application/json". We can add more handlers via aggregates. +-- +-- 2. "mime-typed" values, which specifically return a domain type that is +-- associated to a certain mimetype. e.g, a function returning only +-- "image/png". +-- +-- FIXME: +-- If the function returns a domain type - let's say image/png, we should +-- accept */*, image/*, and image/png. +-- Related issue: https://github.com/PostgREST/postgrest/issues/3391 + +-- | Do content negotiation. i.e. choose a media type based on the +-- intersection of accepted/produced media types. +negotiateContent :: AppConfig -> ApiRequest -> QualifiedIdentifier -> [MediaType] -> MediaHandlerMap -> Bool -> Either ApiRequestError ResolvedHandler +negotiateContent conf ApiRequest{iAction=act, iPreferences=Preferences{preferRepresentation=rep}} identifier accepts produces defaultSelect = + case (act, firstAcceptedPick) of + (_, Nothing) -> Left . MediaTypeError $ map MediaType.toMime accepts + (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. + (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. + matchMT mt = case mt of + -- all the vendored media types have special handling as they have media type parameters, they cannot be overridden + m@(MTVndSingularJSON strip) -> Just (BuiltinAggSingleJson strip, m) + m@MTVndArrayJSONStrip -> Just (BuiltinAggArrayJsonStrip, m) + m@(MTVndPlan (MTVndSingularJSON strip) _ _) -> mtPlanToNothing $ Just (BuiltinAggSingleJson strip, m) + m@(MTVndPlan MTVndArrayJSONStrip _ _) -> mtPlanToNothing $ Just (BuiltinAggArrayJsonStrip, m) + -- TODO the plan should have its own MediaHandler instead of relying on MediaType + m@(MTVndPlan mType _ _) -> mtPlanToNothing $ ((,) . fst <$> lookupHandler mType) <*> pure m + -- all the other media types can be overridden + x -> lookupHandler x + mtPlanToNothing x = if configDbPlanEnabled conf then x else Nothing -- don't find anything if the plan media type is not allowed + lookupHandler mt = + when' defaultSelect (HM.lookup (RelId identifier, MTAny) produces) <|> -- lookup for identifier and `*/*` + when' defaultSelect (HM.lookup (RelId identifier, mt) produces) <|> -- lookup for identifier and a particular media type + HM.lookup (RelAnyElement, mt) produces -- lookup for anyelement and a particular media type + when' :: Bool -> Maybe a -> Maybe a + when' True (Just a) = Just a + when' _ _ = Nothing