Allow GET on RPC (#946)

src/PostgREST/App.hs

@@ -6,6 +6,7 @@ module PostgREST.App (
 ) where
 
 import           Control.Applicative
+import           Data.Aeson                (toJSON)
 import qualified Data.ByteString.Char8     as BS
 import           Data.Maybe
 import           Data.IORef                (IORef, readIORef)
@@ -37,6 +38,7 @@ import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.DbStructure
 import           PostgREST.DbRequestBuilder( readRequest
                                            , mutateRequest
+                                           , readRpcRequest
                                            , fieldNames
                                            )
 import           PostgREST.Error           ( simpleError, pgError
@@ -94,7 +96,7 @@ transactionMode structure target action =
     ActionRead -> HT.Read
     ActionInfo -> HT.Read
     ActionInspect -> HT.Read
-    ActionInvoke ->
+    ActionInvoke{isReadOnly=False} ->
       let proc =
             case target of
               (TargetProc qi) -> M.lookup (qiName qi) $
@@ -104,6 +106,7 @@ transactionMode structure target action =
       if v == Stable || v == Immutable
          then HT.Read
          else HT.Write
+    ActionInvoke{isReadOnly=True} -> HT.Read
     _ -> HT.Write
 
 app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response
@@ -227,7 +230,7 @@ app dbStructure conf apiRequest =
               let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
               return $ responseLBS status200 [allOrigins, acceptH] ""
 
-        (ActionInvoke, TargetProc qi, Just (PayloadJSON payload)) ->
+        (ActionInvoke _isReadOnly, TargetProc qi, payload) ->
           let proc = M.lookup (qiName qi) allProcs
               returnsScalar = case proc of
                 Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
@@ -235,18 +238,20 @@ app dbStructure conf apiRequest =
               rpcBinaryField = if returnsScalar
                                  then Right Nothing
                                  else binaryField contentType =<< fldNames
-              partsField = (,) <$> readSqlParts <*> rpcBinaryField in
-          case partsField of
+              parts = (,,) <$> readSqlParts <*> rpcBinaryField <*> rpcQParams in
+          case parts of
             Left errorResponse -> return errorResponse
-            Right ((q, cq), bField) -> do
-              let p = V.head payload
+            Right ((q, cq), bField, params) -> do
+              let prms = case payload of
+                          Just (PayloadJSON pld) -> V.head pld
+                          Nothing -> M.fromList $ second toJSON <$> params -- toJSON is just for reusing the callProc function
                   singular = contentType == CTSingularJSON
                   paramsAsSingleObject = iPreferSingleObjectParameter apiRequest
               row <- H.query () $
-                callProc qi p returnsScalar q cq topLevelRange shouldCount
+                callProc qi prms returnsScalar q cq topLevelRange shouldCount
                          singular paramsAsSingleObject
                          (contentType == CTTextCSV)
-                         (contentType == CTOctetStream) bField
+                         (contentType == CTOctetStream) _isReadOnly bField
               let (tableTotal, queryTotal, body) =
                     fromMaybe (Just 0, 0, "[]") row
                   (status, contentRange) = rangeHeader queryTotal tableTotal
@@ -298,6 +303,7 @@ app dbStructure conf apiRequest =
       fldNames = fieldNames <$> readReq
       readDbRequest = DbRead <$> readReq
       mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< fldNames)
+      rpcQParams = readRpcRequest apiRequest
       selectQuery = requestToQuery schema False <$> readDbRequest
       mutateQuery = requestToQuery schema False <$> mutateDbRequest
       countQuery = requestToCountQuery schema <$> readDbRequest
@@ -313,7 +319,7 @@ responseContentTypeOrError accepts action = serves contentTypesForRequest accept
         ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
+        ActionInvoke _ ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
         ActionInspect -> [CTOpenAPI, CTApplicationJSON]
         ActionInfo ->    [CTTextCSV]
     serves sProduces cAccepts =