From 75f66da31462c392146cfc61998a8404821a001d Mon Sep 17 00:00:00 2001 From: Laurence Isla Date: Tue, 13 Feb 2024 19:22:17 -0500 Subject: [PATCH 1/3] Parse relationships in columns: `?columns=a,b(x)` --- src/PostgREST/ApiRequest.hs | 3 ++- src/PostgREST/ApiRequest/QueryParams.hs | 29 ++++++++++++++++++++++--- 2 files changed, 28 insertions(+), 4 deletions(-) diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 5b0c97cee1..5c20ec173c 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -37,6 +37,7 @@ import Data.Aeson.Types (emptyArray, emptyObject) import Data.List (lookup) import Data.Ranged.Ranges (emptyRange, rangeIntersection, rangeIsEmpty) +import Data.Tree (flatten) import Network.HTTP.Types.Header (RequestHeaders, hCookie) import Network.HTTP.Types.URI (parseSimpleQuery) import Network.Wai (Request (..)) @@ -242,7 +243,7 @@ getPayload reqBody contentMediaType QueryParams{qsColumns} action = do let cols = case (checkedPayload, columns) of (Just ProcessedJSON{payKeys}, _) -> payKeys (Just ProcessedUrlEncoded{payKeys}, _) -> payKeys - (Just RawJSON{}, Just cls) -> cls + (Just RawJSON{}, Just cls) -> S.fromList $ foldl (<>) [] (flatten <$> cls) _ -> S.empty return (checkedPayload, cols) where diff --git a/src/PostgREST/ApiRequest/QueryParams.hs b/src/PostgREST/ApiRequest/QueryParams.hs index f9150e04e7..7ce2c64a97 100644 --- a/src/PostgREST/ApiRequest/QueryParams.hs +++ b/src/PostgREST/ApiRequest/QueryParams.hs @@ -73,7 +73,7 @@ data QueryParams = -- ^ &order parameters for each level , qsLogic :: [(EmbedPath, LogicTree)] -- ^ &and and &or parameters used for complex boolean logic - , qsColumns :: Maybe (S.Set FieldName) + , qsColumns :: Maybe [Tree FieldName] -- ^ &columns parameter and payload , qsSelect :: [Tree SelectItem] -- ^ &select parameter used to shape the response @@ -260,11 +260,13 @@ pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree -- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)" P.parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v) -pRequestColumns :: Maybe Text -> Either QPError (Maybe (S.Set FieldName)) + +-- Satisfies the form: /products?columns=name,suppliers(name) +pRequestColumns :: Maybe Text -> Either QPError (Maybe [Tree FieldName]) pRequestColumns colStr = case colStr of Just str -> - mapError $ Just . S.fromList <$> P.parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str) + mapError $ Just <$> P.parse pColumnForest ("failed to parse columns parameter (" <> toS str <> ")") (toS str) _ -> Right Nothing ws :: Parser Text @@ -477,6 +479,11 @@ pRelationSelect = lexeme $ do try (void $ lookAhead (string "(")) return $ SelectRelation name alias hint jType +pRelationColumn :: Parser FieldName +pRelationColumn = lexeme $ do + name <- pFieldName + try (void $ lookAhead (string "(")) + return name -- | -- Parse regular fields in select @@ -845,6 +852,22 @@ pLogicPath = do pColumns :: Parser [FieldName] pColumns = pFieldName `sepBy1` lexeme (char ',') +pColumnForest :: Parser [Tree FieldName] +pColumnForest = pColumnTree `sepBy1` lexeme (char ',') + where + pColumnTree = Node <$> try pRelationColumn <*> between (char '(') (char ')') pColumnForest <|> + Node <$> pColumnName <*> pure [] + +pColumnName :: Parser FieldName +pColumnName = lexeme $ do + fld <- pFieldName + pEnd + return fld + where + pEnd = try (void $ lookAhead (string ")")) <|> + try (void $ lookAhead (string ",")) <|> + try eof + pIdentifier :: Parser Text pIdentifier = T.strip . toS <$> many1 pIdentifierChar From 6a237e34423a44301ab0469bebde519679f69d9c Mon Sep 17 00:00:00 2001 From: Laurence Isla Date: Thu, 22 Feb 2024 17:11:17 -0500 Subject: [PATCH 2/3] Use a set of Tree FieldName instead of just FieldName for columns --- src/PostgREST/ApiRequest.hs | 12 ++++++------ src/PostgREST/ApiRequest/QueryParams.hs | 2 +- src/PostgREST/Plan.hs | 4 ++-- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 5c20ec173c..83fa31af62 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -37,7 +37,7 @@ import Data.Aeson.Types (emptyArray, emptyObject) import Data.List (lookup) import Data.Ranged.Ranges (emptyRange, rangeIntersection, rangeIsEmpty) -import Data.Tree (flatten) +import Data.Tree (Tree (..)) import Network.HTTP.Types.Header (RequestHeaders, hCookie) import Network.HTTP.Types.URI (parseSimpleQuery) import Network.Wai (Request (..)) @@ -117,7 +117,7 @@ data ApiRequest = ApiRequest { , iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions , iPreferences :: Preferences.Preferences -- ^ Prefer header values , iQueryParams :: QueryParams.QueryParams - , iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload + , iColumns :: S.Set (Tree FieldName) -- ^ parsed colums from &columns parameter and payload , iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers , iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies , iPath :: ByteString -- ^ Raw request path @@ -237,13 +237,13 @@ getRanges method QueryParams{qsOrder,qsRanges} hdrs isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange) topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows -getPayload :: RequestBody -> MediaType -> QueryParams.QueryParams -> Action -> Either ApiRequestError (Maybe Payload, S.Set FieldName) +getPayload :: RequestBody -> MediaType -> QueryParams.QueryParams -> Action -> Either ApiRequestError (Maybe Payload, S.Set (Tree FieldName)) getPayload reqBody contentMediaType QueryParams{qsColumns} action = do checkedPayload <- if shouldParsePayload then payload else Right Nothing let cols = case (checkedPayload, columns) of - (Just ProcessedJSON{payKeys}, _) -> payKeys - (Just ProcessedUrlEncoded{payKeys}, _) -> payKeys - (Just RawJSON{}, Just cls) -> S.fromList $ foldl (<>) [] (flatten <$> cls) + (Just ProcessedJSON{payKeys}, _) -> S.map (`Node` []) payKeys + (Just ProcessedUrlEncoded{payKeys}, _) -> S.map (`Node` []) payKeys + (Just RawJSON{}, Just cls) -> S.fromList cls _ -> S.empty return (checkedPayload, cols) where diff --git a/src/PostgREST/ApiRequest/QueryParams.hs b/src/PostgREST/ApiRequest/QueryParams.hs index 7ce2c64a97..8d4e431e95 100644 --- a/src/PostgREST/ApiRequest/QueryParams.hs +++ b/src/PostgREST/ApiRequest/QueryParams.hs @@ -863,7 +863,7 @@ pColumnName = lexeme $ do fld <- pFieldName pEnd return fld - where + where pEnd = try (void $ lookAhead (string ")")) <|> try (void $ lookAhead (string ",")) <|> try eof diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index db52d36332..58b57ae997 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -170,7 +170,7 @@ callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} invMethod = do let paramKeys = case invMethod of InvRead _ -> S.fromList $ fst <$> qsParams' - Inv -> iColumns + Inv -> S.map rootLabel iColumns proc@Function{..} <- mapLeft ApiRequestError $ findProc identifier paramKeys (preferParameters == Just SingleObject) (dbRoutines sCache) iContentMediaType (invMethod == Inv) let relIdentifier = QualifiedIdentifier pdSchema (fromMaybe pdName $ Routine.funcTableName proc) -- done so a set returning function can embed other relations @@ -942,7 +942,7 @@ mutatePlan mutation qi ApiRequest{iPreferences=Preferences{..}, ..} SchemaCache{ combinedLogic = foldr (addFilterToLogicForest . resolveFilter ctx) logic qsFiltersRoot body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates) applyDefaults = preferMissing == Just ApplyDefaults - typedColumnsOrError = resolveOrError ctx tbl `traverse` S.toList iColumns + typedColumnsOrError = resolveOrError ctx tbl `traverse` S.toList (S.map rootLabel iColumns) resolveOrError :: ResolverContext -> Maybe Table -> FieldName -> Either ApiRequestError CoercibleField resolveOrError _ Nothing _ = Left NotFound From fdeffd5825e70adf0fbda2c74d947d2a8e21228b Mon Sep 17 00:00:00 2001 From: Laurence Isla Date: Wed, 27 Mar 2024 20:30:13 -0500 Subject: [PATCH 3/3] Allow alias and hint for columns in query string --- src/PostgREST/ApiRequest.hs | 12 ++++++------ src/PostgREST/ApiRequest/QueryParams.hs | 26 +++++++++++++------------ src/PostgREST/ApiRequest/Types.hs | 10 ++++++++++ src/PostgREST/Plan.hs | 10 ++++++++-- 4 files changed, 38 insertions(+), 20 deletions(-) diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 83fa31af62..e2f9d390e9 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -46,6 +46,7 @@ import Web.Cookie (parseCookies) import PostgREST.ApiRequest.QueryParams (QueryParams (..)) import PostgREST.ApiRequest.Types (ApiRequestError (..), + ColumnItem (..), RangeError (..)) import PostgREST.Config (AppConfig (..), OpenAPIMode (..)) @@ -55,8 +56,7 @@ import PostgREST.RangeQuery (NonnegRange, allRange, hasLimitZero, rangeRequested) import PostgREST.SchemaCache (SchemaCache (..)) -import PostgREST.SchemaCache.Identifiers (FieldName, - QualifiedIdentifier (..), +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), Schema) import qualified PostgREST.ApiRequest.Preferences as Preferences @@ -117,7 +117,7 @@ data ApiRequest = ApiRequest { , iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions , iPreferences :: Preferences.Preferences -- ^ Prefer header values , iQueryParams :: QueryParams.QueryParams - , iColumns :: S.Set (Tree FieldName) -- ^ parsed colums from &columns parameter and payload + , iColumns :: S.Set (Tree ColumnItem) -- ^ parsed colums from &columns parameter and payload , iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers , iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies , iPath :: ByteString -- ^ Raw request path @@ -237,12 +237,12 @@ getRanges method QueryParams{qsOrder,qsRanges} hdrs isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange) topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows -getPayload :: RequestBody -> MediaType -> QueryParams.QueryParams -> Action -> Either ApiRequestError (Maybe Payload, S.Set (Tree FieldName)) +getPayload :: RequestBody -> MediaType -> QueryParams.QueryParams -> Action -> Either ApiRequestError (Maybe Payload, S.Set (Tree ColumnItem)) getPayload reqBody contentMediaType QueryParams{qsColumns} action = do checkedPayload <- if shouldParsePayload then payload else Right Nothing let cols = case (checkedPayload, columns) of - (Just ProcessedJSON{payKeys}, _) -> S.map (`Node` []) payKeys - (Just ProcessedUrlEncoded{payKeys}, _) -> S.map (`Node` []) payKeys + (Just ProcessedJSON{payKeys}, _) -> S.map ((`Node` []) . ColumnField) payKeys + (Just ProcessedUrlEncoded{payKeys}, _) -> S.map ((`Node` []) . ColumnField) payKeys (Just RawJSON{}, Just cls) -> S.fromList cls _ -> S.empty return (checkedPayload, cols) diff --git a/src/PostgREST/ApiRequest/QueryParams.hs b/src/PostgREST/ApiRequest/QueryParams.hs index 8d4e431e95..1ede04ed32 100644 --- a/src/PostgREST/ApiRequest/QueryParams.hs +++ b/src/PostgREST/ApiRequest/QueryParams.hs @@ -44,10 +44,10 @@ import PostgREST.RangeQuery (NonnegRange, allRange, import PostgREST.SchemaCache.Identifiers (FieldName) import PostgREST.ApiRequest.Types (AggregateFunction (..), - EmbedParam (..), EmbedPath, Field, - Filter (..), FtsOperator (..), - Hint, JoinType (..), - JsonOperand (..), + ColumnItem (..), EmbedParam (..), + EmbedPath, Field, Filter (..), + FtsOperator (..), Hint, + JoinType (..), JsonOperand (..), JsonOperation (..), JsonPath, ListVal, LogicOperator (..), LogicTree (..), OpExpr (..), @@ -73,7 +73,7 @@ data QueryParams = -- ^ &order parameters for each level , qsLogic :: [(EmbedPath, LogicTree)] -- ^ &and and &or parameters used for complex boolean logic - , qsColumns :: Maybe [Tree FieldName] + , qsColumns :: Maybe [Tree ColumnItem] -- ^ &columns parameter and payload , qsSelect :: [Tree SelectItem] -- ^ &select parameter used to shape the response @@ -261,8 +261,8 @@ pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree P.parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v) --- Satisfies the form: /products?columns=name,suppliers(name) -pRequestColumns :: Maybe Text -> Either QPError (Maybe [Tree FieldName]) +-- Satisfies the form: /products?columns=name,sup:suppliers!fk(name) +pRequestColumns :: Maybe Text -> Either QPError (Maybe [Tree ColumnItem]) pRequestColumns colStr = case colStr of Just str -> @@ -479,11 +479,13 @@ pRelationSelect = lexeme $ do try (void $ lookAhead (string "(")) return $ SelectRelation name alias hint jType -pRelationColumn :: Parser FieldName +pRelationColumn :: Parser ColumnItem pRelationColumn = lexeme $ do + alias <- optionMaybe ( try(pFieldName <* aliasSeparator) ) name <- pFieldName + (hint, _) <- pEmbedParams try (void $ lookAhead (string "(")) - return name + return $ ColumnRelation name alias hint -- | -- Parse regular fields in select @@ -852,17 +854,17 @@ pLogicPath = do pColumns :: Parser [FieldName] pColumns = pFieldName `sepBy1` lexeme (char ',') -pColumnForest :: Parser [Tree FieldName] +pColumnForest :: Parser [Tree ColumnItem] pColumnForest = pColumnTree `sepBy1` lexeme (char ',') where pColumnTree = Node <$> try pRelationColumn <*> between (char '(') (char ')') pColumnForest <|> Node <$> pColumnName <*> pure [] -pColumnName :: Parser FieldName +pColumnName :: Parser ColumnItem pColumnName = lexeme $ do fld <- pFieldName pEnd - return fld + return $ ColumnField fld where pEnd = try (void $ lookAhead (string ")")) <|> try (void $ lookAhead (string ",")) <|> diff --git a/src/PostgREST/ApiRequest/Types.hs b/src/PostgREST/ApiRequest/Types.hs index e4fb6dc323..d40b4d3395 100644 --- a/src/PostgREST/ApiRequest/Types.hs +++ b/src/PostgREST/ApiRequest/Types.hs @@ -33,6 +33,7 @@ module PostgREST.ApiRequest.Types , QuantOperator(..) , FtsOperator(..) , SelectItem(..) + , ColumnItem(..) ) where import PostgREST.MediaType (MediaType (..)) @@ -68,6 +69,15 @@ data SelectItem } deriving (Eq, Show) +data ColumnItem + = ColumnField FieldName + | ColumnRelation + { colRelation :: FieldName + , colAlias :: Maybe Alias + , colHint :: Maybe Hint + } + deriving (Eq, Show, Ord) + data ApiRequestError = AggregatesNotAllowed | AmbiguousRelBetween Text Text [Relationship] diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index 58b57ae997..12d535103f 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -170,7 +170,7 @@ callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} invMethod = do let paramKeys = case invMethod of InvRead _ -> S.fromList $ fst <$> qsParams' - Inv -> S.map rootLabel iColumns + Inv -> S.map (getColumnAsText . rootLabel) iColumns proc@Function{..} <- mapLeft ApiRequestError $ findProc identifier paramKeys (preferParameters == Just SingleObject) (dbRoutines sCache) iContentMediaType (invMethod == Inv) let relIdentifier = QualifiedIdentifier pdSchema (fromMaybe pdName $ Routine.funcTableName proc) -- done so a set returning function can embed other relations @@ -942,7 +942,7 @@ mutatePlan mutation qi ApiRequest{iPreferences=Preferences{..}, ..} SchemaCache{ combinedLogic = foldr (addFilterToLogicForest . resolveFilter ctx) logic qsFiltersRoot body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates) applyDefaults = preferMissing == Just ApplyDefaults - typedColumnsOrError = resolveOrError ctx tbl `traverse` S.toList (S.map rootLabel iColumns) + typedColumnsOrError = resolveOrError ctx tbl `traverse` S.toList (S.map (getColumnAsText . rootLabel) iColumns) resolveOrError :: ResolverContext -> Maybe Table -> FieldName -> Either ApiRequestError CoercibleField resolveOrError _ Nothing _ = Left NotFound @@ -1051,3 +1051,9 @@ negotiateContent conf ApiRequest{iAction=act, iPreferences=Preferences{preferRep when' :: Bool -> Maybe a -> Maybe a when' True (Just a) = Just a when' _ _ = Nothing + +getColumnAsText :: ColumnItem -> Text +getColumnAsText colItem = + case colItem of + ColumnField col -> col + ColumnRelation{colRelation} -> colRelation