diff --git a/CHANGELOG.md b/CHANGELOG.md index 4c4ab1c19..7bb3e1142 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -28,6 +28,7 @@ This project adheres to [Semantic Versioning](http://semver.org/). - Fatal error on postgres unsupported version, format supported version in error message - @steve-chavez - Prevent database memory cosumption by prepared statements caches - @ruslantalpa - Use specific columns in the RETURNING section - @ruslantalpa +- Fix columns alias for RETURNING - @steve-chavez ### Changed - Replace `Prefer: plurality=singular` with `Accept: application/vnd.pgrst.object` - @begriffs diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 797624e48..6fc04e959 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -7,6 +7,8 @@ module PostgREST.App ( ) where import Control.Applicative +import Control.Lens.Getter (view) +import Control.Lens.Tuple (_1) import qualified Data.ByteString.Char8 as BS import Data.IORef (IORef, readIORef) import Data.List (delete, lookup) @@ -21,7 +23,6 @@ import qualified Hasql.Transaction as HT import qualified Hasql.Transaction.Sessions as HT import Text.Parsec.Error -import Text.ParserCombinators.Parsec (parse) import Network.HTTP.Types.Header import Network.HTTP.Types.Status @@ -59,7 +60,6 @@ import PostgREST.QueryBuilder ( callProc , createReadStatement , createWriteStatement , ResultsWithCount - , returningF ) import PostgREST.Types import PostgREST.OpenAPI @@ -268,11 +268,11 @@ app dbStructure conf apiRequest = in (status, contentRange) mapSnd f (a, b) = (a, f b) - readDbRequest = DbRead <$> readRequest (configMaxRows conf) (dbRelations dbStructure) (map (mapSnd pdReturnType) $ dbProcs dbStructure) apiRequest - mutateDbRequest = DbMutate <$> mutateRequest apiRequest - returningSql = returningF (iTarget apiRequest) (iPreferRepresentation apiRequest) <$> readDbRequest - selectQuery = requestToQuery schema False "" <$> readDbRequest - mutateQuery = requestToQuery schema False <$> returningSql <*> mutateDbRequest + readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) (map (mapSnd pdReturnType) $ dbProcs dbStructure) apiRequest + readDbRequest = DbRead <$> readReq + mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< readReq) + selectQuery = requestToQuery schema False <$> readDbRequest + mutateQuery = requestToQuery schema False <$> mutateDbRequest countQuery = requestToCountQuery schema <$> readDbRequest readSqlParts = (,) <$> selectQuery <*> countQuery mutateSqlParts = (,) <$> selectQuery <*> mutateQuery @@ -388,7 +388,7 @@ readRequest maxRows allRels allProcs apiRequest = parseReadRequest :: Either ParseError ReadRequest parseReadRequest = addFiltersOrdersRanges apiRequest <*> - parse (pRequestSelect rootName) ("failed to parse select parameter <<" <> toS selStr <> ">>") (toS selStr) + pRequestSelect rootName selStr where selStr = iSelect apiRequest rootName = if action == ActionRead @@ -404,12 +404,12 @@ readRequest maxRows allRels allProcs apiRequest = _ -> allRels where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation -mutateRequest :: ApiRequest -> Either Response MutateRequest -mutateRequest apiRequest = mapLeft (errResponse status400) $ +mutateRequest :: ApiRequest -> ReadRequest -> Either Response MutateRequest +mutateRequest apiRequest readReq = mapLeft (errResponse status400) $ case action of - ActionCreate -> Insert rootTableName <$> pure payload - ActionUpdate -> Update rootTableName <$> pure payload <*> filters - ActionDelete -> Delete rootTableName <$> filters + ActionCreate -> Right $ Insert rootTableName payload returnings + ActionUpdate -> Update rootTableName <$> pure payload <*> filters <*> pure returnings + ActionDelete -> Delete rootTableName <$> filters <*> pure returnings _ -> Left "Unsupported HTTP verb" where action = iAction apiRequest @@ -419,6 +419,15 @@ mutateRequest apiRequest = mapLeft (errResponse status400) $ case target of (TargetIdent (QualifiedIdentifier _ t) ) -> t _ -> undefined + fieldNames :: ReadRequest -> PreferRepresentation -> [FieldName] + fieldNames _ None = [] + fieldNames (Node (sel, _) forest) _ = + map (fst . view _1) (select sel) ++ map colName fks + where + fks = concatMap (fromMaybe [] . f) forest + f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _)) _) = Just cols + f _ = Nothing + returnings = fieldNames readReq (iPreferRepresentation apiRequest) filters = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters where mutateFilters = filter (not . ( "." `isInfixOf` ) . fst) $ iFilters apiRequest -- update/delete filters can be only on the root table diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs index b9d56c642..2c50b53d5 100644 --- a/src/PostgREST/Parsers.hs +++ b/src/PostgREST/Parsers.hs @@ -10,20 +10,9 @@ import PostgREST.Types import Text.ParserCombinators.Parsec hiding (many, (<|>)) import PostgREST.RangeQuery (NonnegRange,allRange) -pRequestSelect :: Text -> Parser ReadRequest -pRequestSelect rootNodeName = do - fieldTree <- pFieldForest - return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing)) []) fieldTree - where - readQuery = Select [] [rootNodeName] [] Nothing allRange - treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest - treeEntry (Node fld@((fn, _),_,alias) fldForest) (Node (q, i) rForest) = - case fldForest of - [] -> Node (q {select=fld:select q}, i) rForest - _ -> Node (q, i) newForest - where - newForest = - foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias)) []) fldForest:rForest +pRequestSelect :: Text -> Text -> Either ParseError ReadRequest +pRequestSelect rootName selStr = + parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr) pRequestFilter :: (Text, Text) -> Either ParseError (Path, Filter) pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val) @@ -54,6 +43,21 @@ ws = toS <$> many (oneOf " \t") lexeme :: Parser a -> Parser a lexeme p = ws *> p <* ws +pReadRequest :: Text -> Parser ReadRequest +pReadRequest rootNodeName = do + fieldTree <- pFieldForest + return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing)) []) fieldTree + where + readQuery = Select [] [rootNodeName] [] Nothing allRange + treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest + treeEntry (Node fld@((fn, _),_,alias) fldForest) (Node (q, i) rForest) = + case fldForest of + [] -> Node (q {select=fld:select q}, i) rForest + _ -> Node (q, i) newForest + where + newForest = + foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias)) []) fldForest:rForest + pTreePath :: Parser (Path,Field) pTreePath = do p <- pFieldName `sepBy1` pDelimiter diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index 1a78bc5c7..958d45d6a 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -23,7 +23,6 @@ module PostgREST.QueryBuilder ( , pgFmtLit , requestToQuery , requestToCountQuery - , returningF , sourceCTEName , unquoted , ResultsWithCount @@ -53,7 +52,7 @@ import Data.Scientific ( FPFormat (..) , isInteger ) import Protolude hiding (from, intercalate, ord, cast) -import PostgREST.ApiRequest (PreferRepresentation (..), Target (..)) +import PostgREST.ApiRequest (PreferRepresentation (..)) import Unsafe (unsafeHead) {-| The generic query result format used by API responses. The location header @@ -312,8 +311,8 @@ requestToCountQuery schema (DbRead (Node (Select _ _ conditions _ _, (mainTbl, _ fn Filter{value=VForeignKey _ _} = False localConditions = filter fn conditions -requestToQuery :: Schema -> Bool -> SqlFragment -> DbRequest -> SqlQuery -requestToQuery schema isParent _ (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) = +requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery +requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) = query where -- TODO! the following helper functions are just to remove the "schema" part when the table is "source" which is the name @@ -350,7 +349,7 @@ requestToQuery schema isParent _ (DbRead (Node (Select colSelects tbls condition <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) " <> "FROM (" <> subquery <> ") " <> pgFmtIdent table <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias) - where subquery = requestToQuery schema False "" (DbRead (Node n forst)) + where subquery = requestToQuery schema False (DbRead (Node n forst)) getQueryParts (Node n@(_, (name, Just r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (joi:j,sel:s) where node_name = fromMaybe name alias @@ -360,20 +359,20 @@ requestToQuery schema isParent _ (DbRead (Node (Select colSelects tbls condition sel = "row_to_json(" <> pgFmtIdent local_table_name <> ".*) AS " <> pgFmtIdent node_name joi = " LEFT OUTER JOIN ( " <> subquery <> " ) AS " <> pgFmtIdent local_table_name <> " ON " <> intercalate " AND " ( map (pgFmtCondition qi . replaceTableName local_table_name) (getJoinConditions r) ) - where subquery = requestToQuery schema True "" (DbRead (Node n forst)) + where subquery = requestToQuery schema True (DbRead (Node n forst)) getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s) where sel = "COALESCE ((" <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) " <> "FROM (" <> subquery <> ") " <> pgFmtIdent table <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias) - where subquery = requestToQuery schema False "" (DbRead (Node n forst)) + where subquery = requestToQuery schema False (DbRead (Node n forst)) --the following is just to remove the warning --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only --posible relations are Child Parent Many getQueryParts _ _ = undefined -requestToQuery schema _ returningSql (DbMutate (Insert mainTbl (PayloadJSON rows))) = - insInto <> vals <> returningSql +requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON rows) returnings)) = + insInto <> vals <> ret where qi = QualifiedIdentifier schema mainTbl cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0)) colsString = intercalate ", " cols @@ -384,7 +383,10 @@ requestToQuery schema _ returningSql (DbMutate (Insert mainTbl (PayloadJSON rows if T.null colsString then if V.null rows then ["SELECT null WHERE false"] else ["DEFAULT VALUES"] else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"] -requestToQuery schema _ returningSql (DbMutate (Update mainTbl (PayloadJSON rows) conditions)) = + ret = if null returnings + then "" + else unwords [" RETURNING ", intercalate ", " (map (pgFmtColumn qi) returnings)] +requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions returnings)) = case rows V.!? 0 of Just obj -> let assignments = map @@ -393,32 +395,21 @@ requestToQuery schema _ returningSql (DbMutate (Update mainTbl (PayloadJSON rows "UPDATE ", fromQi qi, " SET " <> intercalate "," assignments <> " ", ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, - returningSql + ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnNull` returnings ] Nothing -> undefined where qi = QualifiedIdentifier schema mainTbl -requestToQuery schema _ returningSql (DbMutate (Delete mainTbl conditions)) = +requestToQuery schema _ (DbMutate (Delete mainTbl conditions returnings)) = query where qi = QualifiedIdentifier schema mainTbl query = unwords [ "DELETE FROM ", fromQi qi, ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, - returningSql + ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnNull` returnings ] -returningF :: Target -> PreferRepresentation -> DbRequest -> SqlFragment -returningF _ None _ = "" -returningF (TargetIdent qi) _ (DbRead (Node (Select colSelects _ _ _ _, (_, _, _)) forest)) = - " RETURNING " <> - intercalate ", " ( map (pgFmtSelectItem qi) colSelects ++ map (pgFmtColumn qi . colName) fks) - where - fks = concatMap (fromMaybe [] . f) forest - f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _)) _) = Just cols - f _ = Nothing -returningF _ _ _ = "" - sourceCTEName :: SqlFragment sourceCTEName = "pg_source" diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index 5136ffc04..b9405ea8e 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -125,9 +125,9 @@ type NodeName = Text type SelectItem = (Field, Maybe Cast, Maybe Alias) type Path = [Text] data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq) -data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON } - | Delete { in_::TableName, where_::[Filter] } - | Update { in_::TableName, qPayload::PayloadJSON, where_::[Filter] } deriving (Show, Eq) +data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] } + | Delete { in_::TableName, where_::[Filter], returning::[FieldName] } + | Update { in_::TableName, qPayload::PayloadJSON, where_::[Filter], returning::[FieldName] } deriving (Show, Eq) data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq) type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias)) type ReadRequest = Tree ReadNode diff --git a/test/Feature/DeleteSpec.hs b/test/Feature/DeleteSpec.hs index 7b618a4f8..1df64b8c6 100644 --- a/test/Feature/DeleteSpec.hs +++ b/test/Feature/DeleteSpec.hs @@ -35,6 +35,9 @@ spec = , matchStatus = 200 , matchHeaders = ["Content-Range" <:> "*/*"] } + it "can rename and cast the selected columns" $ + request methodDelete "/complex_items?id=eq.3&select=ciId:id::text,ciName:name" [("Prefer", "return=representation")] "" + `shouldRespondWith` [str|[{"ciId":"3","ciName":"Three"}]|] it "can embed (parent) entities" $ request methodDelete "/tasks?id=eq.8&select=id,name,project{id}" [("Prefer", "return=representation")] "" `shouldRespondWith` ResponseMatcher { diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index b0be2a141..59a3720dd 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -49,6 +49,7 @@ spec = do , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"] } + context "requesting full representation" $ do it "includes related data after insert" $ request methodPost "/projects?select=id,name,clients{id,name}" [("Prefer", "return=representation"), ("Prefer", "count=exact")] @@ -60,6 +61,17 @@ spec = do , "Content-Range" <:> "*/1" ] } + it "can rename and cast the selected columns" $ + request methodPost "/projects?select=pId:id::text,pName:name,cId:client_id::text" + [("Prefer", "return=representation")] + [str|{"id":7,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher { + matchBody = Just [str|[{"pId":"7","pName":"New Project","cId":"2"}]|] + , matchStatus = 201 + , matchHeaders = [ "Content-Type" <:> "application/json; charset=utf-8" + , "Location" <:> "/projects?id=eq.7" + , "Content-Range" <:> "*/*" ] + } + context "from an html form" $ it "accepts disparate json types" $ do p <- request methodPost "/menagerie" @@ -277,6 +289,17 @@ spec = do "Location" <:> "/no_pk?a=is.null&b=eq.foo"] } + it "only returns the requested column header with its associated data" $ + request methodPost "/projects?select=id" + [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] + "id,name,client_id\n8,Xenix,1\n9,Windows NT,1" + `shouldRespondWith` ResponseMatcher { + matchBody = Just "id\n8\n9" + , matchStatus = 201 + , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8", + "Content-Range" <:> "*/*"] + } + context "with wrong number of columns" $ it "fails for too few" $ do p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"