Make costly bulk call query optional

Bulk Call should be used by specifying
the `Prefer: params=multiple-objects` header.

CHANGELOG.md

@@ -9,6 +9,10 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 - #1383, Add support for HEAD request - @steve-chavez
 
+### Changed
+
+- #1385, bulk RPC call now should be done by specifying a `Prefer: params=multiple-objects` header - @steve-chavez
+
 ### Fixed
 
 ## [6.0.2] - 2019-08-22

src/PostgREST/ApiRequest.hs

@@ -3,6 +3,7 @@ Module      : PostgREST.ApiRequest
 Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
 -}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
 
 module PostgREST.ApiRequest (
   ApiRequest(..)
@@ -65,6 +66,7 @@ data Target = TargetIdent QualifiedIdentifier
             | TargetDefaultSpec -- The default spec offered at root "/"
             | TargetUnknown [Text]
             deriving Eq
+
 -- | How to return the inserted data
 data PreferRepresentation = Full | HeadersOnly | None deriving Eq
 
@@ -77,43 +79,43 @@ data PreferRepresentation = Full | HeadersOnly | None deriving Eq
 -}
 data ApiRequest = ApiRequest {
   -- | Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
-    iAction                      :: Action
+    iAction               :: Action
   -- | Requested range of rows within response
-  , iRange                       :: M.HashMap ByteString NonnegRange
+  , iRange                :: M.HashMap ByteString NonnegRange
   -- | Requested range of rows from the top level
-  , iTopLevelRange               :: NonnegRange
+  , iTopLevelRange        :: NonnegRange
   -- | The target, be it calling a proc or accessing a table
-  , iTarget                      :: Target
+  , iTarget               :: Target
   -- | Content types the client will accept, [CTAny] if no Accept header
-  , iAccepts                     :: [ContentType]
+  , iAccepts              :: [ContentType]
   -- | Data sent by client and used for mutation actions
-  , iPayload                     :: Maybe PayloadJSON
+  , iPayload              :: Maybe PayloadJSON
   -- | If client wants created items echoed back
-  , iPreferRepresentation        :: PreferRepresentation
+  , iPreferRepresentation :: PreferRepresentation
-  -- | Pass all parameters as a single json object to a stored procedure
+  -- | How to pass parameters to a stored procedure
-  , iPreferSingleObjectParameter :: Bool
+  , iPreferParameters     :: Maybe PreferParameters
   -- | Whether the client wants a result count (slower)
-  , iPreferCount                 :: Bool
+  , iPreferCount          :: Bool
   -- | Whether the client wants to UPSERT or ignore records on PK conflict
-  , iPreferResolution            :: Maybe PreferResolution
+  , iPreferResolution     :: Maybe PreferResolution
   -- | Filters on the result ("id", "eq.10")
-  , iFilters                     :: [(Text, Text)]
+  , iFilters              :: [(Text, Text)]
   -- | &and and &or parameters used for complex boolean logic
-  , iLogic                       :: [(Text, Text)]
+  , iLogic                :: [(Text, Text)]
   -- | &select parameter used to shape the response
-  , iSelect                      :: Text
+  , iSelect               :: Text
   -- | &columns parameter used to shape the payload
-  , iColumns                     :: Maybe Text
+  , iColumns              :: Maybe Text
   -- | &order parameters for each level
-  , iOrder                       :: [(Text, Text)]
+  , iOrder                :: [(Text, Text)]
   -- | Alphabetized (canonical) request query string for response URLs
-  , iCanonicalQS                 :: ByteString
+  , iCanonicalQS          :: ByteString
   -- | JSON Web Token
-  , iJWT                         :: Text
+  , iJWT                  :: Text
   -- | HTTP request headers
-  , iHeaders                     :: [(Text, Text)]
+  , iHeaders              :: [(Text, Text)]
   -- | Request Cookies
-  , iCookies                     :: [(Text, Text)]
+  , iCookies              :: [(Text, Text)]
   }
 
 -- | Examines HTTP request and translates it into user intent.
@@ -130,11 +132,13 @@ userApiRequest schema rootSpec req reqBody
       , iAccepts = maybe [CTAny] (map decodeContentType . parseHttpAccept) $ lookupHeader "accept"
       , iPayload = relevantPayload
       , iPreferRepresentation = representation
-      , iPreferSingleObjectParameter = singleObject
+      , iPreferParameters = if | hasPrefer (show SingleObject)     -> Just SingleObject
+                               | hasPrefer (show MultipleObjects)  -> Just MultipleObjects
+                               | otherwise                         -> Nothing
       , iPreferCount = hasPrefer "count=exact"
