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

CHANGELOG.md

@@ -6,6 +6,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 ## Unreleased
 
 ### Added
+- New `Prefer` header value: `params=single-object` to pass all form values as a single json object to a stored procedure - @dsimunic
 - Ability to generate an OpenAPI spec - @mainx07, @hudayou, @ruslantalpa, @begriffs
 - Ability to generate an OpenAPI spec behind a proxy - @hudayou
 - Ability to set addresses to listen on - @hudayou

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 ")

test/Feature/QuerySpec.hs

@@ -609,6 +609,20 @@ spec = do
       post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
         [json|2|]
 
+    context "expects a single json object" $ do
+      it "does not expand posted json into parameters" $
+        request methodPost "/rpc/singlejsonparam"
+          [("Prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith`
+          [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |]
+
+      it "accepts parameters from an html form" $ 
+        request methodPost "/rpc/singlejsonparam"
+          [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")]
+          ("integer=7&double=2.71828&varchar=forms+are+fun&" <>
+           "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `shouldRespondWith`
+          [json| { "integer": "7", "double": "2.71828", "varchar" : "forms are fun"
+                 , "boolean":"false", "date":"1900-01-01", "money":"$3.99", "enum":"foo" } |]
+
   describe "weird requests" $ do
     it "can query as normal" $ do
       get "/Escap3e;" `shouldRespondWith`

test/Feature/StructureSpec.hs

@@ -33,7 +33,7 @@ spec = do
         r <- simpleBody <$> get "/"
         let ref = r ^? key "paths" . key "/rpc/varied_arguments"
                      . key "post"  . key "parameters"
-                     . nth 0       . key "schema"
+                     . nth 1       . key "schema"
                      . key "$ref"  . _String
             args = r ^? key "definitions" . key "(rpc) varied_arguments"
 

test/fixtures/schema.sql

@@ -322,6 +322,16 @@ CREATE FUNCTION callcounter() RETURNS bigint
     SELECT nextval('test.callcounter_count');
 $_$;
 
+--
+-- Name: singlejsonparam(json); Type: FUNCTION; Schema: test; Owner: -
+--
+
+CREATE FUNCTION singlejsonparam(single_param json) RETURNS json
+    LANGUAGE sql
+    AS $_$
+    SELECT single_param;
+$_$;
+
 --
 -- Name: test_empty_rowset(); Type: FUNCTION; Schema: test; Owner: -
 --