Merge pull request #228 from begriffs/rpc

Expose stored procedures
This commit is contained in:
Joe Nelson
2015-08-20 22:27:30 -07:00
5 changed files with 109 additions and 41 deletions
+20 -5
View File
@@ -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
+36 -28
View File
@@ -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 {
qtSchema :: T.Text
, qtName :: T.Text
data QualifiedIdentifier = QualifiedIdentifier {
qiSchema :: 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 t = B.Stmt ("select pg_catalog.count(1) from " <> fromQt t) empty True
countRows :: QualifiedIdentifier -> PStmt
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 = '"
<> fromQt table <> "' order by ordinal_position) h) || '\r' || "
<> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '"
<> 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 t = B.Stmt ("select * from " <> fromQt t) empty True
selectStar :: QualifiedIdentifier -> PStmt
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 t = B.Stmt ("delete from " <> fromQt t) empty True
deleteFrom :: QualifiedIdentifier -> PStmt
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
fromQt t = pgFmtIdent (qtSchema t) <> "." <> pgFmtIdent (qtName t)
fromQi :: QualifiedIdentifier -> T.Text
fromQi t = pgFmtIdent (qiSchema t) <> "." <> pgFmtIdent (qiName t)
unquoted :: JSON.Value -> T.Text
unquoted (JSON.String t) = t
+19 -8
View File
@@ -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
+12
View File
@@ -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"}] |]
+22
View File
@@ -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;