-      , iPreferResolution = if hasPrefer (show MergeDuplicates) then Just MergeDuplicates
+      , iPreferResolution = if | hasPrefer (show MergeDuplicates)  -> Just MergeDuplicates
-                            else if hasPrefer (show IgnoreDuplicates) then Just IgnoreDuplicates
+                               | hasPrefer (show IgnoreDuplicates) -> Just IgnoreDuplicates
-                            else Nothing
+                               | otherwise                         -> Nothing
       , iFilters = filters
       , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
       , iSelect = toS $ fromMaybe "*" $ join $ lookup "select" qParams
@@ -243,7 +247,6 @@ userApiRequest schema rootSpec req reqBody
     where
         split :: BS.ByteString -> [Text]
         split = map T.strip . T.split (==',') . toS
-  singleObject    = hasPrefer "params=single-object"
   representation
     | hasPrefer "return=representation" = Full
     | hasPrefer "return=minimal" = None

src/PostgREST/App.hs

@@ -91,7 +91,7 @@ postgrest conf refDbStructure pool getTime worker =
                     (Just RawJSON{}, Just cls)      -> cls
                     _                               -> S.empty
                   proc = case iTarget apiRequest of
-                    TargetProc qi _ -> findProc qi cols (iPreferSingleObjectParameter apiRequest) $ dbProcs dbStructure
+                    TargetProc qi _ -> findProc qi cols (iPreferParameters apiRequest == Just SingleObject) $ dbProcs dbStructure
                     _ -> Nothing
                   handleReq = runWithClaims conf eClaims (app dbStructure proc cols conf) apiRequest
                   txMode = transactionMode proc (iAction apiRequest)
@@ -280,10 +280,11 @@ app dbStructure proc cols conf apiRequest =
             Left errorResponse -> return errorResponse
             Right ((q, cq), bField) -> do
               let
-                pq = requestToCallProcQuery qi (specifiedProcArgs cols proc) returnsScalar $
+                preferParams = iPreferParameters apiRequest
-                        iPreferSingleObjectParameter apiRequest
+                pq = requestToCallProcQuery qi (specifiedProcArgs cols proc) returnsScalar preferParams
                 stm = callProcStatement returnsScalar pq q cq shouldCount (contentType == CTSingularJSON)
-                        (contentType == CTTextCSV) (contentType `elem` rawContentTypes) bField (pgVersion dbStructure)
+                        (contentType == CTTextCSV) (contentType `elem` rawContentTypes) (preferParams == Just MultipleObjects)
+                        bField (pgVersion dbStructure)
               row <- H.statement (toS $ pjRaw pJson) stm
               let (tableTotal, queryTotal, body, gucHeaders) = row
                   (status, contentRange) = rangeStatusHeader topLevelRange queryTotal tableTotal

src/PostgREST/QueryBuilder.hs

@@ -134,38 +134,45 @@ requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
   where
     qi = QualifiedIdentifier schema mainTbl
 
-requestToCallProcQuery :: QualifiedIdentifier -> [PgArg] -> Bool -> Bool -> SqlQuery
+requestToCallProcQuery :: QualifiedIdentifier -> [PgArg] -> Bool -> Maybe PreferParameters -> SqlQuery
-requestToCallProcQuery qi pgArgs returnsScalar paramsAsSingleObject =
+requestToCallProcQuery qi pgArgs returnsScalar preferParams =
   unwords [
     "WITH",
-    argsRecord,
+    argsCTE,
     sourceBody ]
   where
-    (argsRecord, args)
+    paramsAsSingleObject    = preferParams == Just SingleObject
+    paramsAsMulitpleObjects = preferParams == Just MultipleObjects
+
+    (argsCTE, args)
       | null pgArgs = (ignoredBody, "")
-      | paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")
+      | paramsAsSingleObject = ("pgrst_args AS (SELECT NULL)", "$1::json")
       | otherwise = (
           unwords [
             normalizedBody <> ",",
-            "_args_record AS (",
+            "pgrst_args AS (",
-              "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <>
+              "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtArgs (\a -> " " <> pgaType a) <> ")",
-                intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",
             ")"]
-         , intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := _args_record." <> pgFmtIdent (pgaName a)) <$> pgArgs))
+         , if paramsAsMulitpleObjects
+             then fmtArgs (\a -> " := pgrst_args." <> pgFmtIdent (pgaName a))
+             else fmtArgs (\a -> " := (SELECT " <> pgFmtIdent (pgaName a) <> " FROM pgrst_args LIMIT 1)")
+        )
+
+    fmtArgs :: (PgArg -> SqlFragment) -> SqlFragment
+    fmtArgs argFrag = intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> argFrag a) <$> pgArgs)
 
     sourceBody :: SqlFragment
     sourceBody
