Allow GET on RPC (#946)

2017-09-17 11:16:46 -05:00
parent 32117ba477
commit cf19ad0369
12 changed files with 375 additions and 250 deletions
@@ -8,6 +8,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 ### Added

 - #887, #601, Allow specifying dictionary and plain/phrase tsquery in full text search - @steve-chavez
+- #328, Allow doing GET on rpc - @steve-chavez

 ### Fixed

@@ -126,6 +126,7 @@ Test-Suite spec
                     , Feature.StructureSpec
                     , Feature.UnicodeSpec
                     , Feature.AndOrParamsSpec
+                     , Feature.RpcSpec
                     , SpecHelper
                     , TestTypes
  Build-Depends:       aeson
@@ -19,7 +19,7 @@ import qualified Data.ByteString.Internal  as BS (c2w)
 import qualified Data.ByteString.Lazy      as BL
 import qualified Data.Csv                  as CSV
 import qualified Data.List                 as L
-import           Data.List                 (lookup, last)
+import           Data.List                 (lookup, last, partition)
 import qualified Data.HashMap.Strict       as M
 import qualified Data.Set                  as S
 import           Data.Maybe                (fromJust)
@@ -38,7 +38,8 @@ import           PostgREST.Types           ( QualifiedIdentifier (..)
                                           , PayloadJSON(..)
                                           , ContentType(..)
                                           , ApiRequestError(..)
-                                           , toMime)
+                                           , toMime
+                                           , operators)
 import           Data.Ranged.Ranges        (Range(..), rangeIntersection, emptyRange)
 import qualified Data.CaseInsensitive      as CI
 import           Web.Cookie                (parseCookiesText)
@@ -48,7 +49,7 @@ type RequestBody = BL.ByteString
 -- | Types of things a user wants to do to tables/views/procs
 data Action = ActionCreate | ActionRead
            | ActionUpdate | ActionDelete
-            | ActionInfo   | ActionInvoke
+            | ActionInfo   | ActionInvoke{isReadOnly :: Bool}
            | ActionInspect
            deriving Eq
 -- | The target db object of a user action
@@ -100,12 +101,14 @@ data ApiRequest = ApiRequest {
  , iHeaders :: [(Text, Text)]
  -- | Request Cookies
  , iCookies :: [(Text, Text)]
+  -- | Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
+  , iRpcQParams :: [(Text, Text)]
  }

 -- | Examines HTTP request and translates it into user intent.
 userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
 userApiRequest schema req reqBody
-  | isTargetingProc && method /= "POST" = Left ActionInappropriate
+  | isTargetingProc && method `notElem` ["GET", "POST"] = Left ActionInappropriate
  | topLevelRange == emptyRange = Left InvalidRange
  | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) undefined payload
  | otherwise = Right ApiRequest {
@@ -118,7 +121,8 @@ userApiRequest schema req reqBody
      , iPreferRepresentation = representation
      , iPreferSingleObjectParameter = singleObject
      , iPreferCount = hasPrefer "count=exact"
-      , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
+      , iFilters = filters
+      , iRpcQParams = rpcQParams
      , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
      , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
      , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
@@ -132,6 +136,13 @@ userApiRequest schema req reqBody
      , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie"
      }
 where
+  (filters, rpcQParams) =
+    case action of
+      ActionInvoke{isReadOnly=True} -> partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
+      _ -> (flts, [])
+  flts = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
+  hasOperator val = foldr ((||) . flip T.isPrefixOf val) False $ (<> ".") <$> M.keys operators
+  isEmbedPath = T.isInfixOf "."
  isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
  payload =
    case decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type" of
@@ -150,17 +161,19 @@ userApiRequest schema req reqBody
      ct ->
        Left $ toS $ "Content-Type not acceptable: " <> toMime ct
  topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges
