Add UPSERT for POST with Prefer:resoultion=merge/ignore-duplicates

postgrest.cabal

@@ -132,6 +132,7 @@ Test-Suite spec
                      , Feature.AndOrParamsSpec
                      , Feature.RpcSpec
                      , Feature.NonexistentSchemaSpec
+                     , Feature.UpsertSpec
                      , SpecHelper
                      , TestTypes
   Build-Depends:       aeson

src/PostgREST/ApiRequest.hs

@@ -55,7 +55,7 @@ data Target = TargetIdent QualifiedIdentifier
             deriving Eq
 -- | How to return the inserted data
 data PreferRepresentation = Full | HeadersOnly | None deriving Eq
-                          --
+
 {-|
   Describes what the user wants to do. This data type is a
   translation of the raw elements of an HTTP request into domain
@@ -80,6 +80,8 @@ data ApiRequest = ApiRequest {
   , iPreferSingleObjectParameter :: Bool
   -- | Whether the client wants a result count (slower)
   , iPreferCount :: Bool
+  -- | Whether the client wants to UPSERT or ignore records on PK conflict
+  , iPreferResolution :: Maybe PreferResolution
   -- | Filters on the result ("id", "eq.10")
   , iFilters :: [(Text, Text)]
   -- | &and and &or parameters used for complex boolean logic
@@ -114,6 +116,9 @@ userApiRequest schema req reqBody
       , iPreferRepresentation = representation
       , iPreferSingleObjectParameter = singleObject
       , iPreferCount = hasPrefer "count=exact"
+      , iPreferResolution = if hasPrefer "resolution=merge-duplicates" then Just MergeDuplicates
+                            else if hasPrefer "resolution=ignore-duplicates" then Just IgnoreDuplicates
+                            else Nothing
       , iFilters = filters
       , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
       , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams

src/PostgREST/App.hs

@@ -278,7 +278,7 @@ app dbStructure proc conf apiRequest =
               uri Nothing = ("http", host, port, "/")
               uri (Just Proxy { proxyScheme = s, proxyHost = h, proxyPort = p, proxyPath = b }) = (s, h, p, b)
               uri' = uri proxy
-              encodeApi ti sd procs = encodeOpenAPI (concat $ M.elems procs) (toTableInfo ti) uri' sd (dbPrimaryKeys dbStructure)
+              encodeApi ti sd procs = encodeOpenAPI (concat $ M.elems procs) (toTableInfo ti) uri' sd allPrKeys
           body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription <*> H.query schema accessibleProcs
           return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
 
@@ -311,7 +311,7 @@ app dbStructure proc conf apiRequest =
       readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) proc apiRequest
       fldNames = fieldNames <$> readReq
       readDbRequest = DbRead <$> readReq
-      mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< fldNames)
+      mutateDbRequest = DbMutate <$> (mutateRequest apiRequest allPrKeys =<< fldNames)
       selectQuery = requestToQuery schema False <$> readDbRequest
       mutateQuery = requestToQuery schema False <$> mutateDbRequest
       countQuery = requestToCountQuery schema <$> readDbRequest

src/PostgREST/Config.hs

@@ -19,6 +19,7 @@ module PostgREST.Config ( prettyVersion
                         , readOptions
                         , corsPolicy
                         , minimumPgVersion
+                        , pgVersion95
                         , pgVersion96
                         , AppConfig (..)
                         )
@@ -231,3 +232,6 @@ minimumPgVersion = PgVersion 90400 "9.4"
 
 pgVersion96 :: PgVersion
 pgVersion96 = PgVersion 90600 "9.6"
+
+pgVersion95 :: PgVersion
+pgVersion95 = PgVersion 90500 "9.5"

src/PostgREST/DbRequestBuilder.hs

@@ -302,21 +302,22 @@ toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
   | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt}
   | otherwise = Nothing
 
-mutateRequest :: ApiRequest -> [FieldName] -> Either Response MutateRequest
-mutateRequest apiRequest fldNames = mapLeft apiRequestError $
+mutateRequest :: ApiRequest -> [PrimaryKey] -> [FieldName] -> Either Response MutateRequest
+mutateRequest apiRequest pks fldNames = mapLeft apiRequestError $
   case action of
-    ActionCreate -> Right $ Insert rootTableName payload returnings
+    ActionCreate -> Right $ Insert rootTableName payload pkCols_ (iPreferResolution apiRequest) returnings
     ActionUpdate -> Update rootTableName <$> pure payload <*> combinedLogic <*> pure returnings
     ActionDelete -> Delete rootTableName <$> combinedLogic <*> pure returnings
-    _        -> Left UnsupportedVerb
+    _            -> Left UnsupportedVerb
   where
     action = iAction apiRequest
     payload = fromJust $ iPayload apiRequest
