From 9da7db9e09382c433d737a5178f023636b03c908 Mon Sep 17 00:00:00 2001 From: Diogo Biazus Date: Thu, 12 Nov 2015 20:08:18 -0500 Subject: [PATCH] Moves some top level bindings to 'where' when it makes sense --- src/PostgREST/QueryBuilder.hs | 288 +++++++++++++++++----------------- 1 file changed, 140 insertions(+), 148 deletions(-) diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index ca442a00f..4f382c079 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -4,23 +4,23 @@ module PostgREST.QueryBuilder ( addRelations , addJoinConditions - , requestToQuery - , callProc - , pgFmtLit - , pgFmtIdent - , unquoted - , wrapQuery - , operators + , asCsvF , asJson , asJsonF , asJsonSingleF - , asCsvF - , countF - , selectStarF - , locationF - , sourceSubqueryName + , callProc , countAllF + , countF , countNoneF + , locationF + , operators + , pgFmtIdent + , pgFmtLit + , requestToQuery + , selectStarF + , sourceSubqueryName + , unquoted + , wrapQuery ) where import qualified Hasql as H @@ -29,23 +29,25 @@ import qualified Hasql.Postgres as P import qualified Data.Aeson as JSON -import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset) -import Control.Error +import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset) +import Control.Error (note, fromMaybe, mapMaybe) import Control.Monad (join) -import Data.List (find) -import Data.Monoid -import Data.Text (Text) +import Data.List (find) +import Data.Monoid ((<>)) +import Data.Text (Text) import qualified Data.Text as T import Data.String.Conversions (cs) import qualified Data.HashMap.Strict as H -import Control.Applicative -import Data.Tree +import Control.Applicative (empty, (<|>)) +import Data.Tree (Tree(..)) import PostgREST.Types import qualified Data.Map as M import Text.Regex.TDFA ((=~)) import qualified Data.ByteString.Char8 as BS -import Data.Scientific (FPFormat (..), formatScientific, - isInteger) +import Data.Scientific ( FPFormat (..) + , formatScientific + , isInteger + ) type PStmt = H.Stmt P.Postgres instance Monoid PStmt where @@ -54,105 +56,7 @@ instance Monoid PStmt where mempty = B.Stmt "" empty True type StatementT = PStmt -> PStmt -sourceSubqueryName :: T.Text -sourceSubqueryName = "pg_source" - -countAllF :: T.Text -countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )" - -countNoneF :: T.Text -countNoneF = "null" - -asCsvHeaderF :: T.Text -asCsvHeaderF = - "(SELECT string_agg(a.k, ',')" <> - " FROM (" <> - " SELECT json_object_keys(r)::TEXT as k" <> - " FROM ( " <> - " SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <> - " ) s" <> - " ) a" <> - ")" - -asCsvBodyF :: T.Text -asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')" - -selectStarF :: T.Text -selectStarF = "SELECT * FROM " <> sourceSubqueryName - -locationF :: [T.Text] -> T.Text -locationF pKeys = - "(" <> - " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss limit 1)" <> - " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <> - " FROM s, json_each_text(s.r) AS json_data" <> - ( - if null pKeys - then "" - else " WHERE json_data.key IN ('" <> T.intercalate "','" pKeys <> "')" - ) <> - ")" - -countF :: T.Text -countF = "pg_catalog.count(t)" - -asJsonSingleF :: T.Text --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element -asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying " - -asJsonF :: T.Text -asJsonF = "array_to_json(array_agg(row_to_json(t)))::character varying" - -asCsvF :: T.Text -asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF - -asJson :: StatementT -asJson s = s { - B.stmtTemplate = - "array_to_json(array_agg(row_to_json(t)))::character varying from (" - <> B.stmtTemplate s <> ") t" } - -operators :: [(T.Text, T.Text)] -operators = [ - ("eq", "="), - ("gte", ">="), -- has to be before gt (parsers) - ("gt", ">"), - ("lte", "<="), -- has to be before lt (parsers) - ("lt", "<"), - ("neq", "<>"), - ("like", "like"), - ("ilike", "ilike"), - ("in", "in"), - ("notin", "not in"), - ("isnot", "is not"), -- has to be before is (parsers) - ("is", "is"), - ("@@", "@@"), - ("@>", "@>"), - ("<@", "<@") - ] - -wrapQuery :: T.Text -> [T.Text] -> T.Text -> Maybe NonnegRange -> T.Text -wrapQuery source selectColumns returnSelect range = - withSourceF source <> - " SELECT " <> - T.intercalate ", " selectColumns <> - " " <> - fromF returnSelect ( limitF range ) - -unquoted :: JSON.Value -> T.Text -unquoted (JSON.String t) = t -unquoted (JSON.Number n) = - cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n -unquoted (JSON.Bool b) = cs . show $ b -unquoted v = cs $ JSON.encode v - -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 - -addRelations :: Schema -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest +addRelations :: Text -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) = case parentNode of Nothing -> Node (query, (table, Nothing)) <$> updatedForest @@ -166,7 +70,7 @@ addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) for where updatedForest = mapM (addRelations schema allRelations (Just node)) forest findRelation s t1 t2 = - find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations + find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest addJoinConditions schema (Node (query, (n, r)) forest) = @@ -192,6 +96,97 @@ addJoinConditions schema (Node (query, (n, r)) forest) = updatedForest = mapM (addJoinConditions schema) forest addCond q con = q{where_=con ++ where_ q} +asCsvF :: T.Text +asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF + where + asCsvHeaderF = + "(SELECT string_agg(a.k, ',')" <> + " FROM (" <> + " SELECT json_object_keys(r)::TEXT as k" <> + " FROM ( " <> + " SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <> + " ) s" <> + " ) a" <> + ")" + asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')" + +asJson :: StatementT +asJson s = s { + B.stmtTemplate = + "array_to_json(coalesce(array_agg(row_to_json(t)), '{}'))::character varying from (" + <> B.stmtTemplate s <> ") t" } + +asJsonF :: T.Text +asJsonF = "array_to_json(array_agg(row_to_json(t)))::character varying" + +asJsonSingleF :: T.Text --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element +asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying " + +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 + +countAllF :: T.Text +countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )" + +countF :: T.Text +countF = "pg_catalog.count(t)" + +countNoneF :: T.Text +countNoneF = "null" + +locationF :: [T.Text] -> T.Text +locationF pKeys = + "(" <> + " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss limit 1)" <> + " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <> + " FROM s, json_each_text(s.r) AS json_data" <> + ( + if null pKeys + then "" + else " WHERE json_data.key IN ('" <> T.intercalate "','" pKeys <> "')" + ) <> + ")" + +operators :: [(T.Text, T.Text)] +operators = [ + ("eq", "="), + ("gte", ">="), -- has to be before gt (parsers) + ("gt", ">"), + ("lte", "<="), -- has to be before lt (parsers) + ("lt", "<"), + ("neq", "<>"), + ("like", "like"), + ("ilike", "ilike"), + ("in", "in"), + ("notin", "not in"), + ("isnot", "is not"), -- has to be before is (parsers) + ("is", "is"), + ("@@", "@@"), + ("@>", "@>"), + ("<@", "<@") + ] + +pgFmtIdent :: T.Text -> T.Text +pgFmtIdent x = + let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in + if (cs escaped :: BS.ByteString) =~ danger + then "\"" <> escaped <> "\"" + else escaped + where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString + +pgFmtLit :: T.Text -> T.Text +pgFmtLit x = + let trimmed = trimNullChars x + escaped = "'" <> T.replace "'" "''" trimmed <> "'" + slashed = T.replace "\\" "\\\\" escaped in + if T.isInfixOf "\\\\" escaped + then "E" <> slashed + else slashed + requestToQuery :: Text -> ApiRequest -> Text requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest) = query @@ -270,6 +265,27 @@ requestToQuery schema (Node (Delete _ conditions, (mainTbl, _)) _) = "RETURNING " <> fromQi qi <> ".*" ] +selectStarF :: T.Text +selectStarF = "SELECT * FROM " <> sourceSubqueryName + +sourceSubqueryName :: T.Text +sourceSubqueryName = "pg_source" + +unquoted :: JSON.Value -> T.Text +unquoted (JSON.String t) = t +unquoted (JSON.Number n) = + cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n +unquoted (JSON.Bool b) = cs . show $ b +unquoted v = cs $ JSON.encode v + +wrapQuery :: T.Text -> [T.Text] -> T.Text -> Maybe NonnegRange -> T.Text +wrapQuery source selectColumns returnSelect range = + withSourceF source <> + " SELECT " <> + T.intercalate ", " selectColumns <> + " " <> + fromF returnSelect ( limitF range ) + -- private functions fromQi :: QualifiedIdentifier -> T.Text fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n @@ -307,20 +323,15 @@ orderF ts = <> cs (otDirection t) <> " " <> maybe "" cs (otNullOrder t) <> " " -insertableText :: T.Text -> T.Text -insertableText = (<> "::unknown") . pgFmtLit - insertableValue :: JSON.Value -> T.Text insertableValue JSON.Null = "null" -insertableValue v = insertableText $ unquoted v +insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v whiteList :: T.Text -> T.Text whiteList val = fromMaybe (cs (pgFmtLit val) <> "::unknown ") (find ((==) . T.toLower $ val) ["null","true","false"]) - --- formating functions pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text pgFmtColumn table "*" = fromQi table <> ".*" pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c @@ -369,24 +380,8 @@ pgFmtValue opCode val = pgFmtOperator :: T.Text -> T.Text pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap - -pgFmtIdent :: T.Text -> T.Text -pgFmtIdent x = - let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in - if (cs escaped :: BS.ByteString) =~ danger - then "\"" <> escaped <> "\"" - else escaped - - where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString - -pgFmtLit :: T.Text -> T.Text -pgFmtLit x = - let trimmed = trimNullChars x - escaped = "'" <> T.replace "'" "''" trimmed <> "'" - slashed = T.replace "\\" "\\\\" escaped in - if T.isInfixOf "\\\\" escaped - then "E" <> slashed - else slashed + where + operatorsMap = M.fromList operators pgFmtJsonPath :: Maybe JsonPath -> T.Text pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x @@ -397,9 +392,6 @@ pgFmtAsJsonPath :: Maybe JsonPath -> T.Text pgFmtAsJsonPath Nothing = "" pgFmtAsJsonPath (Just xx) = " AS " <> last xx -operatorsMap :: M.Map T.Text T.Text -operatorsMap = M.fromList operators - trimNullChars :: T.Text -> T.Text trimNullChars = T.takeWhile (/= '\x0')