-      | paramsAsSingleObject || null pgArgs =
+      | paramsAsMulitpleObjects =
           if returnsScalar
-            then "SELECT " <> callIt <> " AS _scalar_res"
+            then "SELECT " <> callIt <> " AS pgrst_scalar FROM pgrst_args"
-            else "SELECT * FROM " <> callIt
+            else unwords [ "SELECT pgrst_lat_args.*"
+                         , "FROM pgrst_args,"
+                         , "LATERAL ( SELECT * FROM " <> callIt <> " ) pgrst_lat_args" ]
       | otherwise =
           if returnsScalar
-            then "SELECT " <> callIt <> " AS _scalar_res FROM _args_record"
+            then "SELECT " <> callIt <> " AS pgrst_scalar"
-            else unwords [
+            else "SELECT * FROM " <> callIt
-              "SELECT _.*",
-              "FROM _args_record,",
-              "LATERAL ( SELECT * FROM " <> callIt <> " ) _" ]
 
     callIt :: SqlFragment
     callIt = fromQi qi <> "(" <> args <> ")"

src/PostgREST/QueryBuilder/Private.hs

@@ -27,7 +27,7 @@ noLocationF = "array[]::text[]"
 -- This happens because `unknown` relies on the context to determine the value type.
 -- The error also happens on raw libpq used with C.
 ignoredBody :: SqlFragment
-ignoredBody = "ignored_body AS (SELECT $1::text) "
+ignoredBody = "pgrst_ignored_body AS (SELECT $1::text) "
 
 -- |
 -- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads

src/PostgREST/Statements.hs

@@ -118,9 +118,9 @@ standardRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
 type ProcResults = (Maybe Int64, Int64, ByteString, Either Text [GucHeader])
 
 callProcStatement :: Bool -> SqlQuery -> SqlQuery -> SqlQuery -> Bool ->
-                     Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
+                     Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
                      H.Statement ByteString ProcResults
-callProcStatement returnsScalar callProcQuery selectQuery countQuery countTotal isSingle asCsv asBinary binaryField pgVer =
+callProcStatement returnsScalar callProcQuery selectQuery countQuery countTotal isSingle asCsv asBinary multObjects binaryField pgVer =
   unicodeStatement sql (param HE.unknown) decodeProc True
   where
     sql = [qc|
@@ -134,21 +134,18 @@ callProcStatement returnsScalar callProcQuery selectQuery countQuery countTotal
 
     bodyF
      | returnsScalar = scalarBodyF
-     | isSingle = asJsonSingleF
+     | isSingle     = asJsonSingleF
      | asCsv = asCsvF
      | isJust binaryField = asBinaryF $ fromJust binaryField
      | otherwise = asJsonF
 
     scalarBodyF
-     | asBinary = asBinaryF "_scalar_res"
+     | asBinary    = asBinaryF "pgrst_scalar"
-     | otherwise = unwords [
+     | multObjects = "json_agg(_postgrest_t.pgrst_scalar)::character varying"
-        "CASE",
+     | otherwise   = "(json_agg(_postgrest_t.pgrst_scalar)->0)::character varying"
-          "WHEN pg_catalog.count(_postgrest_t) = 1",
-            "THEN (json_agg(_postgrest_t._scalar_res)->0)::character varying",
-            "ELSE (json_agg(_postgrest_t._scalar_res))::character varying",
-        "END"]
 
     countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
+
     responseHeaders =
       if pgVer >= pgVersion96
         then "coalesce(nullif(current_setting('response.headers', true), ''), '[]')" :: Text -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15

src/PostgREST/Types.hs

@@ -67,6 +67,15 @@ instance Show PreferResolution where
   show MergeDuplicates  = "resolution=merge-duplicates"
   show IgnoreDuplicates = "resolution=ignore-duplicates"
 
+data PreferParameters
+  = SingleObject    -- ^ Pass all parameters as a single json object to a stored procedure
+  | MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure
+  deriving Eq
+
+instance Show PreferParameters where
+  show SingleObject    = "params=single-object"
+  show MultipleObjects = "params=multiple-objects"
+
 data DbStructure = DbStructure {
   dbTables      :: [Table]
 , dbColumns     :: [Column]

test/Feature/RpcSpec.hs

@@ -433,24 +433,34 @@ spec actualPgVersion =
 
       it "ignores json keys not included in ?columns" $
         post "/rpc/sayhello?columns=name"
-          [json|{"name": "John", "smth": "here", "other": "stuff", "fake_id": 13}|] `shouldRespondWith`
+          [json|{"name": "John", "smth": "here", "other": "stuff", "fake_id": 13}|]
+          `shouldRespondWith`
           [json|"Hello, John"|]
           { matchHeaders = [matchContentTypeJson] }
 
-    context "bulk RPC" $ do
+      it "only takes the first object in case of array of objects payload" $
-      it "works with a scalar function an returns a json array" $
         post "/rpc/add_them"
           [json|[
             {"a": 1, "b": 2},
             {"a": 4, "b": 6},
-            {"a": 100, "b": 200}
+            {"a": 100, "b": 200} ]|]
-          ]|] `shouldRespondWith`
+          `shouldRespondWith` "3"
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "bulk RPC with params=multiple-objects" $ do
+      it "works with a scalar function an returns a json array" $
+        request methodPost "/rpc/add_them" [("Prefer", "params=multiple-objects")]
+          [json|[
+            {"a": 1, "b": 2},
+            {"a": 4, "b": 6},
+            {"a": 100, "b": 200} ]|]
+          `shouldRespondWith`
           [json|
             [3, 10, 300]
           |] { matchHeaders = [matchContentTypeJson] }
 
       it "works with a scalar function an returns a json array when posting CSV" $
