+20
-5
@@ -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
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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"}] |]
|
||||
|
||||
Vendored
+22
@@ -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;
|
||||
|
||||
Reference in New Issue
Block a user