|
| 1 | +{-| |
| 2 | +Module : PostgREST.Plan.Negotiate |
| 3 | +Description : PostgREST Content Negotiation |
| 4 | +
|
| 5 | +This module contains logic for content negotiation. |
| 6 | +RFC: https://datatracker.ietf.org/doc/html/rfc7231#section-3.4 |
| 7 | +-} |
| 8 | + |
| 9 | +module PostgREST.Plan.Negotiate |
| 10 | + ( negotiateContent |
| 11 | + ) where |
| 12 | + |
| 13 | +import qualified Data.HashMap.Strict as HM |
| 14 | + |
| 15 | +import PostgREST.ApiRequest (ApiRequest (..)) |
| 16 | +import PostgREST.Config (AppConfig (..)) |
| 17 | +import PostgREST.Error (ApiRequestError (..)) |
| 18 | +import PostgREST.MediaType (MediaType (..)) |
| 19 | +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), |
| 20 | + RelIdentifier (..)) |
| 21 | +import PostgREST.SchemaCache.Routine (MediaHandler (..), |
| 22 | + MediaHandlerMap, |
| 23 | + ResolvedHandler) |
| 24 | + |
| 25 | +import PostgREST.ApiRequest.Preferences |
| 26 | +import PostgREST.ApiRequest.Types |
| 27 | +import qualified PostgREST.MediaType as MediaType |
| 28 | + |
| 29 | +import Protolude hiding (from) |
| 30 | + |
| 31 | +-- We have two general cases of return values from database objects |
| 32 | +-- (tables/views/functions): |
| 33 | +-- |
| 34 | +-- 1. "un-mime-typed" values, in most of the cases this is a composite/row |
| 35 | +-- value, for example for tables or views, but also often for functions. |
| 36 | +-- It can be simple integer values or text or bytea as well. |
| 37 | +-- |
| 38 | +-- For this, we need handlers to transform the "non-mime-typed" values |
| 39 | +-- into "mimetypes". We have a default builtin handler that does |
| 40 | +-- "application/json". We can add more handlers via aggregates. |
| 41 | +-- |
| 42 | +-- 2. "mime-typed" values, which specifically return a domain type that is |
| 43 | +-- associated to a certain mimetype. e.g, a function returning only |
| 44 | +-- "image/png". |
| 45 | +-- |
| 46 | +-- FIXME: |
| 47 | +-- If the function returns a domain type - let's say image/png, we should |
| 48 | +-- accept */*, image/*, and image/png. |
| 49 | +-- Related issue: https://github.com/PostgREST/postgrest/issues/3391 |
| 50 | + |
| 51 | +-- | Do content negotiation. i.e. choose a media type based on the |
| 52 | +-- intersection of accepted/produced media types. |
| 53 | +negotiateContent :: AppConfig -> ApiRequest -> QualifiedIdentifier -> [MediaType] -> MediaHandlerMap -> Bool -> Either ApiRequestError ResolvedHandler |
| 54 | +negotiateContent conf ApiRequest{iAction=act, iPreferences=Preferences{preferRepresentation=rep}} identifier accepts produces defaultSelect = |
| 55 | + case (act, firstAcceptedPick) of |
| 56 | + (_, Nothing) -> Left . MediaTypeError $ map MediaType.toMime accepts |
| 57 | + (ActDb (ActRelationMut _ _), Just (x, mt)) -> Right (if rep == Just Full then x else NoAgg, mt) |
| 58 | + -- no need for an aggregate on HEAD https://github.com/PostgREST/postgrest/issues/2849 |
| 59 | + -- TODO: despite no aggregate, these are responding with a Content-Type, which is not correct. |
| 60 | + (ActDb (ActRelationRead _ True), Just (_, mt)) -> Right (NoAgg, mt) |
| 61 | + (ActDb (ActRoutine _ (InvRead True)), Just (_, mt)) -> Right (NoAgg, mt) |
| 62 | + (_, Just (x, mt)) -> Right (x, mt) |
| 63 | + where |
| 64 | + firstAcceptedPick = listToMaybe $ mapMaybe matchMT accepts -- If there are multiple accepted media types, pick the first. This is usual in content negotiation. |
| 65 | + matchMT mt = case mt of |
| 66 | + -- all the vendored media types have special handling as they have media type parameters, they cannot be overridden |
| 67 | + m@(MTVndSingularJSON strip) -> Just (BuiltinAggSingleJson strip, m) |
| 68 | + m@MTVndArrayJSONStrip -> Just (BuiltinAggArrayJsonStrip, m) |
| 69 | + m@(MTVndPlan (MTVndSingularJSON strip) _ _) -> mtPlanToNothing $ Just (BuiltinAggSingleJson strip, m) |
| 70 | + m@(MTVndPlan MTVndArrayJSONStrip _ _) -> mtPlanToNothing $ Just (BuiltinAggArrayJsonStrip, m) |
| 71 | + -- TODO the plan should have its own MediaHandler instead of relying on MediaType |
| 72 | + m@(MTVndPlan mType _ _) -> mtPlanToNothing $ ((,) . fst <$> lookupHandler mType) <*> pure m |
| 73 | + -- all the other media types can be overridden |
| 74 | + x -> lookupHandler x |
| 75 | + mtPlanToNothing x = if configDbPlanEnabled conf then x else Nothing -- don't find anything if the plan media type is not allowed |
| 76 | + lookupHandler mt = |
| 77 | + when' defaultSelect (HM.lookup (RelId identifier, MTAny) produces) <|> -- lookup for identifier and `*/*` |
| 78 | + when' defaultSelect (HM.lookup (RelId identifier, mt) produces) <|> -- lookup for identifier and a particular media type |
| 79 | + HM.lookup (RelAnyElement, mt) produces -- lookup for anyelement and a particular media type |
| 80 | + when' :: Bool -> Maybe a -> Maybe a |
| 81 | + when' True (Just a) = Just a |
| 82 | + when' _ _ = Nothing |
0 commit comments