From 858e4405ec133f6419b83e166217955bac5ead28 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Wed, 28 Sep 2022 00:31:08 -0500 Subject: [PATCH] refactor: getSchema in ApiRequest --- src/PostgREST/App.hs | 2 +- src/PostgREST/Request/ApiRequest.hs | 51 +++++++++++++++-------------- src/PostgREST/Response.hs | 17 ++++++---- 3 files changed, 37 insertions(+), 33 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index e191bb9b7..7b008de60 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -285,7 +285,7 @@ handleInvoke invMethod proc context@RequestContext{..} = do handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response handleOpenApi headersOnly tSchema (RequestContext conf dbStructure apiRequest pgVer) = do oaiResult <- Query.openApiQuery dbStructure pgVer conf tSchema - pure $ Response.openApiResponse headersOnly oaiResult conf dbStructure $ iProfile apiRequest + pure $ Response.openApiResponse headersOnly oaiResult conf dbStructure (iSchema apiRequest) (iNegotiatedByProfile apiRequest) writeRequest :: Mutation -> QualifiedIdentifier -> RequestContext -> [FieldName] -> Either Error (MutateRequest.MutateRequest, ReadRequest) writeRequest mutation identifier@QualifiedIdentifier{..} context@RequestContext{..} pkCols = do diff --git a/src/PostgREST/Request/ApiRequest.hs b/src/PostgREST/Request/ApiRequest.hs index bbfacdda1..2d101a52a 100644 --- a/src/PostgREST/Request/ApiRequest.hs +++ b/src/PostgREST/Request/ApiRequest.hs @@ -35,7 +35,6 @@ import qualified Data.Vector as V import Control.Arrow ((***)) import Data.Aeson.Types (emptyArray, emptyObject) import Data.List (lookup, union) -import Data.Maybe (fromJust) import Data.Ranged.Ranges (emptyRange, rangeIntersection, rangeIsEmpty) import Network.HTTP.Types.Header (hCookie, RequestHeaders) @@ -171,8 +170,8 @@ data ApiRequest = ApiRequest { , iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies , iPath :: ByteString -- ^ Raw request path , 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. + , iSchema :: Schema -- ^ The request schema. Can vary depending on profile headers. + , iNegotiatedByProfile :: Bool -- ^ If schema was was chosen according to the profile spec https://www.w3.org/TR/dx-prof-conneg/ , iAcceptMediaType :: MediaType } @@ -183,7 +182,8 @@ userApiRequest conf dbStructure req reqBody = do pInfo <- getPathInfo conf $ pathInfo req act <- getAction pInfo $ requestMethod req mediaTypes <- getMediaTypes conf (requestHeaders req) act pInfo - apiRequest conf dbStructure req reqBody qPrms pInfo act mediaTypes + negotiatedSchema <- getSchema conf (requestHeaders req) (requestMethod req) + apiRequest dbStructure req reqBody qPrms pInfo act mediaTypes negotiatedSchema getPathInfo :: AppConfig -> [Text] -> Either ApiRequestError PathInfo getPathInfo AppConfig{configOpenApiMode, configDbRootSpec} path = @@ -226,9 +226,27 @@ getMediaTypes conf hdrs action path = do contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type" lookupHeader = flip lookup hdrs -apiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action -> (MediaType, MediaType) -> Either ApiRequestError ApiRequest -apiRequest AppConfig{configDbSchemas} dbStructure req reqBody queryparams@QueryParams{..} PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action (acceptMediaType, contentMediaType) - | isJust profile && fromJust profile `notElem` configDbSchemas = Left $ UnacceptableSchema $ toList configDbSchemas +getSchema :: AppConfig -> RequestHeaders -> ByteString -> Either ApiRequestError (Schema, Bool) +getSchema AppConfig{configDbSchemas} hdrs method = do + case profile of + Just p | p `notElem` configDbSchemas -> Left $ UnacceptableSchema $ toList configDbSchemas + | otherwise -> Right (p, True) + Nothing -> Right (defaultSchema, length configDbSchemas /= 1) -- if we have many schemas, assume the default schema was negotiated + where + defaultSchema = NonEmptyList.head configDbSchemas + profile = case method of + -- POST/PATCH/PUT/DELETE don't use the same header as per the spec + "DELETE" -> contentProfile + "PATCH" -> contentProfile + "POST" -> contentProfile + "PUT" -> contentProfile + _ -> acceptProfile + contentProfile = T.decodeUtf8 <$> lookupHeader "Content-Profile" + acceptProfile = T.decodeUtf8 <$> lookupHeader "Accept-Profile" + lookupHeader = flip lookup hdrs + +apiRequest :: DbStructure -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action -> (MediaType, MediaType) -> (Schema, Bool) -> Either ApiRequestError ApiRequest +apiRequest dbStructure req reqBody queryparams@QueryParams{..} PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action (acceptMediaType, contentMediaType) (schema, negotiatedByProfile) | isInvalidRange = Left $ InvalidRange (if rangeIsEmpty headerRange then LowerGTUpper else NegativeLimit) | shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload | not expectParams && not (L.null qsParams) = Left $ ParseRequestError "Unexpected param or filter missing operator" ("Failed to parse " <> show qsParams) @@ -253,8 +271,8 @@ apiRequest AppConfig{configDbSchemas} dbStructure req reqBody queryparams@QueryP , iCookies = maybe [] parseCookies $ lookupHeader "Cookie" , iPath = rawPathInfo req , iMethod = method - , iProfile = profile , iSchema = schema + , iNegotiatedByProfile = negotiatedByProfile , iAcceptMediaType = acceptMediaType } where @@ -296,23 +314,6 @@ apiRequest AppConfig{configDbSchemas} dbStructure req reqBody queryparams@QueryP (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 - defaultSchema = NonEmptyList.head configDbSchemas - profile - | length configDbSchemas <= 1 -- only enable content negotiation by profile when there are multiple schemas specified in the config - = Nothing - | otherwise = case method of - -- POST/PATCH/PUT/DELETE don't use the same header as per the spec - "DELETE" -> contentProfile - "PATCH" -> contentProfile - "POST" -> contentProfile - "PUT" -> contentProfile - _ -> acceptProfile - where - contentProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Content-Profile" - acceptProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Accept-Profile" - - schema = fromMaybe defaultSchema profile - target | pathIsProc = (`TargetProc` pathIsRootSpec) <$> callFindProc schema pathName | pathIsDefSpec = Right $ TargetDefaultSpec schema diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs index da4b7f524..aea0d23c8 100644 --- a/src/PostgREST/Response.hs +++ b/src/PostgREST/Response.hs @@ -215,10 +215,10 @@ invokeResponse invMethod proc ctxApiRequest@ApiRequest{..} resultSet = case resu RSPlan plan -> Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan -openApiResponse :: Bool -> Maybe (TablesMap, ProcsMap, Maybe Text) -> AppConfig -> DbStructure -> Maybe Schema -> Wai.Response -openApiResponse headersOnly body conf dbStructure iProfile = +openApiResponse :: Bool -> Maybe (TablesMap, ProcsMap, Maybe Text) -> AppConfig -> DbStructure -> Schema -> Bool -> Wai.Response +openApiResponse headersOnly body conf dbStructure schema negotiatedByProfile = Wai.responseLBS HTTP.status200 - (MediaType.toContentType MTOpenAPI : maybeToList (profileHeader iProfile)) + (MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile)) (maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode conf dbStructure x y z) body) -- | Response with headers and status overridden from GUCs. @@ -245,11 +245,14 @@ decodeGucStatus = contentTypeHeaders :: ApiRequest -> [HTTP.Header] contentTypeHeaders ApiRequest{..} = - MediaType.toContentType iAcceptMediaType : maybeToList (profileHeader iProfile) + MediaType.toContentType iAcceptMediaType : maybeToList (profileHeader iSchema iNegotiatedByProfile) -profileHeader :: Maybe Schema -> Maybe HTTP.Header -profileHeader iProfile = - (,) "Content-Profile" <$> (toS <$> iProfile) +profileHeader :: Schema -> Bool -> Maybe HTTP.Header +profileHeader schema negotiatedByProfile = + if negotiatedByProfile + then Just $ (,) "Content-Profile" (toS schema) + else + Nothing addRetryHint :: Int -> Wai.Response -> Wai.Response addRetryHint delay response = do