From 2e4c862d25ee57711da7856c13da76a5792d3798 Mon Sep 17 00:00:00 2001 From: Ruslan Talpa Date: Mon, 2 Nov 2015 10:49:22 +0200 Subject: [PATCH] Refactor to add operators in just one place, @> and <@ operators for #338 and #181 --- src/PostgREST/App.hs | 43 ------------ src/PostgREST/Parsers.hs | 26 ++----- src/PostgREST/PgQuery.hs | 144 ++++---------------------------------- test/Feature/QuerySpec.hs | 13 +++- test/SpecHelper.hs | 3 +- test/fixtures/schema.sql | 3 +- 6 files changed, 33 insertions(+), 199 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 1248c4012..2361a7355 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -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 diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs index 753067567..e4d56e1ba 100644 --- a/src/PostgREST/Parsers.hs +++ b/src/PostgREST/Parsers.hs @@ -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) diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs index 70247c9ac..9d66f6ecb 100644 --- a/src/PostgREST/PgQuery.hs +++ b/src/PostgREST/PgQuery.hs @@ -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 = diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index b6a236813..7a96229e0 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -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` diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 30af213d0..1a0dae557 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -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 () diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index 61ab265c6..8c17f72ff 100755 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -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[] );