jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixes for failing tests (only 2 failing, yay! :))

Browse Source
This commit is contained in:
Ruslan Talpa
2015-09-24 16:29:20 +03:00
parent 448a81dff8
commit f2d6c59bab
6 changed files with 105 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+17 -3
View File
@@ -82,10 +82,22 @@ app dbstructure conf reqBody role req =
if range == Just emptyRange
then return $ responseLBS status416 [] "HTTP Range error"
else
case query of
case queries of
Left e -> return $ responseLBS status200 [("Content-Type", "text/plain")] $ cs e
Right qs -> do
let q = B.Stmt qs V.empty True
Right (qs, cqs) -> do
let qt = qualify table
q = B.Stmt "select " V.empty True <>
parentheticT (
cqs
) <> commaq <> (
bodyForAccept contentType qt
. limitT range
-- . orderT (orderParse qq)
-- . whereT qt qq
-- $ select qt qq
$ qs
)
-- return $ responseLBS status200 [contentTypeH] (cs $ show $ B.stmtTemplate q)
row <- H.maybeEx q
let (tableTotal, queryTotal, body) = fromMaybe (0::Int, 0::Int, Just "" :: Maybe Text) row
to = from+queryTotal-1
@@ -115,6 +127,8 @@ app dbstructure conf reqBody role req =
>>= addJoinConditions allColumns
where formatParserError = pack.show
query = dbRequestToQuery <$> dbRequest
countQuery = dbRequestToCountQuery <$> dbRequest
queries = (,) <$> query <*> countQuery
--
src/PostgREST/Functions.hs
+43 -29
View File
@@ -8,7 +8,12 @@ import Data.List (find)
import Data.Tree
import Data.Text hiding (find, foldr, map, null, last, head)
import Data.Monoid
import PostgREST.PgQuery (pgFmtOperator, pgFmtValue, pgFmtIdent, pgFmtLit, fromQi, whiteList, QualifiedIdentifier(..))
import PostgREST.PgQuery (orderT, pgFmtOperator, pgFmtValue, pgFmtIdent, pgFmtLit, fromQi, whiteList, QualifiedIdentifier(..), StatementT, PStmt)
import qualified Hasql as H
import qualified Hasql.Postgres as P
import qualified Hasql.Backend as B
import qualified Data.Vector as V (empty)
findColumn :: [Column] -> Text -> Text -> Text -> Either Text Column
@@ -33,8 +38,8 @@ filterToCondition schema allColumns table (Filter fld op val) =
requestNodeToQuery ::Text -> [Table] -> [Column] -> RequestNode -> Either Text Query
requestNodeToQuery schema allTables allColumns (RequestNode tblNameS flds fltrs) =
Select <$> mainTable <*> select <*> joinTables <*> qwhere <*> rel
requestNodeToQuery schema allTables allColumns (RequestNode tblNameS flds fltrs ord) =
Select <$> mainTable <*> select <*> joinTables <*> qwhere <*> rel <*> pure ord
where
tblName = pack tblNameS
mainTable = findTable allTables schema tblName
@@ -95,31 +100,37 @@ 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 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 ("
<> query
<> ") t;"
_ -> query
dbRequestToCountQuery :: DbRequest -> PStmt
dbRequestToCountQuery (Node (Select mainTable _ _ conditions _ _) forest) =
B.Stmt query V.empty True
where
query = Data.Text.unwords [
query = Data.Text.unwords [
"SELECT pg_catalog.count(1)",
"FROM ", pgFmtTable mainTable,
("WHERE " <> intercalate " AND " ( map pgFmtCondition conditions )) `emptyOnNull` conditions
]
emptyOnNull val x = if null x then "" else val
dbRequestToQuery :: DbRequest -> PStmt
dbRequestToQuery r@(Node (Select mainTable columns tables conditions relation ord) forest) =
orderT (fromMaybe [] ord) $ query
-- case relation of
-- Nothing ->B.Stmt ("SELECT "
-- <> "("
-- <> dbRequestToCountQuery r
-- <> "),"
-- <> "pg_catalog.count(t),"
-- <> "array_to_json(array_agg(row_to_json(t)))::CHARACTER VARYING AS json "
-- <> "FROM ("
-- <> query
-- <> ") t;"
-- ) V.empty True
--
-- _ -> B.Stmt query V.empty True
where
query = B.Stmt q V.empty True
q = Data.Text.unwords [
("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
"SELECT ", intercalate ", " (map selectItemToStr columns ++ selects),
"FROM ", intercalate ", " (map pgFmtTable (mainTable:tables)),
@@ -134,12 +145,15 @@ dbRequestToQuery r@(Node (Select mainTable columns tables conditions relation) f
where name = tableName table
sel = "("
<> "SELECT array_to_json(array_agg(row_to_json("<>name<>"))) "
<> "FROM (" <> dbRequestToQuery (Node q forst) <> ") " <> name
<> "FROM (" <> subquery <> ") " <> name
<> ") AS " <> name
where (B.Stmt subquery _ _) = dbRequestToQuery (Node q forst)
getQueryParts (Node q@(Select{qMainTable=table, qRelation=(Just (Relation{relType="parent"}))}) forst) (w,s) = (wit:w,sel:s)
where name = tableName table
sel = "row_to_json(" <> name <> ".*) AS "<>name --TODO must be singular
wit = name <> " AS ( " <> dbRequestToQuery (Node q forst) <> " )"
wit = name <> " AS ( " <> subquery <> " )"
where (B.Stmt subquery _ _) = dbRequestToQuery (Node q forst)
-- getQueryParts (Node q@(Select{qMainTable=table, qRelation=(Just (Many _ _))}) forst) (w,s) = (w,sel:s)
-- where name = tableName table
-- sel = "("
src/PostgREST/Parsers.hs
+21 -7
View File
@@ -23,30 +23,35 @@ import PostgREST.Types
import Data.List (delete, find)
import Data.Maybe
import Data.String.Conversions (cs)
import Control.Monad (join)
--import qualified Data.ByteString.Char8 as C
--buildRequest :: String -> String -> [(String, String)] -> Either P.ParseError Request
parseGetRequest :: Request -> Either ParseError ApiRequest
parseGetRequest httpRequest =
foldr addFilter <$> apiRequest <*> flts
foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
where
apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select ("++selectStr++")") $ cs selectStr
addOrder (Node r f) o = Node r{order=o} f
flts = mapM pRequestFilter whereFilters
rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
orderStr = join $ lookup "order" qString
ord = traverse (parse pOrder ("failed to parse order ()")) orderStr
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", "order"], isJust v ]
pRequestSelect :: String -> Parser ApiRequest
pRequestSelect rootNodeName = do
fieldTree <- pFieldForest
return $ foldr treeEntry (Node (RequestNode rootNodeName [] []) []) fieldTree
return $ foldr treeEntry (Node (RequestNode rootNodeName [] [] Nothing) []) fieldTree
where
treeEntry :: Tree SelectItem -> Tree RequestNode -> Tree RequestNode
treeEntry (Node fld@((fn, _),_) fldForest) (Node rNode rForest) =
case fldForest of
[] -> Node (rNode {fields=fld:fields rNode}) rForest
_ -> Node rNode (foldr treeEntry (Node (RequestNode fn [] []) []) fldForest:rForest)
_ -> Node rNode (foldr treeEntry (Node (RequestNode fn [] [] Nothing) []) fldForest:rForest)
pRequestFilter :: (String, String) -> Either ParseError (Path, Filter)
pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
@@ -133,14 +138,12 @@ pSelect = lexeme $
return ((s, Nothing), Nothing)
pOperator :: Parser Operator
pOperator = try (string "eq")
<|> try (string "gt")
pOperator = 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 "gte")
<|> try (string "lte")
<|> try (string "neq")
<|> try (string "like")
<|> try (string "ilike")
@@ -169,3 +172,14 @@ pOpValueExp = do
pDelimiter
v <- pValue
return (o, v)
pOrder :: Parser ([OrderTerm])
pOrder = lexeme pOrderTerm `sepBy` char ','
pOrderTerm :: Parser OrderTerm
pOrderTerm = do
c <- pFieldName
pDelimiter
d <- string "asc" <|> string "desc"
nls <- optionMaybe (pDelimiter *> ( try(string "nullslast" *> pure ("nulls last"::String)) <|> try(string "nullsfirst" *> pure ("nulls first"::String))))
return $ OrderTerm (cs c) (cs d) (cs <$> nls)
src/PostgREST/PgQuery.hs
+1 -6
View File
@@ -4,7 +4,7 @@
module PostgREST.PgQuery where
import PostgREST.RangeQuery
import PostgREST.Types (OrderTerm(..))
import qualified Hasql as H
import qualified Hasql.Postgres as P
import qualified Hasql.Backend as B
@@ -39,11 +39,6 @@ data QualifiedIdentifier = QualifiedIdentifier {
, qiName :: T.Text
} deriving (Show)
data OrderTerm = OrderTerm {
otTerm :: T.Text
, otDirection :: BS.ByteString
, otNullOrder :: Maybe BS.ByteString
}
limitT :: Maybe NonnegRange -> StatementT
limitT r q =
src/PostgREST/RangeQuery.hs
+1
View File
@@ -6,6 +6,7 @@ module PostgREST.RangeQuery (
, NonnegRange
) where
import PostgREST.Types (OrderTerm(..))
import Control.Applicative
import Network.HTTP.Types.Header
src/PostgREST/Types.hs
+22 -2
View File
@@ -1,6 +1,7 @@
module PostgREST.Types where
import Data.Text
import Data.Tree
import qualified Data.ByteString.Char8 as BS
data DbStructure = DbStructure {
tables :: [Table]
@@ -41,6 +42,13 @@ data PrimaryKey = PrimaryKey {
pkSchema::Text, pkTable::Text, pkName::Text
}
data OrderTerm = OrderTerm {
otTerm :: Text
, otDirection :: BS.ByteString
, otNullOrder :: Maybe BS.ByteString
} deriving (Show, Eq)
data Relation = Relation {
relSchema :: Text
, relTable :: Text
@@ -62,7 +70,12 @@ type Field = (FieldName, Maybe JsonPath)
type Cast = String
type SelectItem = (Field, Maybe Cast)
type Path = [String]
data RequestNode = RequestNode {nodeName::String, fields::[SelectItem], filters::[Filter]} deriving (Show, Eq)
data RequestNode = RequestNode {
nodeName::String
, fields::[SelectItem]
, filters::[Filter]
, order::Maybe [OrderTerm]
} deriving (Show, Eq)
data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
-- Db Request Types
@@ -70,5 +83,12 @@ type DbField = (Column, Maybe JsonPath)
type DbSelectItem = (DbField, Maybe Cast)
data DbValue = VText Text | VForeignKey Relation deriving (Show)
data Condition = Condition {conColumn::DbField, conOperator::Operator, conValue::DbValue} deriving (Show)
data Query = Select {qMainTable::Table, qSelect::[DbSelectItem], qJoinTables::[Table], qWhere::[Condition], qRelation::Maybe Relation} deriving (Show)
data Query = Select {
qMainTable::Table
, qSelect::[DbSelectItem]
, qJoinTables::[Table]
, qWhere::[Condition]
, qRelation::Maybe Relation
, qOrder::Maybe [OrderTerm]
} deriving (Show)
type DbRequest = Tree Query