refactor: rename ContentType to MediaType

The core type was wrongly named as the header
This commit is contained in:
steve-chavez
2022-07-06 13:47:59 -05:00
committed by Steve Chavez
parent 3e83bef9c4
commit 7a7ceaf39a
9 changed files with 187 additions and 187 deletions
+1 -1
View File
@@ -44,7 +44,6 @@ library
PostgREST.Config.JSPath
PostgREST.Config.PgVersion
PostgREST.Config.Proxy
PostgREST.ContentType
PostgREST.Cors
PostgREST.DbStructure
PostgREST.DbStructure.Identifiers
@@ -55,6 +54,7 @@ library
PostgREST.GucHeader
PostgREST.Logger
PostgREST.Middleware
PostgREST.MediaType
PostgREST.OpenAPI
PostgREST.Query.QueryBuilder
PostgREST.Query.SqlFragment
+31 -31
View File
@@ -61,7 +61,6 @@ import PostgREST.Config (AppConfig (..),
LogLevel (..),
OpenAPIMode (..))
import PostgREST.Config.PgVersion (PgVersion (..))
import PostgREST.ContentType (ContentType (..))
import PostgREST.DbStructure (DbStructure (..))
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier (..),
@@ -73,6 +72,7 @@ import PostgREST.Error (Error)
import PostgREST.GucHeader (GucHeader,
addHeadersIfNotIncluded,
unwrapGucHeader)
import PostgREST.MediaType (MediaType (..))
import PostgREST.Request.ApiRequest (Action (..),
ApiRequest (..),
InvokeMethod (..),
@@ -86,8 +86,8 @@ import PostgREST.Request.ReadQuery (ReadRequest, fstFieldNames)
import PostgREST.Version (prettyVersion)
import PostgREST.Workers (connectionWorker, listener)
import qualified PostgREST.ContentType as ContentType
import qualified PostgREST.DbStructure.Proc as Proc
import qualified PostgREST.MediaType as MediaType
import Protolude hiding (Handler)
@@ -267,11 +267,11 @@ handleRead headersOnly identifier context@RequestContext{..} = do
else
countQuery
)
(iAcceptContentType == CTSingularJSON)
(iAcceptMediaType == MTSingularJSON)
(shouldCount iPreferCount)
(iAcceptContentType == CTTextCSV)
(iAcceptContentType == CTTextXML)
(iAcceptContentType == CTGeoJSON)
(iAcceptMediaType == MTTextCSV)
(iAcceptMediaType == MTTextXML)
(iAcceptMediaType == MTGeoJSON)
bField
configDbPreparedStatements
@@ -290,7 +290,7 @@ handleRead headersOnly identifier context@RequestContext{..} = do
]
++ contentTypeHeaders context
failNotSingular iAcceptContentType queryTotal . response status headers $
failNotSingular iAcceptMediaType queryTotal . response status headers $
if headersOnly then mempty else LBS.fromStrict body
readTotal :: AppConfig -> ApiRequest -> Maybe Int64 -> SQL.Snippet -> DbHandler (Maybe Int64)
@@ -341,7 +341,7 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
toAppliedHeader <$> iPreferResolution
]
failNotSingular iAcceptContentType resQueryTotal $
failNotSingular iAcceptMediaType resQueryTotal $
if iPreferRepresentation == Full then
response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict resBody)
else
@@ -368,7 +368,7 @@ handleUpdate identifier context@RequestContext{..} = do
if shouldCount iPreferCount then Just resQueryTotal else Nothing
failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resQueryTotal =<<
failNotSingular iAcceptContentType resQueryTotal (
failNotSingular iAcceptMediaType resQueryTotal (
if fullRepr then
response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict resBody)
else
@@ -408,7 +408,7 @@ handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do
if shouldCount iPreferCount then Just resQueryTotal else Nothing
failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resQueryTotal =<<
failNotSingular iAcceptContentType resQueryTotal (
failNotSingular iAcceptMediaType resQueryTotal (
if iPreferRepresentation == Full then
response HTTP.status200
(contentTypeHeaders context ++ [contentRangeHeader])
@@ -462,10 +462,10 @@ handleInvoke invMethod proc context@RequestContext{..} = do
(QueryBuilder.readRequestToQuery req)
(QueryBuilder.readRequestToCountQuery req)
(shouldCount iPreferCount)
(iAcceptContentType == CTSingularJSON)
(iAcceptContentType == CTTextCSV)
(iAcceptContentType == CTTextXML)
(iAcceptContentType == CTGeoJSON)
(iAcceptMediaType == MTSingularJSON)
(iAcceptMediaType == MTTextCSV)
(iAcceptMediaType == MTTextXML)
(iAcceptMediaType == MTGeoJSON)
(iPreferParameters == Just MultipleObjects)
bField
(configDbPreparedStatements ctxConfig)
@@ -476,7 +476,7 @@ handleInvoke invMethod proc context@RequestContext{..} = do
(status, contentRange) =
RangeQuery.rangeStatusHeader iTopLevelRange queryTotal tableTotal
failNotSingular iAcceptContentType queryTotal $
failNotSingular iAcceptMediaType queryTotal $
if Proc.procReturnsVoid proc then
response HTTP.status204 [contentRange] mempty
else
@@ -503,7 +503,7 @@ handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure
return $
Wai.responseLBS HTTP.status200
(ContentType.toHeader CTOpenAPI : maybeToList (profileHeader apiRequest))
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader apiRequest))
(if headersOnly then mempty else body)
txMode :: ApiRequest -> SQL.Mode
@@ -550,10 +550,10 @@ writeQuery mutation identifier@QualifiedIdentifier{..} isInsert pkCols context@R
Statements.createWriteStatement
(QueryBuilder.readRequestToQuery readReq)
(QueryBuilder.mutateRequestToQuery mutateReq)
(iAcceptContentType ctxApiRequest == CTSingularJSON)
(iAcceptMediaType ctxApiRequest == MTSingularJSON)
isInsert
(iAcceptContentType ctxApiRequest == CTTextCSV)
(iAcceptContentType ctxApiRequest == CTGeoJSON)
(iAcceptMediaType ctxApiRequest == MTTextCSV)
(iAcceptMediaType ctxApiRequest == MTGeoJSON)
(iPreferRepresentation ctxApiRequest)
pkCols
(configDbPreparedStatements ctxConfig)
@@ -575,9 +575,9 @@ gucResponse gucStatus gucHeaders status headers =
-- |
-- Fail a response if a single JSON object was requested and not exactly one
-- was found.
failNotSingular :: ContentType -> Int64 -> Wai.Response -> DbHandler Wai.Response
failNotSingular contentType queryTotal response =
if contentType == CTSingularJSON && queryTotal /= 1 then
failNotSingular :: MediaType -> Int64 -> Wai.Response -> DbHandler Wai.Response
failNotSingular mediaType queryTotal response =
if mediaType == MTSingularJSON && queryTotal /= 1 then
do
lift SQL.condemn
throwError $ Error.singularityError queryTotal
@@ -611,16 +611,16 @@ readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure ap
contentTypeHeaders :: RequestContext -> [HTTP.Header]
contentTypeHeaders RequestContext{..} =
ContentType.toHeader (iAcceptContentType ctxApiRequest) : maybeToList (profileHeader ctxApiRequest)
MediaType.toContentType (iAcceptMediaType ctxApiRequest) : maybeToList (profileHeader ctxApiRequest)
-- | If raw(binary) output is requested, check that ContentType is one of the
-- admitted rawContentTypes and that`?select=...` contains only one field other
-- | If raw(binary) output is requested, check that MediaType is one of the
-- admitted rawMediaTypes and that`?select=...` contains only one field other
-- than `*`
binaryField :: Monad m => RequestContext -> ReadRequest -> Handler m (Maybe FieldName)
binaryField RequestContext{..} readReq
| returnsScalar (iTarget ctxApiRequest) && iAcceptContentType ctxApiRequest `elem` rawContentTypes ctxConfig =
| returnsScalar (iTarget ctxApiRequest) && iAcceptMediaType ctxApiRequest `elem` rawMediaTypes ctxConfig =
return $ Just "pgrst_scalar"
| iAcceptContentType ctxApiRequest `elem` rawContentTypes ctxConfig =
| iAcceptMediaType ctxApiRequest `elem` rawMediaTypes ctxConfig =
let
fldNames = fstFieldNames readReq
fieldName = headMay fldNames
@@ -628,13 +628,13 @@ binaryField RequestContext{..} readReq
if length fldNames == 1 && fieldName /= Just "*" then
return fieldName
else
throwError $ Error.BinaryFieldError (iAcceptContentType ctxApiRequest)
throwError $ Error.BinaryFieldError (iAcceptMediaType ctxApiRequest)
| otherwise =
return Nothing
rawContentTypes :: AppConfig -> [ContentType]
rawContentTypes AppConfig{..} =
(ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain, CTTextXML]
rawMediaTypes :: AppConfig -> [MediaType]
rawMediaTypes AppConfig{..} =
(MediaType.decodeMediaType <$> configRawMediaTypes) `union` [MTOctetStream, MTTextPlain, MTTextXML]
profileHeader :: ApiRequest -> Maybe HTTP.Header
profileHeader ApiRequest{..} =
-70
View File
@@ -1,70 +0,0 @@
{-# LANGUAGE DuplicateRecordFields #-}
module PostgREST.ContentType
( ContentType(..)
, toHeader
, toMime
, decodeContentType
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (c2w)
import Network.HTTP.Types.Header (Header, hContentType)
import Protolude
-- | Enumeration of currently supported response content types
data ContentType
= CTApplicationJSON
| CTSingularJSON
| CTGeoJSON
| CTTextCSV
| CTTextPlain
| CTTextXML
| CTOpenAPI
| CTUrlEncoded
| CTOctetStream
| CTAny
| CTOther ByteString
deriving (Eq)
-- | Convert from ContentType to a full HTTP Header
toHeader :: ContentType -> Header
toHeader ct = (hContentType, toMime ct <> charset)
where
charset = case ct of
CTOctetStream -> mempty
CTOther _ -> mempty
_ -> "; charset=utf-8"
-- | Convert from ContentType to a ByteString representing the mime type
toMime :: ContentType -> ByteString
toMime CTApplicationJSON = "application/json"
toMime CTGeoJSON = "application/geo+json"
toMime CTTextCSV = "text/csv"
toMime CTTextPlain = "text/plain"
toMime CTTextXML = "text/xml"
toMime CTOpenAPI = "application/openapi+json"
toMime CTSingularJSON = "application/vnd.pgrst.object+json"
toMime CTUrlEncoded = "application/x-www-form-urlencoded"
toMime CTOctetStream = "application/octet-stream"
toMime CTAny = "*/*"
toMime (CTOther ct) = ct
-- | Convert from ByteString to ContentType. Warning: discards MIME parameters
decodeContentType :: BS.ByteString -> ContentType
decodeContentType ct =
case BS.takeWhile (/= BS.c2w ';') ct of
"application/json" -> CTApplicationJSON
"application/geo+json" -> CTGeoJSON
"text/csv" -> CTTextCSV
"text/plain" -> CTTextPlain
"text/xml" -> CTTextXML
"application/openapi+json" -> CTOpenAPI
"application/vnd.pgrst.object+json" -> CTSingularJSON
"application/vnd.pgrst.object" -> CTSingularJSON
"application/x-www-form-urlencoded" -> CTUrlEncoded
"application/octet-stream" -> CTOctetStream
"*/*" -> CTAny
ct' -> CTOther ct'
+19 -19
View File
@@ -29,8 +29,8 @@ import Network.Wai (Response, responseLBS)
import Network.HTTP.Types.Header (Header)
import PostgREST.ContentType (ContentType (..))
import qualified PostgREST.ContentType as ContentType
import PostgREST.MediaType (MediaType (..))
import qualified PostgREST.MediaType as MediaType
import PostgREST.Request.Types (ApiRequestError (..),
QPError (..))
@@ -57,7 +57,7 @@ instance PgrstError ApiRequestError where
status ActionInappropriate = HTTP.status405
status AmbiguousRelBetween{} = HTTP.status300
status AmbiguousRpc{} = HTTP.status300
status ContentTypeError{} = HTTP.status415
status MediaTypeError{} = HTTP.status415
status InvalidBody{} = HTTP.status400
status InvalidFilters = HTTP.status405
status InvalidRange = HTTP.status416
@@ -70,7 +70,7 @@ instance PgrstError ApiRequestError where
status UnacceptableSchema{} = HTTP.status406
status LimitNoOrderError = HTTP.status400
headers _ = [ContentType.toHeader CTApplicationJSON]
headers _ = [MediaType.toContentType MTApplicationJSON]
instance JSON.ToJSON ApiRequestError where
toJSON (QueryParamError (QPError message details)) = JSON.object [
@@ -108,9 +108,9 @@ instance JSON.ToJSON ApiRequestError where
"message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (ContentTypeError cts) = JSON.object [
toJSON (MediaTypeError cts) = JSON.object [
"code" .= ApiRequestErrorCode07,
"message" .= ("None of these Content-Types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts)),
"message" .= ("None of these media types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts)),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (NotEmbedded resource) = JSON.object [
@@ -147,10 +147,10 @@ instance JSON.ToJSON ApiRequestError where
"message" .= ("Could not find the " <> schema <> "." <> procName <>
(case (hasPreferSingleObject, isInvPost, contentType) of
(True, _, _) -> " function with a single json or jsonb parameter"
(_, True, CTTextPlain) -> " function with a single unnamed text parameter"
(_, True, CTTextXML) -> " function with a single unnamed xml parameter"
(_, True, CTOctetStream) -> " function with a single unnamed bytea parameter"
(_, True, CTApplicationJSON) -> prms <> " function or the " <> schema <> "." <> procName <>" function with a single unnamed json or jsonb parameter"
(_, True, MTTextPlain) -> " function with a single unnamed text parameter"
(_, True, MTTextXML) -> " function with a single unnamed xml parameter"
(_, True, MTOctetStream) -> " function with a single unnamed bytea parameter"
(_, True, MTApplicationJSON) -> prms <> " function or the " <> schema <> "." <> procName <>" function with a single unnamed json or jsonb parameter"
_ -> prms <> " function") <>
" in the schema cache"),
"details" .= JSON.Null,
@@ -200,8 +200,8 @@ instance PgrstError PgError where
headers err =
if status err == HTTP.status401
then [ContentType.toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
else [ContentType.toHeader CTApplicationJSON]
then [MediaType.toContentType MTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
else [MediaType.toContentType MTApplicationJSON]
instance JSON.ToJSON PgError where
toJSON (PgError _ usageError) = JSON.toJSON usageError
@@ -304,7 +304,7 @@ checkIsFatal _ = Nothing
data Error
= ApiRequestError ApiRequestError
| BinaryFieldError ContentType
| BinaryFieldError MediaType
| GucHeadersError
| GucStatusError
| JwtTokenInvalid Text
@@ -335,11 +335,11 @@ instance PgrstError Error where
status UnsupportedVerb{} = HTTP.status405
headers (ApiRequestError err) = headers err
headers (JwtTokenInvalid m) = [ContentType.toHeader CTApplicationJSON, invalidTokenHeader m]
headers JwtTokenRequired = [ContentType.toHeader CTApplicationJSON, requiredTokenHeader]
headers (JwtTokenInvalid m) = [MediaType.toContentType MTApplicationJSON, invalidTokenHeader m]
headers JwtTokenRequired = [MediaType.toContentType MTApplicationJSON, requiredTokenHeader]
headers (PgErr err) = headers err
headers SingularityError{} = [ContentType.toHeader CTSingularJSON]
headers _ = [ContentType.toHeader CTApplicationJSON]
headers SingularityError{} = [MediaType.toContentType MTSingularJSON]
headers _ = [MediaType.toContentType MTApplicationJSON]
instance JSON.ToJSON Error where
toJSON NoSchemaCacheError = JSON.object [
@@ -382,7 +382,7 @@ instance JSON.ToJSON Error where
"hint" .= JSON.Null]
toJSON (BinaryFieldError ct) = JSON.object [
"code" .= ApiRequestErrorCode13,
"message" .= ((T.decodeUtf8 (ContentType.toMime ct) <> " requested but more than one column was selected") :: Text),
"message" .= ((T.decodeUtf8 (MediaType.toMime ct) <> " requested but more than one column was selected") :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
@@ -395,7 +395,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 (ContentType.toMime CTSingularJSON), "requires 1 row"],
"details" .= T.unwords ["Results contain", show n, "rows,", T.decodeUtf8 (MediaType.toMime MTSingularJSON), "requires 1 row"],
"hint" .= JSON.Null]
toJSON (UnsupportedVerb verb) = JSON.object [
+70
View File
@@ -0,0 +1,70 @@
{-# LANGUAGE DuplicateRecordFields #-}
module PostgREST.MediaType
( MediaType(..)
, toContentType
, toMime
, decodeMediaType
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (c2w)
import Network.HTTP.Types.Header (Header, hContentType)
import Protolude
-- | Enumeration of currently supported media types
data MediaType
= MTApplicationJSON
| MTSingularJSON
| MTGeoJSON
| MTTextCSV
| MTTextPlain
| MTTextXML
| MTOpenAPI
| MTUrlEncoded
| MTOctetStream
| MTAny
| MTOther ByteString
deriving (Eq)
-- | Convert MediaType to a Content-Type HTTP Header
toContentType :: MediaType -> Header
toContentType ct = (hContentType, toMime ct <> charset)
where
charset = case ct of
MTOctetStream -> mempty
MTOther _ -> mempty
_ -> "; charset=utf-8"
-- | Convert from MediaType to a ByteString representing the mime type
toMime :: MediaType -> ByteString
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
-- | Convert from ByteString to MediaType. Warning: discards MIME parameters
decodeMediaType :: BS.ByteString -> MediaType
decodeMediaType ct =
case BS.takeWhile (/= BS.c2w ';') ct 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
ct' -> MTOther ct'
+6 -6
View File
@@ -37,7 +37,7 @@ import PostgREST.DbStructure.Table (Column (..), Table (..),
TablesMap)
import PostgREST.Version (docsVersion, prettyVersion)
import PostgREST.ContentType
import PostgREST.MediaType
import Protolude hiding (Proxy, get)
@@ -51,7 +51,7 @@ encode conf dbStructure tables procs schemaDescription =
(proxyUri conf)
schemaDescription
makeMimeList :: [ContentType] -> MimeList
makeMimeList :: [MediaType] -> MimeList
makeMimeList cs = MimeList $ fmap (fromString . BS.unpack . toMime) cs
toSwaggerType :: Text -> Maybe (SwaggerType t)
@@ -294,7 +294,7 @@ makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
& description .~ mfilter (/="") pDesc
& parameters .~ makeProcParam pd
& tags .~ Set.fromList ["(rpc) " <> pdName pd]
& produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON]
& produces ?~ makeMimeList [MTApplicationJSON, MTSingularJSON]
& at 200 ?~ "OK"
pe = (mempty :: PathItem) & post ?~ postOp
@@ -304,7 +304,7 @@ makeRootPathItem = ("/", p)
getOp = (mempty :: Operation)
& tags .~ Set.fromList ["Introspection"]
& summary ?~ "OpenAPI description (this document)"
& produces ?~ makeMimeList [CTOpenAPI, CTApplicationJSON]
& produces ?~ makeMimeList [MTOpenAPI, MTApplicationJSON]
& at 200 ?~ "OK"
pr = (mempty :: PathItem) & get ?~ getOp
p = pr
@@ -336,8 +336,8 @@ postgrestSpec rels pds ti (s, h, p, b) sd = (mempty :: Swagger)
& definitions .~ fromList (makeTableDef rels <$> ti)
& parameters .~ fromList (makeParamDefs ti)
& paths .~ makePathItems pds ti
& produces .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
& consumes .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
& produces .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
& consumes .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
where
s' = if s == "http" then Http else Https
h' = Just $ Host (T.unpack $ escapeHostName h) (Just (fromInteger p))
+56 -56
View File
@@ -10,7 +10,7 @@ module PostgREST.Request.ApiRequest
( ApiRequest(..)
, InvokeMethod(..)
, Mutation(..)
, ContentType(..)
, MediaType(..)
, Action(..)
, Target(..)
, Payload(..)
@@ -45,13 +45,13 @@ import Web.Cookie (parseCookies)
import PostgREST.Config (AppConfig (..),
OpenAPIMode (..))
import PostgREST.ContentType (ContentType (..))
import PostgREST.DbStructure (DbStructure (..))
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema)
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcParam (..), ProcsMap)
import PostgREST.MediaType (MediaType (..))
import PostgREST.RangeQuery (NonnegRange, allRange,
hasLimitZero,
limitZeroRange,
@@ -64,7 +64,7 @@ import PostgREST.Request.Preferences (PreferCount (..),
import PostgREST.Request.QueryParams (QueryParams (..))
import PostgREST.Request.Types (ApiRequestError (..))
import qualified PostgREST.ContentType as ContentType
import qualified PostgREST.MediaType as MediaType
import qualified PostgREST.Request.Preferences as Preferences
import qualified PostgREST.Request.QueryParams as QueryParams
@@ -173,7 +173,7 @@ data ApiRequest = ApiRequest {
, iMethod :: ByteString -- ^ Raw request method
, iProfile :: Maybe Schema -- ^ The request profile for enabling use of multiple schemas. Follows the spec in hhttps://www.w3.org/TR/dx-prof-conneg/ttps://www.w3.org/TR/dx-prof-conneg/.
, iSchema :: Schema -- ^ The request schema. Can vary depending on iProfile.
, iAcceptContentType :: ContentType
, iAcceptMediaType :: MediaType
}
-- | Examines HTTP request and translates it into user intent.
@@ -191,7 +191,7 @@ apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..
| method `elem` ["PATCH", "DELETE"] && not (null qsRanges) && null qsOrder = Left LimitNoOrderError
| method == "PUT" && topLevelRange /= allRange = Left PutRangeNotAllowedError
| otherwise = do
acceptContentType <- findAcceptContentType conf action path accepts
acceptMediaType <- findAcceptMediaType conf action path accepts
checkedTarget <- target
return ApiRequest {
iAction = action
@@ -212,10 +212,10 @@ apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..
, iMethod = method
, iProfile = profile
, iSchema = schema
, iAcceptContentType = acceptContentType
, iAcceptMediaType = acceptMediaType
}
where
accepts = maybe [CTAny] (map ContentType.decodeContentType . parseHttpAccept) $ lookupHeader "accept"
accepts = maybe [MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
expectParams = isTargetingProc && method /= "POST"
@@ -225,7 +225,7 @@ apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..
isTargetingDefaultSpec = case path of
PathInfo{pIsDefaultSpec=True} -> True
_ -> False
contentType = maybe CTApplicationJSON ContentType.decodeContentType $ lookupHeader "content-type"
contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type"
columns = case action of
ActionMutate MutationCreate -> qsColumns
@@ -234,33 +234,33 @@ apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..
_ -> Nothing
payloadColumns =
case (contentType, action) of
case (contentMediaType, action) of
(_, ActionInvoke InvGet) -> S.fromList $ fst <$> qsParams
(_, ActionInvoke InvHead) -> S.fromList $ fst <$> qsParams
(CTUrlEncoded, _) -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
(MTUrlEncoded, _) -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
_ -> case (relevantPayload, columns) of
(Just ProcessedJSON{payKeys}, _) -> payKeys
(Just RawJSON{}, Just cls) -> cls
_ -> S.empty
payload :: Either ByteString Payload
payload = case (contentType, isTargetingProc) of
(CTApplicationJSON, _) ->
payload = case (contentMediaType, isTargetingProc) of
(MTApplicationJSON, _) ->
if isJust columns
then Right $ RawJSON reqBody
else note "All object keys must match" . payloadAttributes reqBody
=<< if LBS.null reqBody && isTargetingProc
then Right emptyObject
else first BS.pack $ JSON.eitherDecode reqBody
(CTTextCSV, _) -> 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
(CTUrlEncoded, _) ->
(MTUrlEncoded, _) ->
let paramsMap = HM.fromList $ (T.decodeUtf8 *** JSON.String . T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) in
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (HM.keys paramsMap)
(CTTextPlain, True) -> Right $ RawPay reqBody
(CTTextXML, True) -> Right $ RawPay reqBody
(CTOctetStream, True) -> Right $ RawPay reqBody
(ct, _) -> Left $ "Content-Type not acceptable: " <> ContentType.toMime ct
(MTTextPlain, True) -> Right $ RawPay reqBody
(MTTextXML, True) -> Right $ RawPay reqBody
(MTOctetStream, True) -> Right $ RawPay reqBody
(ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct
topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows
action =
case method of
@@ -300,7 +300,7 @@ apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..
let
callFindProc procSch procNam = findProc
(QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs dbStructure)
contentType (action == ActionInvoke InvPost)
contentMediaType (action == ActionInvoke InvPost)
in
case path of
PathInfo{pSchema, pName, pHasRpc, pIsRootSpec, pIsDefaultSpec}
@@ -309,19 +309,19 @@ apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..
| otherwise -> Right $ TargetIdent $ QualifiedIdentifier pSchema pName
PathUnknown -> Right TargetUnknown
shouldParsePayload = case (action, contentType) of
shouldParsePayload = case (action, contentMediaType) of
(ActionMutate MutationCreate, _) -> True
(ActionInvoke InvPost, CTUrlEncoded) -> False
(ActionInvoke InvPost, MTUrlEncoded) -> False
(ActionInvoke InvPost, _) -> True
(ActionMutate MutationSingleUpsert, _) -> True
(ActionMutate MutationUpdate, _) -> True
_ -> False
relevantPayload = case (contentType, action) of
relevantPayload = case (contentMediaType, action) of
-- Though ActionInvoke GET/HEAD doesn't really have a payload, we use the payload variable as a way
-- to store the query string arguments to the function.
(_, ActionInvoke InvGet) -> targetToJsonRpcParams (rightToMaybe target) qsParams
(_, ActionInvoke InvHead) -> targetToJsonRpcParams (rightToMaybe target) qsParams
(CTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
(MTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
_ | shouldParsePayload -> rightToMaybe payload
| otherwise -> Nothing
path =
@@ -348,15 +348,15 @@ apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..
isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange)
{-|
Find the best match from a list of content types accepted by the
Find the best match from a list of media types accepted by the
client in order of decreasing preference and a list of types
producible by the server. If there is no match but the client
accepts */* then return the top server pick.
-}
mutuallyAgreeable :: [ContentType] -> [ContentType] -> Maybe ContentType
mutuallyAgreeable :: [MediaType] -> [MediaType] -> Maybe MediaType
mutuallyAgreeable sProduces cAccepts =
let exact = listToMaybe $ L.intersect cAccepts sProduces in
if isNothing exact && CTAny `elem` cAccepts
if isNothing exact && MTAny `elem` cAccepts
then listToMaybe sProduces
else exact
@@ -409,42 +409,42 @@ payloadAttributes raw json =
where
emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty
findAcceptContentType :: AppConfig -> Action -> Path -> [ContentType] -> Either ApiRequestError ContentType
findAcceptContentType conf action path accepts =
case mutuallyAgreeable (requestContentTypes conf action path) accepts of
findAcceptMediaType :: AppConfig -> Action -> Path -> [MediaType] -> Either ApiRequestError MediaType
findAcceptMediaType conf action path accepts =
case mutuallyAgreeable (requestMediaTypes conf action path) accepts of
Just ct ->
Right ct
Nothing ->
Left . ContentTypeError $ map ContentType.toMime accepts
Left . MediaTypeError $ map MediaType.toMime accepts
requestContentTypes :: AppConfig -> Action -> Path -> [ContentType]
requestContentTypes conf action path =
requestMediaTypes :: AppConfig -> Action -> Path -> [MediaType]
requestMediaTypes conf action path =
case action of
ActionRead _ -> defaultContentTypes ++ rawContentTypes conf
ActionInvoke _ -> invokeContentTypes
ActionInspect _ -> [CTOpenAPI, CTApplicationJSON]
ActionInfo -> [CTTextCSV]
_ -> defaultContentTypes
ActionRead _ -> defaultMediaTypes ++ rawMediaTypes conf
ActionInvoke _ -> invokeMediaTypes
ActionInspect _ -> [MTOpenAPI, MTApplicationJSON]
ActionInfo -> [MTTextCSV]
_ -> defaultMediaTypes
where
invokeContentTypes =
defaultContentTypes
++ rawContentTypes conf
++ [CTOpenAPI | pIsRootSpec path]
defaultContentTypes =
[CTApplicationJSON, CTSingularJSON, CTGeoJSON, CTTextCSV]
invokeMediaTypes =
defaultMediaTypes
++ rawMediaTypes conf
++ [MTOpenAPI | pIsRootSpec path]
defaultMediaTypes =
[MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV]
rawContentTypes :: AppConfig -> [ContentType]
rawContentTypes AppConfig{..} =
(ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain, CTTextXML]
rawMediaTypes :: AppConfig -> [MediaType]
rawMediaTypes AppConfig{..} =
(MediaType.decodeMediaType <$> configRawMediaTypes) `union` [MTOctetStream, MTTextPlain, MTTextXML]
{-|
Search a pg proc by matching name and arguments keys to parameters. Since a function can be overloaded,
the name is not enough to find it. An overloaded function can have a different volatility or even a different return type.
-}
findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> ContentType -> Bool -> Either ApiRequestError ProcDescription
findProc qi argumentsKeys paramsAsSingleObject allProcs contentType isInvPost =
findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> MediaType -> Bool -> Either ApiRequestError ProcDescription
findProc qi argumentsKeys paramsAsSingleObject allProcs contentMediaType isInvPost =
case matchProc of
([], []) -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentType isInvPost
([], []) -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentMediaType isInvPost
-- If there are no functions with named arguments, fallback to the single unnamed argument function
([], [proc]) -> Right proc
([], procs) -> Left $ AmbiguousRpc (toList procs)
@@ -462,12 +462,12 @@ findProc qi argumentsKeys paramsAsSingleObject allProcs contentType isInvPost =
| otherwise = (ts,fs)
-- If the function is called with post and has a single unnamed parameter
-- it can be called depending on content type and the parameter type
hasSingleUnnamedParam ProcDescription{pdParams=[ProcParam{ppType}]} = isInvPost && case (contentType, ppType) of
(CTApplicationJSON, "json") -> True
(CTApplicationJSON, "jsonb") -> True
(CTTextPlain, "text") -> True
(CTTextXML, "xml") -> True
(CTOctetStream, "bytea") -> True
hasSingleUnnamedParam ProcDescription{pdParams=[ProcParam{ppType}]} = isInvPost && case (contentMediaType, ppType) of
(MTApplicationJSON, "json") -> True
(MTApplicationJSON, "jsonb") -> True
(MTTextPlain, "text") -> True
(MTTextXML, "xml") -> True
(MTOctetStream, "bytea") -> True
_ -> False
hasSingleUnnamedParam _ = False
matchesParams proc =
@@ -480,7 +480,7 @@ findProc qi argumentsKeys paramsAsSingleObject allProcs contentType isInvPost =
then length params == 1 && (firstType == Just "json" || firstType == Just "jsonb")
-- If the function has no parameters, the arguments keys must be empty as well
else if null params
then null argumentsKeys && not (isInvPost && contentType `elem` [CTOctetStream, CTTextPlain, CTTextXML])
then null argumentsKeys && not (isInvPost && contentMediaType `elem` [MTOctetStream, MTTextPlain, MTTextXML])
-- A function has optional and required parameters. Optional parameters have a default value and
-- don't require arguments for the function to be executed, required parameters must have an argument present.
else case L.partition ppReq params of
+3 -3
View File
@@ -35,12 +35,12 @@ module PostgREST.Request.Types
import qualified Data.ByteString.Lazy as LBS
import PostgREST.ContentType (ContentType (..))
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcParam (..))
import PostgREST.DbStructure.Relationship (Relationship)
import PostgREST.MediaType (MediaType (..))
import Protolude
@@ -50,13 +50,13 @@ data ApiRequestError
= ActionInappropriate
| AmbiguousRelBetween Text Text [Relationship]
| AmbiguousRpc [ProcDescription]
| ContentTypeError [ByteString]
| MediaTypeError [ByteString]
| InvalidBody ByteString
| InvalidFilters
| InvalidRange
| LimitNoOrderError
| NoRelBetween Text Text Text
| NoRpc Text Text [Text] Bool ContentType Bool
| NoRpc Text Text [Text] Bool MediaType Bool
| NotEmbedded Text
| ParseRequestError Text Text
| PutRangeNotAllowedError
+1 -1
View File
@@ -909,7 +909,7 @@ spec actualPgVersion = do
request methodGet "/simple_pk"
(acceptHdrs "text/unknowntype") ""
`shouldRespondWith`
[json|{"message":"None of these Content-Types are available: text/unknowntype","code":"PGRST107","details":null,"hint":null}|]
[json|{"message":"None of these media types are available: text/unknowntype","code":"PGRST107","details":null,"hint":null}|]
{ matchStatus = 415
, matchHeaders = [matchContentTypeJson]
}