diff --git a/postgrest.cabal b/postgrest.cabal index 8ed0385d2..9d79664b8 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -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 diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 9e92c3cc9..65fffe93f 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -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{..} = diff --git a/src/PostgREST/ContentType.hs b/src/PostgREST/ContentType.hs deleted file mode 100644 index ced8e5b8c..000000000 --- a/src/PostgREST/ContentType.hs +++ /dev/null @@ -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' diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 00b9c5d47..d35bec9a9 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -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 [ diff --git a/src/PostgREST/MediaType.hs b/src/PostgREST/MediaType.hs new file mode 100644 index 000000000..6f7424049 --- /dev/null +++ b/src/PostgREST/MediaType.hs @@ -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' diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs index 71363046f..139b9757e 100644 --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -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)) diff --git a/src/PostgREST/Request/ApiRequest.hs b/src/PostgREST/Request/ApiRequest.hs index 221ba91c2..5e66cd4ed 100644 --- a/src/PostgREST/Request/ApiRequest.hs +++ b/src/PostgREST/Request/ApiRequest.hs @@ -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 diff --git a/src/PostgREST/Request/Types.hs b/src/PostgREST/Request/Types.hs index 16c076982..5b0f56877 100644 --- a/src/PostgREST/Request/Types.hs +++ b/src/PostgREST/Request/Types.hs @@ -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 diff --git a/test/spec/Feature/Query/QuerySpec.hs b/test/spec/Feature/Query/QuerySpec.hs index 9649e328e..9fe205b13 100644 --- a/test/spec/Feature/Query/QuerySpec.hs +++ b/test/spec/Feature/Query/QuerySpec.hs @@ -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] }