Allow csv formatting in rpc output (#882)

CHANGELOG.md

@@ -10,6 +10,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - #742, Add connection retrying on startup and SIGHUP - @steve-chavez
 - #652, Add and/or params for complex boolean logic - @steve-chavez
 - #808, Env var interpolation in config file (helps Docker) - @begriffs
+- #878 - CSV output support for RPC - @begriffs
 
 ### Fixed
 

src/PostgREST/App.hs

@@ -238,7 +238,9 @@ app dbStructure conf apiRequest =
               let p = V.head payload
                   singular = contentType == CTSingularJSON
                   paramsAsSingleObject = iPreferSingleObjectParameter apiRequest
-              row <- H.query () (callProc qi p q cq topLevelRange shouldCount singular paramsAsSingleObject)
+              row <- H.query () $
+                callProc qi p q cq topLevelRange shouldCount singular
+                         paramsAsSingleObject (contentType == CTTextCSV)
               let (tableTotal, queryTotal, body) =
                     fromMaybe (Just 0, 0, "[]") row
                   (status, contentRange) = rangeHeader queryTotal tableTotal
@@ -246,7 +248,7 @@ app dbStructure conf apiRequest =
                 then do
                   HT.condemn
                   return $ singularityError (toInteger queryTotal)
-                else return $ responseLBS status [jsonH, contentRange] (toS body)
+                else return $ responseLBS status [toHeader contentType, contentRange] (toS body)
 
         (ActionInspect, TargetRoot, Nothing) -> do
           let host = configHost conf
@@ -275,7 +277,6 @@ app dbStructure conf apiRequest =
       filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb
       allPrKeys = dbPrimaryKeys dbStructure
       allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
-      jsonH = toHeader CTApplicationJSON
       shouldCount = iPreferCount apiRequest
       schema = toS $ configSchema conf
       topLevelRange = fromMaybe allRange $ M.lookup "limit" $ iRange apiRequest
@@ -305,7 +306,7 @@ responseContentTypeOrError accepts action = serves contentTypesForRequest accept
         ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON]
+        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionInspect -> [CTOpenAPI, CTApplicationJSON]
         ActionInfo ->    [CTTextCSV]
     serves sProduces cAccepts =

src/PostgREST/QueryBuilder.hs

@@ -144,8 +144,9 @@ createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys
     | otherwise = asJsonF
 
 type ProcResults = (Maybe Int64, Int64, ByteString)
-callProc :: QualifiedIdentifier -> JSON.Object -> SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool -> H.Query () (Maybe ProcResults)
-callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson =
+callProc :: QualifiedIdentifier -> JSON.Object -> SqlQuery -> SqlQuery -> NonnegRange ->
+  Bool -> Bool -> Bool -> Bool -> H.Query () (Maybe ProcResults)
+callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson asCsv =
   unicodeStatement sql HE.unit decodeProc True
   where
     sql = [qc|
@@ -178,6 +179,7 @@ callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson =
                    <*> HD.value HD.bytea
     bodyF
      | isSingle = asJsonSingleF
+     | asCsv = asCsvF
      | otherwise = asJsonF
 
 pgFmtIdent :: SqlFragment -> SqlFragment
@@ -199,7 +201,7 @@ requestToCountQuery schema (DbRead (Node (Select _ _ conditions logic_ _ _, (mai
    "SELECT pg_catalog.count(*)",
    "FROM ", fromQi qi,
     -- logic_ doesn't not need localFilter filtering because it doesn't have VForeignKey vals
-    ("WHERE " <> intercalate " AND " (map (pgFmtFilter qi) localConditions ++ map (pgFmtLogicTree qi) logic_)) 
+    ("WHERE " <> intercalate " AND " (map (pgFmtFilter qi) localConditions ++ map (pgFmtLogicTree qi) logic_))
       `emptyOnFalse` (null conditions && null logic_)
    ]
  where
@@ -292,7 +294,7 @@ requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions
       unwords [
         "UPDATE ", fromQi qi,
         " SET " <> intercalate "," assignments <> " ",
-        ("WHERE " <> intercalate " AND " (map (pgFmtFilter qi) conditions ++ map (pgFmtLogicTree qi) logic_)) 
+        ("WHERE " <> intercalate " AND " (map (pgFmtFilter qi) conditions ++ map (pgFmtLogicTree qi) logic_))
           `emptyOnFalse` (null conditions && null logic_),
         ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
         ]

test/Feature/AuthSpec.hs

@@ -44,14 +44,14 @@ spec = describe "authorization" $ do
       [json| { "id": "jdoe", "pass": "1234" } |]
       `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.P2G9EVSVI22MWxXWFuhEYd9BZerLS1WDlqzdqplM15s"} |]
         { matchStatus = 200
-        , matchHeaders = [matchContentTypeJson]
+        , matchHeaders = [matchContentTypeSingular]
         }
 
   it "sql functions can encode custom and standard claims" $
     request methodPost  "/rpc/jwt_test" [single] "{}"
       `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.IHF16ZSU6XTbOnUWO8CCpUn2fJwt8P00rlYVyXQjpWc"} |]
         { matchStatus = 200
-        , matchHeaders = [matchContentTypeJson]
+        , matchHeaders = [matchContentTypeSingular]
         }
 
   it "sql functions can read custom and standard claims variables" $ do

test/Feature/QuerySpec.hs

@@ -487,6 +487,15 @@ spec = do
           [json| [ {"id": 3}, {"id":4} ] |]
           { matchHeaders = [matchContentTypeJson] }
 
+      it "returns CSV" $
+        request methodPost "/rpc/getitemrange"
+                (acceptHdrs "text/csv")
+                [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` "id\n3\n4"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+            }
+
     context "unknown function" $
       it "returns 404" $
         post "/rpc/fakefunc" [json| {} |] `shouldRespondWith` 404

test/SpecHelper.hs

@@ -32,6 +32,9 @@ import Protolude
 matchContentTypeJson :: MatchHeader
 matchContentTypeJson = "Content-Type" <:> "application/json; charset=utf-8"
 
+matchContentTypeSingular :: MatchHeader
+matchContentTypeSingular = "Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"
+
 validateOpenApiResponse :: [Header] -> WaiSession ()
 validateOpenApiResponse headers = do
   r <- request methodGet "/" headers ""