Merge pull request #228 from begriffs/rpc

Expose stored procedures

src/PostgREST/App.hs

@@ -163,6 +163,22 @@ app conf reqBody req =
                   ] $ if echoRequested then encode obj else ""
           return $ multipart status201 responses
 
+    (["rpc", proc], "POST") -> do
+      let qi = QualifiedIdentifier schema (cs proc)
+      exists <- doesProcExist schema proc
+      if exists
+        then do
+          let call = B.Stmt "select " V.empty True <>
+                asJson (callProc qi $ fromMaybe M.empty (decode reqBody))
+          body :: Maybe (Identity Text) <- H.maybeEx call
+          return $ responseLBS status200 [jsonH]
+            (cs $ fromMaybe "[]" $ runIdentity <$> body)
+        else return $ responseLBS status404 [] ""
+
+      -- check that proc exists
+      -- check that arg names are all specified
+      -- select * from "1".proc(a := "foo"::undefined) where whereT limit limitT
+
     ([table], "PUT") ->
       handleJsonObj reqBody $ \obj -> do
         let qt = qualify table
@@ -209,7 +225,7 @@ app conf reqBody req =
 
     ([table], "DELETE") -> do
       let qt = qualify table
-      let del = countT
+          del = countT
             . returningStarT
             . whereT qt qq
             $ deleteFrom qt
@@ -226,7 +242,7 @@ app conf reqBody req =
     path          = pathInfo req
     verb          = requestMethod req
     qq            = queryString req
-    qualify       = QualifiedTable schema
+    qualify       = QualifiedIdentifier schema
     hdrs          = requestHeaders req
     lookupHeader  = flip lookup hdrs
     accept        = lookupHeader hAccept
@@ -280,7 +296,7 @@ jsonH :: Header
 jsonH = (hContentType, jsonMT)
 
 contentTypeForAccept :: Maybe BS.ByteString -> Maybe BS.ByteString
-contentTypeForAccept accept 
+contentTypeForAccept accept
   | isNothing accept || hasJson = Just jsonMT
   | hasCsv = Just csvMT
   | otherwise = Nothing
@@ -290,12 +306,11 @@ contentTypeForAccept accept
     hasJson  = isJust $ findInAccept $ BS.isPrefixOf jsonMT
     hasCsv   = isJust $ findInAccept $ BS.isPrefixOf csvMT
 
-bodyForAccept :: BS.ByteString -> QualifiedTable -> StatementT
+bodyForAccept :: BS.ByteString -> QualifiedIdentifier  -> StatementT
 bodyForAccept contentType table
   | contentType == csvMT = asCsvWithCount table
   | otherwise = asJsonWithCount -- defaults to JSON
 
-
 handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response)
               -> H.Tx P.Postgres s Response
 handleJsonObj reqBody handler = do

src/PostgREST/PgQuery.hs

@@ -10,6 +10,7 @@ import qualified Hasql.Postgres as P
 import qualified Hasql.Backend as B
 
 import qualified Data.Text as T
+import qualified Data.HashMap.Strict as H
 import Text.Regex.TDFA ( (=~) )
 import qualified Network.HTTP.Types.URI as Net
 import qualified Data.ByteString.Char8 as BS
@@ -33,9 +34,9 @@ instance Monoid PStmt where
   mempty = B.Stmt "" empty True
 type StatementT = PStmt -> PStmt
 
