add: Pgrst Patch for partial document update

Signed-off-by: Taimoor Zaeem <[email protected]>

Author: taimoorzaeem

CHANGELOG.md

@@ -12,6 +12,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
   + 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
 

postgrest.cabal

@@ -239,6 +239,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

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)
 

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

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`

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

src/PostgREST/Plan.hs

@@ -975,8 +975,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 &&

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

src/PostgREST/Query.hs

@@ -142,7 +142,7 @@ actionQuery (DbCrud plan@MutateReadPlan{..}) conf@AppConfig{..} apiReq@ApiReques
     failMutation resultSet = case mrMutation of
       MutationCreate -> do
         failNotSingular mrMedia resultSet
-      MutationUpdate -> do
+      MutationUpdate _ -> do
         failNotSingular mrMedia resultSet
         failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
       MutationSingleUpsert -> do

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,13 +163,15 @@ 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 <> " " <>
   returningF mainQi 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