-  action = case method of
-            "GET"     -> if target == TargetRoot
-                          then ActionInspect
-                          else ActionRead
-            "POST"    -> if isTargetingProc
-                          then ActionInvoke
-                          else ActionCreate
-            "PATCH"   -> ActionUpdate
-            "DELETE"  -> ActionDelete
-            "OPTIONS" -> ActionInfo
-            _         -> ActionInspect
+  action =
+    case method of
+      "GET"      | target == TargetRoot -> ActionInspect
+                 | isTargetingProc -> ActionInvoke{isReadOnly=True}
+                 | otherwise -> ActionRead
+
+      "POST"    -> if isTargetingProc
+                    then ActionInvoke{isReadOnly=False}
+                    else ActionCreate
+      "PATCH"   -> ActionUpdate
+      "DELETE"  -> ActionDelete
+      "OPTIONS" -> ActionInfo
+      _         -> ActionInspect
  target = case path of
              []            -> TargetRoot
              [table]       -> TargetIdent
@@ -168,10 +181,10 @@ userApiRequest schema req reqBody
              ["rpc", proc] -> TargetProc
                              $ QualifiedIdentifier schema proc
              other         -> TargetUnknown other
-  shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionInvoke]
-  relevantPayload = if shouldParsePayload
-                      then rightToMaybe payload
-                      else Nothing
+  shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionInvoke{isReadOnly=False}]
+  relevantPayload | action == ActionInvoke{isReadOnly=True} = Nothing
+                  | shouldParsePayload = rightToMaybe payload
+                  | otherwise = Nothing
  path            = pathInfo req
  method          = requestMethod req
  hdrs            = requestHeaders req
@@ -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 =
@@ -3,6 +3,7 @@
 module PostgREST.DbRequestBuilder (
  readRequest
 , mutateRequest
+, readRpcRequest
 , fieldNames
 ) where

@@ -72,10 +73,10 @@ readRequest maxRows allRels allProcs apiRequest  =

    relations :: [Relation]
    relations = case action of
-      ActionCreate -> fakeSourceRelations ++ allRels
-      ActionUpdate -> fakeSourceRelations ++ allRels
-      ActionDelete -> fakeSourceRelations ++ allRels
-      ActionInvoke -> fakeSourceRelations ++ allRels
+      ActionCreate   -> fakeSourceRelations ++ allRels
+      ActionUpdate   -> fakeSourceRelations ++ allRels
+      ActionDelete   -> fakeSourceRelations ++ allRels
+      ActionInvoke _ -> fakeSourceRelations ++ allRels
      _       -> allRels
      where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation

@@ -222,9 +223,11 @@ addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
    logicForest = mapM pRequestLogicTree logFrst
    action = iAction apiRequest
    -- there can be no filters on the root table when we are doing insert/update/delete
-    (flts, logFrst)
-      | action == ActionRead || action == ActionInvoke = (iFilters apiRequest, iLogic apiRequest)
-      | otherwise = join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
+    (flts, logFrst) =
+      case action of
+        ActionInvoke _ -> (iFilters apiRequest, iLogic apiRequest)
+        ActionRead     -> (iFilters apiRequest, iLogic apiRequest)
+        _              -> join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
    orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
    orders = mapM pRequestOrder $ iOrder apiRequest
    ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
@@ -310,6 +313,11 @@ mutateRequest apiRequest fldNames = mapLeft apiRequestError $
    (mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest)
    onlyRoot = filter (not . ( "." `isInfixOf` ) . fst)

+readRpcRequest :: ApiRequest -> Either Response [RpcQParam]
+readRpcRequest apiRequest = mapLeft apiRequestError rpcQParams
+  where
+    rpcQParams = mapM pRequestRpcQParam $ iRpcQParams apiRequest
+
 fieldNames :: ReadRequest -> [FieldName]
 fieldNames (Node (sel, _) forest) =
  map (fst . view _1) (select sel) ++ map colName fks
@@ -44,9 +44,15 @@ pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
    path = parse pLogicPath ("failed to parser logic path (" ++ toS k ++ ")") $ toS k
    embedPath = fst <$> path
    op = snd <$> path
