refactor: remove SchemaCache from ApiRequest (#2695)

src/PostgREST/ApiRequest.hs

@@ -3,6 +3,7 @@ Module      : PostgREST.Request.ApiRequest
 Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
 -}
 {-# LANGUAGE LambdaCase      #-}
+{-# LANGUAGE MultiWayIf      #-}
 {-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -32,12 +33,13 @@ import qualified Data.Set              as S
 import qualified Data.Text.Encoding    as T
 import qualified Data.Vector           as V
 
+import Data.Either.Combinators (mapBoth)
+
 import Control.Arrow             ((***))
 import Data.Aeson.Types          (emptyArray, emptyObject)
 import Data.List                 (lookup, union)
 import Data.Ranged.Ranges        (emptyRange, rangeIntersection,
                                   rangeIsEmpty)
-import Data.Tree                 (Tree (..))
 import Network.HTTP.Types.Header (RequestHeaders, hCookie)
 import Network.HTTP.Types.URI    (parseSimpleQuery)
 import Network.Wai               (Request (..))
@@ -51,8 +53,7 @@ import PostgREST.ApiRequest.Preferences  (PreferCount (..),
                                           PreferTransaction (..))
 import PostgREST.ApiRequest.QueryParams  (QueryParams (..))
 import PostgREST.ApiRequest.Types        (ApiRequestError (..),
-                                          RangeError (..),
+                                          RangeError (..))
-                                          SelectItem (..))
 import PostgREST.Config                  (AppConfig (..),
                                           OpenAPIMode (..))
 import PostgREST.MediaType               (MTPlanAttrs (..),
@@ -62,13 +63,9 @@ import PostgREST.RangeQuery              (NonnegRange, allRange,
                                           convertToLimitZeroRange,
                                           hasLimitZero,
                                           rangeRequested)
-import PostgREST.SchemaCache             (SchemaCache (..))
 import PostgREST.SchemaCache.Identifiers (FieldName,
                                           QualifiedIdentifier (..),
                                           Schema)
-import PostgREST.SchemaCache.Proc        (ProcDescription (..),
-                                          ProcParam (..), ProcsMap,
-                                          procReturnsScalar)
 
 import qualified PostgREST.ApiRequest.Preferences as Preferences
 import qualified PostgREST.ApiRequest.QueryParams as QueryParams
@@ -90,6 +87,7 @@ data Payload
       -- ^ Keys of the object or if it's an array these keys are guaranteed to
       -- be the same across all its objects
       }
+  | ProcessedUrlEncoded { payArray  :: [(Text, Text)], payKeys :: S.Set Text }
   | RawJSON { payRaw  :: LBS.ByteString }
   | RawPay  { payRaw  :: LBS.ByteString }
 
@@ -114,41 +112,9 @@ data PathInfo
       }
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
-            | TargetProc{tProc :: ProcDescription, tpIsRootSpec :: Bool}
+            | TargetProc{tProc :: QualifiedIdentifier, tpIsRootSpec :: Bool}
             | TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/"
 
--- | RPC query param value `/rpc/func?v=<value>`, used for VARIADIC functions on form-urlencoded POST and GETs
--- | It can be fixed `?v=1` or repeated `?v=1&v=2&v=3.
-data RpcParamValue = Fixed Text | Variadic [Text]
-instance JSON.ToJSON RpcParamValue where
-  toJSON (Fixed    v) = JSON.toJSON v
-  toJSON (Variadic v) = JSON.toJSON v
-
-toRpcParamValue :: ProcDescription -> (Text, Text) -> (Text, RpcParamValue)
-toRpcParamValue proc (k, v) | prmIsVariadic k = (k, Variadic [v])
-                            | otherwise       = (k, Fixed v)
-  where
-    prmIsVariadic prm = isJust $ find (\ProcParam{ppName, ppVar} -> ppName == prm && ppVar) $ pdParams proc
-
--- | Convert rpc params `/rpc/func?a=val1&b=val2` to json `{"a": "val1", "b": "val2"}
-jsonRpcParams :: ProcDescription -> [(Text, Text)] -> Payload
-jsonRpcParams proc prms =
-  if not $ pdHasVariadic proc then -- if proc has no variadic param, save steps and directly convert to json
-    ProcessedJSON (JSON.encode $ HM.fromList $ second JSON.toJSON <$> prms) (S.fromList $ fst <$> prms)
-  else
-    let paramsMap = HM.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
-    ProcessedJSON (JSON.encode paramsMap) (S.fromList $ HM.keys paramsMap)
-  where
-    mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue
-    mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a
-    mergeParams v _                       = v -- repeated params for non-variadic parameters are not merged
-
-targetToJsonRpcParams :: Maybe Target -> [(Text, Text)] -> Maybe Payload
-targetToJsonRpcParams target params =
-  case target of
-    Just TargetProc{tProc} -> Just $ jsonRpcParams tProc params
-    _                      -> Nothing
-
 {-|
   Describes what the user wants to do. This data type is a
   translation of the raw elements of an HTTP request into domain
@@ -176,22 +142,50 @@ data ApiRequest = ApiRequest {
   , iSchema               :: Schema                           -- ^ The request schema. Can vary depending on profile headers.
   , iNegotiatedByProfile  :: Bool                             -- ^ If schema was was chosen according to the profile spec https://www.w3.org/TR/dx-prof-conneg/
   , iAcceptMediaType      :: MediaType                        -- ^ The media type in the Accept header
-  , iBinaryField          :: Maybe FieldName                  -- ^ field used for raw output
+  , iContentMediaType     :: MediaType                        -- ^ The media type in the Content-Type header
   }
 
 -- | Examines HTTP request and translates it into user intent.
-userApiRequest :: AppConfig -> SchemaCache -> Request -> RequestBody -> Either ApiRequestError ApiRequest
+userApiRequest :: AppConfig -> Request -> RequestBody -> Either ApiRequestError ApiRequest
-userApiRequest conf sCache req reqBody = do
+userApiRequest conf req reqBody = do
-  pInfo <- getPathInfo conf $ pathInfo req
+  pInfo@PathInfo{..} <- getPathInfo conf $ pathInfo req
   act <- getAction pInfo method
-  qPrms <- first QueryParamError $ QueryParams.parse (pathIsProc pInfo && act `elem` [ActionInvoke InvGet, ActionInvoke InvHead]) $ rawQueryString req
+  qPrms <- first QueryParamError $ QueryParams.parse (pathIsProc && act `elem` [ActionInvoke InvGet, ActionInvoke InvHead]) $ rawQueryString req
-  mediaTypes <- getMediaTypes conf hdrs act pInfo
+  (acceptMediaType, contentMediaType) <- getMediaTypes conf hdrs act pInfo
-  negotiatedSchema <- getSchema conf hdrs method
+  (schema, negotiatedByProfile) <- getSchema conf hdrs method
-  ranges <- getRanges method qPrms hdrs
+  (topLevelRange, ranges) <- getRanges method qPrms hdrs
-  apiRequest conf sCache req reqBody qPrms pInfo act mediaTypes negotiatedSchema ranges method hdrs
+  (payload, columns) <- getPayload reqBody contentMediaType qPrms act pInfo
+  return $ ApiRequest {
+    iAction = act
+  , iTarget = if | pathIsProc    -> TargetProc (QualifiedIdentifier schema pathName) pathIsRootSpec
+                 | pathIsDefSpec -> TargetDefaultSpec schema
+                 | otherwise     -> TargetIdent $ QualifiedIdentifier schema pathName
+  , iRange = ranges
+  , iTopLevelRange = topLevelRange
+  , iPayload = payload
+  , iPreferRepresentation = fromMaybe None preferRepresentation
+  , iPreferParameters = preferParameters
+  , iPreferCount = preferCount
+  , iPreferResolution = preferResolution
+  , iPreferTransaction = preferTransaction
+  , iQueryParams = qPrms
+  , iColumns = columns
+  , iHeaders = iHdrs
+  , iCookies = iCkies
+  , iPath = rawPathInfo req
+  , iMethod = method
+  , iSchema = schema
+  , iNegotiatedByProfile = negotiatedByProfile
+  , iAcceptMediaType = acceptMediaType
+  , iContentMediaType = contentMediaType
+  }
   where
     method = requestMethod req
     hdrs = requestHeaders req
+    lookupHeader    = flip lookup hdrs
+    Preferences.Preferences{..} = Preferences.fromHeaders hdrs
+    iHdrs = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
+    iCkies = maybe [] parseCookies $ lookupHeader "Cookie"
 
 getPathInfo :: AppConfig -> [Text] -> Either ApiRequestError PathInfo
 getPathInfo AppConfig{configOpenApiMode, configDbRootSpec} path =
@@ -270,98 +264,52 @@ getRanges method QueryParams{qsOrder,qsRanges} hdrs
     isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange)
     topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows
 
-apiRequest :: AppConfig -> SchemaCache -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action ->
+getPayload :: RequestBody -> MediaType -> QueryParams.QueryParams -> Action -> PathInfo -> Either ApiRequestError (Maybe Payload, S.Set FieldName)
-  (MediaType, MediaType) -> (Schema, Bool) -> (NonnegRange, HM.HashMap Text NonnegRange) -> ByteString -> RequestHeaders ->
+getPayload reqBody contentMediaType QueryParams{qsColumns} action PathInfo{pathIsProc}= do
-  Either ApiRequestError ApiRequest
+  checkedPayload <- if shouldParsePayload then payload else Right Nothing
-apiRequest conf sCache req reqBody queryparams@QueryParams{..} PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action (acceptMediaType, contentMediaType) (schema, negotiatedByProfile) (topLevelRange, ranges) method hdrs
+  let cols = case (checkedPayload, columns) of
-  | shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload
+        (Just ProcessedJSON{payKeys}, _)       -> payKeys
-  | otherwise = do
+        (Just ProcessedUrlEncoded{payKeys}, _) -> payKeys
-     checkedTarget <- target
+        (Just RawJSON{}, Just cls)             -> cls
-     bField <- binaryField conf acceptMediaType checkedTarget queryparams
+        _                                      -> S.empty
-     return ApiRequest {
+  return (checkedPayload, cols)
-      iAction = action
+  where
-      , iTarget = checkedTarget
+    payload :: Either ApiRequestError (Maybe Payload)
-      , iRange = ranges
+    payload = mapBoth InvalidBody Just $ case (contentMediaType, pathIsProc) of
-      , iTopLevelRange = topLevelRange
+      (MTApplicationJSON, _) ->
-      , iPayload = relevantPayload
+        if isJust columns
-      , iPreferRepresentation = fromMaybe None preferRepresentation
+          then Right $ RawJSON reqBody
-      , iPreferParameters = preferParameters
+          else note "All object keys must match" . payloadAttributes reqBody
-      , iPreferCount = preferCount
+                 =<< if LBS.null reqBody && pathIsProc
-      , iPreferResolution = preferResolution
+                       then Right emptyObject
-      , iPreferTransaction = preferTransaction
+                       else first BS.pack $ JSON.eitherDecode reqBody
-      , iQueryParams = queryparams
+      (MTTextCSV, _) -> do
-      , iColumns = payloadColumns
+        json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
-      , iHeaders = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
+        note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
-      , iCookies = maybe [] parseCookies $ lookupHeader "Cookie"
+      (MTUrlEncoded, isProc) -> do
-      , iPath = rawPathInfo req
+        let params = (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
-      , iMethod = method
+        if isProc
-      , iSchema = schema
+          then Right $ ProcessedUrlEncoded params (S.fromList $ fst <$> params)
-      , iNegotiatedByProfile = negotiatedByProfile
+          else
-      , iAcceptMediaType = acceptMediaType
+            let paramsMap = HM.fromList $ (identity *** JSON.String) <$> params in
-      , iBinaryField = bField
+            Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (HM.keys paramsMap)
-      }
+      (MTTextPlain, True) -> Right $ RawPay reqBody
- where
+      (MTTextXML, True) -> Right $ RawPay reqBody
-  columns = case action of
+      (MTOctetStream, True) -> Right $ RawPay reqBody
-    ActionMutate MutationCreate -> qsColumns
+      (ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct
-    ActionMutate MutationUpdate -> qsColumns
-    ActionInvoke InvPost        -> qsColumns
-    _                           -> Nothing
 
-  payloadColumns =
+    shouldParsePayload = case (action, contentMediaType) of
-    case (contentMediaType, action) of
+      (ActionMutate MutationCreate, _)       -> True
-      (_, ActionInvoke InvGet)  -> S.fromList $ fst <$> qsParams
+      (ActionInvoke InvPost, _)              -> True
-      (_, ActionInvoke InvHead) -> S.fromList $ fst <$> qsParams
+      (ActionMutate MutationSingleUpsert, _) -> True
-      (MTUrlEncoded, _)         -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
+      (ActionMutate MutationUpdate, _)       -> True
-      _ -> case (relevantPayload, columns) of
+      _                                      -> False
-        (Just ProcessedJSON{payKeys}, _) -> payKeys
-        (Just RawJSON{}, Just cls)       -> cls
-        _                                -> S.empty
-  payload :: Either ByteString Payload
-  payload = case (contentMediaType, pathIsProc) of
-    (MTApplicationJSON, _) ->
-      if isJust columns
-        then Right $ RawJSON reqBody
-        else note "All object keys must match" . payloadAttributes reqBody
-               =<< if LBS.null reqBody && pathIsProc
-                     then Right emptyObject
-                     else first BS.pack $ JSON.eitherDecode reqBody
-    (MTTextCSV, _) -> do
-      json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
-      note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
-    (MTUrlEncoded, _) ->
-      let paramsMap = HM.fromList $ (T.decodeUtf8 *** JSON.String . T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) in
-      Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (HM.keys paramsMap)
-    (MTTextPlain, True) -> Right $ RawPay reqBody
-    (MTTextXML, True) -> Right $ RawPay reqBody
-    (MTOctetStream, True) -> Right $ RawPay reqBody
-    (ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct
 
-  target
+    columns = case action of
-    | pathIsProc    = (`TargetProc` pathIsRootSpec) <$> callFindProc schema pathName
+      ActionMutate MutationCreate -> qsColumns
-    | pathIsDefSpec = Right $ TargetDefaultSpec schema
+      ActionMutate MutationUpdate -> qsColumns
-    | otherwise     = Right $ TargetIdent $ QualifiedIdentifier schema pathName
+      ActionInvoke InvPost        -> qsColumns
-    where
+      _                           -> Nothing
-      callFindProc procSch procNam = findProc
-        (QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs sCache)
-        contentMediaType (action == ActionInvoke InvPost)
-
-  shouldParsePayload = case (action, contentMediaType) of
-    (ActionMutate MutationCreate, _)       -> True
-    (ActionInvoke InvPost, MTUrlEncoded)   -> False
-    (ActionInvoke InvPost, _)              -> True
-    (ActionMutate MutationSingleUpsert, _) -> True
-    (ActionMutate MutationUpdate, _)       -> True
-    _                                      -> False
-  relevantPayload = case (contentMediaType, action) of
-    -- Though ActionInvoke GET/HEAD doesn't really have a payload, we use the payload variable as a way
-    -- to store the query string arguments to the function.
-    (_, ActionInvoke InvGet)             -> targetToJsonRpcParams (rightToMaybe target) qsParams
-    (_, ActionInvoke InvHead)            -> targetToJsonRpcParams (rightToMaybe target) qsParams
-    (MTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
-    _ | shouldParsePayload               -> rightToMaybe payload
-      | otherwise                        -> Nothing
-  lookupHeader    = flip lookup hdrs
-  Preferences.Preferences{..} = Preferences.fromHeaders hdrs
 
 {-|
   Find the best match from a list of media types accepted by the
@@ -450,92 +398,3 @@ requestMediaTypes conf action path =
       [MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++
       [MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf]
     rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML]
-
-{-|
-  Search a pg proc by matching name and arguments keys to parameters. Since a function can be overloaded,
-  the name is not enough to find it. An overloaded function can have a different volatility or even a different return type.
--}
-findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> MediaType -> Bool -> Either ApiRequestError ProcDescription
-findProc qi argumentsKeys paramsAsSingleObject allProcs contentMediaType isInvPost =
-  case matchProc of
-    ([], [])     -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentMediaType isInvPost (HM.keys allProcs) lookupProcName
-    -- If there are no functions with named arguments, fallback to the single unnamed argument function
-    ([], [proc]) -> Right proc
-    ([], procs)  -> Left $ AmbiguousRpc (toList procs)
-    -- Matches the functions with named arguments
-    ([proc], _)  -> Right proc
-    (procs, _)   -> Left $ AmbiguousRpc (toList procs)
-  where
-    matchProc = overloadedProcPartition lookupProcName
-    -- First find the proc by name
-    lookupProcName = HM.lookupDefault mempty qi allProcs
-    -- The partition obtained has the form (overloadedProcs,fallbackProcs)
-    -- where fallbackProcs are functions with a single unnamed parameter
-    overloadedProcPartition = foldr select ([],[])
-    select proc ~(ts,fs)
-      | matchesParams proc         = (proc:ts,fs)
-      | hasSingleUnnamedParam proc = (ts,proc:fs)
-      | otherwise                  = (ts,fs)
-    -- If the function is called with post and has a single unnamed parameter
-    -- it can be called depending on content type and the parameter type
-    hasSingleUnnamedParam ProcDescription{pdParams=[ProcParam{ppType}]} = isInvPost && case (contentMediaType, ppType) of
-      (MTApplicationJSON, "json")  -> True
-      (MTApplicationJSON, "jsonb") -> True
-      (MTTextPlain, "text")        -> True
-      (MTTextXML, "xml")           -> True
-      (MTOctetStream, "bytea")     -> True
-      _                            -> False
-    hasSingleUnnamedParam _ = False
-    matchesParams proc =
-      let
-        params = pdParams proc
-        firstType = (ppType <$> headMay params)
-      in
-      -- exceptional case for Prefer: params=single-object
-      if paramsAsSingleObject
-        then length params == 1 && (firstType == Just "json" || firstType == Just "jsonb")
-      -- If the function has no parameters, the arguments keys must be empty as well
-      else if null params
-        then null argumentsKeys && not (isInvPost && contentMediaType `elem` [MTOctetStream, MTTextPlain, MTTextXML])
-      -- A function has optional and required parameters. Optional parameters have a default value and
-      -- don't require arguments for the function to be executed, required parameters must have an argument present.
-      else case L.partition ppReq params of
-      -- If the function only has required parameters, the arguments keys must match those parameters
-        (reqParams, [])        -> argumentsKeys == S.fromList (ppName <$> reqParams)
-      -- If the function only has optional parameters, the arguments keys can match none or any of them(a subset)
-        ([], optParams)        -> argumentsKeys `S.isSubsetOf` S.fromList (ppName <$> optParams)
-      -- If the function has required and optional parameters, the arguments keys have to match the required parameters
-      -- and can match any or none of the default parameters.
-        (reqParams, optParams) -> argumentsKeys `S.difference` S.fromList (ppName <$> optParams) == S.fromList (ppName <$> reqParams)
-
--- | If raw(binary) output is requested, check that MediaType is one of the
--- admitted rawMediaTypes and that`?select=...` contains only one field other
--- than `*`
-binaryField :: AppConfig -> MediaType -> Target -> QueryParams -> Either ApiRequestError (Maybe FieldName)
-binaryField AppConfig{configRawMediaTypes} acceptMediaType target QueryParams{qsSelect}
-  | returnsScalar target && isRawMediaType =
-      Right $ Just "pgrst_scalar"
-  | isRawMediaType =
-      let
-        fieldName = fstFieldName qsSelect
-      in
-      case fieldName of
-        Just fld -> Right $ Just fld
-        Nothing  -> Left $ BinaryFieldError acceptMediaType
-  | otherwise =
-      Right Nothing
-  where
-    isRawMediaType = acceptMediaType `elem` configRawMediaTypes `union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan acceptMediaType
-    isRawPlan mt = case mt of
-      MTPlan (MTPlanAttrs (Just MTOctetStream) _ _) -> True
-      MTPlan (MTPlanAttrs (Just MTTextPlain) _ _)   -> True
-      MTPlan (MTPlanAttrs (Just MTTextXML) _ _)     -> True
-      _                                             -> False
-    returnsScalar :: Target -> Bool
-    returnsScalar (TargetProc proc _) = procReturnsScalar proc
-    returnsScalar _                   = False
-
-    fstFieldName :: [Tree SelectItem] -> Maybe FieldName
-    fstFieldName [Node SelectField{selField=("*", _)} []] = Nothing
-    fstFieldName [Node SelectField{selField=(fld, _)} []] = Just fld
-    fstFieldName _                                        = Nothing

src/PostgREST/App.hs

@@ -147,7 +147,7 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@
 
   apiRequest <-
     liftEither . mapLeft Error.ApiRequestError $
-      ApiRequest.userApiRequest conf sCache req body
+      ApiRequest.userApiRequest conf req body
 
   Response.optionalRollback conf apiRequest $
     handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache
@@ -172,8 +172,8 @@ handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool ->
 handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache =
   case (iAction, iTarget) of
     (ActionRead headersOnly, TargetIdent identifier) -> do
-      rPlan <- liftEither $ Plan.readPlan identifier conf sCache apiReq
+      wrPlan <- liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq
-      resultSet <- runQuery Plan.readPlanTxMode $ Query.readQuery rPlan conf apiReq
+      resultSet <- runQuery (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq
       return $ Response.readResponse headersOnly identifier apiReq resultSet
 
     (ActionMutate MutationCreate, TargetIdent identifier) -> do
@@ -196,10 +196,10 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A
       resultSet <- runQuery (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf
       return $ Response.deleteResponse apiReq resultSet
 
-    (ActionInvoke invMethod, TargetProc proc _) -> do
+    (ActionInvoke invMethod, TargetProc identifier _) -> do
-      cPlan <- liftEither $ Plan.callReadPlan proc conf sCache apiReq invMethod
+      cPlan <- liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod
-      resultSet <- runQuery (Plan.crTxMode cPlan) $ Query.invokeQuery proc cPlan apiReq conf
+      resultSet <- runQuery (Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf
-      return $ Response.invokeResponse invMethod proc apiReq resultSet
+      return $ Response.invokeResponse invMethod (Plan.crProc cPlan) apiReq resultSet
 
     (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
       oaiResult <- runQuery Plan.inspectPlanTxMode $ Query.openApiQuery sCache pgVer conf tSchema
@@ -208,8 +208,9 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A
     (ActionInfo, TargetIdent identifier) ->
       return $ Response.infoIdentResponse identifier sCache
 
-    (ActionInfo, TargetProc proc _) ->
+    (ActionInfo, TargetProc identifier _) -> do
-      return $ Response.infoProcResponse proc
+      cPlan <- liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead
+      return $ Response.infoProcResponse (Plan.crProc cPlan)
 
     (ActionInfo, TargetDefaultSpec _) ->
       return Response.infoRootResponse

src/PostgREST/Plan.hs

@@ -16,16 +16,19 @@ resource.
 {-# LANGUAGE RecordWildCards       #-}
 
 module PostgREST.Plan
-  ( readPlan
+  ( wrappedReadPlan
   , mutateReadPlan
   , callReadPlan
+  , WrappedReadPlan(..)
   , MutateReadPlan(..)
   , CallReadPlan(..)
-  , readPlanTxMode
   , inspectPlanTxMode
   ) where
 
+
+import qualified Data.ByteString.Lazy       as LBS
 import qualified Data.HashMap.Strict        as HM
+import qualified Data.List                  as L
 import qualified Data.Set                   as S
 import qualified PostgREST.SchemaCache.Proc as Proc
 
@@ -40,6 +43,8 @@ import PostgREST.ApiRequest               (Action (..),
                                            Payload (..))
 import PostgREST.Config                   (AppConfig (..))
 import PostgREST.Error                    (Error (..))
+import PostgREST.MediaType                (MTPlanAttrs (..),
+                                           MediaType (..))
 import PostgREST.Query.SqlFragment        (sourceCTEName)
 import PostgREST.RangeQuery               (NonnegRange, allRange,
                                            convertToLimitZeroRange,
@@ -49,7 +54,7 @@ import PostgREST.SchemaCache.Identifiers  (FieldName,
                                            QualifiedIdentifier (..),
                                            Schema)
 import PostgREST.SchemaCache.Proc         (ProcDescription (..),
-                                           ProcParam (..),
+                                           ProcParam (..), ProcsMap,
                                            procReturnsScalar)
 import PostgREST.SchemaCache.Relationship (Cardinality (..),
                                            Junction (..),
@@ -71,6 +76,12 @@ import qualified PostgREST.ApiRequest.QueryParams as QueryParams
 
 import Protolude hiding (from)
 
+data WrappedReadPlan = WrappedReadPlan {
+  wrReadPlan :: ReadPlanTree
+, wrTxMode   :: SQL.Mode
+, wrBinField :: Maybe FieldName
+}
+
 data MutateReadPlan = MutateReadPlan {
   mrReadPlan   :: ReadPlanTree
 , mrMutatePlan :: MutatePlan
@@ -81,29 +92,105 @@ data CallReadPlan = CallReadPlan {
   crReadPlan :: ReadPlanTree
 , crCallPlan :: CallPlan
 , crTxMode   :: SQL.Mode
+, crProc     :: ProcDescription
+, crBinField :: Maybe FieldName
 }
 
+wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error WrappedReadPlan
+wrappedReadPlan  identifier conf sCache apiRequest = do
+  rPlan <- readPlan identifier conf sCache apiRequest
+  binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) Nothing rPlan
+  return $ WrappedReadPlan rPlan SQL.Read binField
+
 mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error MutateReadPlan
 mutateReadPlan  mutation apiRequest identifier conf sCache = do
   rPlan <- readPlan identifier conf sCache apiRequest
   mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan
   return $ MutateReadPlan rPlan mPlan SQL.Write
 
-callReadPlan :: ProcDescription -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan
+callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan
-callReadPlan proc conf sCache apiRequest invMethod = do
+callReadPlan identifier conf sCache apiRequest invMethod = do
-  let identifier = QualifiedIdentifier (pdSchema proc) (fromMaybe (pdName proc) $ Proc.procTableName proc)
+  let paramKeys = case invMethod of
-  rPlan <- readPlan identifier conf sCache apiRequest
+        InvGet  -> S.fromList $ fst <$> qsParams'
-  let cPlan = callPlan proc apiRequest rPlan
+        InvHead -> S.fromList $ fst <$> qsParams'
-      txMode = case (invMethod, Proc.pdVolatility proc) of
+        InvPost -> iColumns apiRequest
+  proc@ProcDescription{..} <- mapLeft ApiRequestError $
+    findProc identifier paramKeys (iPreferParameters apiRequest == Just SingleObject) (dbProcs sCache) (iContentMediaType apiRequest) (invMethod == InvPost)
+  let relIdentifier = QualifiedIdentifier pdSchema (fromMaybe pdName $ Proc.procTableName proc) -- done so a set returning function can embed other relations
+  rPlan <- readPlan relIdentifier conf sCache apiRequest
+  let args = case (invMethod, iContentMediaType apiRequest) of
+        (InvGet, _)             -> jsonRpcParams proc qsParams'
+        (InvHead, _)            -> jsonRpcParams proc qsParams'
+        (InvPost, MTUrlEncoded) -> maybe mempty (jsonRpcParams proc . payArray) $ iPayload apiRequest
+        (InvPost, _)            -> maybe mempty payRaw $ iPayload apiRequest
+      txMode = case (invMethod, pdVolatility) of
           (InvGet,  _)              -> SQL.Read
           (InvHead, _)              -> SQL.Read
           (InvPost, Proc.Stable)    -> SQL.Read
           (InvPost, Proc.Immutable) -> SQL.Read
           (InvPost, Proc.Volatile)  -> SQL.Write
-  return $ CallReadPlan rPlan cPlan txMode
+      cPlan = callPlan proc apiRequest paramKeys args rPlan
+  binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) (Just proc) rPlan
+  return $ CallReadPlan rPlan cPlan txMode proc binField
+  where
+    qsParams' = QueryParams.qsParams (iQueryParams apiRequest)
 
-readPlanTxMode :: SQL.Mode
+{-|
-readPlanTxMode = SQL.Read
+  Search a pg proc by matching name and arguments keys to parameters. Since a function can be overloaded,
+  the name is not enough to find it. An overloaded function can have a different volatility or even a different return type.
+-}
+findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> MediaType -> Bool -> Either ApiRequestError ProcDescription
+findProc qi argumentsKeys paramsAsSingleObject allProcs contentMediaType isInvPost =
+  case matchProc of
+    ([], [])     -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentMediaType isInvPost (HM.keys allProcs) lookupProcName
+    -- If there are no functions with named arguments, fallback to the single unnamed argument function
+    ([], [proc]) -> Right proc
+    ([], procs)  -> Left $ AmbiguousRpc (toList procs)
+    -- Matches the functions with named arguments
+    ([proc], _)  -> Right proc
+    (procs, _)   -> Left $ AmbiguousRpc (toList procs)
+  where
+    matchProc = overloadedProcPartition lookupProcName
+    -- First find the proc by name
+    lookupProcName = HM.lookupDefault mempty qi allProcs
+    -- The partition obtained has the form (overloadedProcs,fallbackProcs)
+    -- where fallbackProcs are functions with a single unnamed parameter
+    overloadedProcPartition = foldr select ([],[])
+    select proc ~(ts,fs)
+      | matchesParams proc         = (proc:ts,fs)
+      | hasSingleUnnamedParam proc = (ts,proc:fs)
+      | otherwise                  = (ts,fs)
+    -- If the function is called with post and has a single unnamed parameter
+    -- it can be called depending on content type and the parameter type
+    hasSingleUnnamedParam ProcDescription{pdParams=[ProcParam{ppType}]} = isInvPost && case (contentMediaType, ppType) of
+      (MTApplicationJSON, "json")  -> True
+      (MTApplicationJSON, "jsonb") -> True
+      (MTTextPlain, "text")        -> True
+      (MTTextXML, "xml")           -> True
+      (MTOctetStream, "bytea")     -> True
+      _                            -> False
+    hasSingleUnnamedParam _ = False
+    matchesParams proc =
+      let
+        params = pdParams proc
+        firstType = (ppType <$> headMay params)
+      in
+      -- exceptional case for Prefer: params=single-object
+      if paramsAsSingleObject
+        then length params == 1 && (firstType == Just "json" || firstType == Just "jsonb")
+      -- If the function has no parameters, the arguments keys must be empty as well
+      else if null params
+        then null argumentsKeys && not (isInvPost && contentMediaType `elem` [MTOctetStream, MTTextPlain, MTTextXML])
+      -- A function has optional and required parameters. Optional parameters have a default value and
+      -- don't require arguments for the function to be executed, required parameters must have an argument present.
+      else case L.partition ppReq params of
+      -- If the function only has required parameters, the arguments keys must match those parameters
+        (reqParams, [])        -> argumentsKeys == S.fromList (ppName <$> reqParams)
+      -- If the function only has optional parameters, the arguments keys can match none or any of them(a subset)
+        ([], optParams)        -> argumentsKeys `S.isSubsetOf` S.fromList (ppName <$> optParams)
+      -- If the function has required and optional parameters, the arguments keys have to match the required parameters
+      -- and can match any or none of the default parameters.
+        (reqParams, optParams) -> argumentsKeys `S.difference` S.fromList (ppName <$> optParams) == S.fromList (ppName <$> reqParams)
 
 inspectPlanTxMode :: SQL.Mode
 inspectPlanTxMode = SQL.Read
@@ -452,23 +539,23 @@ resolveOrError (Just table) field =
     Nothing         -> Left $ ColumnNotFound (tableName table) field
     Just typedField -> Right typedField
 
-callPlan :: ProcDescription -> ApiRequest -> ReadPlanTree -> CallPlan
+callPlan :: ProcDescription -> ApiRequest -> S.Set FieldName -> LBS.ByteString -> ReadPlanTree -> CallPlan
-callPlan proc apiReq readReq = FunctionCall {
+callPlan proc apiReq paramKeys args readReq = FunctionCall {
   funCQi = QualifiedIdentifier (pdSchema proc) (pdName proc)
 , funCParams = callParams
-, funCArgs = payRaw <$> iPayload apiReq
+, funCArgs = Just args
 , funCScalar = procReturnsScalar proc
 , funCMultipleCall = iPreferParameters apiReq == Just MultipleObjects
 , funCReturning = inferColsEmbedNeeds readReq []
 }
   where
     paramsAsSingleObject = iPreferParameters apiReq == Just SingleObject
+    specifiedParams = filter (\x -> ppName x `S.member` paramKeys)
     callParams = case pdParams proc of
       [prm] | paramsAsSingleObject -> OnePosParam prm
             | ppName prm == mempty -> OnePosParam prm
             | otherwise            -> KeyParams $ specifiedParams [prm]
       prms  -> KeyParams $ specifiedParams prms
-    specifiedParams = filter (\x -> ppName x `S.member` iColumns apiReq)
 
 -- | Infers the columns needed for an embed to be successful after a mutation or a function call.
 inferColsEmbedNeeds :: ReadPlanTree -> [FieldName] -> [FieldName]
@@ -519,3 +606,33 @@ inferColsEmbedNeeds (Node ReadPlan{select} forest) pkCols
 -- they are later concatenated with AND in the QueryBuilder
 addFilterToLogicForest :: Filter -> [LogicTree] -> [LogicTree]
 addFilterToLogicForest flt lf = Stmnt flt : lf
+
+-- | If raw(binary) output is requested, check that MediaType is one of the
+-- admitted rawMediaTypes and that`?select=...` contains only one field other
+-- than `*`
+binaryField :: AppConfig -> MediaType -> Maybe ProcDescription -> ReadPlanTree -> Either ApiRequestError (Maybe FieldName)
+binaryField AppConfig{configRawMediaTypes} acceptMediaType proc rpTree
+  | isRawMediaType =
+    if (procReturnsScalar <$> proc) == Just True
+      then Right $ Just "pgrst_scalar"
+      else
+        let
+          fieldName = fstFieldName rpTree
+        in
+        case fieldName of
+          Just fld -> Right $ Just fld
+          Nothing  -> Left $ BinaryFieldError acceptMediaType
+  | otherwise =
+      Right Nothing
+  where
+    isRawMediaType = acceptMediaType `elem` configRawMediaTypes `L.union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan acceptMediaType
+    isRawPlan mt = case mt of
+      MTPlan (MTPlanAttrs (Just MTOctetStream) _ _) -> True
+      MTPlan (MTPlanAttrs (Just MTTextPlain) _ _)   -> True
+      MTPlan (MTPlanAttrs (Just MTTextXML) _ _)     -> True
+      _                                             -> False
+
+    fstFieldName :: ReadPlanTree -> Maybe FieldName
+    fstFieldName (Node ReadPlan{select=(("*", []), _, _):_} [])  = Nothing
+    fstFieldName (Node ReadPlan{select=[((fld, []), _, _)]} []) = Just fld
+    fstFieldName _                                               = Nothing

src/PostgREST/Plan/CallPlan.hs

@@ -1,13 +1,18 @@
+{-# LANGUAGE NamedFieldPuns #-}
 module PostgREST.Plan.CallPlan
   ( CallPlan(..)
   , CallParams(..)
+  , jsonRpcParams
   )
 where
 
+import qualified Data.Aeson                        as JSON
 import qualified Data.ByteString.Lazy              as LBS
+import qualified Data.HashMap.Strict               as HM
 import           PostgREST.SchemaCache.Identifiers (FieldName,
                                                     QualifiedIdentifier)
-import           PostgREST.SchemaCache.Proc        (ProcParam (..))
+import           PostgREST.SchemaCache.Proc        (ProcDescription (..),
+                                                    ProcParam (..))
 
 import Protolude
 
@@ -23,3 +28,29 @@ data CallPlan = FunctionCall
 data CallParams
   = KeyParams [ProcParam] -- ^ Call with key params: func(a := val1, b:= val2)
   | OnePosParam ProcParam -- ^ Call with positional params(only one supported): func(val)
+
+-- | Convert rpc params `/rpc/func?a=val1&b=val2` to json `{"a": "val1", "b": "val2"}
+jsonRpcParams :: ProcDescription -> [(Text, Text)] -> LBS.ByteString
+jsonRpcParams proc prms =
+  if not $ pdHasVariadic proc then -- if proc has no variadic param, save steps and directly convert to json
+    JSON.encode $ HM.fromList $ second JSON.toJSON <$> prms
+  else
+    let paramsMap = HM.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
+    JSON.encode paramsMap
+  where
+    mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue
+    mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a
+    mergeParams v _                       = v -- repeated params for non-variadic parameters are not merged
+
+toRpcParamValue :: ProcDescription -> (Text, Text) -> (Text, RpcParamValue)
+toRpcParamValue proc (k, v) | prmIsVariadic k = (k, Variadic [v])
+                            | otherwise       = (k, Fixed v)
+  where
+    prmIsVariadic prm = isJust $ find (\ProcParam{ppName, ppVar} -> ppName == prm && ppVar) $ pdParams proc
+
+-- | RPC query param value `/rpc/func?v=<value>`, used for VARIADIC functions on form-urlencoded POST and GETs
+-- | It can be fixed `?v=1` or repeated `?v=1&v=2&v=3.
+data RpcParamValue = Fixed Text | Variadic [Text]
+instance JSON.ToJSON RpcParamValue where
+  toJSON (Fixed    v) = JSON.toJSON v
+  toJSON (Variadic v) = JSON.toJSON v

src/PostgREST/Query.hs

@@ -46,9 +46,9 @@ import PostgREST.Config.PgVersion        (PgVersion (..),
 import PostgREST.Error                   (Error)
 import PostgREST.MediaType               (MediaType (..))
 import PostgREST.Plan                    (CallReadPlan (..),
-                                          MutateReadPlan (..))
+                                          MutateReadPlan (..),
+                                          WrappedReadPlan (..))
 import PostgREST.Plan.MutatePlan         (MutatePlan (..))
-import PostgREST.Plan.ReadPlan           (ReadPlanTree)
 import PostgREST.Query.SqlFragment       (fromQi, intercalateSnippet,
                                           pgFmtIdentList,
                                           setConfigLocal,
@@ -65,13 +65,13 @@ import Protolude hiding (Handler)
 
 type DbHandler = ExceptT Error SQL.Transaction
 
-readQuery :: ReadPlanTree -> AppConfig -> ApiRequest -> DbHandler ResultSet
+readQuery :: WrappedReadPlan -> AppConfig -> ApiRequest -> DbHandler ResultSet
-readQuery req conf@AppConfig{..} apiReq@ApiRequest{..} = do
+readQuery WrappedReadPlan{wrReadPlan, wrBinField} conf@AppConfig{..} apiReq@ApiRequest{..} = do
-  let countQuery = QueryBuilder.readPlanToCountQuery req
+  let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan
   resultSet <-
      lift . SQL.statement mempty $
       Statements.prepareRead
-        (QueryBuilder.readPlanToQuery req)
+        (QueryBuilder.readPlanToQuery wrReadPlan)
         (if iPreferCount == Just EstimatedCount then
            -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
            QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
@@ -80,7 +80,7 @@ readQuery req conf@AppConfig{..} apiReq@ApiRequest{..} = do
         )
         (shouldCount iPreferCount)
         iAcceptMediaType
-        iBinaryField
+        wrBinField
         configDbPreparedStatements
   failNotSingular iAcceptMediaType resultSet
   optionalRollback conf apiReq
@@ -151,7 +151,7 @@ deleteQuery mrPlan apiReq@ApiRequest{..} conf = do
   pure resultSet
 
 invokeQuery :: ProcDescription -> CallReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
-invokeQuery proc CallReadPlan{crReadPlan, crCallPlan} apiReq@ApiRequest{..} conf@AppConfig{..} = do
+invokeQuery proc CallReadPlan{crReadPlan, crCallPlan, crBinField} apiReq@ApiRequest{..} conf@AppConfig{..} = do
   resultSet <-
     lift . SQL.statement mempty $
       Statements.prepareCall
@@ -163,7 +163,7 @@ invokeQuery proc CallReadPlan{crReadPlan, crCallPlan} apiReq@ApiRequest{..} conf
         (shouldCount iPreferCount)
         iAcceptMediaType
         (iPreferParameters == Just MultipleObjects)
-        iBinaryField
+        crBinField
         configDbPreparedStatements
 
   optionalRollback conf apiReq