-data QualifiedTable = QualifiedTable {
+data QualifiedIdentifier = QualifiedIdentifier {
-  qtSchema :: T.Text
+  qiSchema :: T.Text
-, qtName   :: T.Text
+, qiName   :: T.Text
 } deriving (Show)
 
 data OrderTerm = OrderTerm {
@@ -51,7 +52,7 @@ limitT r q =
     limit  = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
     offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
 
-whereT :: QualifiedTable -> Net.Query -> StatementT
+whereT :: QualifiedIdentifier -> Net.Query -> StatementT
 whereT table params q =
  if L.null cols
    then q
@@ -97,17 +98,17 @@ countT :: StatementT
 countT s =
   s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" }
 
-countRows :: QualifiedTable -> PStmt
+countRows :: QualifiedIdentifier  -> PStmt
-countRows t = B.Stmt ("select pg_catalog.count(1) from " <> fromQt t) empty True
+countRows t = B.Stmt ("select pg_catalog.count(1) from " <> fromQi t) empty True
 
-asCsvWithCount :: QualifiedTable -> StatementT
+asCsvWithCount :: QualifiedIdentifier -> StatementT
 asCsvWithCount table = withCount . asCsv table
 
-asCsv :: QualifiedTable -> StatementT
+asCsv :: QualifiedIdentifier -> StatementT
 asCsv table s = s { B.stmtTemplate =
     "(select string_agg(quote_ident(column_name::text), ',') from "
-    <> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '" 
+    <> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '"
-    <> fromQt table <> "' order by ordinal_position) h) || '\r' || "
+    <> fromQi table <> "' order by ordinal_position) h) || '\r' || "
     <> "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '') from ("
     <> B.stmtTemplate s <> ") t" }
 
@@ -125,23 +126,23 @@ withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s }
 asJsonRow :: StatementT
 asJsonRow s = s { B.stmtTemplate = "row_to_json(t) from (" <> B.stmtTemplate s <> ") t" }
 
-selectStar :: QualifiedTable -> PStmt
+selectStar :: QualifiedIdentifier -> PStmt
-selectStar t = B.Stmt ("select * from " <> fromQt t) empty True
+selectStar t = B.Stmt ("select * from " <> fromQi t) empty True
 
 returningStarT :: StatementT
 returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
 
-deleteFrom :: QualifiedTable -> PStmt
+deleteFrom :: QualifiedIdentifier -> PStmt
-deleteFrom t = B.Stmt ("delete from " <> fromQt t) empty True
+deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True
 
-insertInto :: QualifiedTable
+insertInto :: QualifiedIdentifier
               -> V.Vector T.Text
               -> V.Vector (V.Vector JSON.Value)
               -> PStmt
 insertInto t cols vals
-  | V.null cols = B.Stmt ("insert into " <> fromQt t <> " default values returning *") empty True
+  | V.null cols = B.Stmt ("insert into " <> fromQi t <> " default values returning *") empty True
   | otherwise   = B.Stmt
-    ("insert into " <> fromQt t <> " (" <>
+    ("insert into " <> fromQi t <> " (" <>
       T.intercalate ", " (V.toList $ V.map pgFmtIdent cols) <>
       ") values "
       <> T.intercalate ", "
@@ -150,29 +151,36 @@ insertInto t cols vals
             <> ")"
           ) vals
         )
-      <> " returning row_to_json(" <> fromQt t <> ".*)")
+      <> " returning row_to_json(" <> fromQi t <> ".*)")
     empty True
 
-insertSelect :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt
+insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
 insertSelect t [] _ = B.Stmt
-  ("insert into " <> fromQt t <> " default values returning *") empty True
+  ("insert into " <> fromQi t <> " default values returning *") empty True
 insertSelect t cols vals = B.Stmt
-  ("insert into " <> fromQt t <> " ("
+  ("insert into " <> fromQi t <> " ("
     <> T.intercalate ", " (map pgFmtIdent cols)
     <> ") select "
     <> T.intercalate ", " (map insertableValue vals))
   empty True
 
-update :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt
+update :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
 update t cols vals = B.Stmt
-  ("update " <> fromQt t <> " set ("
+  ("update " <> fromQi t <> " set ("
     <> T.intercalate ", " (map pgFmtIdent cols)
     <> ") = ("
     <> T.intercalate ", " (map insertableValue vals)
     <> ")")
   empty True
 
-wherePred :: QualifiedTable -> Net.QueryItem -> PStmt
+callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
+callProc qi params = do
+  let args = T.intercalate "," $ map assignment (H.toList params)
+  B.Stmt ("select * from " <> fromQi qi <> "(" <> args <> ")") empty True
+  where
+    assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
+
+wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt
 wherePred table (col, predicate) =
   B.Stmt (" " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <>
       if opCode `elem` ["is","isnot"] then whiteList value
@@ -257,11 +265,11 @@ parseJsonbPath p =
         (KeyIdentifier b)
     _ -> Nothing
 
-pgFmtJsonbPath :: QualifiedTable -> T.Text -> T.Text
+pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
 pgFmtJsonbPath table p =
   pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
   where
-    pgFmtJsonbPath' (ColIdentifier i) = fromQt table <> "." <> pgFmtIdent i
+    pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
     pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
     pgFmtJsonbPath' (SingleArrow a b) =
       pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
@@ -289,8 +297,8 @@ pgFmtLit x =
 trimNullChars :: T.Text -> T.Text
 trimNullChars = T.takeWhile (/= '\x0')
 
-fromQt :: QualifiedTable -> T.Text
+fromQi :: QualifiedIdentifier -> T.Text
-fromQt t = pgFmtIdent (qtSchema t) <> "." <> pgFmtIdent (qtName t)
+fromQi t = pgFmtIdent (qiSchema t) <> "." <> pgFmtIdent (qiName t)
 
 unquoted :: JSON.Value -> T.Text
 unquoted (JSON.String t) = t

src/PostgREST/PgStructure.hs

@@ -3,12 +3,12 @@
              FlexibleContexts #-}
 module PostgREST.PgStructure where
 
-import PostgREST.PgQuery (QualifiedTable(..))
+import PostgREST.PgQuery (QualifiedIdentifier(..))
 import Data.Text hiding (foldl, map, zipWith, concat)
 import Data.Aeson
 import Data.Functor.Identity
 import Data.String.Conversions (cs)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, isJust)
 import Control.Applicative
 
 import qualified Data.Map as Map
@@ -18,7 +18,7 @@ import qualified Hasql.Postgres as P
 
 import Prelude
 
-foreignKeys :: QualifiedTable -> H.Tx P.Postgres s (Map.Map Text ForeignKey)
+foreignKeys :: QualifiedIdentifier -> H.Tx P.Postgres s (Map.Map Text ForeignKey)
 foreignKeys table = do
   r <- H.listEx $ [H.stmt|
       select kcu.column_name, ccu.table_name AS foreign_table_name,
@@ -31,7 +31,7 @@ foreignKeys table = do
       where constraint_type = 'FOREIGN KEY'
         and tc.table_name=? and tc.table_schema = ?
         order by kcu.column_name
-    |] (qtName table) (qtSchema table)
+    |] (qiName table) (qiSchema table)
 
   return $ foldl addKey Map.empty r
   where
@@ -67,7 +67,7 @@ tables schema = do
   return $ map tableFromRow rows
 
 
-columns :: QualifiedTable -> H.Tx P.Postgres s [Column]
+columns :: QualifiedIdentifier -> H.Tx P.Postgres s [Column]
 columns table = do
   cols <- H.listEx $ [H.stmt|
       select info.table_schema as schema, info.table_name as table_name,
@@ -97,7 +97,7 @@ columns table = do
          ) as enum_info
          on (info.udt_name = enum_info.n)
       order by position |]
