Skip to content

Commit

Permalink
feat: custom media types for Accept
Browse files Browse the repository at this point in the history 
* test text/html and drop HtmlRawOutputSpec.hs
* all tests passing, removed all pendingWith
* make functions compatible with pg <= 12
* move custom media types tests to own spec
* anyelement aggregate
* apply aggregates without a final function
* overriding works
* overriding anyelement with particular agg
* cannot override vendored media types
* plan spec works with custom aggregate
* renamed media types to make clear which ones are overridable
* correct content negotiation with same weight
* text/tab-separated-values media type
* text/csv with BOM plus content-disposition header
  • Loading branch information
@steve-chavez
steve-chavez committed Oct 25, 2023
1 parent e7df9d1 commit 7ce199c
Show file tree
Hide file tree
Showing 26 changed files with 791 additions and 375 deletions.
2 changes: 1 addition & 1 deletion postgrest.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -204,11 +204,11 @@ test-suite spec
Feature.OptionsSpec
Feature.Query.AndOrParamsSpec
Feature.Query.ComputedRelsSpec
Feature.Query.CustomMediaSpec
Feature.Query.DeleteSpec
Feature.Query.EmbedDisambiguationSpec
Feature.Query.EmbedInnerJoinSpec
Feature.Query.ErrorSpec
Feature.Query.HtmlRawOutputSpec
Feature.Query.InsertSpec
Feature.Query.JsonOperatorSpec
Feature.Query.MultipleSchemaSpec
Expand Down
2 changes: 1 addition & 1 deletion src/PostgREST/App.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -220,7 +220,7 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A
return $ pgrstResponse metrics pgrst

(ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
(planTime', iPlan) <- withTiming $ liftEither $ Plan.inspectPlan conf apiReq
(planTime', iPlan) <- withTiming $ liftEither $ Plan.inspectPlan apiReq
(rsTime', oaiResult) <- withTiming $ runQuery roleIsoLvl (Plan.ipTxmode iPlan) $ Query.openApiQuery sCache pgVer conf tSchema
(renderTime', pgrst) <- withTiming $ liftEither $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile
let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime]
Expand Down
2 changes: 1 addition & 1 deletion src/PostgREST/Error.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -91,7 +91,7 @@ instance PgrstError ApiRequestError where
status SingularityError{} = HTTP.status406
status PGRSTParseError = HTTP.status500

headers SingularityError{} = [MediaType.toContentType $ MTSingularJSON False]
headers SingularityError{} = [MediaType.toContentType $ MTVndSingularJSON False]
headers _ = mempty

toJsonPgrstError :: ErrorCode -> Text -> Maybe JSON.Value -> Maybe JSON.Value -> JSON.Value
Expand Down
74 changes: 32 additions & 42 deletions src/PostgREST/MediaType.hs
View file
Original file line number Diff line number Diff line change
@@ -1,9 +1,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}

module PostgREST.MediaType
( MediaType(..)
, MTPlanOption (..)
, MTPlanFormat (..)
, MTVndPlanOption (..)
, MTVndPlanFormat (..)
, toContentType
, toMime
, decodeMediaType
Expand All @@ -19,8 +20,6 @@ import Protolude
-- | Enumeration of currently supported media types
data MediaType
= MTApplicationJSON
| MTArrayJSONStrip
| MTSingularJSON Bool
| MTGeoJSON
| MTTextCSV
| MTTextPlain
Expand All @@ -30,32 +29,23 @@ 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
MTApplicationJSON == MTApplicationJSON = True
MTArrayJSONStrip == MTArrayJSONStrip = True
MTSingularJSON x == MTSingularJSON y = x == y
MTGeoJSON == MTGeoJSON = True
MTTextCSV == MTTextCSV = True
MTTextPlain == MTTextPlain = True
MTTextXML == MTTextXML = True
MTOpenAPI == MTOpenAPI = True
MTUrlEncoded == MTUrlEncoded = True
MTOctetStream == MTOctetStream = True
MTAny == MTAny = True
MTOther x == MTOther y = x == y
MTPlan{} == MTPlan{} = True
_ == _ = False
-- vendored media types
| MTVndArrayJSONStrip
| MTVndSingularJSON Bool
-- TODO MTVndPlan should only have its options as [Text]. Its ResultAggregate should have the typed attributes.
| MTVndPlan MediaType MTVndPlanFormat [MTVndPlanOption]
deriving (Eq, Show, Generic)
instance Hashable MediaType

data MTPlanOption
data MTVndPlanOption
= PlanAnalyze | PlanVerbose | PlanSettings | PlanBuffers | PlanWAL
deriving (Eq, Show)
deriving (Eq, Show, Generic)

Check warning on line 42 in src/PostgREST/MediaType.hs

View check run for this annotation

Codecov / codecov/patch

src/PostgREST/MediaType.hs#L42 

Added line #L42 was not covered by tests
instance Hashable MTVndPlanOption

data MTPlanFormat
data MTVndPlanFormat
= PlanJSON | PlanText
deriving (Eq, Show)
deriving (Eq, Show, Generic)

Check warning on line 47 in src/PostgREST/MediaType.hs

View check run for this annotation

Codecov / codecov/patch

src/PostgREST/MediaType.hs#L47 

Added line #L47 was not covered by tests
instance Hashable MTVndPlanFormat

-- | Convert MediaType to a Content-Type HTTP Header
toContentType :: MediaType -> Header
Expand All @@ -69,31 +59,31 @@ toContentType ct = (hContentType, toMime ct <> charset)
-- | Convert from MediaType to a ByteString representing the mime type
toMime :: MediaType -> ByteString
toMime MTApplicationJSON = "application/json"
toMime MTArrayJSONStrip = "application/vnd.pgrst.array+json;nulls=stripped"
toMime MTVndArrayJSONStrip = "application/vnd.pgrst.array+json;nulls=stripped"
toMime MTGeoJSON = "application/geo+json"
toMime MTTextCSV = "text/csv"
toMime MTTextPlain = "text/plain"
toMime MTTextXML = "text/xml"
toMime MTOpenAPI = "application/openapi+json"
toMime (MTSingularJSON True) = "application/vnd.pgrst.object+json;nulls=stripped"
toMime (MTSingularJSON False) = "application/vnd.pgrst.object+json"
toMime (MTVndSingularJSON True) = "application/vnd.pgrst.object+json;nulls=stripped"
toMime (MTVndSingularJSON False) = "application/vnd.pgrst.object+json"
toMime MTUrlEncoded = "application/x-www-form-urlencoded"
toMime MTOctetStream = "application/octet-stream"
toMime MTAny = "*/*"
toMime (MTOther ct) = ct
toMime (MTPlan mt fmt opts) =
toMime (MTVndPlan mt fmt opts) =
"application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
("; for=\"" <> toMime mt <> "\"") <>
(if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts))

toMimePlanOption :: MTPlanOption -> ByteString
toMimePlanOption :: MTVndPlanOption -> ByteString
toMimePlanOption PlanAnalyze = "analyze"
toMimePlanOption PlanVerbose = "verbose"
toMimePlanOption PlanSettings = "settings"
toMimePlanOption PlanBuffers = "buffers"
toMimePlanOption PlanWAL = "wal"

toMimePlanFormat :: MTPlanFormat -> ByteString
toMimePlanFormat :: MTVndPlanFormat -> ByteString
toMimePlanFormat PlanJSON = "json"
toMimePlanFormat PlanText = "text"

Expand All @@ -103,25 +93,25 @@ toMimePlanFormat PlanText = "text"
-- MTApplicationJSON
--
-- >>> decodeMediaType "application/vnd.pgrst.plan;"
-- MTPlan MTApplicationJSON PlanText []
-- MTVndPlan MTApplicationJSON PlanText []
--
-- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"application/json\""
-- MTPlan MTApplicationJSON PlanText []
-- MTVndPlan MTApplicationJSON PlanText []
--
-- >>> decodeMediaType "application/vnd.pgrst.plan+json;for=\"text/csv\""
-- MTPlan MTTextCSV PlanJSON []
-- MTVndPlan MTTextCSV PlanJSON []
--
-- >>> decodeMediaType "application/vnd.pgrst.array+json;nulls=stripped"
-- MTArrayJSONStrip
-- MTVndArrayJSONStrip
--
-- >>> decodeMediaType "application/vnd.pgrst.array+json"
-- MTApplicationJSON
--
-- >>> decodeMediaType "application/vnd.pgrst.object+json;nulls=stripped"
-- MTSingularJSON True
-- MTVndSingularJSON True
--
-- >>> decodeMediaType "application/vnd.pgrst.object+json"
-- MTSingularJSON False
-- MTVndSingularJSON False

decodeMediaType :: BS.ByteString -> MediaType
decodeMediaType mt =
Expand All @@ -145,11 +135,11 @@ decodeMediaType mt =
other:_ -> MTOther other
_ -> MTAny
where
checkArrayNullStrip ["nulls=stripped"] = MTArrayJSONStrip
checkArrayNullStrip ["nulls=stripped"] = MTVndArrayJSONStrip
checkArrayNullStrip _ = MTApplicationJSON

checkSingularNullStrip ["nulls=stripped"] = MTSingularJSON True
checkSingularNullStrip _ = MTSingularJSON False
checkSingularNullStrip ["nulls=stripped"] = MTVndSingularJSON True
checkSingularNullStrip _ = MTVndSingularJSON False

getPlan fmt rest =
let
Expand All @@ -161,7 +151,7 @@ decodeMediaType mt =
strippedFor <- BS.stripPrefix "for=" foundFor
pure . decodeMediaType $ dropAround (== BS.c2w '"') strippedFor
in
MTPlan mtFor fmt $
MTVndPlan mtFor fmt $
[PlanAnalyze | inOpts "analyze" ] ++
[PlanVerbose | inOpts "verbose" ] ++
[PlanSettings | inOpts "settings"] ++
Expand Down
111 changes: 50 additions & 61 deletions src/PostgREST/Plan.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,15 +44,15 @@ import PostgREST.ApiRequest (Action (..),
Payload (..))
import PostgREST.Config (AppConfig (..))
import PostgREST.Error (Error (..))
import PostgREST.MediaType (MTPlanFormat (..),
MediaType (..))
import PostgREST.MediaType (MediaType (..))
import PostgREST.Query.SqlFragment (sourceCTEName)
import PostgREST.RangeQuery (NonnegRange, allRange,
convertToLimitZeroRange,
restrictRange)
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier (..),
RelIdentifier (..),
Schema)
import PostgREST.SchemaCache.Relationship (Cardinality (..),
Junction (..),
Expand All @@ -61,7 +61,7 @@ import PostgREST.SchemaCache.Relationship (Cardinality (..),
relIsToOne)
import PostgREST.SchemaCache.Representations (DataRepresentation (..),
RepresentationsMap)
import PostgREST.SchemaCache.Routine (ResultAggregate (..),
import PostgREST.SchemaCache.Routine (MediaHandler (..),
Routine (..),
RoutineMap,
RoutineParam (..),
Expand Down Expand Up @@ -93,25 +93,28 @@ import Protolude hiding (from)
data WrappedReadPlan = WrappedReadPlan {
wrReadPlan :: ReadPlanTree
, wrTxMode :: SQL.Mode
, wrResAgg :: ResultAggregate
, wrHandler :: MediaHandler

Check warning on line 96 in src/PostgREST/Plan.hs

View check run for this annotation

Codecov / codecov/patch

src/PostgREST/Plan.hs#L96 

Added line #L96 was not covered by tests
, wrMedia :: MediaType
, wrIdent :: QualifiedIdentifier

Check warning on line 98 in src/PostgREST/Plan.hs

View check run for this annotation

Codecov / codecov/patch

src/PostgREST/Plan.hs#L98 

Added line #L98 was not covered by tests
}

data MutateReadPlan = MutateReadPlan {
mrReadPlan :: ReadPlanTree
, mrMutatePlan :: MutatePlan
, mrTxMode :: SQL.Mode
, mrResAgg :: ResultAggregate
, mrHandler :: MediaHandler

Check warning on line 105 in src/PostgREST/Plan.hs

View check run for this annotation

Codecov / codecov/patch

src/PostgREST/Plan.hs#L105 

Added line #L105 was not covered by tests
, mrMedia :: MediaType
, mrIdent :: QualifiedIdentifier

Check warning on line 107 in src/PostgREST/Plan.hs

View check run for this annotation

Codecov / codecov/patch

src/PostgREST/Plan.hs#L107 

Added line #L107 was not covered by tests
}

data CallReadPlan = CallReadPlan {
crReadPlan :: ReadPlanTree
, crCallPlan :: CallPlan
, crTxMode :: SQL.Mode
, crProc :: Routine
, crResAgg :: ResultAggregate
, crHandler :: MediaHandler

Check warning on line 115 in src/PostgREST/Plan.hs

View check run for this annotation

Codecov / codecov/patch

src/PostgREST/Plan.hs#L115 

Added line #L115 was not covered by tests
, crMedia :: MediaType
, crIdent :: QualifiedIdentifier

Check warning on line 117 in src/PostgREST/Plan.hs

View check run for this annotation

Codecov / codecov/patch

src/PostgREST/Plan.hs#L117 

Added line #L117 was not covered by tests
}

data InspectPlan = InspectPlan {
Expand All @@ -122,17 +125,17 @@ data InspectPlan = InspectPlan {
wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error WrappedReadPlan
wrappedReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} = do
rPlan <- readPlan identifier conf sCache apiRequest
mediaType <- mapLeft ApiRequestError $ negotiateContent conf iAction iAcceptMediaType
(hdler, mediaType) <- mapLeft ApiRequestError $ negotiateContent conf apiRequest identifier iAcceptMediaType (dbMediaHandlers sCache)
if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestError $ InvalidPreferences invalidPrefs else Right ()
return $ WrappedReadPlan rPlan SQL.Read (mediaToAggregate mediaType apiRequest) mediaType
return $ WrappedReadPlan rPlan SQL.Read hdler mediaType identifier

mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error MutateReadPlan
mutateReadPlan mutation apiRequest@ApiRequest{iPreferences=Preferences{..},..} identifier conf sCache = do
rPlan <- readPlan identifier conf sCache apiRequest
mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan
mediaType <- mapLeft ApiRequestError $ negotiateContent conf iAction iAcceptMediaType
if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestError $ InvalidPreferences invalidPrefs else Right ()
return $ MutateReadPlan rPlan mPlan SQL.Write (mediaToAggregate mediaType apiRequest) mediaType
(hdler, mediaType) <- mapLeft ApiRequestError $ negotiateContent conf apiRequest identifier iAcceptMediaType (dbMediaHandlers sCache)
return $ MutateReadPlan rPlan mPlan SQL.Write hdler mediaType identifier

callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan
callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} invMethod = do
Expand All @@ -156,15 +159,19 @@ callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferenc
(InvPost, Routine.Immutable) -> SQL.Read
(InvPost, Routine.Volatile) -> SQL.Write
cPlan = callPlan proc apiRequest paramKeys args rPlan
mediaType <- mapLeft ApiRequestError $ negotiateContent conf iAction iAcceptMediaType
(hdler, mediaType) <- mapLeft ApiRequestError $ negotiateContent conf apiRequest relIdentifier iAcceptMediaType (dbMediaHandlers sCache)
if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestError $ InvalidPreferences invalidPrefs else Right ()
return $ CallReadPlan rPlan cPlan txMode proc (mediaToAggregate mediaType apiRequest) mediaType
return $ CallReadPlan rPlan cPlan txMode proc hdler mediaType relIdentifier
where
qsParams' = QueryParams.qsParams iQueryParams

inspectPlan :: AppConfig -> ApiRequest -> Either Error InspectPlan
inspectPlan conf apiRequest = do
mediaType <- mapLeft ApiRequestError $ negotiateContent conf (iAction apiRequest) (iAcceptMediaType apiRequest)
inspectPlan :: ApiRequest -> Either Error InspectPlan
inspectPlan apiRequest = do
let producedMTs = [MTOpenAPI, MTApplicationJSON, MTAny]
accepts = iAcceptMediaType apiRequest
mediaType <- if not . null $ L.intersect accepts producedMTs
then Right MTOpenAPI
else Left . ApiRequestError . MediaTypeError $ MediaType.toMime <$> accepts
return $ InspectPlan mediaType SQL.Read

{-|
Expand Down Expand Up @@ -824,52 +831,34 @@ inferColsEmbedNeeds (Node ReadPlan{select} forest) pkCols
addFilterToLogicForest :: CoercibleFilter -> [CoercibleLogicTree] -> [CoercibleLogicTree]
addFilterToLogicForest flt lf = CoercibleStmnt flt : lf

mediaToAggregate :: MediaType -> ApiRequest -> ResultAggregate
mediaToAggregate mt apiReq@ApiRequest{iAction=act, iPreferences=Preferences{preferRepresentation=rep}} =
if noAgg then NoAgg
else case mt of
MTApplicationJSON -> BuiltinAggJson
MTSingularJSON strip -> BuiltinAggSingleJson strip
MTArrayJSONStrip -> BuiltinAggArrayJsonStrip
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.

-- 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 apiReq
_ -> NoAgg
where
noAgg = case act of
ActionMutate _ -> rep == Just HeadersOnly || rep == Just None || isNothing rep
ActionRead _isHead -> _isHead -- no need for an aggregate on HEAD https://github.com/PostgREST/postgrest/issues/2849
ActionInvoke invMethod -> invMethod == InvHead
_ -> False

-- | Do content negotiation. i.e. choose a media type based on the intersection of accepted/produced media types.
negotiateContent :: AppConfig -> Action -> [MediaType] -> Either ApiRequestError MediaType
negotiateContent conf action accepts =
case firstAcceptedPick of
Just MTAny -> Right MTApplicationJSON -- by default(for */*) we respond with json
Just mt -> Right mt
Nothing -> Left . MediaTypeError $ map MediaType.toMime accepts
negotiateContent :: AppConfig -> ApiRequest -> QualifiedIdentifier -> [MediaType] ->
HM.HashMap (RelIdentifier, MediaType) MediaHandler -> Either ApiRequestError (MediaHandler, MediaType)
negotiateContent conf ApiRequest{iAction=act, iPreferences=Preferences{preferRepresentation=rep}} identifier accepts produces =
mtAnyToJSON $ case (act, firstAcceptedPick) of
(_, Nothing) -> Left . MediaTypeError $ map MediaType.toMime accepts
(ActionMutate _, 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.
(ActionRead True, Just (_, mt)) -> Right (NoAgg, mt)
(ActionInvoke InvHead, Just (_, mt)) -> Right (NoAgg, mt)
(_, Just (x, mt)) -> Right (x, mt)
where
-- TODO initial */* is not overridable
-- initial handlers in the schema cache have a */* to BuiltinAggJson but they don't preserve the media type (application/json)
-- for now we just convert the resultant */* to application/json here
mtAnyToJSON = mapRight (\(x, y) -> (x, if y == MTAny then MTApplicationJSON else y))
-- if there are multiple accepted media types, pick the first
firstAcceptedPick = listToMaybe $ L.intersect accepts $ producedMediaTypes conf action

producedMediaTypes :: AppConfig -> Action -> [MediaType]
producedMediaTypes conf action =
case action of
ActionRead _ -> defaultMediaTypes
ActionInvoke _ -> defaultMediaTypes
ActionInfo -> defaultMediaTypes
ActionMutate _ -> defaultMediaTypes
ActionInspect _ -> inspectMediaTypes
where
inspectMediaTypes = [MTOpenAPI, MTApplicationJSON, MTArrayJSONStrip, MTAny]
defaultMediaTypes =
[MTApplicationJSON, MTArrayJSONStrip, MTSingularJSON True, MTSingularJSON False, MTGeoJSON, MTTextCSV] ++
[MTPlan MTApplicationJSON PlanText mempty | configDbPlanEnabled conf] ++ [MTAny]
firstAcceptedPick = listToMaybe $ mapMaybe searchMT accepts
lookupIdent mt = -- first search for an aggregate that applies to the particular relation, then for one that applies to anyelement
HM.lookup (RelId identifier, mt) produces <|> HM.lookup (RelAnyElement, mt) produces
searchMT 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)

Check warning on line 860 in src/PostgREST/Plan.hs

View check run for this annotation

Codecov / codecov/patch

src/PostgREST/Plan.hs#L860 

Added line #L860 was not covered by tests
-- all the other media types can be overridden
m@(MTVndPlan mType _ _) -> mtPlanToNothing $ (,) <$> lookupIdent mType <*> pure m
x -> (,) <$> lookupIdent x <*> pure x
mtPlanToNothing x = if configDbPlanEnabled conf then x else Nothing -- don't find anything if the plan media type is not allowed
Loading

0 comments on commit 7ce199c

Please sign in to comment.