From 18cc214c04abc562dbf01a234c4e0d0b3d540a7f Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Sat, 3 Oct 2020 16:24:51 +0200 Subject: [PATCH] refactor moving findProc into ApiRequest to allow parsing parameters differently by proc --- src/PostgREST/ApiRequest.hs | 41 ++++++++++++------- src/PostgREST/App.hs | 65 +++++++++++++------------------ src/PostgREST/DbRequestBuilder.hs | 10 ++--- src/PostgREST/Types.hs | 23 +++++------ test/Feature/RpcSpec.hs | 33 +++++++++------- 5 files changed, 91 insertions(+), 81 deletions(-) diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index b45fb72fa..2dffadad2 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -2,8 +2,9 @@ Module : PostgREST.ApiRequest Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest. -} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} module PostgREST.ApiRequest ( ApiRequest(..) @@ -45,6 +46,7 @@ import Web.Cookie (parseCookiesText) import Data.Ranged.Boundaries import PostgREST.Error (ApiRequestError (..)) +import PostgREST.Parsers (pRequestColumns) import PostgREST.RangeQuery (NonnegRange, allRange, rangeGeq, rangeLimit, rangeOffset, rangeRequested, restrictRange) @@ -63,7 +65,7 @@ data Action = ActionCreate | ActionRead{isHead :: Bool} deriving Eq -- | The target db object of a user action data Target = TargetIdent QualifiedIdentifier - | TargetProc{tpQi :: QualifiedIdentifier, tpIsRootSpec :: Bool} + | TargetProc{tProc :: ProcDescription, tpIsRootSpec :: Bool} | TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/" | TargetUnknown [Text] deriving Eq @@ -90,7 +92,7 @@ data ApiRequest = ApiRequest { , iLogic :: [(Text, Text)] -- ^ &and and &or parameters used for complex boolean logic , iSelect :: Maybe Text -- ^ &select parameter used to shape the response , iOnConflict :: Maybe Text -- ^ &on_conflict parameter used to upsert on specific unique keys - , iColumns :: Maybe Text -- ^ &columns parameter used to shape the payload + , iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload , iOrder :: [(Text, Text)] -- ^ &order parameters for each level , iCanonicalQS :: ByteString -- ^ Alphabetized (canonical) request query string for response URLs , iJWT :: Text -- ^ JSON Web Token @@ -103,12 +105,13 @@ data ApiRequest = ApiRequest { } -- | Examines HTTP request and translates it into user intent. -userApiRequest :: NonEmpty Schema -> Maybe Text -> Request -> RequestBody -> Either ApiRequestError ApiRequest -userApiRequest confSchemas rootSpec req reqBody +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 | 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 { iAction = action , iTarget = target @@ -131,7 +134,7 @@ userApiRequest confSchemas rootSpec req reqBody , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ] , iSelect = toS <$> join (lookup "select" qParams) , iOnConflict = toS <$> join (lookup "on_conflict" qParams) - , iColumns = columns + , iColumns = payloadColumns , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ] , iCanonicalQS = toS $ urlEncodeVars . L.sortOn fst @@ -174,6 +177,12 @@ userApiRequest confSchemas rootSpec req reqBody columns | action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams) | otherwise = Nothing + parsedColumns = pRequestColumns columns + payloadColumns = + case (relevantPayload, fromRight Nothing parsedColumns) of + (Just ProcessedJSON{pjKeys}, _) -> pjKeys + (Just RawJSON{}, Just cls) -> cls + _ -> S.empty payload = case (contentType, action) of (_, ActionInvoke InvGet) -> Right rpcPrmsToJson @@ -226,13 +235,17 @@ userApiRequest confSchemas rootSpec req reqBody = Just $ maybe defaultSchema toS $ lookupHeader "Accept-Profile" | otherwise = Nothing schema = fromMaybe defaultSchema profile - target = case path of - [] -> case rootSpec of - Just pName -> TargetProc (QualifiedIdentifier schema pName) True - Nothing -> TargetDefaultSpec schema - [table] -> TargetIdent $ QualifiedIdentifier schema table - ["rpc", proc] -> TargetProc (QualifiedIdentifier schema proc) False - other -> TargetUnknown other + target = + let + callFindProc proc = findProc (QualifiedIdentifier schema proc) payloadColumns (hasPrefer (show SingleObject)) $ dbProcs dbStructure + in + case path of + [] -> case rootSpec of + Just pName -> TargetProc (callFindProc pName) True + Nothing -> TargetDefaultSpec schema + [table] -> TargetIdent $ QualifiedIdentifier schema table + ["rpc", pName] -> TargetProc (callFindProc pName) False + other -> TargetUnknown other shouldParsePayload = action `elem` diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index bf9311828..41c56a169 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -50,7 +50,6 @@ import PostgREST.Error (PgError (..), SimpleError (..), errorResponseFor, singularityError) import PostgREST.Middleware import PostgREST.OpenAPI -import PostgREST.Parsers (pRequestColumns) import PostgREST.QueryBuilder (limitedQuery, mutateRequestToQuery, readRequestToCountQuery, readRequestToQuery, @@ -76,12 +75,10 @@ postgrest logLev refConf refDbStructure pool getTime connWorker = Nothing -> respond . errorResponseFor $ ConnectionLostError Just dbStructure -> do response <- do - let apiReq = userApiRequest (configSchemas conf) (configRootSpec conf) req body - -- Need to parse ?columns early because findProc needs it to solve overloaded functions. - apiReqCols = (,) <$> apiReq <*> (pRequestColumns . iColumns =<< apiReq) - case apiReqCols of + let apiReq = userApiRequest (configSchemas conf) (configRootSpec conf) dbStructure req body + case apiReq of Left err -> return . errorResponseFor $ err - Right (apiRequest, maybeCols) -> do + Right apiRequest -> do -- The jwt must be checked before touching the db. attempt <- attemptJwtClaims (configJWKS conf) (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf) case jwtClaims attempt of @@ -89,38 +86,27 @@ postgrest logLev refConf refDbStructure pool getTime connWorker = Right claims -> do let authed = containsRole claims - cols = case (iPayload apiRequest, maybeCols) of - (Just ProcessedJSON{pjKeys}, _) -> pjKeys - (Just RawJSON{}, Just cls) -> cls - _ -> S.empty - proc = case iTarget apiRequest of - TargetProc qi _ -> findProc qi cols (iPreferParameters apiRequest == Just SingleObject) $ dbProcs dbStructure - _ -> Nothing - handleReq = runPgLocals conf claims (app dbStructure proc cols conf) apiRequest - txMode = transactionMode proc (iAction apiRequest) - dbResp <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq + handleReq = runPgLocals conf claims (app dbStructure conf) apiRequest + dbResp <- P.use pool $ HT.transaction HT.ReadCommitted (txMode apiRequest) handleReq return $ either (errorResponseFor . PgError authed) identity dbResp -- Launch the connWorker when the connection is down. The postgrest function can respond successfully(with a stale schema cache) before the connWorker is done. when (responseStatus response == status503) connWorker respond response -transactionMode :: Maybe ProcDescription -> Action -> HT.Mode -transactionMode proc action = - case action of - ActionRead _ -> HT.Read - ActionInfo -> HT.Read - ActionInspect _ -> HT.Read - ActionInvoke InvGet -> HT.Read - ActionInvoke InvHead -> HT.Read - ActionInvoke InvPost -> - let v = maybe Volatile pdVolatility proc in - if v == Stable || v == Immutable - then HT.Read - else HT.Write +txMode :: ApiRequest -> HT.Mode +txMode apiRequest = + case (iAction apiRequest, iTarget apiRequest) of + (ActionRead _ , _) -> HT.Read + (ActionInfo , _) -> HT.Read + (ActionInspect _ , _) -> HT.Read + (ActionInvoke InvGet , _) -> HT.Read + (ActionInvoke InvHead, _) -> HT.Read + (ActionInvoke InvPost, TargetProc ProcDescription{pdVolatility=Stable} _) -> HT.Read + (ActionInvoke InvPost, TargetProc ProcDescription{pdVolatility=Immutable} _) -> HT.Read _ -> HT.Write -app :: DbStructure -> Maybe ProcDescription -> S.Set FieldName -> AppConfig -> ApiRequest -> H.Transaction Response -app dbStructure proc cols conf apiRequest = +app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response +app dbStructure conf apiRequest = let rawContentTypes = (decodeContentType <$> configRawMediaTypes conf) `L.union` [ CTOctetStream, CTTextPlain ] in case responseContentTypeOrError (iAccepts apiRequest) rawContentTypes (iAction apiRequest) (iTarget apiRequest) of Left errorResponse -> return errorResponse @@ -210,7 +196,7 @@ app dbStructure proc cols conf apiRequest = Left err -> return $ errorResponseFor err Right (ghdrs, gstatus) -> do let - updateIsNoOp = S.null cols + updateIsNoOp = S.null (iColumns apiRequest) defStatus | queryTotal == 0 && not updateIsNoOp = status404 | iPreferRepresentation apiRequest == Full = status200 | otherwise = status204 @@ -294,14 +280,14 @@ app dbStructure proc cols conf apiRequest = allOrigins = ("Access-Control-Allow-Origin", "*") :: Header in return $ responseLBS status200 [allOrigins, allowH] mempty - (ActionInvoke invMethod, TargetProc qi@(QualifiedIdentifier tSchema pName) _, Just pJson) -> - let tName = fromMaybe pName $ procTableName =<< proc in - case readSqlParts tSchema tName of + (ActionInvoke invMethod, TargetProc proc@ProcDescription{pdSchema, pdName} _, Just pJson) -> + let tName = fromMaybe pdName $ procTableName proc in + case readSqlParts pdSchema tName of Left errorResponse -> return errorResponse Right (q, cq, bField, returning) -> do let preferParams = iPreferParameters apiRequest - pq = requestToCallProcQuery qi (specifiedProcArgs cols proc) returnsScalar preferParams returning + pq = requestToCallProcQuery (QualifiedIdentifier pdSchema pdName) (specifiedProcArgs (iColumns apiRequest) proc) returnsScalar preferParams returning stm = callProcStatement returnsScalar pq q cq shouldCount (contentType == CTSingularJSON) (contentType == CTTextCSV) (contentType `elem` rawContentTypes) (preferParams == Just MultipleObjects) bField pgVer @@ -351,7 +337,10 @@ app dbStructure proc cols conf apiRequest = plannedCount = iPreferCount apiRequest == Just PlannedCount shouldCount = exactCount || estimatedCount topLevelRange = iTopLevelRange apiRequest - returnsScalar = maybe False procReturnsScalar proc + returnsScalar = + case iTarget apiRequest of + TargetProc proc _ -> procReturnsScalar proc + _ -> False pgVer = pgVersion dbStructure profileH = contentProfileH <$> iProfile apiRequest @@ -370,7 +359,7 @@ app dbStructure proc cols conf apiRequest = mutateSqlParts s t = let readReq = readRequest s t maxRows (dbRelations dbStructure) apiRequest - mutReq = mutateRequest s t apiRequest cols (tablePKCols dbStructure s t) =<< readReq + mutReq = mutateRequest s t apiRequest (tablePKCols dbStructure s t) =<< readReq in (,) <$> (readRequestToQuery <$> readReq) <*> diff --git a/src/PostgREST/DbRequestBuilder.hs b/src/PostgREST/DbRequestBuilder.hs index dc971ae33..8770d8b0a 100644 --- a/src/PostgREST/DbRequestBuilder.hs +++ b/src/PostgREST/DbRequestBuilder.hs @@ -287,15 +287,15 @@ addProperty f (targetNodeName:remainingPath, a) (Node rn forest) = where pathNode = find (\(Node (_,(nodeName,_,alias,_,_)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest -mutateRequest :: Schema -> TableName -> ApiRequest -> S.Set FieldName -> [FieldName] -> ReadRequest -> Either Response MutateRequest -mutateRequest schema tName apiRequest cols pkCols readReq = mapLeft errorResponseFor $ +mutateRequest :: Schema -> TableName -> ApiRequest -> [FieldName] -> ReadRequest -> Either Response MutateRequest +mutateRequest schema tName apiRequest pkCols readReq = mapLeft errorResponseFor $ case action of ActionCreate -> do confCols <- case iOnConflict apiRequest of Nothing -> pure pkCols Just param -> pRequestOnConflict param - pure $ Insert qi cols ((,) <$> iPreferResolution apiRequest <*> Just confCols) [] returnings - ActionUpdate -> Update qi cols <$> combinedLogic <*> pure returnings + pure $ Insert qi (iColumns apiRequest) ((,) <$> iPreferResolution apiRequest <*> Just confCols) [] returnings + ActionUpdate -> Update qi (iColumns apiRequest) <$> combinedLogic <*> pure returnings ActionSingleUpsert -> (\flts -> if null (iLogic apiRequest) && @@ -304,7 +304,7 @@ mutateRequest schema tName apiRequest cols pkCols readReq = mapLeft errorRespons all (\case Filter _ (OpExpr False (Op "eq" _)) -> True _ -> False) flts - then Insert qi cols (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings + then Insert qi (iColumns apiRequest) (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings else Left InvalidFilters) =<< filters ActionDelete -> Delete qi <$> combinedLogic <*> pure returnings diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index e8419ce5d..034f52e76 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -157,13 +157,17 @@ type ProcsMap = M.HashMap QualifiedIdentifier [ProcDescription] An overloaded function can have a different volatility or even a different return type. Ideally, handling overloaded functions should be left to pg itself. But we need to know certain proc attributes in advance. -} -findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> Maybe ProcDescription -findProc qi payloadKeys paramsAsSingleObject allProcs = - case M.lookup qi allProcs of - Nothing -> Nothing - Just [proc] -> Just proc -- if it's not an overloaded function then immediately get the ProcDescription - Just procs -> find matches procs -- Handle overloaded functions case +findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> ProcDescription +findProc qi payloadKeys paramsAsSingleObject allProcs = fromMaybe fallback bestMatch where + -- instead of passing Maybe ProcDescription around, we create a fallback description here when we can't find a matching function + -- args is empty, but because "specifiedProcArgs" will fill the missing arguments with default type text, this is not a problem + fallback = ProcDescription (qiSchema qi) (qiName qi) Nothing mempty (SetOf $ Composite $ QualifiedIdentifier "" "record") Volatile + bestMatch = + case M.lookup qi allProcs of + Nothing -> Nothing + Just [proc] -> Just proc -- if it's not an overloaded function then immediately get the ProcDescription + Just procs -> find matches procs -- Handle overloaded functions case matches proc = if paramsAsSingleObject -- if the arg is not of json type let the db give the err @@ -174,12 +178,9 @@ findProc qi payloadKeys paramsAsSingleObject allProcs = Search the procedure parameters by matching them with the specified keys. If the key doesn't match a parameter, a parameter with a default type "text" is assumed. -} -specifiedProcArgs :: S.Set FieldName -> Maybe ProcDescription -> [PgArg] +specifiedProcArgs :: S.Set FieldName -> ProcDescription -> [PgArg] specifiedProcArgs keys proc = - let - args = maybe [] pdArgs proc - in - (\k -> fromMaybe (PgArg k "text" True) (find ((==) k . pgaName) args)) <$> S.toList keys + (\k -> fromMaybe (PgArg k "text" True) (find ((==) k . pgaName) (pdArgs proc))) <$> S.toList keys procReturnsScalar :: ProcDescription -> Bool procReturnsScalar proc = case proc of diff --git a/test/Feature/RpcSpec.hs b/test/Feature/RpcSpec.hs index 5426d40b3..1afc2016f 100644 --- a/test/Feature/RpcSpec.hs +++ b/test/Feature/RpcSpec.hs @@ -511,19 +511,26 @@ spec actualPgVersion = `shouldRespondWith` [json|{ "p1": "1", "p2": "text"}|] { matchHeaders = [matchContentTypeJson] } - it "should work with an overloaded function" $ do - get "/rpc/overloaded" `shouldRespondWith` - [json|[{ "overloaded": 1 }, - { "overloaded": 2 }, - { "overloaded": 3 }]|] - { matchHeaders = [matchContentTypeJson] } - request methodPost "/rpc/overloaded" [("Prefer","params=single-object")] - [json|[{"x": 1, "y": "first"}, {"x": 2, "y": "second"}]|] - `shouldRespondWith` - [json|[{"x": 1, "y": "first"}, {"x": 2, "y": "second"}]|] - { matchHeaders = [matchContentTypeJson] } - get "/rpc/overloaded?a=1&b=2" `shouldRespondWith` [str|3|] - get "/rpc/overloaded?a=1&b=2&c=3" `shouldRespondWith` [str|"123"|] + context "should work with an overloaded function" $ do + it "overloaded()" $ + get "/rpc/overloaded" `shouldRespondWith` + [json|[{ "overloaded": 1 }, + { "overloaded": 2 }, + { "overloaded": 3 }]|] + { matchHeaders = [matchContentTypeJson] } + + it "overloaded(json) single-object" $ + request methodPost "/rpc/overloaded" [("Prefer","params=single-object")] + [json|[{"x": 1, "y": "first"}, {"x": 2, "y": "second"}]|] + `shouldRespondWith` + [json|[{"x": 1, "y": "first"}, {"x": 2, "y": "second"}]|] + { matchHeaders = [matchContentTypeJson] } + + it "overloaded(int, int)" $ + get "/rpc/overloaded?a=1&b=2" `shouldRespondWith` [str|3|] + + it "overloaded(text, text, text)" $ + get "/rpc/overloaded?a=1&b=2&c=3" `shouldRespondWith` [str|"123"|] context "only for POST rpc" $ do it "gives a parse filter error if GET style proc args are specified" $