-    (qtSchema table) (qtName table)
+    (qiSchema table) (qiName table)
 
   fks <- foreignKeys table
   return $ map (addFK fks . columnFromRow) cols
@@ -106,7 +106,7 @@ columns table = do
     addFK fks col = col { colFK = Map.lookup (cs . colName $ col) fks }
 
 
-primaryKeyColumns :: QualifiedTable -> H.Tx P.Postgres s [Text]
+primaryKeyColumns :: QualifiedIdentifier -> H.Tx P.Postgres s [Text]
 primaryKeyColumns table = do
   r <- H.listEx $ [H.stmt|
     select kc.column_name
@@ -118,9 +118,20 @@ primaryKeyColumns table = do
       and kc.table_name = tc.table_name and kc.table_schema = tc.table_schema
       and kc.constraint_name = tc.constraint_name
       and kc.table_schema = ?
-      and kc.table_name  = ? |] (qtSchema table) (qtName table)
+      and kc.table_name  = ? |] (qiSchema table) (qiName table)
   return $ map runIdentity r
 
+doesProcExist :: Text -> Text -> H.Tx P.Postgres s Bool
+doesProcExist schema proc = do
+  row :: Maybe (Identity Int) <- H.maybeEx $ [H.stmt|
+      SELECT 1
+      FROM   pg_catalog.pg_namespace n
+      JOIN   pg_catalog.pg_proc p
+      ON     pronamespace = n.oid
+      WHERE  nspname = ?
+      AND    proname = ?
+    |] schema proc
+  return $ isJust row
 
 data Table = Table {
   tableSchema :: Text

test/Feature/QuerySpec.hs

@@ -172,3 +172,15 @@ spec =
         [json| [{"data": {"foo": {"bar": "baz"}}}] |]
       get "/json?data->foo->>bar=eq.fake" `shouldRespondWith`
         [json| [] |]
+
+  describe "remote procedure call" $ do
+    context "a proc that returns a set" . before_ (clearTable "items" >> createItems 10) .
+      after_ (clearTable "items") $
+      it "returns proper json" $
+        post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+
+    context "a proc that returns plain text" $
+      it "returns proper json" $
+        post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
+          [json| [{"sayhello":"Hello, world"}] |]

test/fixtures/schema.sql

@@ -217,6 +217,17 @@ ALTER SEQUENCE items_id_seq OWNED BY items.id;
 
 
 
+CREATE FUNCTION "1".getitemrange(min bigint, max bigint) RETURNS SETOF "1".items AS $$
+    SELECT * FROM "1".items WHERE id > $1 AND id <= $2;
+$$ LANGUAGE SQL;
+
+
+
+CREATE FUNCTION "1".sayhello(name text) RETURNS text AS $$
+    SELECT 'Hello, ' || $1;
+$$ LANGUAGE SQL;
+
+
 CREATE TABLE menagerie (
     "integer" integer NOT NULL,
     double double precision NOT NULL,
@@ -521,6 +532,17 @@ GRANT ALL ON TABLE items TO postgrest_test;
 GRANT ALL ON TABLE items TO postgrest_anonymous;
 
 
+REVOKE ALL ON FUNCTION getitemrange(bigint, bigint) FROM PUBLIC;
+REVOKE ALL ON FUNCTION getitemrange(bigint, bigint) FROM postgrest_test;
+GRANT EXECUTE ON FUNCTION getitemrange(bigint, bigint) TO postgrest_test;
+GRANT EXECUTE ON FUNCTION getitemrange(bigint, bigint) TO postgrest_anonymous;
+
+
+REVOKE ALL ON FUNCTION sayhello(text) FROM PUBLIC;
+REVOKE ALL ON FUNCTION sayhello(text) FROM postgrest_test;
+GRANT EXECUTE ON FUNCTION sayhello(text) TO postgrest_test;
+GRANT EXECUTE ON FUNCTION sayhello(text) TO postgrest_anonymous;
+
 
 REVOKE ALL ON SEQUENCE items_id_seq FROM PUBLIC;
 REVOKE ALL ON SEQUENCE items_id_seq FROM postgrest_test;