first fully functioning build, some tests are failing (limit,order,csv not implemented yet)

This commit is contained in:
Ruslan Talpa
2015-09-24 11:45:34 +03:00
parent fb92b76a1a
commit 448a81dff8
3 changed files with 107 additions and 45 deletions
+61 -36
View File
@@ -81,49 +81,74 @@ app dbstructure conf reqBody role req =
([table], "GET") ->
if range == Just emptyRange
then return $ responseLBS status416 [] "HTTP Range error"
else do
let apiRequest = parseGetRequest req
else
case query of
Left e -> return $ responseLBS status200 [("Content-Type", "text/plain")] $ cs e
Right qs -> do
let q = B.Stmt qs V.empty True
row <- H.maybeEx q
let (tableTotal, queryTotal, body) = fromMaybe (0::Int, 0::Int, Just "" :: Maybe Text) row
to = from+queryTotal-1
contentRange = contentRangeH from to tableTotal
status = rangeStatus from to tableTotal
canonical = urlEncodeVars
. sortBy (comparing fst)
. map (join (***) cs)
. parseSimpleQuery
$ rawQueryString req
return $ responseLBS status
[contentTypeH, contentRange,
("Content-Location",
"/" <> cs table <>
if Prelude.null canonical then "" else "?" <> cs canonical
)
] (cs $ fromMaybe "[]" body)
where
from = fromMaybe 0 $ rangeOffset <$> range
apiRequest = parseGetRequest req
dbRequest = first formatParserError apiRequest
>>= traverse (requestNodeToQuery schema allTables allColumns)
>>= addRelations allRelations Nothing
>>= addJoinConditions allColumns
where formatParserError = pack.show
query = dbRequestToQuery <$> dbRequest
body = show query
return $ responseLBS status200 [] $ cs body
{--
let qt = qualify table
from = fromMaybe 0 $ rangeOffset <$> range
query = B.Stmt "select " V.empty True <>
parentheticT (
whereT qt qq $ countRows qt
) <> commaq <> (
bodyForAccept contentType qt
. limitT range
. orderT (orderParse qq)
. whereT qt qq
$ select qt qq
)
row <- H.maybeEx query
let (tableTotal, queryTotal, body) =
fromMaybe (0, 0, Just "" :: Maybe Text) row
to = from+queryTotal-1
contentRange = contentRangeH from to tableTotal
status = rangeStatus from to tableTotal
canonical = urlEncodeVars
. sortBy (comparing fst)
. map (join (***) cs)
. parseSimpleQuery
$ rawQueryString req
return $ responseLBS status
[contentTypeH, contentRange,
("Content-Location",
"/" <> cs table <>
if Prelude.null canonical then "" else "?" <> cs canonical
)
] (cs $ fromMaybe "[]" body)
--}
--
-- let qt = qualify table
-- from = fromMaybe 0 $ rangeOffset <$> range
-- query = B.Stmt "select " V.empty True <>
-- parentheticT (
-- whereT qt qq $ countRows qt
-- ) <> commaq <> (
-- bodyForAccept contentType qt
-- . limitT range
-- . orderT (orderParse qq)
-- . whereT qt qq
-- $ select qt qq
-- )
-- row <- H.maybeEx query
-- let (tableTotal, queryTotal, body) =
-- fromMaybe (0, 0, Just "" :: Maybe Text) row
-- to = from+queryTotal-1
-- contentRange = contentRangeH from to tableTotal
-- status = rangeStatus from to tableTotal
-- canonical = urlEncodeVars
-- . sortBy (comparing fst)
-- . map (join (***) cs)
-- . parseSimpleQuery
-- $ rawQueryString req
-- return $ responseLBS status
-- [contentTypeH, contentRange,
-- ("Content-Location",
-- "/" <> cs table <>
-- if Prelude.null canonical then "" else "?" <> cs canonical
-- )
-- ] (cs $ fromMaybe "[]" body)
(["postgrest", "users"], "POST") -> do
let user = decode reqBody :: Maybe AuthUser
+27 -7
View File
@@ -6,9 +6,9 @@ import PostgREST.Types
import Control.Error
import Data.List (find)
import Data.Tree
import Data.Text hiding (find, foldr, map, null, last)
import Data.Text hiding (find, foldr, map, null, last, head)
import Data.Monoid
import PostgREST.PgQuery (pgFmtOperator, pgFmtValue, pgFmtIdent, pgFmtLit, fromQi, QualifiedIdentifier(..))
import PostgREST.PgQuery (pgFmtOperator, pgFmtValue, pgFmtIdent, pgFmtLit, fromQi, whiteList, QualifiedIdentifier(..))
findColumn :: [Column] -> Text -> Text -> Text -> Either Text Column
@@ -95,10 +95,22 @@ addJoinConditions allColumns (Node query@(Select{qRelation=relation}) forest) =
addCond q con = q{qWhere=con:qWhere q}
dbRequestToCountQuery :: DbRequest -> Text
dbRequestToCountQuery (Node (Select mainTable columns tables conditions relation) forest) =
Data.Text.unwords [
"SELECT pg_catalog.count(1)",
"FROM ", pgFmtTable mainTable,
("WHERE " <> intercalate " AND " ( map pgFmtCondition conditions )) `emptyOnNull` conditions
]
where emptyOnNull val x = if null x then "" else val
dbRequestToQuery :: DbRequest -> Text
dbRequestToQuery (Node (Select mainTable columns tables conditions relation) forest) =
dbRequestToQuery r@(Node (Select mainTable columns tables conditions relation) forest) =
case relation of
Nothing -> "SELECT "
<> "("
<> dbRequestToCountQuery r
<> "),"
<> "pg_catalog.count(t),"
<> "array_to_json(array_agg(row_to_json(t)))::CHARACTER VARYING AS json "
<> "FROM ("
@@ -139,12 +151,20 @@ dbRequestToQuery (Node (Select mainTable columns tables conditions relation) for
getQueryParts (Node (Select{qRelation=(Just (Relation {relType=_}))}) _) _ = undefined
pgFmtCondition :: Condition -> Text
pgFmtCondition (Condition (col,jp) ops val) = pgFmtColumn col <> pgFmtJsonPath jp <> opToStr op <> valToStr val
pgFmtCondition (Condition (col,jp) ops val) =
notOp <> " " <> pgFmtColumn col <> pgFmtJsonPath jp <> " " <> pgFmtOperator opCode <> " " <>
if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
where
op = pack ops
opToStr o = pgFmtOperator o
headPredicate:rest = split (=='.') $ pack ops
hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
opCode = hasNot (head rest) headPredicate
notOp = hasNot headPredicate ""
sqlValue = valToStr val
getInner v = case v of
VText s -> s
_ -> ""
valToStr v = case v of
VText s -> pgFmtValue op s
VText s -> pgFmtValue opCode s
VForeignKey (Relation{relFTable=table, relFColumn=column}) -> table <> "." <> column
pgFmtColumn :: Column -> Text
+19 -2
View File
@@ -35,7 +35,7 @@ parseGetRequest httpRequest =
rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
selectStr = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qString --in case the parametre is missing or empty we default to *
whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select"], isJust v ]
whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ]
pRequestSelect :: String -> Parser ApiRequest
pRequestSelect rootNodeName = do
@@ -136,6 +136,19 @@ pOperator :: Parser Operator
pOperator = try (string "eq")
<|> try (string "gt")
<|> try (string "lt")
<|> try (string "eq")
<|> try (string "gt")
<|> try (string "lt")
<|> try (string "gte")
<|> try (string "lte")
<|> 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, ...)"
pInt :: Parser Int
@@ -151,4 +164,8 @@ pDelimiter :: Parser Char
pDelimiter = char '.' <?> "delimiter (.)"
pOpValueExp :: Parser (Operator, FValue)
pOpValueExp = liftA2 (,) pOperator (pDelimiter *> pValue)
pOpValueExp = do
o <- ( try ( liftA2 (++) (string "not.") pOperator) <|> pOperator )
pDelimiter
v <- pValue
return (o, v)