Introduce new 'Prefer' header, params=single-object (#739)

src/PostgREST/ApiRequest.hs

@@ -96,6 +96,8 @@ data ApiRequest = ApiRequest {
   , iPreferRepresentation :: PreferRepresentation
   -- | If client wants first row as raw object
   , iPreferSingular :: Bool
+  -- | Pass all parameters as a single json object to a stored procedure
+  , iPreferSingleObjectParameter :: Bool
   -- | Whether the client wants a result count (slower)
   , iPreferCount :: Bool
   -- | Filters on the result ("id", "eq.10")
@@ -172,6 +174,7 @@ userApiRequest schema req reqBody =
   , iPayload = relevantPayload
   , iPreferRepresentation = representation
   , iPreferSingular = singular
+  , iPreferSingleObjectParameter = singleObject
   , iPreferCount = not singular && hasPrefer "count=exact"
   , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset"] k) ]
   , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
@@ -197,6 +200,7 @@ userApiRequest schema req reqBody =
         split :: BS.ByteString -> [Text]
         split = map T.strip . T.split (==',') . toS
   singular        = hasPrefer "plurality=singular"
+  singleObject    = hasPrefer "params=single-object"
   representation
     | hasPrefer "return=representation" = Full
     | hasPrefer "return=minimal" = None

src/PostgREST/App.hs

@@ -215,7 +215,8 @@ app dbStructure conf apiRequest =
             Right (q, cq) -> respondToRange $ do
               let p = V.head payload
                   singular = iPreferSingular apiRequest
-              row <- H.query () (callProc qi p q cq topLevelRange shouldCount singular)
+                  paramsAsSingleObject = iPreferSingleObjectParameter apiRequest
+              row <- H.query () (callProc qi p q cq topLevelRange shouldCount singular paramsAsSingleObject)
               let (tableTotal, queryTotal, body) =
                     fromMaybe (Just 0, 0, emptyArray) row
                   (status, contentRange) = rangeHeader queryTotal tableTotal

src/PostgREST/OpenAPI.hs

@@ -182,12 +182,14 @@ makePostParams tn =
     & schema .~ ParamBody (Ref (Reference tn))
   ]
 
-makeProcParam :: Text -> Param
+makeProcParam :: Text -> [Param]
 makeProcParam refName =
-  (mempty :: Param)
+  [ makePreferParam ["params=single-object"]
+  , (mempty :: Param)
     & name     .~ "args"
     & required ?~ True
     & schema   .~ ParamBody (Ref (Reference refName))
+  ]
 
 makeDeleteParams :: [Param]
 makeDeleteParams =
@@ -224,7 +226,7 @@ makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
 makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
   where
     postOp = (mempty :: Operation)
-      & parameters .~ [Inline (makeProcParam $ "(rpc) " <> pdName pd)]
+      & parameters .~ map Inline (makeProcParam $ "(rpc) " <> pdName pd)
       & tags .~ Set.fromList ["(rpc) " <> pdName pd]
       & produces ?~ makeMimeList [CTApplicationJSON]
       & at 200 ?~ "OK"

src/PostgREST/QueryBuilder.hs

@@ -238,8 +238,8 @@ addJoinConditions schema (Node nn@(query, (n, r, a)) forest) =
     addCond query' con = query'{flt_=con ++ flt_ query'}
 
 type ProcResults = (Maybe Int64, Int64, JSON.Value)
-callProc :: QualifiedIdentifier -> JSON.Object -> SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> H.Query () (Maybe ProcResults)
-callProc qi params selectQuery countQuery _ countTotal isSingle =
+callProc :: QualifiedIdentifier -> JSON.Object -> SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool -> H.Query () (Maybe ProcResults)
+callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson =
   unicodeStatement sql HE.unit decodeProc True
   where
     sql = [qc|
@@ -258,7 +258,9 @@ callProc qi params selectQuery countQuery _ countTotal isSingle =
           |]
           -- FROM (select * from {sourceCTEName} {limitF range}) t;
     countResultF = if countTotal then "("<>countQuery<>")" else "null::bigint" :: Text
-    _args = intercalate "," $ map _assignment (HM.toList params)
+    _args = if paramsAsJson
+                then insertableValueWithType "json" $ JSON.Object params
+                else intercalate "," $ map _assignment (HM.toList params)
     _procName = pgFmtLit $ qiName qi
     _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
     _callSql = [qc|select * from {fromQi qi}({_args}) |] :: Text
@@ -498,6 +500,10 @@ insertableValue :: JSON.Value -> SqlFragment
 insertableValue JSON.Null = "null"
 insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v
 
+insertableValueWithType :: Text -> JSON.Value -> SqlFragment
+insertableValueWithType t v =
+  pgFmtLit (unquoted v) <> "::" <> t
+
 whiteList :: Text -> SqlFragment
 whiteList val = fromMaybe
   (toS (pgFmtLit val) <> "::unknown ")