first fully functioning build, some tests are failing (limit,order,csv not implemented yet)
This commit is contained in:
+61
-36
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user