This commit is contained in:
Ruslan Talpa
@@ -20,12 +20,10 @@ import Data.List (find, sortBy, delete, transpose)
|
||||
import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, mapMaybe)
|
||||
import Data.Ord (comparing)
|
||||
import Data.Ranged.Ranges (emptyRange)
|
||||
--import qualified Data.Set as S
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Text (Text, replace, strip)
|
||||
import Data.Tree
|
||||
import qualified Data.Map as M
|
||||
--import Data.Foldable (forlrM)
|
||||
|
||||
import Text.Parsec.Error
|
||||
import Text.ParserCombinators.Parsec (parse)
|
||||
@@ -109,30 +107,6 @@ app dbstructure conf reqBody req =
|
||||
request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
|
||||
fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
|
||||
|
||||
-- ([table], "PUT") ->
|
||||
-- handleJsonObj reqBody $ \obj -> do
|
||||
-- let qt = qualify table
|
||||
-- pKeys = map pkName $ filter (filterPk schema table) allPrKeys
|
||||
-- specifiedKeys = map (cs . fst) qq
|
||||
-- if S.fromList pKeys /= S.fromList specifiedKeys
|
||||
-- then return $ responseLBS status405 []
|
||||
-- "You must speficy all and only primary keys as params"
|
||||
-- else do
|
||||
-- let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols
|
||||
-- cols = map cs $ HM.keys obj
|
||||
-- if S.fromList tableCols == S.fromList cols
|
||||
-- then do
|
||||
-- let vals = HM.elems obj
|
||||
-- H.unitEx $ iffNotT
|
||||
-- (whereT qt qq $ update qt cols vals)
|
||||
-- (insertSelect qt cols vals)
|
||||
-- return $ responseLBS status204 [ jsonH ] ""
|
||||
--
|
||||
-- else return $ if Prelude.null tableCols
|
||||
-- then responseLBS status404 [] ""
|
||||
-- else responseLBS status400 []
|
||||
-- "You must specify all columns in PUT request"
|
||||
|
||||
([table], "PATCH") -> do
|
||||
let echoRequested = hasPrefer "return=representation"
|
||||
case request of
|
||||
@@ -269,23 +243,6 @@ contentTypeForAccept accept
|
||||
findInAccept = flip find $ parseHttpAccept acceptH
|
||||
has = isJust . findInAccept . BS.isPrefixOf
|
||||
|
||||
-- handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response)
|
||||
-- -> H.Tx P.Postgres s Response
|
||||
-- handleJsonObj reqBody handler = do
|
||||
-- let p = eitherDecode reqBody
|
||||
-- case p of
|
||||
-- Left err ->
|
||||
-- return $ responseLBS status400 [jsonH] jErr
|
||||
-- where
|
||||
-- jErr = encode . object $
|
||||
-- [("message", String $ "Failed to parse JSON payload. " <> cs err)]
|
||||
-- Right (Object o) -> handler o
|
||||
-- Right _ ->
|
||||
-- return $ responseLBS status400 [jsonH] jErr
|
||||
-- where
|
||||
-- jErr = encode . object $
|
||||
-- [("message", String "Expecting a JSON object")]
|
||||
|
||||
parseCsvCell :: BL.ByteString -> Value
|
||||
parseCsvCell s = if s == "NULL" then Null else String $ cs s
|
||||
|
||||
|
||||
@@ -4,16 +4,14 @@ module PostgREST.Parsers
|
||||
where
|
||||
|
||||
import Control.Applicative hiding ((<$>))
|
||||
--import Control.Monad (join)
|
||||
--import Data.List (delete, find)
|
||||
--import Data.Maybe
|
||||
import Data.Monoid
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Text (Text)
|
||||
import Data.Tree
|
||||
--import Network.Wai (Request, pathInfo, queryString)
|
||||
import PostgREST.Types
|
||||
import Text.ParserCombinators.Parsec hiding (many, (<|>))
|
||||
import PostgREST.PgQuery (operators)
|
||||
|
||||
|
||||
pRequestSelect :: Text -> Parser ApiRequest
|
||||
pRequestSelect rootNodeName = do
|
||||
@@ -50,8 +48,6 @@ pTreePath = do
|
||||
let pp = map cs p
|
||||
jpp = map cs <$> jp
|
||||
return (init pp, (last pp, jpp))
|
||||
where
|
||||
|
||||
|
||||
pFieldForest :: Parser [Tree SelectItem]
|
||||
pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
|
||||
@@ -84,22 +80,8 @@ pSelect = lexeme $
|
||||
return ((s, Nothing), Nothing)
|
||||
|
||||
pOperator :: Parser Operator
|
||||
pOperator = cs <$> ( try (string "lte") -- has to be before lt
|
||||
<|> try (string "lt")
|
||||
<|> try (string "eq")
|
||||
<|> try (string "gte") -- has to be before gh
|
||||
<|> try (string "gt")
|
||||
<|> try (string "lt")
|
||||
<|> try (string "neq")
|
||||
<|> try (string "like")
|
||||
<|> try (string "ilike")
|
||||
<|> try (string "in")
|
||||
<|> try (string "notin")
|
||||
<|> try (string "is" )
|
||||
<|> try (string "isnot")
|
||||
<|> try (string "@@")
|
||||
<?> "operator (eq, gt, ...)"
|
||||
)
|
||||
pOperator = cs <$> (pOp <?> "operator (eq, gt, ...)")
|
||||
where pOp = foldl (<|>) empty $ map (try . string . cs . fst) operators
|
||||
|
||||
pValue :: Parser FValue
|
||||
pValue = VText <$> (cs <$> many anyChar)
|
||||
|
||||
+13
-131
@@ -9,13 +9,8 @@ module PostgREST.PgQuery (
|
||||
, wrapQuery
|
||||
, asJson
|
||||
, callProc
|
||||
-- , iffNotT
|
||||
-- , update
|
||||
-- , insertSelect
|
||||
-- , deleteFrom
|
||||
-- , asCsvWithCount
|
||||
-- , asJsonWithCount
|
||||
, unquoted
|
||||
, operators
|
||||
|
||||
-- format functions
|
||||
, pgFmtLit
|
||||
@@ -29,12 +24,6 @@ module PostgREST.PgQuery (
|
||||
, pgFmtSelectItem
|
||||
, pgFmtAsJsonPath
|
||||
|
||||
-- query transformers (to be removed)
|
||||
-- , withT
|
||||
-- , countT
|
||||
-- , returningStarT
|
||||
-- , whereT
|
||||
|
||||
-- query fragments
|
||||
, sourceSubqueryName
|
||||
, orderF
|
||||
@@ -70,7 +59,6 @@ import Data.Scientific (FPFormat (..), formatScientific,
|
||||
import Data.String.Conversions (cs)
|
||||
import qualified Data.Text as T
|
||||
import Data.Vector (empty)
|
||||
--import qualified Network.HTTP.Types.URI as Net
|
||||
import Text.Regex.TDFA ((=~))
|
||||
|
||||
import Prelude
|
||||
@@ -89,100 +77,34 @@ data JsonbPath =
|
||||
| DoubleArrow JsonbPath JsonbPath
|
||||
deriving (Show)
|
||||
|
||||
operators :: M.Map T.Text T.Text
|
||||
operators = M.fromList [
|
||||
|
||||
operators :: [(T.Text, T.Text)]
|
||||
operators = [
|
||||
("eq", "="),
|
||||
("gte", ">="), -- has to be before gt (parsers)
|
||||
("gt", ">"),
|
||||
("lte", "<="), -- has to be before lt (parsers)
|
||||
("lt", "<"),
|
||||
("gte", ">="),
|
||||
("lte", "<="),
|
||||
("neq", "<>"),
|
||||
("like", "like"),
|
||||
("ilike", "ilike"),
|
||||
("in", "in"),
|
||||
("notin", "not in"),
|
||||
("isnot", "is not"), -- has to be before is (parsers)
|
||||
("is", "is"),
|
||||
("isnot", "is not"),
|
||||
("@@", "@@")
|
||||
("@@", "@@"),
|
||||
("@>", "@>"),
|
||||
("<@", "<@")
|
||||
]
|
||||
|
||||
operatorsMap :: M.Map T.Text T.Text
|
||||
operatorsMap = M.fromList operators
|
||||
|
||||
-- whereT :: QualifiedIdentifier -> Net.Query -> StatementT
|
||||
-- whereT table params q =
|
||||
-- if L.null cols
|
||||
-- then q
|
||||
-- else q <> B.Stmt " where " empty True <> conjunction
|
||||
-- where
|
||||
-- cols = [ col | col <- params, fst col `notElem` ["order","select"] ]
|
||||
-- wherePredTable = wherePred table
|
||||
-- conjunction = mconcat $ L.intersperse andq (map wherePredTable cols)
|
||||
--
|
||||
-- withT :: PStmt -> T.Text -> StatementT
|
||||
-- withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
|
||||
-- B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq <> " from " <> v)
|
||||
-- (ep <> wp)
|
||||
-- (epre && wpre)
|
||||
--
|
||||
-- iffNotT :: PStmt -> StatementT
|
||||
-- iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) =
|
||||
-- B.Stmt
|
||||
-- ("WITH aaa AS (" <> aq <> " returning *) " <>
|
||||
-- bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)")
|
||||
-- (ap <> bp)
|
||||
-- (apre && bpre)
|
||||
--
|
||||
-- countT :: StatementT
|
||||
-- countT s =
|
||||
-- s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" }
|
||||
--
|
||||
-- asCsvWithCount :: QualifiedIdentifier -> StatementT
|
||||
-- asCsvWithCount table = withCount . asCsv table
|
||||
--
|
||||
-- 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 = '"
|
||||
-- <> 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" }
|
||||
--
|
||||
-- asJsonWithCount :: StatementT
|
||||
-- asJsonWithCount = withCount . asJson
|
||||
--
|
||||
asJson :: StatementT
|
||||
asJson s = s {
|
||||
B.stmtTemplate =
|
||||
"array_to_json(array_agg(row_to_json(t)))::character varying from ("
|
||||
<> B.stmtTemplate s <> ") t" }
|
||||
--
|
||||
-- withCount :: StatementT
|
||||
-- withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s }
|
||||
--
|
||||
-- returningStarT :: StatementT
|
||||
-- returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
|
||||
--
|
||||
-- deleteFrom :: QualifiedIdentifier -> PStmt
|
||||
-- deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True
|
||||
--
|
||||
-- insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
|
||||
-- insertSelect t [] _ = B.Stmt
|
||||
-- ("insert into " <> fromQi t <> " default values returning *") empty True
|
||||
-- insertSelect t cols vals = B.Stmt
|
||||
-- ("insert into " <> fromQi t <> " ("
|
||||
-- <> T.intercalate ", " (map pgFmtIdent cols)
|
||||
-- <> ") select "
|
||||
-- <> T.intercalate ", " (map insertableValue vals))
|
||||
-- empty True
|
||||
--
|
||||
-- update :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
|
||||
-- update t cols vals = B.Stmt
|
||||
-- ("update " <> fromQi t <> " set ("
|
||||
-- <> T.intercalate ", " (map pgFmtIdent cols)
|
||||
-- <> ") = ("
|
||||
-- <> T.intercalate ", " (map insertableValue vals)
|
||||
-- <> ")")
|
||||
-- empty True
|
||||
|
||||
callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
|
||||
callProc qi params = do
|
||||
@@ -191,40 +113,11 @@ callProc qi params = do
|
||||
where
|
||||
assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
|
||||
|
||||
-- wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt
|
||||
-- wherePred table (col, predicate) =
|
||||
-- B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <>
|
||||
-- if opCode `elem` ["is","isnot"] then whiteList val
|
||||
-- else cs sqlValue)
|
||||
-- empty True
|
||||
--
|
||||
-- where
|
||||
-- headPredicate:rest = T.split (=='.') $ cs $ fromMaybe "." predicate
|
||||
-- hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
|
||||
-- opCode = hasNot (head rest) headPredicate
|
||||
-- notOp = hasNot headPredicate ""
|
||||
-- val = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest)
|
||||
-- sqlValue = pgFmtValue opCode val
|
||||
-- op = pgFmtOperator opCode
|
||||
|
||||
whiteList :: T.Text -> T.Text
|
||||
whiteList val = fromMaybe
|
||||
(cs (pgFmtLit val) <> "::unknown ")
|
||||
(L.find ((==) . T.toLower $ val) ["null","true","false"])
|
||||
|
||||
-- andq :: PStmt
|
||||
-- andq = B.Stmt " and " empty True
|
||||
|
||||
-- parseJsonbPath :: T.Text -> Maybe JsonbPath
|
||||
-- parseJsonbPath p =
|
||||
-- case T.splitOn "->>" p of
|
||||
-- [a,b] ->
|
||||
-- let i:is = T.splitOn "->" a in
|
||||
-- Just $ DoubleArrow
|
||||
-- (foldl SingleArrow (ColIdentifier i) (map KeyIdentifier is))
|
||||
-- (KeyIdentifier b)
|
||||
-- _ -> Nothing
|
||||
|
||||
trimNullChars :: T.Text -> T.Text
|
||||
trimNullChars = T.takeWhile (/= '\x0')
|
||||
|
||||
@@ -350,18 +243,7 @@ pgFmtValue opCode val =
|
||||
unknownLiteral = (<> "::unknown ") . pgFmtLit
|
||||
|
||||
pgFmtOperator :: T.Text -> T.Text
|
||||
pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operators
|
||||
|
||||
-- pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
|
||||
-- pgFmtJsonbPath table p =
|
||||
-- pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
|
||||
-- where
|
||||
-- pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
|
||||
-- pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
|
||||
-- pgFmtJsonbPath' (SingleArrow a b) =
|
||||
-- pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
|
||||
-- pgFmtJsonbPath' (DoubleArrow a b) =
|
||||
-- pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
|
||||
pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
|
||||
|
||||
pgFmtIdent :: T.Text -> T.Text
|
||||
pgFmtIdent x =
|
||||
|
||||
@@ -7,6 +7,8 @@ import Network.HTTP.Types
|
||||
import Network.Wai.Test (SResponse(simpleHeaders))
|
||||
|
||||
import SpecHelper
|
||||
import Text.Heredoc
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
@@ -135,11 +137,20 @@ spec =
|
||||
get "/clients?select=id,projects(id,tasks(id,name))&projects.tasks.name=like.Design*" `shouldRespondWith`
|
||||
"[{\"id\":1,\"projects\":[{\"id\":1,\"tasks\":[{\"id\":1,\"name\":\"Design w7\"}]},{\"id\":2,\"tasks\":[{\"id\":3,\"name\":\"Design w10\"}]}]},{\"id\":2,\"projects\":[{\"id\":3,\"tasks\":[{\"id\":5,\"name\":\"Design IOS\"}]},{\"id\":4,\"tasks\":[{\"id\":7,\"name\":\"Design OSX\"}]}]}]"
|
||||
|
||||
it "matches with @> operator" $
|
||||
get "/complex_items?select=id&arr_data=@>.{2}" `shouldRespondWith`
|
||||
[str|[{"id":2},{"id":3}]|]
|
||||
|
||||
it "matches with <@ operator" $
|
||||
get "/complex_items?select=id&arr_data=<@.{1,2,4}" `shouldRespondWith`
|
||||
[str|[{"id":1},{"id":2}]|]
|
||||
|
||||
|
||||
describe "Shaping response with select parameter" $ do
|
||||
|
||||
it "selectStar works in absense of parameter" $
|
||||
get "/complex_items?id=eq.3" `shouldRespondWith`
|
||||
"[{\"id\":3,\"name\":\"Three\",\"settings\":{\"foo\":{\"int\":1,\"bar\":\"baz\"}}}]"
|
||||
[str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3]}]|]
|
||||
|
||||
it "one simple column" $
|
||||
get "/complex_items?select=id" `shouldRespondWith`
|
||||
|
||||
+2
-1
@@ -151,10 +151,11 @@ createComplexItems = do
|
||||
void . liftIO $ H.session pool $ H.tx Nothing txn
|
||||
where
|
||||
txn = mapM_ H.unitEx stmts
|
||||
stmts = getZipList $ [H.stmt|insert into test.complex_items (id, name, settings) values (?,?,?)|]
|
||||
stmts = getZipList $ [H.stmt|insert into test.complex_items (id, name, settings, arr_data) values (?,?,?,?)|]
|
||||
<$> ZipList ([1..3]::[Int])
|
||||
<*> ZipList (["One", "Two", "Three"]::[Text])
|
||||
<*> ZipList [jobj,jobj,jobj]
|
||||
<*> ZipList ([[1], [1,2], [1,2,3]]::[[Int]])
|
||||
jobj = J.object [("foo", J.object [("int", J.Number 1),("bar", J.String "baz")])]
|
||||
|
||||
createNulls :: Int -> IO ()
|
||||
|
||||
Vendored
+2
-1
@@ -204,7 +204,8 @@ ALTER TABLE test.items OWNER TO postgrest_test;
|
||||
CREATE TABLE complex_items (
|
||||
id bigint NOT NULL,
|
||||
name text,
|
||||
settings json
|
||||
settings json,
|
||||
arr_data INTEGER[]
|
||||
);
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user