diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 111ad490a..3870ea9bf 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -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 diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index 8c66712d0..1044cdf8a 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -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 = "" diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index 2dac663c1..4bd0a5df1 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -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