-    -- Concat op and v to make pLogicTree argument regular, in the form of "op(.,.)"
+    -- Concat op and v to make pLogicTree argument regular, in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
    logicTree = join $ parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") . toS <$> ((<>) <$> op <*> pure v)

+pRequestRpcQParam :: (Text, Text) -> Either ApiRequestError RpcQParam
+pRequestRpcQParam (k, v) = mapError $ (,) <$> name <*> val
+  where
+    name = parse pFieldName ("failed to parse rpc arg name (" ++ toS k ++ ")") $ toS k
+    val = toS <$> parse (many anyChar) ("failed to parse rpc arg value (" ++ toS v ++ ")") v
+
 ws :: Parser Text
 ws = toS <$> many (oneOf " \t")

@@ -144,8 +144,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 -> Bool -> Maybe FieldName -> H.Query () (Maybe ProcResults)
-callProc qi params returnsScalar selectQuery countQuery _ countTotal isSingle paramsAsJson asCsv asBinary binaryField =
+  Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> H.Query () (Maybe ProcResults)
+callProc qi params returnsScalar selectQuery countQuery _ countTotal isSingle paramsAsJson asCsv asBinary isReadOnly binaryField =
  unicodeStatement sql HE.unit decodeProc True
  where
    sql =
@@ -165,7 +165,7 @@ callProc qi params returnsScalar selectQuery countQuery _ countTotal isSingle pa
       FROM ({selectQuery}) _postgrest_t;|]

    countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
-    _args = if paramsAsJson
+    _args = if paramsAsJson && not isReadOnly
                then insertableValueWithType "json" $ JSON.Object params
                else intercalate "," $ map _assignment (HM.toList params)
    _procName = qiName qi
@@ -208,6 +208,9 @@ type Alias = Text
 type Cast = Text
 type NodeName = Text

+-- Rpc query param, only used for GET rpcs
+type RpcQParam = (Text, Text)
+
 {-|
  This type will hold information about which particular 'Relation' between two tables to choose when there are multiple ones.
  Specifically, it will contain the name of the foreign key or the join table in many to many relations.
@@ -4,8 +4,7 @@ import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus,simpleBody))
-import qualified Data.ByteString.Lazy as BL (empty)
+import Network.Wai.Test (SResponse(simpleHeaders))

 import SpecHelper
 import Text.Heredoc