-    rootTableName = -- TODO: Make it safe
-      let target = iTarget apiRequest in
-      case target of
-        (TargetIdent (QualifiedIdentifier _ t) ) -> t
+    (schema, rootTableName) = -- TODO: Make it safe
+      case iTarget apiRequest of
+        TargetIdent (QualifiedIdentifier s t) -> (s, t)
         _ -> undefined
+    pkCols_ = pkName <$> filter (filterPk schema rootTableName) pks
+    filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
     returnings = if iPreferRepresentation apiRequest == None then [] else fldNames
     filters = map snd <$> mapM pRequestFilter mutateFilters
     logic = map snd <$> mapM pRequestLogicTree logicFilters

src/PostgREST/QueryBuilder.hs

@@ -275,7 +275,7 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
     --posible relations are Child Parent Many
     getQueryParts _ _ = undefined
-requestToQuery schema _ (DbMutate (Insert mainTbl p@(PayloadJSON _ pType keys) returnings)) =
+requestToQuery schema _ (DbMutate (Insert mainTbl p@(PayloadJSON _ pType keys) _pkCols _onConflict returnings)) =
   unwords [
     ("WITH " <> ignoredBody) `emptyOnFalse` not payloadIsEmpty,
     "INSERT INTO ", fromQi qi, if payloadIsEmpty then " " else "(" <> cols <> ") ",
@@ -286,7 +286,13 @@ requestToQuery schema _ (DbMutate (Insert mainTbl p@(PayloadJSON _ pType keys) r
         "SELECT " <> cols <> " FROM ",
         case pType of
           PJObject  -> "json_populate_record"
-          PJArray _ -> "json_populate_recordset", "(null::", fromQi qi, ", $1) "],
+          PJArray _ -> "json_populate_recordset", "(null::", fromQi qi, ", $1)"],
+    case _onConflict of
+      Just IgnoreDuplicates  -> "ON CONFLICT(" <> intercalate ", " _pkCols <> ") DO NOTHING "
+      Just MergeDuplicates -> "ON CONFLICT(" <> intercalate ", " _pkCols <> ") DO UPDATE SET " <>
+                               intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList (keys `S.difference` S.fromList _pkCols))
+
+      Nothing -> "",
     ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
     ]
   where

src/PostgREST/Types.hs

@@ -25,6 +25,8 @@ data ApiRequestError = ActionInappropriate
                      | UnsupportedVerb
                      deriving (Show, Eq)
 
+data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving (Eq, Show)
+
 data DbStructure = DbStructure {
   dbTables      :: [Table]
 , dbColumns     :: [Column]
@@ -262,7 +264,7 @@ type EmbedPath = [Text]
 data Filter = Filter { field::Field, opExpr::OpExpr } deriving (Show, Eq)
 
 data ReadQuery = Select { select::[SelectItem], from::[TableName], where_::[LogicTree], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq)
-data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] }
+data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, pkCols::[Text], onConflict:: Maybe PreferResolution, returning::[FieldName] }
                  | Delete { in_::TableName, where_::[LogicTree], returning::[FieldName] }
                  | Update { in_::TableName, qPayload::PayloadJSON, where_::[LogicTree], returning::[FieldName] } deriving (Show, Eq)
 type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail))

test/Feature/UpsertSpec.hs

