jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: Move accept content type code from App into ApiRequest (#1830)

Browse Source
This commit is contained in:
Remo Rechkemmer
2021-04-25 21:58:03 +02:00
committed by GitHub
parent 63e0292e23
commit 6670a3214b
3 changed files with 77 additions and 69 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+27 -51
View File
@@ -89,7 +89,6 @@ data RequestContext = RequestContext
{ ctxConfig :: AppConfig
, ctxDbStructure :: DbStructure
, ctxApiRequest :: ApiRequest
, ctxContentType :: ContentType
}
type Handler = ExceptT Error
@@ -161,7 +160,7 @@ postgrestResponse
-> UTCTime
-> Wai.Request
-> Handler IO Wai.Response
postgrestResponse conf@AppConfig{..} maybeDbStructure pool time req = do
postgrestResponse conf maybeDbStructure pool time req = do
body <- lift $ Wai.strictRequestBody req
dbStructure <-
@@ -173,21 +172,14 @@ postgrestResponse conf@AppConfig{..} maybeDbStructure pool time req = do
apiRequest@ApiRequest{..} <-
liftEither . mapLeft Error.ApiRequestError $
ApiRequest.userApiRequest configDbSchemas configDbRootSpec dbStructure req body
ApiRequest.userApiRequest conf dbStructure req body
-- The JWT must be checked before touching the db
jwtClaims <- Auth.jwtClaims conf (toS iJWT) time
contentType <-
case ApiRequest.mutuallyAgreeable (requestContentTypes conf apiRequest) iAccepts of
Just ct ->
return ct
Nothing ->
throwError . Error.ContentTypeError $ map ContentType.toMime iAccepts
let
handleReq apiReq =
handleRequest $ RequestContext conf dbStructure apiReq contentType
handleRequest $ RequestContext conf dbStructure apiReq
runDbHandler pool (txMode apiRequest) jwtClaims .
Middleware.optionalRollback conf apiRequest $
@@ -205,7 +197,7 @@ runDbHandler pool mode jwtClaims handler = do
liftEither resp
handleRequest :: RequestContext -> DbHandler Wai.Response
handleRequest context@(RequestContext _ _ ApiRequest{..} _) =
handleRequest context@(RequestContext _ _ ApiRequest{..}) =
case (iAction, iTarget) of
(ActionRead headersOnly, TargetIdent identifier) ->
handleRead headersOnly identifier context
@@ -246,9 +238,9 @@ handleRead headersOnly identifier context@RequestContext{..} = do
else
countQuery
)
(ctxContentType == CTSingularJSON)
(iAcceptContentType == CTSingularJSON)
(shouldCount iPreferCount)
(ctxContentType == CTTextCSV)
(iAcceptContentType == CTTextCSV)
bField
(pgVersion ctxDbStructure)
configDbPreparedStatements
@@ -268,7 +260,7 @@ handleRead headersOnly identifier context@RequestContext{..} = do
]
++ contentTypeHeaders context
failNotSingular ctxContentType queryTotal . response status headers $
failNotSingular iAcceptContentType queryTotal . response status headers $
if headersOnly then mempty else toS body
readTotal :: AppConfig -> ApiRequest -> Maybe Int64 -> SQL.Snippet -> DbHandler (Maybe Int64)
@@ -317,14 +309,14 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
(\x -> ("Preference-Applied", BS8.pack $ show x)) <$> iPreferResolution
]
failNotSingular ctxContentType resQueryTotal $
failNotSingular iAcceptContentType resQueryTotal $
if iPreferRepresentation == Full then
response HTTP.status201 (headers ++ contentTypeHeaders context) (toS resBody)
else
response HTTP.status201 headers mempty
handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} contentType) = do
handleUpdate identifier context@(RequestContext _ _ ApiRequest{..}) = do
WriteQueryResult{..} <- writeQuery identifier False mempty context
let
@@ -339,14 +331,14 @@ handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} contentType)
RangeQuery.contentRangeH 0 (resQueryTotal - 1) $
if shouldCount iPreferCount then Just resQueryTotal else Nothing
failNotSingular contentType resQueryTotal $
failNotSingular iAcceptContentType resQueryTotal $
if fullRepr then
response status (contentTypeHeaders context ++ [contentRangeHeader]) (toS resBody)
else
response status [contentRangeHeader] mempty
handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response
handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..} _) = do
handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..}) = do
when (iTopLevelRange /= RangeQuery.allRange) $
throwError Error.PutRangeNotAllowedError
@@ -370,7 +362,7 @@ handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..} _) = do
response HTTP.status204 (contentTypeHeaders context) mempty
handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleDelete identifier context@(RequestContext _ _ ApiRequest{..} contentType) = do
handleDelete identifier context@(RequestContext _ _ ApiRequest{..}) = do
WriteQueryResult{..} <- writeQuery identifier False mempty context
let
@@ -379,7 +371,7 @@ handleDelete identifier context@(RequestContext _ _ ApiRequest{..} contentType)
RangeQuery.contentRangeH 1 0 $
if shouldCount iPreferCount then Just resQueryTotal else Nothing
failNotSingular contentType resQueryTotal $
failNotSingular iAcceptContentType resQueryTotal $
if iPreferRepresentation == Full then
response HTTP.status200
(contentTypeHeaders context ++ [contentRangeHeader])
@@ -443,8 +435,8 @@ handleInvoke invMethod proc context@RequestContext{..} = do
(QueryBuilder.readRequestToQuery req)
(QueryBuilder.readRequestToCountQuery req)
(shouldCount iPreferCount)
(ctxContentType == CTSingularJSON)
(ctxContentType == CTTextCSV)
(iAcceptContentType == CTSingularJSON)
(iAcceptContentType == CTTextCSV)
(iPreferParameters == Just MultipleObjects)
bField
(pgVersion ctxDbStructure)
@@ -456,13 +448,13 @@ handleInvoke invMethod proc context@RequestContext{..} = do
(status, contentRange) =
RangeQuery.rangeStatusHeader iTopLevelRange queryTotal tableTotal
failNotSingular ctxContentType queryTotal $
failNotSingular iAcceptContentType queryTotal $
response status
(contentTypeHeaders context ++ [contentRange])
(if invMethod == InvHead then mempty else toS body)
handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response
handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest _) = do
handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest) = do
body <-
lift $
OpenAPI.encode conf dbStructure
@@ -519,9 +511,9 @@ writeQuery identifier@QualifiedIdentifier{..} isInsert pkCols context@RequestCon
Statements.createWriteStatement
(QueryBuilder.readRequestToQuery readReq)
(QueryBuilder.mutateRequestToQuery mutateReq)
(ctxContentType == CTSingularJSON)
(iAcceptContentType ctxApiRequest == CTSingularJSON)
isInsert
(ctxContentType == CTTextCSV)
(iAcceptContentType ctxApiRequest == CTTextCSV)
(iPreferRepresentation ctxApiRequest)
pkCols
(pgVersion ctxDbStructure)
@@ -562,7 +554,7 @@ returnsScalar (TargetProc proc _) = Proc.procReturnsScalar proc
returnsScalar _ = False
readRequest :: Monad m => QualifiedIdentifier -> RequestContext -> Handler m ReadRequest
readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure apiRequest _) =
readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure apiRequest) =
liftEither $
ReqBuilder.readRequest qiSchema qiName configDbMaxRows
(dbRelationships dbStructure)
@@ -570,32 +562,16 @@ readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure ap
contentTypeHeaders :: RequestContext -> [HTTP.Header]
contentTypeHeaders RequestContext{..} =
ContentType.toHeader ctxContentType : maybeToList (profileHeader ctxApiRequest)
ContentType.toHeader (iAcceptContentType ctxApiRequest) : maybeToList (profileHeader ctxApiRequest)
requestContentTypes :: AppConfig -> ApiRequest -> [ContentType]
requestContentTypes conf ApiRequest{..} =
case iAction of
ActionRead _ -> defaultContentTypes ++ rawContentTypes conf
ActionInvoke _ -> invokeContentTypes
ActionInspect _ -> [CTOpenAPI, CTApplicationJSON]
ActionInfo -> [CTTextCSV]
_ -> defaultContentTypes
where
invokeContentTypes =
defaultContentTypes
++ rawContentTypes conf
++ [CTOpenAPI | ApiRequest.tpIsRootSpec iTarget]
defaultContentTypes =
[CTApplicationJSON, CTSingularJSON, CTTextCSV]
-- |
-- If raw(binary) output is requested, check that ContentType is one of the admitted
-- rawContentTypes and that`?select=...` contains only one field other than `*`
-- | If raw(binary) output is requested, check that ContentType is one of the
-- admitted rawContentTypes and that`?select=...` contains only one field other
-- than `*`
binaryField :: Monad m => RequestContext -> ReadRequest -> Handler m (Maybe FieldName)
binaryField RequestContext{..} readReq
| returnsScalar (iTarget ctxApiRequest) && ctxContentType `elem` rawContentTypes ctxConfig =
| returnsScalar (iTarget ctxApiRequest) && iAcceptContentType ctxApiRequest `elem` rawContentTypes ctxConfig =
return $ Just "pgrst_scalar"
| ctxContentType `elem` rawContentTypes ctxConfig =
| iAcceptContentType ctxApiRequest `elem` rawContentTypes ctxConfig =
let
fldNames = fstFieldNames readReq
fieldName = headMay fldNames
@@ -603,7 +579,7 @@ binaryField RequestContext{..} readReq
if length fldNames == 1 && fieldName /= Just "*" then
return fieldName
else
throwError $ Error.BinaryFieldError ctxContentType
throwError $ Error.BinaryFieldError (iAcceptContentType ctxApiRequest)
| otherwise =
return Nothing
src/PostgREST/Error.hs
+4 -4
View File
@@ -59,6 +59,7 @@ data ApiRequestError
| AmbiguousRelBetween Text Text [Relationship]
| InvalidFilters
| UnacceptableSchema [Text]
| ContentTypeError [ByteString]
| UnsupportedVerb -- Unreachable?
instance PgrstError ApiRequestError where
@@ -71,6 +72,7 @@ instance PgrstError ApiRequestError where
status (NoRelBetween _ _) = HT.status400
status AmbiguousRelBetween{} = HT.status300
status (UnacceptableSchema _) = HT.status406
status (ContentTypeError _) = HT.status415
headers _ = [ContentType.toHeader CTApplicationJSON]
@@ -95,6 +97,8 @@ instance JSON.ToJSON ApiRequestError where
"message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text)]
toJSON (UnacceptableSchema schemas) = JSON.object [
"message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas)]
toJSON (ContentTypeError cts) = JSON.object [
"message" .= ("None of these Content-Types are available: " <> (toS . intercalate ", " . map toS) cts :: Text)]
compressedRel :: Relationship -> JSON.Value
compressedRel Relationship{..} =
@@ -237,7 +241,6 @@ data Error
| JwtTokenMissing
| JwtTokenInvalid Text
| SingularityError Integer
| ContentTypeError [ByteString]
| NotFound
| ApiRequestError ApiRequestError
| PgErr PgError
@@ -252,7 +255,6 @@ instance PgrstError Error where
status JwtTokenMissing = HT.status500
status (JwtTokenInvalid _) = HT.unauthorized401
status (SingularityError _) = HT.status406
status (ContentTypeError _) = HT.status415
status NotFound = HT.status404
status (PgErr err) = status err
status (ApiRequestError err) = status err
@@ -278,8 +280,6 @@ instance JSON.ToJSON Error where
toJSON PutMatchingPkError = JSON.object [
"message" .= ("Payload values do not match URL in primary key column(s)" :: Text)]
toJSON (ContentTypeError cts) = JSON.object [
"message" .= ("None of these Content-Types are available: " <> (toS . intercalate ", " . map toS) cts :: Text)]
toJSON (SingularityError n) = JSON.object [
"message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
"details" .= T.unwords ["Results contain", show n, "rows,", toS (ContentType.toMime CTSingularJSON), "requires 1 row"]]
src/PostgREST/Request/ApiRequest.hs
+46 -14
View File
@@ -2,9 +2,10 @@
Module : PostgREST.Request.ApiRequest
Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Request.ApiRequest
( ApiRequest(..)
@@ -13,7 +14,6 @@ module PostgREST.Request.ApiRequest
, Action(..)
, Target(..)
, PayloadJSON(..)
, mutuallyAgreeable
, userApiRequest
) where
@@ -30,7 +30,7 @@ import qualified Data.Vector as V
import Control.Arrow ((***))
import Data.Aeson.Types (emptyArray, emptyObject)
import Data.List (last, lookup, partition)
import Data.List (last, lookup, partition, union)
import Data.List.NonEmpty (head)
import Data.Maybe (fromJust)
import Data.Ranged.Boundaries (Boundary (..))
@@ -44,6 +44,7 @@ import Network.Wai (Request (..))
import Network.Wai.Parse (parseHttpAccept)
import Web.Cookie (parseCookiesText)
import PostgREST.Config (AppConfig (..))
import PostgREST.ContentType (ContentType (..))
import PostgREST.DbStructure (DbStructure (..))
import PostgREST.DbStructure.Identifiers (FieldName,
@@ -137,7 +138,6 @@ data ApiRequest = ApiRequest {
, iRange :: M.HashMap ByteString NonnegRange -- ^ Requested range of rows within response
, iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level
, iTarget :: Target -- ^ The target, be it calling a proc or accessing a table
, iAccepts :: [ContentType] -- ^ Content types the client will accept, [CTAny] if no Accept header
, iPayload :: Maybe PayloadJSON -- ^ Data sent by client and used for mutation actions
, iPreferRepresentation :: PreferRepresentation -- ^ If client wants created items echoed back
, iPreferParameters :: Maybe PreferParameters -- ^ How to pass parameters to a stored procedure
@@ -158,22 +158,24 @@ 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
}
-- | Examines HTTP request and translates it into user intent.
userApiRequest :: NonEmpty Schema -> Maybe Text -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
userApiRequest confSchemas rootSpec dbStructure req reqBody
| isJust profile && fromJust profile `notElem` confSchemas = Left $ UnacceptableSchema $ toList confSchemas
userApiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
userApiRequest conf@AppConfig{..} dbStructure req reqBody
| isJust profile && fromJust profile `notElem` configDbSchemas = Left $ UnacceptableSchema $ toList configDbSchemas
| isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate
| topLevelRange == emptyRange = Left InvalidRange
| shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) witness payload
| isLeft parsedColumns = either Left witness parsedColumns
| otherwise = Right ApiRequest {
| otherwise = do
acceptContentType <- findAcceptContentType conf action target accepts
return ApiRequest {
iAction = action
, iTarget = target
, iRange = ranges
, iTopLevelRange = topLevelRange
, iAccepts = maybe [CTAny] (map ContentType.decodeContentType . parseHttpAccept) $ lookupHeader "accept"
, iPayload = relevantPayload
, iPreferRepresentation = representation
, iPreferParameters = if | hasPrefer (show SingleObject) -> Just SingleObject
@@ -206,8 +208,10 @@ userApiRequest confSchemas rootSpec dbStructure req reqBody
, iMethod = method
, iProfile = profile
, iSchema = schema
, iAcceptContentType = acceptContentType
}
where
accepts = maybe [CTAny] (map ContentType.decodeContentType . parseHttpAccept) $ lookupHeader "accept"
-- queryString with '+' converted to ' '(space)
qString = parseQueryReplacePlus True $ rawQueryString req
-- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
@@ -287,9 +291,9 @@ userApiRequest confSchemas rootSpec dbStructure req reqBody
"OPTIONS" -> ActionInfo
_ -> ActionInspect{isHead=False}
defaultSchema = head confSchemas
defaultSchema = head configDbSchemas
profile
| length confSchemas <= 1 -- only enable content negotiation by profile when there are multiple schemas specified in the config
| length configDbSchemas <= 1 -- only enable content negotiation by profile when there are multiple schemas specified in the config
= Nothing
| otherwise = case action of
-- POST/PATCH/PUT/DELETE don't use the same header as per the spec
@@ -308,7 +312,7 @@ userApiRequest confSchemas rootSpec dbStructure req reqBody
callFindProc proc = findProc (QualifiedIdentifier schema proc) payloadColumns (hasPrefer (show SingleObject)) $ dbProcs dbStructure
in
case path of
[] -> case rootSpec of
[] -> case configDbRootSpec of
Just pName -> TargetProc (callFindProc pName) True
Nothing -> TargetDefaultSpec schema
[table] -> TargetIdent $ QualifiedIdentifier schema table
@@ -423,3 +427,31 @@ payloadAttributes raw json =
_ -> Just emptyPJArray
where
emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty
findAcceptContentType :: AppConfig -> Action -> Target -> [ContentType] -> Either ApiRequestError ContentType
findAcceptContentType conf action target accepts =
case mutuallyAgreeable (requestContentTypes conf action target) accepts of
Just ct ->
Right ct
Nothing ->
Left . ContentTypeError $ map ContentType.toMime accepts
requestContentTypes :: AppConfig -> Action -> Target -> [ContentType]
requestContentTypes conf action target =
case action of
ActionRead _ -> defaultContentTypes ++ rawContentTypes conf
ActionInvoke _ -> invokeContentTypes
ActionInspect _ -> [CTOpenAPI, CTApplicationJSON]
ActionInfo -> [CTTextCSV]
_ -> defaultContentTypes
where
invokeContentTypes =
defaultContentTypes
++ rawContentTypes conf
++ [CTOpenAPI | tpIsRootSpec target]
defaultContentTypes =
[CTApplicationJSON, CTSingularJSON, CTTextCSV]
rawContentTypes :: AppConfig -> [ContentType]
rawContentTypes AppConfig{..} =
(ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain]