Skip to content

Commit

Permalink
Revert "refactor: plan media type"
Browse files Browse the repository at this point in the history 
This reverts commit 3cd3a3f.
  • Loading branch information
@steve-chavez
steve-chavez committed Jun 18, 2023
1 parent 3cd3a3f commit 77cd938
Show file tree
Hide file tree
Showing 11 changed files with 100 additions and 157 deletions.
35 changes: 17 additions & 18 deletions src/PostgREST/ApiRequest.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,8 +53,7 @@ import PostgREST.Config (AppConfig (..),
OpenAPIMode (..))
import PostgREST.MediaType (MTPlanAttrs (..),
MTPlanFormat (..),
MediaType (..),
NormalMedia (..))
MediaType (..))
import PostgREST.RangeQuery (NonnegRange, allRange,
convertToLimitZeroRange,
hasLimitZero,
Expand Down Expand Up @@ -211,8 +210,8 @@ getMediaTypes conf hdrs action path = do
acceptMediaType <- negotiateContent conf action path accepts
pure (acceptMediaType, contentMediaType)
where
accepts = maybe [MTNormal MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
contentMediaType = maybe (MTNormal MTApplicationJSON) MediaType.decodeMediaType $ lookupHeader "content-type"
accepts = maybe [MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type"
lookupHeader = flip lookup hdrs

getSchema :: AppConfig -> RequestHeaders -> ByteString -> Either ApiRequestError (Schema, Bool)
Expand Down Expand Up @@ -265,26 +264,26 @@ getPayload reqBody contentMediaType QueryParams{qsColumns} action PathInfo{pathI
where
payload :: Either ApiRequestError (Maybe Payload)
payload = mapBoth InvalidBody Just $ case (contentMediaType, pathIsProc) of
(MTNormal MTApplicationJSON, _) ->
(MTApplicationJSON, _) ->
if isJust columns
then Right $ RawJSON reqBody
else note "All object keys must match" . payloadAttributes reqBody
=<< if LBS.null reqBody && pathIsProc
then Right emptyObject
else first BS.pack $ JSON.eitherDecode reqBody
(MTNormal MTTextCSV, _) -> do
(MTTextCSV, _) -> do
json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
(MTNormal MTUrlEncoded, isProc) -> do
(MTUrlEncoded, isProc) -> do
let params = (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
if isProc
then Right $ ProcessedUrlEncoded params (S.fromList $ fst <$> params)
else
let paramsMap = HM.fromList $ (identity *** JSON.String) <$> params in
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (HM.keys paramsMap)
(MTNormal MTTextPlain, True) -> Right $ RawPay reqBody
(MTNormal MTTextXML, True) -> Right $ RawPay reqBody
(MTNormal MTOctetStream, True) -> Right $ RawPay reqBody
(MTTextPlain, True) -> Right $ RawPay reqBody
(MTTextXML, True) -> Right $ RawPay reqBody
(MTOctetStream, True) -> Right $ RawPay reqBody
(ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct

shouldParsePayload = case (action, contentMediaType) of
Expand Down Expand Up @@ -354,9 +353,9 @@ payloadAttributes raw json =
negotiateContent :: AppConfig -> Action -> PathInfo -> [MediaType] -> Either ApiRequestError MediaType
negotiateContent conf action path accepts =
case firstAcceptedPick of
Just (MTNormal MTAny) -> Right (MTNormal MTApplicationJSON) -- by default(for */*) we respond with json
Just mt -> Right mt
Nothing -> Left . MediaTypeError $ map MediaType.toMime accepts
Just MTAny -> Right MTApplicationJSON -- by default(for */*) we respond with json
Just mt -> Right mt
Nothing -> Left . MediaTypeError $ map MediaType.toMime accepts
where
-- if there are multiple accepted media types, pick the first
firstAcceptedPick = listToMaybe $ L.intersect accepts $ producedMediaTypes conf action path
Expand All @@ -366,15 +365,15 @@ producedMediaTypes conf action path =
case action of
ActionRead _ -> defaultMediaTypes ++ rawMediaTypes
ActionInvoke _ -> invokeMediaTypes
ActionInspect _ -> [MTNormal MTOpenAPI, MTNormal MTApplicationJSON, MTNormal MTAny]
ActionInspect _ -> [MTOpenAPI, MTApplicationJSON, MTAny]
ActionInfo -> defaultMediaTypes
ActionMutate _ -> defaultMediaTypes
where
invokeMediaTypes =
defaultMediaTypes
++ rawMediaTypes
++ [MTNormal MTOpenAPI | pathIsRootSpec path]
++ [MTOpenAPI | pathIsRootSpec path]
defaultMediaTypes =
[MTNormal MTApplicationJSON, MTNormal MTSingularJSON, MTNormal MTGeoJSON, MTNormal MTTextCSV] ++
[MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf] ++ [MTNormal MTAny]
rawMediaTypes = configRawMediaTypes conf `union` [MTNormal MTOctetStream, MTNormal MTTextPlain, MTNormal MTTextXML]
[MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++
[MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf] ++ [MTAny]
rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML]
5 changes: 2 additions & 3 deletions src/PostgREST/Config.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -57,8 +57,7 @@ import PostgREST.Config.JSPath (JSPath, JSPathExp (..),
dumpJSPath, pRoleClaimKey)
import PostgREST.Config.Proxy (Proxy (..),
isMalformedProxyUri, toURI)
import PostgREST.MediaType (MediaType (..),
NormalMedia (..), toMime)
import PostgREST.MediaType (MediaType (..), toMime)
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier, dumpQi,
toQi)

Expand Down Expand Up @@ -263,7 +262,7 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
<*> parseOpenAPIMode "openapi-mode"
<*> (fromMaybe False <$> optBool "openapi-security-active")
<*> parseOpenAPIServerProxyURI "openapi-server-proxy-uri"
<*> (maybe [] (fmap (MTNormal . MTOther . encodeUtf8) . splitOnCommas) <$> optValue "raw-media-types")
<*> (maybe [] (fmap (MTOther . encodeUtf8) . splitOnCommas) <$> optValue "raw-media-types")
<*> (fromMaybe "!4" <$> optString "server-host")
<*> (fromMaybe 3000 <$> optInt "server-port")
<*> (fmap (CI.mk . encodeUtf8) <$> optString "server-trace-header")
Expand Down
33 changes: 16 additions & 17 deletions src/PostgREST/Error.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,8 +33,7 @@ import Network.HTTP.Types.Header (Header)
import PostgREST.ApiRequest.Types (ApiRequestError (..),
QPError (..),
RangeError (..))
import PostgREST.MediaType (MediaType (..),
NormalMedia (..))
import PostgREST.MediaType (MediaType (..))
import qualified PostgREST.MediaType as MediaType

import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
Expand Down Expand Up @@ -82,7 +81,7 @@ instance PgrstError ApiRequestError where
status LimitNoOrderError = HTTP.status400
status ColumnNotFound{} = HTTP.status400

headers _ = [MediaType.toContentType $ MTNormal MTApplicationJSON]
headers _ = [MediaType.toContentType MTApplicationJSON]

instance JSON.ToJSON ApiRequestError where
toJSON (QueryParamError (QPError message details)) = JSON.object [
Expand Down Expand Up @@ -189,18 +188,18 @@ instance JSON.ToJSON ApiRequestError where
prmsMsg = "(" <> prms <> ")"
prmsDet = " with parameter" <> (if length argumentKeys > 1 then "s " else " ") <> prms
fmtPrms p = if null argumentKeys then " without parameters" else p
onlySingleParams = hasPreferSingleObject || (isInvPost && contentType `elem` [MTNormal MTTextPlain, MTNormal MTTextXML, MTNormal MTOctetStream])
onlySingleParams = hasPreferSingleObject || (isInvPost && contentType `elem` [MTTextPlain, MTTextXML, MTOctetStream])
in JSON.object [
"code" .= SchemaCacheErrorCode02,
"message" .= ("Could not find the function " <> func <> (if onlySingleParams then "" else fmtPrms prmsMsg) <> " in the schema cache"),
"details" .= ("Searched for the function " <> func <>
(case (hasPreferSingleObject, isInvPost, contentType) of
(True, _, _) -> " with a single json/jsonb parameter"
(_, True, MTNormal MTTextPlain) -> " with a single unnamed text parameter"
(_, True, MTNormal MTTextXML) -> " with a single unnamed xml parameter"
(_, True, MTNormal MTOctetStream) -> " with a single unnamed bytea parameter"
(_, True, MTNormal MTApplicationJSON) -> fmtPrms prmsDet <> " or with a single unnamed json/jsonb parameter"
_ -> fmtPrms prmsDet) <>
(True, _, _) -> " with a single json/jsonb parameter"
(_, True, MTTextPlain) -> " with a single unnamed text parameter"
(_, True, MTTextXML) -> " with a single unnamed xml parameter"
(_, True, MTOctetStream) -> " with a single unnamed bytea parameter"
(_, True, MTApplicationJSON) -> fmtPrms prmsDet <> " or with a single unnamed json/jsonb parameter"
_ -> fmtPrms prmsDet) <>
", but no matches were found in the schema cache."),
-- The hint will be null in the case of single unnamed parameter functions
"hint" .= if onlySingleParams
Expand Down Expand Up @@ -362,8 +361,8 @@ instance PgrstError PgError where

headers err =
if status err == HTTP.status401
then [MediaType.toContentType $ MTNormal MTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
else [MediaType.toContentType $ MTNormal MTApplicationJSON]
then [MediaType.toContentType MTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
else [MediaType.toContentType MTApplicationJSON]

instance JSON.ToJSON PgError where
toJSON (PgError _ usageError) = JSON.toJSON usageError
Expand Down Expand Up @@ -476,11 +475,11 @@ instance PgrstError Error where
status SingularityError{} = HTTP.status406

headers (ApiRequestError err) = headers err
headers (JwtTokenInvalid m) = [MediaType.toContentType $ MTNormal MTApplicationJSON, invalidTokenHeader m]
headers JwtTokenRequired = [MediaType.toContentType $ MTNormal MTApplicationJSON, requiredTokenHeader]
headers (JwtTokenInvalid m) = [MediaType.toContentType MTApplicationJSON, invalidTokenHeader m]
headers JwtTokenRequired = [MediaType.toContentType MTApplicationJSON, requiredTokenHeader]
headers (PgErr err) = headers err
headers SingularityError{} = [MediaType.toContentType $ MTNormal MTSingularJSON]
headers _ = [MediaType.toContentType $ MTNormal MTApplicationJSON]
headers SingularityError{} = [MediaType.toContentType MTSingularJSON]
headers _ = [MediaType.toContentType MTApplicationJSON]

instance JSON.ToJSON Error where
toJSON NoSchemaCacheError = JSON.object [
Expand Down Expand Up @@ -531,7 +530,7 @@ instance JSON.ToJSON Error where
toJSON (SingularityError n) = JSON.object [
"code" .= ApiRequestErrorCode16,
"message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
"details" .= T.unwords ["Results contain", show n, "rows,", T.decodeUtf8 (MediaType.toMime $ MTNormal MTSingularJSON), "requires 1 row"],
"details" .= T.unwords ["Results contain", show n, "rows,", T.decodeUtf8 (MediaType.toMime MTSingularJSON), "requires 1 row"],
"hint" .= JSON.Null]

toJSON (PgErr err) = JSON.toJSON err
Expand Down
129 changes: 41 additions & 88 deletions src/PostgREST/MediaType.hs
View file
Original file line number Diff line number Diff line change
@@ -1,9 +1,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}

module PostgREST.MediaType
( MediaType(..)
, NormalMedia(..)
, MTPlanOption (..)
, MTPlanFormat (..)
, MTPlanAttrs(..)
Expand All @@ -15,29 +13,14 @@ module PostgREST.MediaType

import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (c2w)
import qualified Data.List as L
import Data.Maybe (fromJust)

import Network.HTTP.Types.Header (Header, hContentType)

import Protolude
--
-- $setup
-- Setup for doctests
-- >>> import Text.Pretty.Simple (pPrint)
-- >>> deriving instance Show NormalMedia
-- >>> deriving instance Show MTPlanFormat
-- >>> deriving instance Show MTPlanOption
-- >>> deriving instance Show MTPlanAttrs
-- >>> deriving instance Show MediaType

-- | Enumeration of currently supported media types
data MediaType
= MTNormal NormalMedia
| MTPlan MTPlanAttrs
deriving Eq

data NormalMedia
= MTApplicationJSON
| MTSingularJSON
| MTGeoJSON
Expand All @@ -49,95 +32,83 @@ data NormalMedia
| MTOctetStream
| MTAny
| MTOther ByteString
| MTPlan MTPlanAttrs
deriving Eq


data MTPlanAttrs = MTPlanAttrs (Maybe NormalMedia) MTPlanFormat [MTPlanOption]
data MTPlanAttrs = MTPlanAttrs (Maybe MediaType) MTPlanFormat [MTPlanOption]
instance Eq MTPlanAttrs where
MTPlanAttrs {} == MTPlanAttrs {} = True -- we don't care about the attributes when comparing two MTPlan media types

data MTPlanOption
= PlanAnalyze | PlanVerbose | PlanSettings | PlanBuffers | PlanWAL
deriving Eq

data MTPlanFormat
= PlanJSON | PlanText
deriving Eq

-- | Convert MediaType to a Content-Type HTTP Header
toContentType :: MediaType -> Header
toContentType ct = (hContentType, toMime ct <> charset)
where
charset = case ct of
MTNormal MTOctetStream -> mempty
MTNormal (MTOther _) -> mempty
_ -> "; charset=utf-8"
MTOctetStream -> mempty
MTOther _ -> mempty
_ -> "; charset=utf-8"

-- | Convert from MediaType to a ByteString representing the mime type
toMime :: MediaType -> ByteString
toMime (MTNormal x) = toMimeNormal x
toMime MTApplicationJSON = "application/json"
toMime MTGeoJSON = "application/geo+json"
toMime MTTextCSV = "text/csv"
toMime MTTextPlain = "text/plain"
toMime MTTextXML = "text/xml"
toMime MTOpenAPI = "application/openapi+json"
toMime MTSingularJSON = "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 (MTPlanAttrs mt fmt opts)) =
"application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
(if isNothing mt then mempty else "; for=\"" <> toMimeNormal (fromJust mt) <> "\"") <>
(if isNothing mt then mempty else "; for=\"" <> toMime (fromJust mt) <> "\"") <>
(if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts))

toMimeNormal :: NormalMedia -> ByteString
toMimeNormal = \case
MTApplicationJSON -> "application/json"
MTGeoJSON -> "application/geo+json"
MTTextCSV -> "text/csv"
MTTextPlain -> "text/plain"
MTTextXML -> "text/xml"
MTOpenAPI -> "application/openapi+json"
MTSingularJSON -> "application/vnd.pgrst.object+json"
MTUrlEncoded -> "application/x-www-form-urlencoded"
MTOctetStream -> "application/octet-stream"
MTAny -> "*/*"
(MTOther ct) -> ct

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

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

-- | Convert from ByteString to MediaType.
--
-- >>> decodeMediaType "application/json"
-- MTNormal MTApplicationJSON
--
-- >>> decodeMediaType "application/vnd.pgrst.plan;"
-- MTPlan (MTPlanAttrs Nothing PlanText [])
--
-- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"application/json\""
-- MTPlan (MTPlanAttrs (Just MTApplicationJSON) PlanText [])
--
-- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"text/csv\""
-- MTPlan (MTPlanAttrs (Just MTTextCSV) PlanText [])
--
-- A plan media type inside "for" shouldn't recurse
--
-- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"application/vnd.pgrst.plan\""
-- MTPlan (MTPlanAttrs (Just (MTOther "application/vnd.pgrst.plan")) PlanText [])
-- | Convert from ByteString to MediaType. Warning: discards MIME parameters
decodeMediaType :: BS.ByteString -> MediaType
decodeMediaType bs =
case BS.split (BS.c2w ';') bs of
decodeMediaType mt =
case BS.split (BS.c2w ';') mt of
"application/json":_ -> MTApplicationJSON
"application/geo+json":_ -> MTGeoJSON
"text/csv":_ -> MTTextCSV
"text/plain":_ -> MTTextPlain
"text/xml":_ -> MTTextXML
"application/openapi+json":_ -> MTOpenAPI
"application/vnd.pgrst.object+json":_ -> MTSingularJSON
"application/vnd.pgrst.object":_ -> MTSingularJSON
"application/x-www-form-urlencoded":_ -> MTUrlEncoded
"application/octet-stream":_ -> MTOctetStream
"application/vnd.pgrst.plan":rest -> getPlan PlanText rest
"application/vnd.pgrst.plan+text":rest -> getPlan PlanText rest
"application/vnd.pgrst.plan+json":rest -> getPlan PlanJSON rest
mt -> MTNormal $ decodeNormalMediaType mt
"*/*":_ -> MTAny
other:_ -> MTOther other
_ -> MTAny
where
getPlan fmt rest =
let
opts = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest)
inOpts str = str `elem` opts
mtFor = decodeNormalMediaType . L.singleton . dropAround (== BS.c2w '"') <$> (BS.stripPrefix "for=" =<< find (BS.isPrefixOf "for=") rest)
mtFor = decodeMediaType . dropAround (== BS.c2w '"') <$> (BS.stripPrefix "for=" =<< find (BS.isPrefixOf "for=") rest)
dropAround p = BS.dropWhile p . BS.dropWhileEnd p in
MTPlan $ MTPlanAttrs mtFor fmt $
[PlanAnalyze | inOpts "analyze" ] ++
Expand All @@ -146,26 +117,8 @@ decodeMediaType bs =
[PlanBuffers | inOpts "buffers" ] ++
[PlanWAL | inOpts "wal" ]

-- | Convert from ByteString to MediaType. Warning: discards MIME parameters
decodeNormalMediaType :: [BS.ByteString] -> NormalMedia
decodeNormalMediaType bs =
case bs of
"application/json":_ -> MTApplicationJSON
"application/geo+json":_ -> MTGeoJSON
"text/csv":_ -> MTTextCSV
"text/plain":_ -> MTTextPlain
"text/xml":_ -> MTTextXML
"application/openapi+json":_ -> MTOpenAPI
"application/vnd.pgrst.object+json":_ -> MTSingularJSON
"application/vnd.pgrst.object":_ -> MTSingularJSON
"application/x-www-form-urlencoded":_ -> MTUrlEncoded
"application/octet-stream":_ -> MTOctetStream
"*/*":_ -> MTAny
other:_ -> MTOther other
_ -> MTAny

getMediaType :: MediaType -> NormalMedia
getMediaType :: MediaType -> MediaType
getMediaType mt = case mt of
MTPlan (MTPlanAttrs (Just mType) _ _) -> mType
MTPlan (MTPlanAttrs Nothing _ _) -> MTApplicationJSON
MTNormal x -> x
other -> other
Loading

0 comments on commit 77cd938

Please sign in to comment.