@@ -0,0 +1,73 @@
+module Feature.UpsertSpec where
+
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.HTTP.Types
+
+import SpecHelper
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "UPSERT" $
+    context "POST with Prefer headers" $ do
+      context "when Prefer: resolution=merge-duplicates is specified" $ do
+        it "does upsert on pk conflict" $
+          request methodPost "/tiobe_pls" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]
+            [json| [
+              { "name": "Javascript", "rank": 6 },
+              { "name": "Java", "rank": 5 }
+            ]|] `shouldRespondWith` [json| [
+              { "name": "Javascript", "rank": 6 },
+              { "name": "Java", "rank": 5 }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = [matchContentTypeJson]
+            }
+
+        it "does upsert on composite pk conflict" $
+          request methodPost "/employees" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]
+            [json| [
+              { "first_name": "Frances M.", "last_name": "Roe", "salary": "30000" },
+              { "first_name": "Peter S.", "last_name": "Yang", "salary": 42000 }
+            ]|] `shouldRespondWith` [json| [
+              { "first_name": "Frances M.", "last_name": "Roe", "salary": "$30,000.00", "company": "One-Up Realty", "occupation": "Author" },
+              { "first_name": "Peter S.", "last_name": "Yang", "salary": "$42,000.00", "company": null, "occupation": null }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = [matchContentTypeJson]
+            }
+
+      context "when Prefer: resolution=ignore-duplicates is specified" $ do
+        it "ignores records on pk conflict" $ do
+          request methodPost "/tiobe_pls" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]
+            [json|[
+              { "name": "PHP", "rank": 9 },
+              { "name": "Python", "rank": 10 }
+            ]|] `shouldRespondWith` [json|[
+              { "name": "PHP", "rank": 9 }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = [matchContentTypeJson]
+            }
+          get "/tiobe_pls?rank=gte.9" `shouldRespondWith`
+            [json| [{ "name": "PHP", "rank": 9 }] |]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "ignores records on composite pk conflict" $ do
+          request methodPost "/employees" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]
+            [json|[
+              { "first_name": "Daniel B.", "last_name": "Lyon", "salary": "72000", "company": null, "occupation": null },
+              { "first_name": "Sara M.", "last_name": "Torpey", "salary": 60000, "company": "Burstein-Applebee", "occupation": "Soil scientist" }
+            ]|] `shouldRespondWith` [json|[
+              { "first_name": "Sara M.", "last_name": "Torpey", "salary": "$60,000.00", "company": "Burstein-Applebee", "occupation": "Soil scientist" }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = [matchContentTypeJson]
+            }
+          get "/employees?first_name=eq.Daniel B.&last_name=eq.Lyon" `shouldRespondWith`
+            [json| [{ "first_name": "Daniel B.", "last_name": "Lyon", "salary": "$36,000.00", "company": "Dubrow's Cafeteria", "occupation": "Packer" }] |]
+            { matchHeaders = [matchContentTypeJson] }

test/Main.hs

@@ -6,7 +6,7 @@ import SpecHelper
 import qualified Hasql.Pool as P
 
 import PostgREST.App (postgrest)
-import PostgREST.Config (pgVersion96, configSettings)
+import PostgREST.Config (pgVersion95, pgVersion96, configSettings)
 import PostgREST.DbStructure (getDbStructure, getPgVersion, fillSessionWithSettings)
 import PostgREST.Types (DbStructure(..))
 import Data.Function (id)
@@ -32,6 +32,7 @@ import qualified Feature.AndOrParamsSpec
 import qualified Feature.RpcSpec
 import qualified Feature.NonexistentSchemaSpec
 import qualified Feature.PgVersion96Spec
+import qualified Feature.UpsertSpec
 
 import Protolude
 
@@ -62,7 +63,9 @@ main = do
       reset = P.use pool (fillSessionWithSettings (configSettings $ testCfg testDbConn)) >> resetDb testDbConn
 
       actualPgVersion = pgVersion dbStructure
-      pg96spec | actualPgVersion >= pgVersion96 = [("Feature.PgVersion96Spec"  , Feature.PgVersion96Spec.spec)]
+      upsertSpec | actualPgVersion >= pgVersion95 = [("Feature.UpsertSpec", Feature.UpsertSpec.spec)]
+                 | otherwise = []
+      pg96spec | actualPgVersion >= pgVersion96 = [("Feature.PgVersion96Spec", Feature.PgVersion96Spec.spec)]
                | otherwise = []
 
       specs = uncurry describe <$> [
@@ -78,7 +81,7 @@ main = do
         , ("Feature.StructureSpec"          , Feature.StructureSpec.spec)
         , ("Feature.AndOrParamsSpec"        , Feature.AndOrParamsSpec.spec)
         , ("Feature.NonexistentSchemaSpec"  , Feature.NonexistentSchemaSpec.spec)
-        ] ++ pg96spec
+        ] ++ pg96spec ++ upsertSpec
 
   hspec $ do
     mapM_ (beforeAll_ reset . before withApp) specs

test/fixtures/data.sql

@@ -334,6 +334,12 @@ INSERT INTO part VALUES (1), (2), (3), (4);
 
 TRUNCATE TABLE being_part CASCADE;
 INSERT INTO being_part VALUES (1,1), (2,1), (3,2), (4,3);
---
--- PostgreSQL database dump complete
---
+
+TRUNCATE TABLE employees CASCADE;
+INSERT INTO employees VALUES
+  ('Frances M.', 'Roe', '24000', 'One-Up Realty', 'Author'),
+  ('Daniel B.', 'Lyon', '36000', 'Dubrow''s Cafeteria', 'Packer'),
+  ('Edwin S.', 'Smith', '48000', 'Pro Garden Management', 'Marine biologist');
+
+TRUNCATE TABLE tiobe_pls CASCADE;
+INSERT INTO tiobe_pls VALUES ('Java', 1), ('C', 2), ('Python', 4);

test/fixtures/privileges.sql

@@ -63,6 +63,8 @@ GRANT ALL ON TABLE
     , part
     , leak
     , perf_articles
+    , employees
+    , tiobe_pls
 TO postgrest_test_anonymous;
 
 GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;

test/fixtures/schema.sql

@@ -1357,3 +1357,17 @@ create table test.perf_articles(
   id integer not null,
   body text not null
 );
+
+create table test.employees(
+  first_name text,
+  last_name text,
+  salary money,
+  company text,
+  occupation text,
+  primary key(first_name, last_name)
+);
+
+create table test.tiobe_pls(
+  name text primary key,
+  rank smallint
+);