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

a bit of warning cleanup

Browse Source
This commit is contained in:
Ruslan Talpa
2015-10-22 18:01:47 +03:00
parent ca4014f751
commit cea4cc5860
3 changed files with 40 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+16 -17
View File
@@ -16,7 +16,7 @@ module PostgREST.App where
import qualified Blaze.ByteString.Builder as BB import qualified Blaze.ByteString.Builder as BB
import Control.Applicative import Control.Applicative
import Control.Arrow (second, (***)) import Control.Arrow ((***))
import Control.Monad (join) import Control.Monad (join)
import Data.Bifunctor (first) import Data.Bifunctor (first)
import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS
@@ -26,8 +26,7 @@ import qualified Data.Csv as CSV
import Data.Functor.Identity import Data.Functor.Identity
import qualified Data.HashMap.Strict as M import qualified Data.HashMap.Strict as M
import Data.List (find, sortBy, delete, transpose) import Data.List (find, sortBy, delete, transpose)
import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, import Data.Maybe (fromMaybe, fromJust, isJust, isNothing)
mapMaybe)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Ranged.Ranges (emptyRange) import Data.Ranged.Ranges (emptyRange)
import qualified Data.Set as S import qualified Data.Set as S
@@ -45,9 +44,8 @@ import Network.HTTP.Types.Status
import Network.HTTP.Types.URI (parseSimpleQuery) import Network.HTTP.Types.URI (parseSimpleQuery)
import Network.Wai import Network.Wai
--import Network.Wai.Internal --import Network.Wai.Internal
import Network.Wai.Internal (Response (..), Request (..)) import Network.Wai.Internal (Response (..))
import Network.Wai.Parse (parseHttpAccept) import Network.Wai.Parse (parseHttpAccept)
import Text.Heredoc
import Data.Aeson import Data.Aeson
import Data.Monoid import Data.Monoid
@@ -85,9 +83,9 @@ app dbstructure conf authenticator reqBody dbrole req =
if range == Just emptyRange if range == Just emptyRange
then return $ responseLBS status416 [] "HTTP Range error" then return $ responseLBS status416 [] "HTTP Range error"
else else
case queries of case query of
Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
Right (qs, cqs) -> do Right qs -> do
-- let qt = qualify table -- let qt = qualify table
-- count = if hasPrefer "count=none" -- count = if hasPrefer "count=none"
-- then countNone -- then countNone
@@ -140,8 +138,8 @@ app dbstructure conf authenticator reqBody dbrole req =
query = requestToQuery schema <$> apiRequest query = requestToQuery schema <$> apiRequest
countQuery = requestToCountQuery schema <$> apiRequest --countQuery = requestToCountQuery schema <$> apiRequest
queries = (,) <$> query <*> countQuery --queries = (,) <$> query <*> countQuery
(["postgrest", "users"], "POST") -> do (["postgrest", "users"], "POST") -> do
let user = decode reqBody :: Maybe AuthUser let user = decode reqBody :: Maybe AuthUser
@@ -177,30 +175,31 @@ app dbstructure conf authenticator reqBody dbrole req =
_ -> return $ responseLBS status401 [jsonH] $ _ -> return $ responseLBS status401 [jsonH] $
encode . object $ [("message", String "Failed authentication.")] encode . object $ [("message", String "Failed authentication.")]
([table], "POST") -> do ([table], "POST") -> do
let echoRequested = hasPrefer "return=representation" --TODO!! do not request content at all in query if not echoRequested let echoRequested = hasPrefer "return=representation" --TODO!! do not request content at all in query if not echoRequested
case insertQuery of case insertQuery of
Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
Right q -> do Right qs -> do
let isSingle = either (const False) id returnSingle let isSingle = either (const False) id returnSingle
pKeys = map pkName $ filter (filterPk schema table) allPrKeys pKeys = map pkName $ filter (filterPk schema table) allPrKeys
qq = B.Stmt q = B.Stmt
(withSourceF q <> (withSourceF qs <>
" SELECT " <> " SELECT " <>
(if isSingle then (locationF pKeys) else "null") <> (if isSingle then locationF pKeys else "null") <>
"," <> "," <>
countF <> countF <>
"," <> "," <>
(case contentType of (case contentType of
"text/csv" -> asCsvF "text/csv" -> asCsvF
_ -> (if isSingle then asJsonSingleF else asJsonF) _ -> if isSingle then asJsonSingleF else asJsonF
) <> ) <>
" " <> " " <>
fromF ( limitF Nothing )) fromF ( limitF Nothing ))
V.empty True V.empty True
row <- H.maybeEx qq row <- H.maybeEx q
let (locationRaw, queryTotal, bodyRaw) = fromMaybe (Just "" :: Maybe BL.ByteString, Just (0::Int), Just "" :: Maybe BL.ByteString) row let (locationRaw, _ {-- queryTotal --}, bodyRaw) = fromMaybe (Just "" :: Maybe BL.ByteString, Just (0::Int), Just "" :: Maybe BL.ByteString) row
body = fromMaybe "[]" bodyRaw body = fromMaybe "[]" bodyRaw
locationH = fromMaybe "" locationRaw locationH = fromMaybe "" locationRaw
return $ responseLBS status201 return $ responseLBS status201
@@ -528,7 +527,7 @@ convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
where where
maps :: Either String [M.HashMap Text [Value]] maps :: Either String [M.HashMap Text [Value]]
maps = mapM getElems $ V.toList a maps = mapM getElems $ V.toList a
getElems (Object o) = Right $ M.map (\x->[x]) o getElems (Object o) = Right $ M.map (:[]) o
getElems _ = Left invalidMsg getElems _ = Left invalidMsg
groupByKey _ = Left invalidMsg groupByKey _ = Left invalidMsg
src/PostgREST/QueryBuilder.hs
+21 -21
View File
@@ -10,12 +10,12 @@ import Data.Text hiding (filter, find, foldr, head, last, map,
null, zipWith) null, zipWith)
import Control.Applicative import Control.Applicative
import Data.Tree import Data.Tree
import PostgREST.PgQuery (PStmt, fromQi, import PostgREST.PgQuery (fromQi,
orderT, pgFmtIdent, pgFmtLit, pgFmtOperator, pgFmtIdent, pgFmtLit, pgFmtOperator,
pgFmtValue, whiteList, insertableValue, orderF) pgFmtValue, whiteList, insertableValue, orderF)
import PostgREST.Types import PostgREST.Types
import qualified Data.Vector as V (empty) --import qualified Data.Vector as V (empty)
import qualified Hasql.Backend as B --import qualified Hasql.Backend as B
findRelation :: [Relation] -> Text -> Text -> Text -> Maybe Relation findRelation :: [Relation] -> Text -> Text -> Text -> Maybe Relation
findRelation allRelations s t1 t2 = findRelation allRelations s t1 t2 =
@@ -71,20 +71,20 @@ addJoinConditions schema allColumns (Node (query, (t, r)) forest) =
updatedForest = mapM (addJoinConditions schema allColumns) forest updatedForest = mapM (addJoinConditions schema allColumns) forest
addCond q con = q{where_=con ++ where_ q} addCond q con = q{where_=con ++ where_ q}
requestToCountQuery :: Text -> ApiRequest -> PStmt -- requestToCountQuery :: Text -> ApiRequest -> PStmt
requestToCountQuery schema (Node (Select _ _ conditions _, (mainTbl, _)) _) = -- requestToCountQuery schema (Node (Select _ _ conditions _, (mainTbl, _)) _) =
B.Stmt query V.empty True -- B.Stmt query V.empty True
where -- where
query = Data.Text.unwords [ -- query = Data.Text.unwords [
"SELECT pg_catalog.count(1)", -- "SELECT pg_catalog.count(1)",
"FROM ", fromQi $ QualifiedIdentifier schema mainTbl, -- "FROM ", fromQi $ QualifiedIdentifier schema mainTbl,
("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions -- ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
] -- ]
emptyOnNull val x = if null x then "" else val -- emptyOnNull val x = if null x then "" else val
localConditions = filter fn conditions -- localConditions = filter fn conditions
where -- where
fn (Filter{value=VText _}) = True -- fn (Filter{value=VText _}) = True
fn (Filter{value=VForeignKey _ _}) = False -- fn (Filter{value=VForeignKey _ _}) = False
--requestToQuery :: Text -> ApiRequest -> PStmt --requestToQuery :: Text -> ApiRequest -> PStmt
requestToQuery :: Text -> ApiRequest -> Text requestToQuery :: Text -> ApiRequest -> Text
@@ -133,7 +133,7 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
--getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
--posible relations are Child Parent Many --posible relations are Child Parent Many
getQueryParts (Node (_,(_,Nothing)) _) _ = undefined getQueryParts (Node (_,(_,Nothing)) _) _ = undefined
requestToQuery schema (Node (Insert tbl flds vals, (mainTbl, _)) forest) = requestToQuery schema (Node (Insert _ flds vals, (mainTbl, _)) _) =
query query
where where
--query = B.Stmt qStr V.empty True --query = B.Stmt qStr V.empty True
@@ -199,8 +199,8 @@ pgFmtField :: QualifiedIdentifier -> Field -> Text
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Text pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Text
pgFmtSelectItem table (f@(c, jp), Nothing) = pgFmtField table f <> asJsonPath jp pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> asJsonPath jp
pgFmtSelectItem table (f@(c, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> asJsonPath jp pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> asJsonPath jp
asJsonPath :: Maybe JsonPath -> Text asJsonPath :: Maybe JsonPath -> Text
asJsonPath Nothing = "" asJsonPath Nothing = ""
src/PostgREST/Types.hs
+3 -3
View File
@@ -3,7 +3,7 @@ import Data.Text
import Data.Tree import Data.Tree
import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS
import Data.Aeson import Data.Aeson
import Data.Map --import Data.Map
data DbStructure = DbStructure { data DbStructure = DbStructure {
tables :: [Table] tables :: [Table]
@@ -80,8 +80,8 @@ type NodeName = Text
type SelectItem = (Field, Maybe Cast) type SelectItem = (Field, Maybe Cast)
type Path = [Text] type Path = [Text]
data Query = Select { select::[SelectItem], from::[Text], where_::[Filter], order::Maybe [OrderTerm] } data Query = Select { select::[SelectItem], from::[Text], where_::[Filter], order::Maybe [OrderTerm] }
| Insert { into::Text, fields::[Field], values::[[Value]] } | Insert { into::Text, fields::[Field], values::[[Value]] } deriving (Show, Eq)
| Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq) -- | Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq)
data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq) data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
type ApiNode = (Query, (NodeName, Maybe Relation)) type ApiNode = (Query, (NodeName, Maybe Relation))
type ApiRequest = Tree ApiNode type ApiRequest = Tree ApiNode