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