From 5579bddb2d36966cd91ece2f699f4fa19aa17f20 Mon Sep 17 00:00:00 2001 From: Taimoor Zaeem Date: Fri, 3 Oct 2025 09:14:24 +0500 Subject: [PATCH] add: Pgrst Patch for partial document update Signed-off-by: Taimoor Zaeem --- CHANGELOG.md | 9 + postgrest.cabal | 1 + src/PostgREST/ApiRequest.hs | 8 +- src/PostgREST/ApiRequest/Payload.hs | 57 +++++- src/PostgREST/ApiRequest/Types.hs | 10 +- src/PostgREST/MainTx.hs | 2 +- src/PostgREST/MediaType.hs | 6 + src/PostgREST/Plan.hs | 4 +- src/PostgREST/Plan/MutatePlan.hs | 13 +- src/PostgREST/Query/QueryBuilder.hs | 12 +- src/PostgREST/Query/SqlFragment.hs | 27 ++- src/PostgREST/Response.hs | 3 +- test/spec/Feature/Query/PgrstPatchSpec.hs | 209 ++++++++++++++++++++++ test/spec/Feature/Query/PlanSpec.hs | 16 ++ test/spec/Main.hs | 2 + test/spec/fixtures/data.sql | 3 + test/spec/fixtures/schema.sql | 5 + 17 files changed, 356 insertions(+), 31 deletions(-) create mode 100644 test/spec/Feature/Query/PgrstPatchSpec.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 58943a93bf..7fd7e9bb46 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,15 @@ This project adheres to [Semantic Versioning](http://semver.org/). ## Unreleased +### Added + +- Improve the `PGRST106` error when the requested schema is invalid by @laurenceisla in #4089 + + It now shows the invalid schema in the `message` field. + + The exposed schemas are now listed in the `hint` instead of the `message` field. +- Improve error details of `PGRST301` error by @taimoorzaeem in #4051 +- Bounded JWT cache using the SIEVE algorithm by @mkleczek in #4084 +- Implement `PGRST Patch` for partial document update by @taimoorzaeem in #3166 + ### Fixed - Fix not logging OpenAPI queries when `log-query=main-query` is enabled by @steve-chavez in #4226 diff --git a/postgrest.cabal b/postgrest.cabal index d9824df5a8..3936888cce 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -242,6 +242,7 @@ test-suite spec Feature.Query.JsonOperatorSpec Feature.Query.MultipleSchemaSpec Feature.Query.NullsStripSpec + Feature.Query.PgrstPatchSpec Feature.Query.PgSafeUpdateSpec Feature.Query.PlanSpec Feature.Query.PostGISSpec diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index fed1c6ac0d..67e13a61c0 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -80,7 +80,7 @@ userApiRequest :: AppConfig -> Preferences.Preferences -> Request -> RequestBody userApiRequest conf prefs req reqBody = do resource <- getResource conf $ pathInfo req (schema, negotiatedByProfile) <- getSchema conf hdrs method - act <- getAction resource schema method + act <- getAction resource schema method contentMediaType qPrms <- first QueryParamError $ QueryParams.parse (actIsInvokeSafe act) $ rawQueryString req (topLevelRange, ranges) <- getRanges method qPrms hdrs (payload, columns) <- getPayload reqBody contentMediaType qPrms act @@ -126,8 +126,8 @@ getResource AppConfig{configOpenApiMode, configDbRootSpec} = \case ["rpc", pName] -> Right $ ResourceRoutine pName _ -> Left InvalidResourcePath -getAction :: Resource -> Schema -> ByteString -> Either ApiRequestError Action -getAction resource schema method = +getAction :: Resource -> Schema -> ByteString -> MediaType -> Either ApiRequestError Action +getAction resource schema method mediaType = case (resource, method) of (ResourceRoutine rout, "HEAD") -> Right . ActDb $ ActRoutine (qi rout) $ InvRead True (ResourceRoutine rout, "GET") -> Right . ActDb $ ActRoutine (qi rout) $ InvRead False @@ -139,7 +139,7 @@ getAction resource schema method = (ResourceRelation rel, "GET") -> Right . ActDb $ ActRelationRead (qi rel) False (ResourceRelation rel, "POST") -> Right . ActDb $ ActRelationMut (qi rel) MutationCreate (ResourceRelation rel, "PUT") -> Right . ActDb $ ActRelationMut (qi rel) MutationSingleUpsert - (ResourceRelation rel, "PATCH") -> Right . ActDb $ ActRelationMut (qi rel) MutationUpdate + (ResourceRelation rel, "PATCH") -> Right . ActDb $ ActRelationMut (qi rel) $ MutationUpdate (mediaType == MTVndPgrstPatch) (ResourceRelation rel, "DELETE") -> Right . ActDb $ ActRelationMut (qi rel) MutationDelete (ResourceRelation rel, "OPTIONS") -> Right $ ActRelationInfo (qi rel) diff --git a/src/PostgREST/ApiRequest/Payload.hs b/src/PostgREST/ApiRequest/Payload.hs index 2c959f895e..c3a00af1c4 100644 --- a/src/PostgREST/ApiRequest/Payload.hs +++ b/src/PostgREST/ApiRequest/Payload.hs @@ -44,6 +44,7 @@ getPayload reqBody contentMediaType QueryParams{qsColumns} action = do (Just ProcessedJSON{payKeys}, _) -> payKeys (Just ProcessedUrlEncoded{payKeys}, _) -> payKeys (Just RawJSON{}, Just cls) -> cls + (Just PgrstPatch{payFields}, _) -> payFields _ -> S.empty return (checkedPayload, cols) where @@ -69,6 +70,12 @@ getPayload reqBody contentMediaType QueryParams{qsColumns} action = do (MTTextPlain, True) -> Right $ RawPay reqBody (MTTextXML, True) -> Right $ RawPay reqBody (MTOctetStream, True) -> Right $ RawPay reqBody + (MTVndPgrstPatch, False) -> + if isJust columns + then Right $ RawJSON reqBody + -- Error message too generic? + else note "All objects should contain 3 key-vals: 'op','path' and 'value', where op and path must be a string" + (pgrstPatchPayloadFields reqBody =<< JSON.decode reqBody) (ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct shouldParsePayload = case action of @@ -78,10 +85,10 @@ getPayload reqBody contentMediaType QueryParams{qsColumns} action = do _ -> False columns = case action of - ActDb (ActRelationMut _ MutationCreate) -> qsColumns - ActDb (ActRelationMut _ MutationUpdate) -> qsColumns - ActDb (ActRoutine _ Inv) -> qsColumns - _ -> Nothing + ActDb (ActRelationMut _ MutationCreate) -> qsColumns + ActDb (ActRelationMut _ (MutationUpdate _)) -> qsColumns + ActDb (ActRoutine _ Inv) -> qsColumns + _ -> Nothing isProc = case action of ActDb (ActRoutine _ _) -> True @@ -136,3 +143,45 @@ payloadAttributes raw json = _ -> Just emptyPJArray where emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty + +-- Here, we verify the following about pgrst patch body: +-- 1. The JSON must be a json array. +-- 2. All objects in the array must have only these three fields: +-- 'op', 'path', 'value'. +-- 3. Finally, extract the 'path' values as fields +-- +-- TODO: Return (Either ByteString Payload) for better error messages +pgrstPatchPayloadFields :: RequestBody -> JSON.Value -> Maybe Payload +pgrstPatchPayloadFields raw (JSON.Array arr) = + if V.all isValidPatchObject arr + then PgrstPatch raw . S.fromList <$> getPaths arr + else Nothing + where + isValidPatchObject (JSON.Object o) = + KM.member "op" o && + KM.member "path" o && + KM.member "value" o && + length (KM.keys o) == 3 + isValidPatchObject _ = False + + getPaths :: V.Vector JSON.Value -> Maybe [Text] + getPaths ar = if any isNothing maybePaths || not (all extractOp $ V.toList ar) + then Nothing + else Just $ catMaybes maybePaths + where + maybePaths :: [Maybe Text] + maybePaths = map extractPath $ V.toList ar + + extractOp (JSON.Object o) = + case KM.lookup "op" o of + Just op -> op == "set" -- we only have "set" operation, for now + Nothing -> False + extractOp _ = False + + extractPath (JSON.Object o) = + case KM.lookup "path" o of + Just (JSON.String path) -> Just path + _ -> Nothing + extractPath _ = Nothing + +pgrstPatchPayloadFields _ _ = Nothing diff --git a/src/PostgREST/ApiRequest/Types.hs b/src/PostgREST/ApiRequest/Types.hs index bf3ddd9b03..5e7590c523 100644 --- a/src/PostgREST/ApiRequest/Types.hs +++ b/src/PostgREST/ApiRequest/Types.hs @@ -55,9 +55,13 @@ data Mutation = MutationCreate | MutationDelete | MutationSingleUpsert - | MutationUpdate + | MutationUpdate PgrstPatch + -- ^ We have two types of updates, regular updates + -- and json patch style updates deriving Eq +type PgrstPatch = Bool + data Resource = ResourceRelation Text | ResourceRoutine Text @@ -91,6 +95,10 @@ data Payload | ProcessedUrlEncoded { payArray :: [(Text, Text)], payKeys :: S.Set Text } | RawJSON { payRaw :: LBS.ByteString } | RawPay { payRaw :: LBS.ByteString } + | PgrstPatch + { payRaw :: LBS.ByteString + , payFields :: S.Set Text -- ^ These are columns that are to be patched. + } -- | The value in `/tbl?select=alias:field.aggregateFunction()::cast` diff --git a/src/PostgREST/MainTx.hs b/src/PostgREST/MainTx.hs index 6a072e7360..0321cedbaf 100644 --- a/src/PostgREST/MainTx.hs +++ b/src/PostgREST/MainTx.hs @@ -159,7 +159,7 @@ actionResult MainQuery{..} (DbCrud _ plan@MutateReadPlan{..}) conf@AppConfig{..} failMutation resultSet = case mrMutation of MutationCreate -> do failNotSingular pMedia resultSet - MutationUpdate -> do + MutationUpdate _ -> do failNotSingular pMedia resultSet failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet MutationSingleUpsert -> do diff --git a/src/PostgREST/MediaType.hs b/src/PostgREST/MediaType.hs index d0055f3bba..6aa8e354e7 100644 --- a/src/PostgREST/MediaType.hs +++ b/src/PostgREST/MediaType.hs @@ -37,6 +37,7 @@ data MediaType -- vendored media types | MTVndArrayJSONStrip | MTVndSingularJSON Bool + | MTVndPgrstPatch -- TODO MTVndPlan should only have its options as [Text]. Its ResultAggregate should have the typed attributes. | MTVndPlan MediaType MTVndPlanFormat [MTVndPlanOption] deriving (Eq, Show, Generic, JSON.ToJSON) @@ -72,6 +73,7 @@ toMime MTTextXML = "text/xml" toMime MTOpenAPI = "application/openapi+json" toMime (MTVndSingularJSON True) = "application/vnd.pgrst.object+json;nulls=stripped" toMime (MTVndSingularJSON False) = "application/vnd.pgrst.object+json" +toMime MTVndPgrstPatch = "application/vnd.pgrst.patch+json" toMime MTUrlEncoded = "application/x-www-form-urlencoded" toMime MTOctetStream = "application/octet-stream" toMime MTAny = "*/*" @@ -121,6 +123,9 @@ toMimePlanFormat PlanText = "text" -- >>> decodeMediaType "application/vnd.pgrst.object+json" -- MTVndSingularJSON False -- +-- >>> decodeMediaType "application/vnd.pgrst.patch+json" +-- MTVndPgrstPatch +-- -- Test uppercase is parsed correctly (per issue #3478) -- >>> decodeMediaType "ApplicatIon/vnd.PgRsT.object+json" -- MTVndSingularJSON False @@ -147,6 +152,7 @@ decodeMediaType mt = decodeMediaType' $ decodeLatin1 mt ("application", "vnd.pgrst.plan+json", _) -> getPlan PlanJSON ("application", "vnd.pgrst.object+json", _) -> MTVndSingularJSON strippedNulls ("application", "vnd.pgrst.object", _) -> MTVndSingularJSON strippedNulls + ("application", "vnd.pgrst.patch+json", _) -> MTVndPgrstPatch ("application", "vnd.pgrst.array+json", _) -> checkArrayNullStrip ("application", "vnd.pgrst.array", _) -> checkArrayNullStrip ("*","*",_) -> MTAny diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index df62291525..c589eee601 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -996,8 +996,8 @@ mutatePlan mutation qi ApiRequest{iPreferences=Preferences{..}, ..} SchemaCache{ case mutation of MutationCreate -> mapRight (\typedColumns -> Insert qi typedColumns body ((,) <$> preferResolution <*> Just confCols) [] returnings pkCols applyDefaults) typedColumnsOrError - MutationUpdate -> - mapRight (\typedColumns -> Update qi typedColumns body combinedLogic returnings applyDefaults) typedColumnsOrError + MutationUpdate pgrstPatch -> + mapRight (\typedColumns -> Update qi typedColumns body combinedLogic returnings applyDefaults pgrstPatch) typedColumnsOrError MutationSingleUpsert -> if null qsLogic && qsFilterFields == S.fromList pkCols && diff --git a/src/PostgREST/Plan/MutatePlan.hs b/src/PostgREST/Plan/MutatePlan.hs index 56f6316504..aa89a08cc9 100644 --- a/src/PostgREST/Plan/MutatePlan.hs +++ b/src/PostgREST/Plan/MutatePlan.hs @@ -26,12 +26,13 @@ data MutatePlan , applyDefs :: Bool } | Update - { in_ :: QualifiedIdentifier - , updCols :: [CoercibleField] - , updBody :: Maybe LBS.ByteString - , where_ :: [CoercibleLogicTree] - , returning :: [FieldName] - , applyDefs :: Bool + { in_ :: QualifiedIdentifier + , updCols :: [CoercibleField] + , updBody :: Maybe LBS.ByteString + , where_ :: [CoercibleLogicTree] + , returning :: [FieldName] + , applyDefs :: Bool + , isPgrstPatch :: Bool } | Delete { in_ :: QualifiedIdentifier diff --git a/src/PostgREST/Query/QueryBuilder.hs b/src/PostgREST/Query/QueryBuilder.hs index d69a3709bd..e7d65264c9 100644 --- a/src/PostgREST/Query/QueryBuilder.hs +++ b/src/PostgREST/Query/QueryBuilder.hs @@ -119,9 +119,10 @@ getJoin fld node@(Node ReadPlan{relJoinType, relSpread} _) = correlatedSubquery (selectSubqAgg <> fromSubqAgg) aggAlias joinCondition mutatePlanToQuery :: MutatePlan -> SQL.Snippet +-- INSERT: Corresponds to HTTP POST and PUT methods mutatePlanToQuery (Insert mainQi iCols body onConflict putConditions returnings _ applyDefaults) = "INSERT INTO " <> fromQi mainQi <> (if null iCols then " " else "(" <> cols <> ") ") <> - fromJsonBodyF body iCols True False applyDefaults <> + fromJsonBodyF body iCols True False applyDefaults False <> -- Only used for PUT (if null putConditions then mempty else "WHERE " <> addConfigPgrstInserted True <> " AND " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "pgrst_body") <$> putConditions)) <> (if null putConditions && mergeDups then "WHERE " <> addConfigPgrstInserted True else mempty) <> @@ -142,7 +143,8 @@ mutatePlanToQuery (Insert mainQi iCols body onConflict putConditions returnings cols = intercalateSnippet ", " $ pgFmtIdent . cfName <$> iCols mergeDups = case onConflict of {Just (MergeDuplicates,_) -> True; _ -> False;} -mutatePlanToQuery (Update mainQi uCols body logicForest returnings applyDefaults) +-- UPDATE: Corresponds to HTTP PATCH method +mutatePlanToQuery (Update mainQi uCols body logicForest returnings applyDefaults isPgrstPatch) | null uCols = -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax -- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select= @@ -151,7 +153,7 @@ mutatePlanToQuery (Update mainQi uCols body logicForest returnings applyDefaults | otherwise = "UPDATE " <> mainTbl <> " SET " <> cols <> " " <> - fromJsonBodyF body uCols False False applyDefaults <> + fromJsonBodyF body uCols False False applyDefaults isPgrstPatch <> whereLogic <> " " <> returningF mainQi returnings @@ -161,6 +163,7 @@ mutatePlanToQuery (Update mainQi uCols body logicForest returnings applyDefaults emptyBodyReturnedColumns = if null returnings then "NULL" else intercalateSnippet ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings) cols = intercalateSnippet ", " (pgFmtIdent . cfName <> const " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_body") . cfName <$> uCols) +-- DELETE: Corresponds to HTTP DELETE method mutatePlanToQuery (Delete mainQi logicForest returnings) = "DELETE FROM " <> fromQi mainQi <> " " <> whereLogic <> " " <> @@ -168,6 +171,7 @@ mutatePlanToQuery (Delete mainQi logicForest returnings) = where whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest) + callPlanToQuery :: CallPlan -> SQL.Snippet callPlanToQuery (FunctionCall qi params arguments returnsScalar returnsSetOfScalar filterFields returnings) = "SELECT " <> (if returnsScalar || returnsSetOfScalar then "pgrst_call.pgrst_scalar" else returnedColumns) <> " " <> @@ -181,7 +185,7 @@ callPlanToQuery (FunctionCall qi params arguments returnsScalar returnsSetOfScal KeyParams [] -> "FROM " <> callIt mempty KeyParams prms -> case arguments of DirectArgs args -> "FROM " <> callIt (fmtArgs prms args) - JsonArgs json -> fromJsonBodyF json ((\p -> CoercibleField (ppName p) mempty False Nothing (ppTypeMaxLength p) mempty Nothing Nothing False) <$> prms) False True False <> ", " <> + JsonArgs json -> fromJsonBodyF json ((\p -> CoercibleField (ppName p) mempty False Nothing (ppTypeMaxLength p) mempty Nothing Nothing False) <$> prms) False True False False <> ", " <> "LATERAL " <> callIt (fmtParams prms) callIt :: SQL.Snippet -> SQL.Snippet diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index 0841058a73..d633a92475 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -315,8 +315,8 @@ pgFmtFullSelName aggAlias fieldName = case fieldName of _ -> pgFmtIdent aggAlias <> "." <> pgFmtIdent fieldName -- TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body -fromJsonBodyF :: Maybe LBS.ByteString -> [CoercibleField] -> Bool -> Bool -> Bool -> SQL.Snippet -fromJsonBodyF body fields includeSelect includeLimitOne includeDefaults = +fromJsonBodyF :: Maybe LBS.ByteString -> [CoercibleField] -> Bool -> Bool -> Bool -> Bool -> SQL.Snippet +fromJsonBodyF body fields includeSelect includeLimitOne includeDefaults isPgrstPatch = selectClause <> fromClause <> defaultsClause <> lateralClause <> " pgrst_body " where selectClause = if includeSelect then "SELECT " <> namedCols <> " " else mempty @@ -346,12 +346,25 @@ fromJsonBodyF body fields includeSelect includeLimitOne includeDefaults = extractFieldDefault CoercibleField{cfName=nam, cfDefault=Just def} = Just $ encodeUtf8 (pgFmtLit nam <> ", " <> def) extractFieldDefault CoercibleField{cfDefault=Nothing} = Nothing - (finalBodyF, jsonArrayElementsF, jsonToRecordsetF) = + (finalBodyF, jsonArrayElementsF, jsonToRecordsetF, jsonObjectAggF, jsonCastF, jsonBuildArrayF) = if includeDefaults - then ("pgrst_json_defs.val", "jsonb_array_elements", if isJsonObject then "jsonb_to_record" else "jsonb_to_recordset") - else ("pgrst_payload.json_data", "json_array_elements", if isJsonObject then "json_to_record" else "json_to_recordset") - - jsonPlaceHolder = SQL.encoderAndParam (HE.nullable $ if includeDefaults then HE.jsonbLazyBytes else HE.jsonLazyBytes) body + then ("pgrst_json_defs.val", "jsonb_array_elements", if isJsonObject then "jsonb_to_record" else "jsonb_to_recordset", "jsonb_object_agg", "::jsonb", "jsonb_build_array") + else ("pgrst_payload.json_data", "json_array_elements", if isJsonObject then "json_to_record" else "json_to_recordset", "json_object_agg", "::json", "json_build_array") + jsonPlaceHolder = + if isPgrstPatch + -- For pgrst patch updates, given json: + -- [{"op":"set","path":"name","value":"john"}, + -- {"op":"set","path":"age" ,"value":20}] + -- We extract the key,values using pg json functions and convert + -- it to a regular json, so we get: {"name":"john","age": 20}. + then + "( SELECT " <> jsonBuildArrayF <> "( " <> jsonObjectAggF <> "(patch_row ->> 'path', patch_row ->> 'value') ) " + <> "FROM " <> jsonArrayElementsF <> "(" + <> SQL.encoderAndParam (HE.nullable $ if includeDefaults then HE.jsonbLazyBytes else HE.jsonLazyBytes) body + <> jsonCastF <> ") as patch_row )" + -- For regular updates, we encode the complete body as is, e.g {"name":"john","age":20} + else + SQL.encoderAndParam (HE.nullable $ if includeDefaults then HE.jsonbLazyBytes else HE.jsonLazyBytes) body isJsonObject = -- light validation as pg's json_to_record(set) already validates that the body is valid JSON. We just need to know whether the body looks like an object or not. LBS.take 1 (LBS.dropWhile (`elem` insignificantWhitespace) (fromMaybe mempty body)) == "{" where diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs index 065c722f71..bdaabd7832 100644 --- a/src/PostgREST/Response.hs +++ b/src/PostgREST/Response.hs @@ -82,7 +82,6 @@ actionResponse (DbCrudResult WrappedReadPlan{pMedia, wrHdrsOnly=headersOnly, cru Error.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal) | headersOnly = mempty | otherwise = LBS.fromStrict rsBody - (ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers Right $ PgrstResponse ovStatus ovHeaders bod @@ -125,7 +124,7 @@ actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationCreate, mrMutateP Right $ PgrstResponse ovStatus ovHeaders bod -actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationUpdate, pMedia} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = do +actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationUpdate _, pMedia} RSStandard{..}) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = do let contentRangeHeader = Just . RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $ diff --git a/test/spec/Feature/Query/PgrstPatchSpec.hs b/test/spec/Feature/Query/PgrstPatchSpec.hs new file mode 100644 index 0000000000..073c4fabf4 --- /dev/null +++ b/test/spec/Feature/Query/PgrstPatchSpec.hs @@ -0,0 +1,209 @@ +module Feature.Query.PgrstPatchSpec where + +import Network.Wai (Application) +import Test.Hspec hiding (pendingWith) + +import Network.HTTP.Types +import Test.Hspec.Wai +import Test.Hspec.Wai.JSON + +import Protolude hiding (get) +import SpecHelper + +spec :: SpecWith ((), Application) +spec = do + let jsonPatchCT = ("Content-Type","application/vnd.pgrst.patch+json") + describe "Partial Document Update using JSON Patch" $ do + context "Update Single Row" $ do + it "should set a single integer column" $ + request methodPatch "/test_pgrst_patch?id=eq.3" + [jsonPatchCT] + [json| [ + { "op": "set", "path": "id", "value": "10" } + ] |] + `shouldRespondWith` + "" + { matchStatus = 204 + , matchHeaders = [] + } + + it "should set a single integer column and return" $ + request methodPatch "/test_pgrst_patch?id=eq.3" + [jsonPatchCT, ("Prefer","return=representation")] + [json| [ + { "op": "set", "path": "id", "value": "10" } + ] |] + `shouldRespondWith` + [json| [{"id":10,"name":"eddy"}] |] + { matchStatus = 200 + , matchHeaders = ["Preference-Applied" <:> "return=representation"] + } + + it "should set a single text column" $ + request methodPatch "/test_pgrst_patch?id=eq.2" + [jsonPatchCT] + [json| [ + { "op": "set", "path": "name", "value": "double d" } + ] |] + `shouldRespondWith` + "" + { matchStatus = 204 + , matchHeaders = [] + } + + it "should set a single text column and return" $ + request methodPatch "/test_pgrst_patch?id=eq.2" + [jsonPatchCT, ("Prefer","return=representation")] + [json| [ + { "op": "set", "path": "name", "value": "double d" } + ] |] + `shouldRespondWith` + [json| [{"id":2,"name":"double d"}] |] + { matchStatus = 200 + , matchHeaders = ["Preference-Applied" <:> "return=representation"] + } + + it "should set multiple columns and return" $ + request methodPatch "/test_pgrst_patch?id=eq.2" + [jsonPatchCT, ("Prefer","return=representation")] + [json| [ + { "op": "set", "path": "id", "value": "10" }, + { "op": "set", "path": "name", "value": "double d" } + ] |] + `shouldRespondWith` + [json| [{"id":10,"name":"double d"}] |] + { matchStatus = 200 + , matchHeaders = ["Preference-Applied" <:> "return=representation"] + } + + it "should err on invalid operator" $ + request methodPatch "/test_pgrst_patch?id=eq.2" + [jsonPatchCT, ("Prefer","return=representation")] + [json| [ + { "op": "invalid_op", "path": "id", "value": "10" } + ] |] + `shouldRespondWith` + [json| {"code":"PGRST102","details":null,"hint":null,"message":"All objects should contain 3 key-vals: 'op','path' and 'value', where op and path must be a string"} |] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + + it "should err when op is other type instead of string" $ + request methodPatch "/test_pgrst_patch?id=eq.2" + [jsonPatchCT] + [json| [ + { "op": 403, "path": "id", "value": "20" } + ] |] + `shouldRespondWith` + [json| {"code":"PGRST102","details":null,"hint":null,"message":"All objects should contain 3 key-vals: 'op','path' and 'value', where op and path must be a string"} |] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + + it "should err when path is other type instead of string" $ + request methodPatch "/test_pgrst_patch?id=eq.3" + [jsonPatchCT] + [json| [ + { "op": "incr", "path": 403, "value": "20" } + ] |] + `shouldRespondWith` + [json| {"code":"PGRST102","details":null,"hint":null,"message":"All objects should contain 3 key-vals: 'op','path' and 'value', where op and path must be a string"} |] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + + it "should err when value other type instead of number" $ + request methodPatch "/test_pgrst_patch?id=eq.3" + [jsonPatchCT, ("Prefer","return=representation")] + [json| [ + { "op": "set", "path": "id", "value": "string" } + ] |] + `shouldRespondWith` + [json| {"code":"22P02","details":null,"hint":null,"message":"invalid input syntax for type integer: \"string\""} |] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + + it "should err on wrong json patch format" $ + request methodPatch "/test_pgrst_patch?id=eq.2" + [jsonPatchCT] + [json| { "non-json-patch": "wrong-format" }|] + `shouldRespondWith` + [json| {"code":"PGRST102","details":null,"hint":null,"message":"All objects should contain 3 key-vals: 'op','path' and 'value', where op and path must be a string"} |] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + + it "should err when column not found" $ + request methodPatch "/test_pgrst_patch?id=eq.2" + [jsonPatchCT, ("Prefer","return=representation")] + [json| [ + { "op": "set", "path": "non-existent-column", "value": "double d" } + ] |] + `shouldRespondWith` + [json| {"code":"PGRST204","details":null,"hint":null,"message":"Could not find the 'non-existent-column' column of 'test_pgrst_patch' in the schema cache"} |] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + + it "should return content-length on success" $ + request methodPatch "/test_pgrst_patch?id=eq.3" + [jsonPatchCT, ("Prefer","return=representation")] + [json| [ + { "op": "set", "path": "id", "value": "10" } + ] |] + `shouldRespondWith` + [json| [{"id":10,"name":"eddy"}] |] + { matchStatus = 200 + , matchHeaders = ["Content-Length" <:> "25", + "Preference-Applied" <:> "return=representation"] + } + + it "should work with count=exact" $ -- added for coverage, not much useful to have? + request methodPatch "/test_pgrst_patch?id=eq.3" + [jsonPatchCT, ("Prefer","return=representation, count=exact")] + [json| [ + { "op": "set", "path": "id", "value": "10" } + ] |] + `shouldRespondWith` + [json| [{"id":10,"name":"eddy"}] |] + { matchStatus = 200 + , matchHeaders = ["Content-Length" <:> "25", + "Content-Range" <:> "0-0/1", + "Preference-Applied" <:> "return=representation, count=exact"] + } + + it "should set on multiple conditions in where logic" $ + request methodPatch "/test_pgrst_patch?id=eq.3&name=eq.eddy" + [jsonPatchCT, ("Prefer","return=representation")] + [json| [ + { "op": "set", "path": "id", "value": "10" } + ] |] + `shouldRespondWith` + [json| [{"id":10,"name":"eddy"}] |] + { matchStatus = 200 + , matchHeaders = ["Preference-Applied" <:> "return=representation"] + } + + it "should return empty on empty body" $ + request methodPatch "/test_pgrst_patch" + [jsonPatchCT] + [json| [] |] + `shouldRespondWith` + "" + { matchStatus = 204 + , matchHeaders = [] + } + + it "should only update the columns in the &columns query param" $ + request methodPatch "/test_pgrst_patch?id=eq.2&columns=name" + [jsonPatchCT, ("Prefer","return=representation")] + [json| [ + { "op": "set", "path": "id", "value": "10" }, + { "op": "set", "path": "name", "value": "double d" } + ] |] + `shouldRespondWith` + [json| [{"id":2,"name":"double d"}] |] + { matchStatus = 200 + , matchHeaders = ["Preference-Applied" <:> "return=representation"] + } diff --git a/test/spec/Feature/Query/PlanSpec.hs b/test/spec/Feature/Query/PlanSpec.hs index f045c8aa9d..8ed0303899 100644 --- a/test/spec/Feature/Query/PlanSpec.hs +++ b/test/spec/Feature/Query/PlanSpec.hs @@ -145,6 +145,22 @@ spec actualPgVersion = do resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } totalCost `shouldBe` 8.23 + it "outputs the total cost for a pgrst patch" $ do + r <- request methodPatch "/projects?id=eq.3" + [("Accept","application/vnd.pgrst.plan+json"), + ("Content-Type","application/vnd.pgrst.patch+json")] + [json|[{"op":"set","path":"name","value":"Patched Project"}]|] + + let totalCost = planCost r + resHeaders = simpleHeaders r + resStatus = simpleStatus r + + liftIO $ do + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8") + resHeaders `shouldSatisfy` notZeroContentLength + resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } + totalCost `shouldBe` 14.21 + it "outputs the total cost for a delete" $ do r <- request methodDelete "/projects?id=in.(1,2,3)" (acceptHdrs "application/vnd.pgrst.plan+json") "" diff --git a/test/spec/Main.hs b/test/spec/Main.hs index e847926b6f..8659c78c4e 100644 --- a/test/spec/Main.hs +++ b/test/spec/Main.hs @@ -50,6 +50,7 @@ import qualified Feature.Query.InsertSpec import qualified Feature.Query.JsonOperatorSpec import qualified Feature.Query.MultipleSchemaSpec import qualified Feature.Query.NullsStripSpec +import qualified Feature.Query.PgrstPatchSpec import qualified Feature.Query.PgSafeUpdateSpec import qualified Feature.Query.PlanSpec import qualified Feature.Query.PostGISSpec @@ -152,6 +153,7 @@ main = do , ("Feature.Query.InsertSpec" , Feature.Query.InsertSpec.spec actualPgVersion) , ("Feature.Query.JsonOperatorSpec" , Feature.Query.JsonOperatorSpec.spec) , ("Feature.Query.NullsStripSpec" , Feature.Query.NullsStripSpec.spec) + , ("Feature.Query.PgrstPatchSpec" , Feature.Query.PgrstPatchSpec.spec) , ("Feature.Query.PgErrorCodeMappingSpec" , Feature.Query.ErrorSpec.pgErrorCodeMapping) , ("Feature.Query.PgSafeUpdateSpec.disabledSpec" , Feature.Query.PgSafeUpdateSpec.disabledSpec) , ("Feature.Query.PlanSpec.disabledSpec" , Feature.Query.PlanSpec.disabledSpec) diff --git a/test/spec/fixtures/data.sql b/test/spec/fixtures/data.sql index b0304ae01c..11ccc4a232 100644 --- a/test/spec/fixtures/data.sql +++ b/test/spec/fixtures/data.sql @@ -970,3 +970,6 @@ VALUES (1, 'stratosphere', 1), (2, 'ants from up above',2), (3, 'vespertine',3), (4, 'contemporary movement', 1); + +TRUNCATE TABLE test_pgrst_patch CASCADE; +INSERT INTO test_pgrst_patch VALUES (1,'ed'), (2,'edd'), (3,'eddy'); diff --git a/test/spec/fixtures/schema.sql b/test/spec/fixtures/schema.sql index 19167867b6..779cbee27e 100644 --- a/test/spec/fixtures/schema.sql +++ b/test/spec/fixtures/schema.sql @@ -3846,3 +3846,8 @@ $$ language sql; create function do_nothing() returns void as $_$ $_$ language sql; + +CREATE TABLE test_pgrst_patch ( + id INTEGER PRIMARY KEY, + name TEXT +);