Add binary output to rpc, Fix #883

src/PostgREST/App.hs

@@ -232,19 +232,25 @@ app dbStructure conf apiRequest =
               return $ responseLBS status200 [allOrigins, acceptH] ""
 
         (ActionInvoke, TargetProc qi, Just (PayloadJSON payload)) ->
-          case readSqlParts of
+          let proc = M.lookup (qiName qi) allProcs
+              returnsScalar = case proc of
+                Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
+                _ -> False
+              rpcBinaryField = if returnsScalar
+                                 then Right Nothing
+                                 else binaryField contentType =<< fldNames
+              partsField = (,) <$> readSqlParts <*> rpcBinaryField in
+          case partsField of
             Left errorResponse -> return errorResponse
-            Right (q, cq) -> do
+            Right ((q, cq), bField) -> do
               let p = V.head payload
                   singular = contentType == CTSingularJSON
                   paramsAsSingleObject = iPreferSingleObjectParameter apiRequest
-                  proc = M.lookup (qiName qi) allProcs 
-                  returnsScalar = case proc of
-                    Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
-                    _ -> False
               row <- H.query () $
-                callProc qi p returnsScalar q cq topLevelRange shouldCount singular
-                         paramsAsSingleObject (contentType == CTTextCSV)
+                callProc qi p returnsScalar q cq topLevelRange shouldCount
+                         singular paramsAsSingleObject
+                         (contentType == CTTextCSV)
+                         (contentType == CTOctetStream) bField
               let (tableTotal, queryTotal, body) =
                     fromMaybe (Just 0, 0, "[]") row
                   (status, contentRange) = rangeHeader queryTotal tableTotal
@@ -311,7 +317,7 @@ responseContentTypeOrError accepts action = serves contentTypesForRequest accept
         ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
         ActionInspect -> [CTOpenAPI, CTApplicationJSON]
         ActionInfo ->    [CTTextCSV]
     serves sProduces cAccepts =

src/PostgREST/QueryBuilder.hs

@@ -145,8 +145,8 @@ createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys
 
 type ProcResults = (Maybe Int64, Int64, ByteString)
 callProc :: QualifiedIdentifier -> JSON.Object -> Bool -> SqlQuery -> SqlQuery -> NonnegRange ->
-  Bool -> Bool -> Bool -> Bool -> H.Query () (Maybe ProcResults)
-callProc qi params returnsScalar selectQuery countQuery _ countTotal isSingle paramsAsJson asCsv =
+  Bool -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> H.Query () (Maybe ProcResults)
+callProc qi params returnsScalar selectQuery countQuery _ countTotal isSingle paramsAsJson asCsv asBinary binaryField =
   unicodeStatement sql HE.unit decodeProc True
   where
     sql = 
@@ -155,7 +155,7 @@ callProc qi params returnsScalar selectQuery countQuery _ countTotal isSingle pa
        SELECT
          {countResultF} AS total_result_set,
          1 AS page_total,
-         (row_to_json(_postgrest_t)->{_procName})::character varying as body
+         {scalarBodyF} as body
        FROM ({selectQuery}) _postgrest_t;|]
      else [qc| 
        WITH {sourceCTEName} AS ({_callSql})
@@ -165,22 +165,24 @@ callProc qi params returnsScalar selectQuery countQuery _ countTotal isSingle pa
          {bodyF} as body
        FROM ({selectQuery}) _postgrest_t;|]
 
-    countResultF = if countTotal then "("<>countQuery<>")" else "null::bigint" :: Text
+    countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
     _args = if paramsAsJson
                 then insertableValueWithType "json" $ JSON.Object params
                 else intercalate "," $ map _assignment (HM.toList params)
-    _procName = pgFmtLit $ qiName qi
+    _procName = qiName qi
     _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
     _callSql = [qc|select * from {fromQi qi}({_args}) |] :: Text
-    _countExpr = if countTotal
-                   then [qc|(select pg_catalog.count(*) from {sourceCTEName})|]
-                   else "null::bigint" :: Text
     decodeProc = HD.maybeRow procRow
     procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
                    <*> HD.value HD.bytea
+    scalarBodyF
+     | asBinary = asBinaryF _procName
+     | otherwise = "(row_to_json(_postgrest_t)->" <> pgFmtLit _procName <> ")::character varying"
+
     bodyF
      | isSingle = asJsonSingleF
      | asCsv = asCsvF
+     | isJust binaryField = asBinaryF $ fromJust binaryField
      | otherwise = asJsonF
 
 pgFmtIdent :: SqlFragment -> SqlFragment