From 2289defe4b1db9006b310b2e3105b70967db19fb Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Thu, 27 Oct 2022 10:37:05 +0200 Subject: [PATCH] refactor: Use stronger typing for SelectItem parser Signed-off-by: Wolfgang Walther --- src/PostgREST/ApiRequest.hs | 9 +++-- src/PostgREST/ApiRequest/QueryParams.hs | 51 ++++++++++++++++++++++--- src/PostgREST/ApiRequest/Types.hs | 16 +++++++- src/PostgREST/Plan.hs | 13 +++---- src/PostgREST/Plan/ReadPlan.hs | 11 +++--- src/PostgREST/Query/SqlFragment.hs | 16 ++++---- 6 files changed, 85 insertions(+), 31 deletions(-) diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index b2c79343f..dba5486a5 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -51,7 +51,8 @@ import PostgREST.ApiRequest.Preferences (PreferCount (..), PreferTransaction (..)) import PostgREST.ApiRequest.QueryParams (QueryParams (..)) import PostgREST.ApiRequest.Types (ApiRequestError (..), - RangeError (..), SelectItem) + RangeError (..), + SelectItem (..)) import PostgREST.Config (AppConfig (..), OpenAPIMode (..)) import PostgREST.MediaType (MTPlanAttrs (..), @@ -528,6 +529,6 @@ binaryField AppConfig{configRawMediaTypes} acceptMediaType target QueryParams{qs returnsScalar _ = False fstFieldName :: [Tree SelectItem] -> Maybe FieldName - fstFieldName [Node (("*", _), Nothing, Nothing, Nothing, Nothing) []] = Nothing - fstFieldName [Node ((fld, _), Nothing, Nothing, Nothing, Nothing) []] = Just fld - fstFieldName _ = Nothing + fstFieldName [Node SelectField{selField=("*", _)} []] = Nothing + fstFieldName [Node SelectField{selField=(fld, _)} []] = Just fld + fstFieldName _ = Nothing diff --git a/src/PostgREST/ApiRequest/QueryParams.hs b/src/PostgREST/ApiRequest/QueryParams.hs index fb13ae1bd..ad3c2d5b4 100644 --- a/src/PostgREST/ApiRequest/QueryParams.hs +++ b/src/PostgREST/ApiRequest/QueryParams.hs @@ -53,7 +53,7 @@ import PostgREST.ApiRequest.Types (EmbedParam (..), EmbedPath, Field, Operation (..), OrderDirection (..), OrderNulls (..), OrderTerm (..), - QPError (..), SelectItem, + QPError (..), SelectItem (..), SimpleOperator (..), SingleVal, TrileanVal (..)) @@ -73,6 +73,7 @@ import Protolude hiding (try) -- >>> deriving instance Show JsonOperation -- >>> deriving instance Show Filter -- >>> deriving instance Show JoinType +-- >>> deriving instance Show SelectItem data QueryParams = QueryParams @@ -113,7 +114,7 @@ data QueryParams = -- 'select' is a reserved parameter that selects the fields to be returned: -- -- >>> qsSelect <$> parse "select=name,location" --- Right [Node {rootLabel = (("name",[]),Nothing,Nothing,Nothing,Nothing), subForest = []},Node {rootLabel = (("location",[]),Nothing,Nothing,Nothing,Nothing), subForest = []}] +-- Right [Node {rootLabel = SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SelectField {selField = ("location",[]), selCast = Nothing, selAlias = Nothing}, subForest = []}] -- -- Filters are parameters whose value contains an operator, separated by a '.' from its value: -- @@ -368,13 +369,33 @@ pField = lexeme $ (,) <$> pFieldName <*> P.option [] pJsonPath aliasSeparator :: Parser () aliasSeparator = char ':' >> notFollowedBy (char ':') +-- | +-- Parse regular fields in select +-- +-- >>> P.parse pRelationSelect "" "rel(*)" +-- Right (SelectRelation {selField = ("rel",[]), selAlias = Nothing, selHint = Nothing, selJoinType = Nothing}) +-- +-- >>> P.parse pRelationSelect "" "alias:rel(*)" +-- Right (SelectRelation {selField = ("rel",[]), selAlias = Just "alias", selHint = Nothing, selJoinType = Nothing}) +-- +-- >>> P.parse pRelationSelect "" "rel!hint(*)" +-- Right (SelectRelation {selField = ("rel",[]), selAlias = Nothing, selHint = Just "hint", selJoinType = Nothing}) +-- +-- >>> P.parse pRelationSelect "" "rel!inner(*)" +-- Right (SelectRelation {selField = ("rel",[]), selAlias = Nothing, selHint = Nothing, selJoinType = Just JTInner}) +-- +-- >>> P.parse pRelationSelect "" "rel!hint!inner(*)" +-- Right (SelectRelation {selField = ("rel",[]), selAlias = Nothing, selHint = Just "hint", selJoinType = Just JTInner}) +-- +-- >>> P.parse pRelationSelect "" "alias:rel!inner!hint(*)" +-- Right (SelectRelation {selField = ("rel",[]), selAlias = Just "alias", selHint = Just "hint", selJoinType = Just JTInner}) pRelationSelect :: Parser SelectItem pRelationSelect = lexeme $ try ( do alias <- optionMaybe ( try(pFieldName <* aliasSeparator) ) fld <- pField prm1 <- optionMaybe pEmbedParam prm2 <- optionMaybe pEmbedParam - return (fld, Nothing, alias, embedParamHint prm1 <|> embedParamHint prm2, embedParamJoin prm1 <|> embedParamJoin prm2) + return $ SelectRelation fld alias (embedParamHint prm1 <|> embedParamHint prm2) (embedParamJoin prm1 <|> embedParamJoin prm2) ) where pEmbedParam :: Parser EmbedParam @@ -390,6 +411,26 @@ pRelationSelect = lexeme $ try ( do Just (EPJoinType jt) -> Just jt _ -> Nothing +-- | +-- Parse regular fields in select +-- +-- >>> P.parse pFieldSelect "" "name" +-- Right (SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Nothing}) +-- +-- >>> P.parse pFieldSelect "" "name->jsonpath" +-- Right (SelectField {selField = ("name",[JArrow {jOp = JKey {jVal = "jsonpath"}}]), selCast = Nothing, selAlias = Nothing}) +-- +-- >>> P.parse pFieldSelect "" "name::cast" +-- Right (SelectField {selField = ("name",[]), selCast = Just "cast", selAlias = Nothing}) +-- +-- >>> P.parse pFieldSelect "" "alias:name" +-- Right (SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Just "alias"}) +-- +-- >>> P.parse pFieldSelect "" "alias:name->jsonpath::cast" +-- Right (SelectField {selField = ("name",[JArrow {jOp = JKey {jVal = "jsonpath"}}]), selCast = Just "cast", selAlias = Just "alias"}) +-- +-- >>> P.parse pFieldSelect "" "*" +-- Right (SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing}) pFieldSelect :: Parser SelectItem pFieldSelect = lexeme $ try ( @@ -397,11 +438,11 @@ pFieldSelect = lexeme $ alias <- optionMaybe ( try(pFieldName <* aliasSeparator) ) fld <- pField cast' <- optionMaybe (string "::" *> many pIdentifierChar) - return (fld, toS <$> cast', alias, Nothing, Nothing) + return $ SelectField fld (toS <$> cast') alias ) <|> do s <- pStar - return ((s, []), Nothing, Nothing, Nothing, Nothing) + return $ SelectField (s, []) Nothing Nothing pOpExpr :: Parser SingleVal -> Parser OpExpr pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation diff --git a/src/PostgREST/ApiRequest/Types.hs b/src/PostgREST/ApiRequest/Types.hs index d66e4f87d..5d7e4f3e5 100644 --- a/src/PostgREST/ApiRequest/Types.hs +++ b/src/PostgREST/ApiRequest/Types.hs @@ -28,7 +28,7 @@ module PostgREST.ApiRequest.Types , TrileanVal(..) , SimpleOperator(..) , FtsOperator(..) - , SelectItem + , SelectItem(..) ) where import PostgREST.MediaType (MediaType (..)) @@ -39,7 +39,19 @@ import PostgREST.SchemaCache.Relationship (Relationship) import Protolude -- | The select value in `/tbl?select=alias:field::cast` -type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType) +data SelectItem + = SelectField + { selField :: Field + , selCast :: Maybe Cast + , selAlias :: Maybe Alias + } + | SelectRelation + { selField :: Field + , selAlias :: Maybe Alias + , selHint :: Maybe Hint + , selJoinType :: Maybe JoinType + } + deriving (Eq) data ApiRequestError = AmbiguousRelBetween Text Text [Relationship] diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index fd5982991..4442f3ce5 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -109,14 +109,13 @@ initReadRequest qi@QualifiedIdentifier{..} = rootDepth = 0 defReadPlan = ReadPlan [] (QualifiedIdentifier mempty mempty) Nothing [] [] allRange mempty Nothing [] Nothing mempty Nothing Nothing rootDepth treeEntry :: Depth -> Tree SelectItem -> ReadPlanTree -> ReadPlanTree - treeEntry depth (Node fld@((fldName, _),_,alias, hint, joinType) fldForest) (Node q rForest) = + treeEntry depth (Node SelectRelation{..} fldForest) (Node q rForest) = let nxtDepth = succ depth in - case fldForest of - [] -> Node q{select=fld:select q} rForest - _ -> Node q $ - foldr (treeEntry nxtDepth) - (Node defReadPlan{from=QualifiedIdentifier qiSchema fldName, relName=fldName, relAlias=alias, relHint=hint, relJoinType=joinType, depth=nxtDepth} []) - fldForest:rForest + Node q $ + foldr (treeEntry nxtDepth) + (Node defReadPlan{from=QualifiedIdentifier qiSchema (fst selField), relName=fst selField, relAlias=selAlias, relHint=selHint, relJoinType=selJoinType, depth=nxtDepth} []) + fldForest:rForest + treeEntry _ (Node SelectField{..} _) (Node q rForest) = Node q{select=(selField, selCast, selAlias):select q} rForest -- | Enforces the `max-rows` config on the result treeRestrictRange :: Maybe Integer -> Action -> ReadPlanTree -> Either ApiRequestError ReadPlanTree diff --git a/src/PostgREST/Plan/ReadPlan.hs b/src/PostgREST/Plan/ReadPlan.hs index 05082328a..95566576c 100644 --- a/src/PostgREST/Plan/ReadPlan.hs +++ b/src/PostgREST/Plan/ReadPlan.hs @@ -8,10 +8,9 @@ module PostgREST.Plan.ReadPlan import Data.Tree (Tree (..)) -import PostgREST.ApiRequest.Types (Alias, Depth, Hint, - JoinType, LogicTree, - NodeName, OrderTerm, - SelectItem) +import PostgREST.ApiRequest.Types (Alias, Cast, Depth, Field, + Hint, JoinType, LogicTree, + NodeName, OrderTerm) import PostgREST.RangeQuery (NonnegRange) import PostgREST.SchemaCache.Identifiers (FieldName, QualifiedIdentifier) @@ -29,7 +28,7 @@ data JoinCondition = deriving (Eq) data ReadPlan = ReadPlan - { select :: [SelectItem] + { select :: [(Field, Maybe Cast, Maybe Alias)] , from :: QualifiedIdentifier , fromAlias :: Maybe Alias , where_ :: [LogicTree] @@ -50,4 +49,4 @@ data ReadPlan = ReadPlan -- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d)) fstFieldNames :: ReadPlanTree -> [FieldName] fstFieldNames (Node ReadPlan{select} _) = - fst . (\(f, _, _, _, _) -> f) <$> select + fst . (\(f, _, _) -> f) <$> select diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index 7525df6f1..24eb20e6b 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes #-} {-| Module : PostgREST.Query.SqlFragment Description : Helper functions for PostgREST.QueryBuilder. @@ -56,7 +57,8 @@ import Control.Arrow ((***)) import Data.Foldable (foldr1) import Text.InterpolatedString.Perl6 (qc) -import PostgREST.ApiRequest.Types (Alias, Field, Filter (..), +import PostgREST.ApiRequest.Types (Alias, Cast, Field, + Filter (..), FtsOperator (..), JsonOperand (..), JsonOperation (..), @@ -66,7 +68,7 @@ import PostgREST.ApiRequest.Types (Alias, Field, Filter (..), Operation (..), OrderDirection (..), OrderNulls (..), - OrderTerm (..), SelectItem, + OrderTerm (..), SimpleOperator (..), TrileanVal (..)) import PostgREST.MediaType (MTPlanFormat (..), @@ -233,12 +235,12 @@ pgFmtField table (c, []) = SQL.sql (pgFmtColumn table c) -- "operator does not exist: json = unknown" pgFmtField table (c, jp) = SQL.sql ("to_jsonb(" <> pgFmtColumn table c <> ")") <> pgFmtJsonPath jp -pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet -pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias) +pgFmtSelectItem :: QualifiedIdentifier -> (Field, Maybe Cast, Maybe Alias) -> SQL.Snippet +pgFmtSelectItem table (f@(fName, jp), Nothing, alias) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias) -- Ideally we'd quote the cast with "pgFmtIdent cast". However, that would invalidate common casts such as "int", "bigint", etc. -- Try doing: `select 1::"bigint"` - it'll err, using "int8" will work though. There's some parser magic that pg does that's invalidated when quoting. -- Not quoting should be fine, we validate the input on Parsers. -pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _, _) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias) +pgFmtSelectItem table (f@(fName, jp), Just cast, alias) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias) pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SQL.Snippet pgFmtOrderTerm qi ot =