-        request methodPost "/rpc/add_them" [("Content-Type", "text/csv")]
+        request methodPost "/rpc/add_them" [("Content-Type", "text/csv"), ("Prefer", "params=multiple-objects")]
           "a,b\n1,2\n4,6\n100,200"
           `shouldRespondWith`
           [json|
@@ -461,11 +471,11 @@ spec actualPgVersion =
           }
 
       it "works with a non-scalar result" $
-        post "/rpc/get_projects_below?select=id,name"
+        request methodPost "/rpc/get_projects_below?select=id,name" [("Prefer", "params=multiple-objects")]
           [json|[
             {"id": 1},
-            {"id": 5}
+            {"id": 5} ]|]
-          ]|] `shouldRespondWith`
+          `shouldRespondWith`
           [json|
             [{"id":1,"name":"Windows 7"},
              {"id":2,"name":"Windows 10"},

test/QueryCost.hs

@@ -13,8 +13,7 @@ import           Text.Heredoc
 import Protolude hiding (get)
 
 import PostgREST.QueryBuilder (requestToCallProcQuery)
-import PostgREST.Types        (PgArg (..), QualifiedIdentifier (..),
+import PostgREST.Types
-                               SqlQuery)
 
 import SpecHelper (getEnvVarWithDefault)
 
@@ -30,22 +29,37 @@ main = do
     context "call proc query" $ do
       it "should not exceed cost when calling setof composite proc" $ do
         cost <- exec pool [str| {"id": 3} |] $
-          requestToCallProcQuery (QualifiedIdentifier "test" "get_projects_below") [PgArg "id" "int" True] False False
+          requestToCallProcQuery (QualifiedIdentifier "test" "get_projects_below") [PgArg "id" "int" True] False Nothing
         liftIO $
-          cost `shouldSatisfy` (< Just 2100)
+          cost `shouldSatisfy` (< Just 40)
 
       it "should not exceed cost when calling setof composite proc with empty params" $ do
         cost <- exec pool mempty $
-          requestToCallProcQuery (QualifiedIdentifier "test" "getallprojects") [] False False
+          requestToCallProcQuery (QualifiedIdentifier "test" "getallprojects") [] False Nothing
         liftIO $
           cost `shouldSatisfy` (< Just 20)
 
       it "should not exceed cost when calling scalar proc" $ do
         cost <- exec pool [str| {"a": 3, "b": 4} |] $
-          requestToCallProcQuery (QualifiedIdentifier "test" "add_them") [PgArg "a" "int" True, PgArg "b" "int" True] True False
+          requestToCallProcQuery (QualifiedIdentifier "test" "add_them") [PgArg "a" "int" True, PgArg "b" "int" True] True Nothing
         liftIO $
           cost `shouldSatisfy` (< Just 10)
 
+      context "params=multiple-objects" $ do
+        it "should not exceed cost when calling setof composite proc" $ do
+          cost <- exec pool [str| [{"id": 1}, {"id": 4}] |] $
+            requestToCallProcQuery (QualifiedIdentifier "test" "get_projects_below") [PgArg "id" "int" True] False (Just MultipleObjects)
+          liftIO $ do
+            cost `shouldSatisfy` (> Just 2000)
+            cost `shouldSatisfy` (< Just 2100)
+
+        it "should not exceed cost when calling scalar proc" $ do
+          cost <- exec pool [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |] $
+            requestToCallProcQuery (QualifiedIdentifier "test" "add_them") [PgArg "a" "int" True, PgArg "b" "int" True] True Nothing
+          liftIO $
+            cost `shouldSatisfy` (< Just 10)
+
+
 exec :: P.Pool -> ByteString -> SqlQuery -> IO (Maybe Int64)
 exec pool input query =
   join . rightToMaybe <$>