@@ -564,214 +563,6 @@ spec = do
        [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
        { matchHeaders = [matchContentTypeJson] }

-  describe "remote procedure call" $ do
-    context "a proc that returns a set" $ do
-      it "returns paginated results" $
-        request methodPost "/rpc/getitemrange"
-                (rangeHdrs (ByteRangeFromTo 0 0))  [json| { "min": 2, "max": 4 } |]
-           `shouldRespondWith` [json| [{"id":3}] |]
-            { matchStatus = 200
-            , matchHeaders = ["Content-Range" <:> "0-0/*"]
-            }
-
-      it "includes total count if requested" $
-        request methodPost "/rpc/getitemrange"
-                (rangeHdrsWithCount (ByteRangeFromTo 0 0))
-                [json| { "min": 2, "max": 4 } |]
-           `shouldRespondWith` [json| [{"id":3}] |]
-            { matchStatus = 206 -- it now knows the response is partial
-            , matchHeaders = ["Content-Range" <:> "0-0/2"]
-            }
-
-      it "returns proper json" $
-        post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
-          [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
-
-    context "shaping the response returned by a proc" $ do
-      it "returns a project" $
-        post "/rpc/getproject" [json| { "id": 1} |] `shouldRespondWith`
-          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
-
-      it "can filter proc results" $
-        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith`
-          [json|[{"id":2},{"id":3},{"id":4}]|]
-          { matchHeaders = [matchContentTypeJson] }
-
-      it "can limit proc results" $
-        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1" [json| {} |]
-          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
-             { matchStatus = 200
-             , matchHeaders = ["Content-Range" <:> "1-2/*"]
-             }
-
-      it "select works on the first level" $
-        post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith`
-          [str|[{"id":1,"name":"Windows 7"}]|]
-
-    context "foreign entities embedding" $ do
-      it "can embed if related tables are in the exposed schema" $
-        post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith`
-          [str|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
-
-      it "cannot embed if the related table is not in the exposed schema" $
-        post "/rpc/single_article?select=*,article_stars{*}" [json|{ "id": 1}|]
-          `shouldRespondWith` 400
-
-      it "can embed if the related tables are in a hidden schema but exposed as views" $
-        post "/rpc/single_article?select=id,articleStars{userId}" [json|{ "id": 2}|]
-          `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|]
-          { matchHeaders = [matchContentTypeJson] }
-
-    context "a proc that returns an empty rowset" $
-      it "returns empty json array" $
-        post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith`
-          [json| [] |]
-          { matchHeaders = [matchContentTypeJson] }
-
-    context "proc return types" $ do
-      context "returns text" $ do
-        it "returns proper json" $
-          post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
-            [json|"Hello, world"|]
-            { matchHeaders = [matchContentTypeJson] }
-
-        it "can handle unicode" $
-          post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith`
-            [json|"Hello, ￥"|]
-            { matchHeaders = [matchContentTypeJson] }
-
-      it "returns array" $
-        post "/rpc/ret_array" [json|{}|] `shouldRespondWith`
-          [json|[1, 2, 3]|]
-          { matchHeaders = [matchContentTypeJson] }
-
-      it "returns setof integers" $
-        post "/rpc/ret_setof_integers" [json|{}|] `shouldRespondWith`
-          [json|[{ "ret_setof_integers": 1 },
-                 { "ret_setof_integers": 2 },
-                 { "ret_setof_integers": 3 }]|]
-          { matchHeaders = [matchContentTypeJson] }
-
-      it "returns enum value" $
-        post "/rpc/ret_enum" [json|{ "val": "foo" }|] `shouldRespondWith`
-          [json|"foo"|]
-          { matchHeaders = [matchContentTypeJson] }
-
-      it "returns domain value" $
-        post "/rpc/ret_domain" [json|{ "val": "8" }|] `shouldRespondWith`
-          [json|8|]
-          { matchHeaders = [matchContentTypeJson] }
-
-      it "returns range" $
-        post "/rpc/ret_range" [json|{ "low": 10, "up": 20 }|] `shouldRespondWith`
-          [json|"[10,20)"|]
-          { matchHeaders = [matchContentTypeJson] }
-
-      it "returns row of scalars" $
-        post "/rpc/ret_scalars" [json|{}|] `shouldRespondWith`
-          [json|[{"a":"scalars", "b":"foo", "c":1, "d":"[10,20)"}]|]
-          { matchHeaders = [matchContentTypeJson] }
-
-      it "returns composite type in exposed schema" $
-        post "/rpc/ret_point_2d" [json|{}|] `shouldRespondWith`
-          [json|[{"x": 10, "y": 5}]|]
-          { matchHeaders = [matchContentTypeJson] }
-
-      it "cannot return composite type in hidden schema" $
-        post "/rpc/ret_point_3d" [json|{}|] `shouldRespondWith` 401
-
-      it "returns single row from table" $
-        post "/rpc/single_article?select=id" [json|{"id": 2}|] `shouldRespondWith`
-          [json|[{"id": 2}]|]
-          { matchHeaders = [matchContentTypeJson] }
-
-      it "returns null for void" $
-        post "/rpc/ret_void" [json|{}|] `shouldRespondWith`
-          [json|null|]
-          { matchHeaders = [matchContentTypeJson] }
-
-    context "improper input" $ do
-      it "rejects unknown content type even if payload is good" $
-        request methodPost "/rpc/sayhello"
-          (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
-            `shouldRespondWith` 415
-      it "rejects malformed json payload" $ do
-        p <- request methodPost "/rpc/sayhello"
-          (acceptHdrs "application/json") "sdfsdf"
-        liftIO $ do
-          simpleStatus p `shouldBe` badRequest400
-          isErrorFormat (simpleBody p) `shouldBe` True
-      it "treats simple plpgsql raise as invalid input" $ do
-        p <- post "/rpc/problem" "{}"
-        liftIO $ do
-          simpleStatus p `shouldBe` badRequest400
-          isErrorFormat (simpleBody p) `shouldBe` True
-
-    context "unsupported verbs" $ do
-      it "DELETE fails" $
-        request methodDelete "/rpc/sayhello" [] ""
-          `shouldRespondWith` 405
-      it "PATCH fails" $
-        request methodPatch "/rpc/sayhello" [] ""
-          `shouldRespondWith` 405
-      it "OPTIONS fails" $
-        -- TODO: should return info about the function
-        request methodOptions "/rpc/sayhello" [] ""
-          `shouldRespondWith` 405
-      it "GET fails with 405 on unknown procs" $
-        -- TODO: should this be 404?
-        get "/rpc/fake" `shouldRespondWith` 405
-      it "GET with 405 on known procs" $
-        get "/rpc/sayhello" `shouldRespondWith` 405
-
-    it "executes the proc exactly once per request" $ do
-      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
-        [json|1|]
-        { matchHeaders = [matchContentTypeJson] }
-      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
-        [json|2|]
-        { matchHeaders = [matchContentTypeJson] }
-
-    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"} } |]
-          { matchHeaders = [matchContentTypeJson] }
-
-      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" } |]
-                 { matchHeaders = [matchContentTypeJson] }
-
-    context "a proc that receives no parameters" $
-      it "interprets empty string as empty json object on a post request" $
-        post "/rpc/noparamsproc" BL.empty `shouldRespondWith`
-          [json| "Return value of no parameters procedure." |]
-          { matchHeaders = [matchContentTypeJson] }
-
-    it "returns proper output when having the same return col name as the proc name" $
-      post "/rpc/test" [json|{}|] `shouldRespondWith`
-        [json|[{"test":"hello","value":1}]|] { matchHeaders = [matchContentTypeJson] }
-
  describe "weird requests" $ do
    it "can query as normal" $ do
      get "/Escap3e;" `shouldRespondWith`
@@ -0,0 +1,288 @@
+module Feature.RpcSpec where
+
+import Test.Hspec hiding (pendingWith)
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.HTTP.Types
+import Network.Wai.Test (SResponse(simpleStatus, simpleBody))
+import qualified Data.ByteString.Lazy as BL (empty)
+
+import SpecHelper
+import Text.Heredoc
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "remote procedure call" $ do
+    context "a proc that returns a set" $ do
+      it "returns paginated results" $ do
+        request methodPost "/rpc/getitemrange"
+                (rangeHdrs (ByteRangeFromTo 0 0))  [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 200
+            , matchHeaders = ["Content-Range" <:> "0-0/*"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (rangeHdrs (ByteRangeFromTo 0 0)) ""
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 200
+            , matchHeaders = ["Content-Range" <:> "0-0/*"]
+            }
+
+      it "includes total count if requested" $ do
+        request methodPost "/rpc/getitemrange"
+                (rangeHdrsWithCount (ByteRangeFromTo 0 0))
+                [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 206 -- it now knows the response is partial
+            , matchHeaders = ["Content-Range" <:> "0-0/2"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (rangeHdrsWithCount (ByteRangeFromTo 0 0)) ""
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 206
+            , matchHeaders = ["Content-Range" <:> "0-0/2"]
+            }
+
+      it "returns proper json" $ do
+        post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getitemrange?min=2&max=4" `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns CSV" $ do
+        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"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (acceptHdrs "text/csv") ""
+           `shouldRespondWith` "id\n3\n4"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+            }
+
+    context "unknown function" $ do
+      it "returns 404" $
+        post "/rpc/fakefunc" [json| {} |] `shouldRespondWith` 404
+      it "should fail with 404 on unknown proc name" $
+        get "/rpc/fake" `shouldRespondWith` 404
+      it "should fail with 404 on unknown proc args" $ do
+        get "/rpc/sayhello" `shouldRespondWith` 404
+        get "/rpc/sayhello?any_arg=value" `shouldRespondWith` 404
+
+    context "shaping the response returned by a proc" $ do
+      it "returns a project" $ do
+        post "/rpc/getproject" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
+        get "/rpc/getproject?id=1" `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
+
+      it "can filter proc results" $ do
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith`
+          [json|[{"id":2},{"id":3},{"id":4}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" `shouldRespondWith`
+          [json|[{"id":2},{"id":3},{"id":4}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can limit proc results" $ do
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1" [json| {} |]
+          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
+             { matchStatus = 200
+             , matchHeaders = ["Content-Range" <:> "1-2/*"] }
+        get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1"
+          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
+             { matchStatus = 200
+             , matchHeaders = ["Content-Range" <:> "1-2/*"] }
+
+      it "select works on the first level" $ do
+        post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7"}]|]
+        get "/rpc/getproject?id=1&select=id,name" `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7"}]|]
+
+    context "foreign entities embedding" $ do
+      it "can embed if related tables are in the exposed schema" $ do
+        post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
+        get "/rpc/getproject?id=1&select=id,name,client{id},tasks{id}" `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
+
+      it "cannot embed if the related table is not in the exposed schema" $ do
+        post "/rpc/single_article?select=*,article_stars{*}" [json|{ "id": 1}|]
+          `shouldRespondWith` 400
+        get "/rpc/single_article?id=1&select=*,article_stars{*}"
+          `shouldRespondWith` 400
+
+      it "can embed if the related tables are in a hidden schema but exposed as views" $ do
+        post "/rpc/single_article?select=id,articleStars{userId}" [json|{ "id": 2}|]
+          `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/single_article?id=2&select=id,articleStars{userId}"
+          `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "a proc that returns an empty rowset" $
+      it "returns empty json array" $ do
+        post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith`
+          [json| [] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/test_empty_rowset" `shouldRespondWith`
+          [json| [] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "proc return types" $ do
+      context "returns text" $ do
+        it "returns proper json" $
+          post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
+            [json|"Hello, world"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can handle unicode" $
+          post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith`
+            [json|"Hello, ￥"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+      it "returns array" $
+        post "/rpc/ret_array" [json|{}|] `shouldRespondWith`
+          [json|[1, 2, 3]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns setof integers" $
+        post "/rpc/ret_setof_integers" [json|{}|] `shouldRespondWith`
+          [json|[{ "ret_setof_integers": 1 },
+                 { "ret_setof_integers": 2 },
+                 { "ret_setof_integers": 3 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns enum value" $
+        post "/rpc/ret_enum" [json|{ "val": "foo" }|] `shouldRespondWith`
+          [json|"foo"|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns domain value" $
+        post "/rpc/ret_domain" [json|{ "val": "8" }|] `shouldRespondWith`
+          [json|8|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns range" $
+        post "/rpc/ret_range" [json|{ "low": 10, "up": 20 }|] `shouldRespondWith`
+          [json|"[10,20)"|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns row of scalars" $
+        post "/rpc/ret_scalars" [json|{}|] `shouldRespondWith`
+          [json|[{"a":"scalars", "b":"foo", "c":1, "d":"[10,20)"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns composite type in exposed schema" $
+        post "/rpc/ret_point_2d" [json|{}|] `shouldRespondWith`
+          [json|[{"x": 10, "y": 5}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "cannot return composite type in hidden schema" $
+        post "/rpc/ret_point_3d" [json|{}|] `shouldRespondWith` 401
+
+      it "returns single row from table" $
+        post "/rpc/single_article?select=id" [json|{"id": 2}|] `shouldRespondWith`
+          [json|[{"id": 2}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns null for void" $
+        post "/rpc/ret_void" [json|{}|] `shouldRespondWith`
+          [json|null|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "improper input" $ do
+      it "rejects unknown content type even if payload is good" $ do
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
+            `shouldRespondWith` 415
+        request methodGet "/rpc/sayhello?name=world"
+          (acceptHdrs "audio/mpeg3") ""
+            `shouldRespondWith` 415
+      it "rejects malformed json payload" $ do
+        p <- request methodPost "/rpc/sayhello"
+          (acceptHdrs "application/json") "sdfsdf"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+      it "treats simple plpgsql raise as invalid input" $ do
+        p <- post "/rpc/problem" "{}"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "unsupported verbs" $ do
+      it "DELETE fails" $
+        request methodDelete "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "PATCH fails" $
+        request methodPatch "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "OPTIONS fails" $
+        -- TODO: should return info about the function
+        request methodOptions "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+
+    it "executes the proc exactly once per request" $ do
+      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
+        [json|1|]
+        { matchHeaders = [matchContentTypeJson] }
+      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
+        [json|2|]
+        { matchHeaders = [matchContentTypeJson] }
+
+    context "a proc that receives no parameters" $ do
+      it "interprets empty string as empty json object on a post request" $
+        post "/rpc/noparamsproc" BL.empty `shouldRespondWith`
+          [json| "Return value of no parameters procedure." |]
+          { matchHeaders = [matchContentTypeJson] }
+      it "interprets empty string as a function with no args on a get request" $
+        get "/rpc/noparamsproc" `shouldRespondWith`
+          [json| "Return value of no parameters procedure." |]
+          { matchHeaders = [matchContentTypeJson] }
+
+    it "returns proper output when having the same return col name as the proc name" $ do
+      post "/rpc/test" [json|{}|] `shouldRespondWith`
+        [json|[{"test":"hello","value":1}]|] { matchHeaders = [matchContentTypeJson] }
+      get "/rpc/test" `shouldRespondWith`
+        [json|[{"test":"hello","value":1}]|] { matchHeaders = [matchContentTypeJson] }
+
+    context "only for POST rpc" $ do
+      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"} } |]
+            { matchHeaders = [matchContentTypeJson] }
+
+        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" } |]
+                   { matchHeaders = [matchContentTypeJson] }
+
+      it "gives a parse filter error if GET style proc args are specified" $
+        post "/rpc/sayhello?name=John" [json|{}|] `shouldRespondWith` 400
+
+    context "only for GET rpc" $ do
+      it "should fail on mutating procs" $ do
+        get "/rpc/callcounter" `shouldRespondWith` 500
+        get "/rpc/setprojects?id_l=1&id_h=5&name=FreeBSD" `shouldRespondWith` 500
+
+      it "should filter a proc that has arg name = filter name" $
+        get "/rpc/get_projects_below?id=5&id=gt.2&select=id" `shouldRespondWith`
+          [json|[{ "id": 3 }, { "id": 4 }]|]
+          { matchHeaders = [matchContentTypeJson] }
@@ -26,6 +26,7 @@ import qualified Feature.SingularSpec
 import qualified Feature.UnicodeSpec
 import qualified Feature.ProxySpec
 import qualified Feature.AndOrParamsSpec
+import qualified Feature.RpcSpec

 import Protolude

@@ -82,6 +83,7 @@ main = do
    , ("Feature.DeleteSpec"       , Feature.DeleteSpec.spec)
    , ("Feature.InsertSpec"       , Feature.InsertSpec.spec)
    , ("Feature.QuerySpec"        , Feature.QuerySpec.spec)
+    , ("Feature.RpcSpec"          , Feature.RpcSpec.spec)
    , ("Feature.RangeSpec"        , Feature.RangeSpec.spec)
    , ("Feature.SingularSpec"     , Feature.SingularSpec.spec)
    , ("Feature.StructureSpec"    , Feature.StructureSpec.spec)
@@ -1096,6 +1096,12 @@ CREATE FUNCTION getproject(id int) RETURNS SETOF projects
    SELECT * FROM test.projects WHERE id = $1;
 $_$;

+CREATE FUNCTION get_projects_below(id int) RETURNS SETOF projects
+    LANGUAGE sql
+    AS $_$
+    SELECT * FROM test.projects WHERE id < $1;
+$_$;
+
 CREATE FUNCTION getallprojects() RETURNS SETOF projects
    LANGUAGE sql
    AS $_$