From 1715ae49db7c59f9fa219e440482cd83af2c6a7e Mon Sep 17 00:00:00 2001 From: Laurence Isla Date: Thu, 10 Oct 2024 17:41:09 -0500 Subject: [PATCH] feat: allow spreading one-to-many and many-to-many embedded resources The selected columns in the embedded resources are aggregated into arrays --- CHANGELOG.md | 2 + src/PostgREST/ApiRequest/Types.hs | 3 +- src/PostgREST/Error.hs | 10 +- src/PostgREST/Plan.hs | 111 ++++- src/PostgREST/Plan/ReadPlan.hs | 34 +- src/PostgREST/Query.hs | 6 +- src/PostgREST/Query/QueryBuilder.hs | 31 +- src/PostgREST/Query/SqlFragment.hs | 26 +- .../Feature/Query/AggregateFunctionsSpec.hs | 469 +++++++++++++----- test/spec/Feature/Query/SpreadQueriesSpec.hs | 396 ++++++++++++++- test/spec/fixtures/data.sql | 35 +- test/spec/fixtures/schema.sql | 18 + 12 files changed, 912 insertions(+), 229 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b0e3d1ee48..78c795bdac 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,8 @@ This project adheres to [Semantic Versioning](http://semver.org/). - #2858, Performance improvements when calling RPCs via GET using indexes in more cases - @wolfgangwalther - #3560, Log resolved host in "Listening on ..." messages - @develop7 - #3727, Log maximum pool size - @steve-chavez + - #3041, Allow spreading one-to-many and many-to-many embedded resources - @laurenceisla + + The selected columns in the embedded resources are aggregated into arrays ### Fixed diff --git a/src/PostgREST/ApiRequest/Types.hs b/src/PostgREST/ApiRequest/Types.hs index c595cb9483..32e3a9599d 100644 --- a/src/PostgREST/ApiRequest/Types.hs +++ b/src/PostgREST/ApiRequest/Types.hs @@ -86,7 +86,6 @@ data ApiRequestError | PutLimitNotAllowedError | QueryParamError QPError | RelatedOrderNotToOne Text Text - | SpreadNotToOne Text Text | UnacceptableFilter Text | UnacceptableSchema [Text] | UnsupportedMethod ByteString @@ -145,7 +144,7 @@ type Cast = Text type Alias = Text type Hint = Text -data AggregateFunction = Sum | Avg | Max | Min | Count +data AggregateFunction = Sum | Avg | Max | Min | Count | ArrayAgg { aaFilters :: [FieldName] } deriving (Show, Eq) data EmbedParam diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 9c7d6d3a6f..cacc2702d9 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -80,7 +80,6 @@ instance PgrstError ApiRequestError where status PutLimitNotAllowedError = HTTP.status400 status QueryParamError{} = HTTP.status400 status RelatedOrderNotToOne{} = HTTP.status400 - status SpreadNotToOne{} = HTTP.status400 status UnacceptableFilter{} = HTTP.status400 status UnacceptableSchema{} = HTTP.status406 status UnsupportedMethod{} = HTTP.status405 @@ -176,12 +175,6 @@ instance JSON.ToJSON ApiRequestError where (Just $ JSON.String $ "'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship") Nothing - toJSON (SpreadNotToOne origin target) = toJsonPgrstError - ApiRequestErrorCode19 - ("A spread operation on '" <> target <> "' is not possible") - (Just $ JSON.String $ "'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship") - Nothing - toJSON (UnacceptableFilter target) = toJsonPgrstError ApiRequestErrorCode20 ("Bad operator on the '" <> target <> "' embedded resource") @@ -629,7 +622,7 @@ data ErrorCode | ApiRequestErrorCode16 | ApiRequestErrorCode17 | ApiRequestErrorCode18 - | ApiRequestErrorCode19 + -- | ApiRequestErrorCode19 -- no longer used (used to be mapped to SpreadNotToOne) | ApiRequestErrorCode20 | ApiRequestErrorCode21 | ApiRequestErrorCode22 @@ -678,7 +671,6 @@ buildErrorCode code = case code of ApiRequestErrorCode16 -> "PGRST116" ApiRequestErrorCode17 -> "PGRST117" ApiRequestErrorCode18 -> "PGRST118" - ApiRequestErrorCode19 -> "PGRST119" ApiRequestErrorCode20 -> "PGRST120" ApiRequestErrorCode21 -> "PGRST121" ApiRequestErrorCode22 -> "PGRST122" diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index 926ab3f9e2..e8f4dc377e 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -332,13 +332,14 @@ readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows, configDbAggregate in mapLeft ApiRequestError $ treeRestrictRange configDbMaxRows (iAction apiRequest) =<< + addFiltersToArrayAgg ctx =<< hoistSpreadAggFunctions =<< validateAggFunctions configDbAggregates =<< addRelSelects =<< addNullEmbedFilters =<< - validateSpreadEmbeds =<< addRelatedOrders =<< addAliases =<< + addArrayAggToManySpread =<< expandStars ctx =<< addRels qiSchema (iAction apiRequest) dbRelationships Nothing =<< addLogicTrees ctx apiRequest =<< @@ -352,7 +353,7 @@ initReadRequest ctx@ResolverContext{qi=QualifiedIdentifier{..}} = foldr (treeEntry rootDepth) $ Node defReadPlan{from=qi ctx, relName=qiName, depth=rootDepth} [] where rootDepth = 0 - defReadPlan = ReadPlan [] (QualifiedIdentifier mempty mempty) Nothing [] [] allRange mempty Nothing [] Nothing mempty Nothing Nothing False [] rootDepth + defReadPlan = ReadPlan [] (QualifiedIdentifier mempty mempty) Nothing [] [] allRange mempty Nothing [] Nothing mempty Nothing Nothing False False [] rootDepth treeEntry :: Depth -> Tree SelectItem -> ReadPlanTree -> ReadPlanTree treeEntry depth (Node si fldForest) (Node q rForest) = let nxtDepth = succ depth in @@ -417,13 +418,14 @@ knownColumnsInContext ResolverContext{..} = -- | Expand "select *" into explicit field names of the table in the following situations: -- * When there are data representations present. -- * When there is an aggregate function in a given ReadPlan or its parent. +-- * When the ReadPlan or any of its children is a spread embed nested inside a to-many spread relationship (array aggregate). expandStars :: ResolverContext -> ReadPlanTree -> Either ApiRequestError ReadPlanTree expandStars ctx rPlanTree = Right $ expandStarsForReadPlan False rPlanTree where expandStarsForReadPlan :: Bool -> ReadPlanTree -> ReadPlanTree - expandStarsForReadPlan hasAgg (Node rp@ReadPlan{select, from=fromQI, fromAlias=alias} children) = + expandStarsForReadPlan hasAgg rpt@(Node rp@ReadPlan{select, from=fromQI, fromAlias=alias} children) = let - newHasAgg = hasAgg || any (isJust . csAggFunction) select + newHasAgg = hasAgg || any (isJust . csAggFunction) select || any (spreadRelIsNestedInToMany . rootLabel) (rpt:children) newCtx = adjustContext ctx fromQI alias newRPlan = expandStarsForTable newCtx newHasAgg rp in Node newRPlan (map (expandStarsForReadPlan newHasAgg) children) @@ -474,18 +476,18 @@ treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> reque addRels :: Schema -> Action -> RelationshipsMap -> Maybe ReadPlanTree -> ReadPlanTree -> Either ApiRequestError ReadPlanTree addRels schema action allRels parentNode (Node rPlan@ReadPlan{relName,relHint,relAlias,depth} forest) = case parentNode of - Just (Node ReadPlan{from=parentNodeQi, fromAlias=parentAlias} _) -> + Just (Node pr@ReadPlan{from=parentNodeQi, fromAlias=parentAlias} _) -> let newReadPlan = (\r -> let newAlias = Just (qiName (relForeignTable r) <> "_" <> show depth) aggAlias = qiName (relTable r) <> "_" <> fromMaybe relName relAlias <> "_" <> show depth in case r of Relationship{relCardinality=M2M _} -> -- m2m does internal implicit joins that don't need aliasing - rPlan{from=relForeignTable r, relToParent=Just r, relAggAlias=aggAlias, relJoinConds=getJoinConditions Nothing parentAlias r} + rPlan{from=relForeignTable r, relToParent=Just r, relAggAlias=aggAlias, relJoinConds=getJoinConditions Nothing parentAlias r, relIsInToManySpread=spreadRelIsNestedInToMany pr} ComputedRelationship{} -> - rPlan{from=relForeignTable r, relToParent=Just r{relTableAlias=maybe (relTable r) (QualifiedIdentifier mempty) parentAlias}, relAggAlias=aggAlias, fromAlias=newAlias} + rPlan{from=relForeignTable r, relToParent=Just r{relTableAlias=maybe (relTable r) (QualifiedIdentifier mempty) parentAlias}, relAggAlias=aggAlias, fromAlias=newAlias, relIsInToManySpread=spreadRelIsNestedInToMany pr} _ -> - rPlan{from=relForeignTable r, relToParent=Just r, relAggAlias=aggAlias, fromAlias=newAlias, relJoinConds=getJoinConditions newAlias parentAlias r} + rPlan{from=relForeignTable r, relToParent=Just r, relAggAlias=aggAlias, fromAlias=newAlias, relJoinConds=getJoinConditions newAlias parentAlias r, relIsInToManySpread=spreadRelIsNestedInToMany pr} ) <$> rel origin = if depth == 1 -- Only on depth 1 we check if the root(depth 0) has an alias so the sourceCTEName alias can be found as a relationship then fromMaybe (qiName parentNodeQi) parentAlias @@ -509,6 +511,10 @@ addRels schema action allRels parentNode (Node rPlan@ReadPlan{relName,relHint,re updateForest :: Maybe ReadPlanTree -> Either ApiRequestError [ReadPlanTree] updateForest rq = addRels schema action allRels rq `traverse` forest +spreadRelIsNestedInToMany :: ReadPlan -> Bool +spreadRelIsNestedInToMany ReadPlan{relIsSpread, relToParent, relIsInToManySpread} = + relIsSpread && (relIsInToManySpread || Just False == (relIsToOne <$> relToParent)) + getJoinConditions :: Maybe Alias -> Maybe Alias -> Relationship -> [JoinCondition] getJoinConditions _ _ ComputedRelationship{} = [] getJoinConditions tblAlias parentAlias Relationship{relTable=qi,relForeignTable=fQi,relCardinality=card} = @@ -616,6 +622,22 @@ findRel schema allRels origin target hint = ) ) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels +-- Add ArrayAgg aggregates to selected fields that do not have other aggregates and: +-- * Are selected inside a to-many spread relationship +-- * Are selected inside a to-one spread relationship but are nested inside a to-many spread relationship at any level +addArrayAggToManySpread :: ReadPlanTree -> Either ApiRequestError ReadPlanTree +addArrayAggToManySpread (Node rp@ReadPlan{select} forest) = + let newForest = addArrayAggToManySpread `traverse` forest + newSelects + | shouldAddArrayAgg = fieldToArrayAgg <$> select + | otherwise = select + in Node rp { select = newSelects } <$> newForest + where + shouldAddArrayAgg = spreadRelIsNestedInToMany rp + fieldToArrayAgg field + | isJust $ csAggFunction field = field + | otherwise = field { csAggFunction = Just $ ArrayAgg [], csAlias = newAlias (csAlias field) (cfName $ csField field) } + newAlias alias fieldName = maybe (Just fieldName) pure alias addRelSelects :: ReadPlanTree -> Either ApiRequestError ReadPlanTree addRelSelects node@(Node rp forest) @@ -628,11 +650,12 @@ addRelSelects node@(Node rp forest) generateRelSelectField :: ReadPlanTree -> Maybe RelSelectField generateRelSelectField (Node rp@ReadPlan{relToParent=Just _, relAggAlias, relIsSpread = True} _) = Just $ Spread { rsSpreadSel = generateSpreadSelectFields rp, rsAggAlias = relAggAlias } -generateRelSelectField (Node ReadPlan{relToParent=Just rel, select, relName, relAlias, relAggAlias, relIsSpread = False} forest) = +generateRelSelectField (Node ReadPlan{relToParent=Just rel, select, relName, relAlias, relAggAlias, relIsSpread = False, relIsInToManySpread} forest) = Just $ JsonEmbed { rsEmbedMode, rsSelName, rsAggAlias = relAggAlias, rsEmptyEmbed } where rsSelName = fromMaybe relName relAlias - rsEmbedMode = if relIsToOne rel then JsonObject else JsonArray + -- If the JsonEmbed is nested in a to-many spread relationship, it will be aggregated at the top. That's why we treat it as `JsonObject`. + rsEmbedMode = if relIsToOne rel || relIsInToManySpread then JsonObject else JsonArray rsEmptyEmbed = hasOnlyNullEmbed (null select) forest hasOnlyNullEmbed = foldr checkIfNullEmbed checkIfNullEmbed :: ReadPlanTree -> Bool -> Bool @@ -641,7 +664,7 @@ generateRelSelectField (Node ReadPlan{relToParent=Just rel, select, relName, rel generateRelSelectField _ = Nothing generateSpreadSelectFields :: ReadPlan -> [SpreadSelectField] -generateSpreadSelectFields ReadPlan{select, relSelect} = +generateSpreadSelectFields rp@ReadPlan{select, relSelect} = -- We combine the select and relSelect fields into a single list of SpreadSelectField. selectSpread ++ relSelectSpread where @@ -653,10 +676,59 @@ generateSpreadSelectFields ReadPlan{select, relSelect} = relSelectSpread = concatMap relSelectToSpread relSelect relSelectToSpread :: RelSelectField -> [SpreadSelectField] relSelectToSpread (JsonEmbed{rsSelName}) = - [SpreadSelectField { ssSelName = rsSelName, ssSelAggFunction = Nothing, ssSelAggCast = Nothing, ssSelAlias = Nothing }] + -- The regular embeds that are nested inside spread to-many relationships are also aggregated in an array + let (aggFun, alias) = if spreadRelIsNestedInToMany rp then (Just $ ArrayAgg [], Just rsSelName) else (Nothing, Nothing) in + [SpreadSelectField { ssSelName = rsSelName, ssSelAggFunction = aggFun, ssSelAggCast = Nothing, ssSelAlias = alias }] relSelectToSpread (Spread{rsSpreadSel}) = rsSpreadSel +addFiltersToArrayAgg :: ResolverContext -> ReadPlanTree -> Either ApiRequestError ReadPlanTree +addFiltersToArrayAgg ctx rpt = Right $ applyAddArrayAggFilters ctx [] rpt + +applyAddArrayAggFilters :: ResolverContext -> [(Alias, [CoercibleSelectField])] -> ReadPlanTree -> ReadPlanTree +applyAddArrayAggFilters ctx pkSelectFields (Node rp@ReadPlan{select, relSelect, relAggAlias} forest) = + let newForest = applyAddArrayAggFilters ctx getFKSelectFields <$> forest + newSelects + | null pkSelectFields = select + | otherwise = select ++ fromMaybe mempty (lookup relAggAlias pkSelectFields) + newRelSelects + | null getFKAliases = relSelect + | otherwise = buildFKRelSelect <$> relSelect + in Node rp { select = newSelects, relSelect = newRelSelects } newForest + where + -- Verify if the current node has an array aggregate in the relSelect + spreadHasArrAgg Spread{rsSpreadSel} = any (\case Just (ArrayAgg _) -> True; _ -> False; . ssSelAggFunction) rsSpreadSel + spreadHasArrAgg _ = False + aggSpreads = mapMaybe (\r -> if spreadHasArrAgg r then Just (rsAggAlias r) else Nothing) relSelect + + -- If it has array aggregates, navigate the children nodes to get the unique FK that will be used as filters for said aggregates + allFKSelectFieldsAndAliases = mapMaybe findFKField forest + findFKField :: ReadPlanTree -> Maybe ((Alias, [Alias]), (Alias, [CoercibleSelectField])) + findFKField (Node ReadPlan{relAggAlias=childAggAlias, from=childTbl, relToParent=childToParent} _) = + if childAggAlias `elem` aggSpreads + then Just ((childAggAlias, fst fkFlds), (childAggAlias, snd fkFlds)) + else Nothing + where + fkAlias field = childAggAlias <> "_" <> field <> "_fk" + toSelectField fld = CoercibleSelectField (resolveOutputField ctx{qi=childTbl} (fld, mempty)) Nothing Nothing Nothing (Just $ fkAlias fld) + fkFlds = unzip $ map (\fk -> (fkAlias fk, toSelectField fk)) + (case childToParent of + Just Relationship{relCardinality = M2M j} -> fst <$> junColsTarget j + Just Relationship{relCardinality = O2M _ cols} -> snd <$> cols + _ -> mempty) + + (getFKAliases, getFKSelectFields) = unzip allFKSelectFieldsAndAliases + + -- Add the FKFields to every ArrayAgg of the respective Spread relSelect + buildFKRelSelect rs@Spread{rsAggAlias=rsAlias, rsSpreadSel=rsSel} = + case lookup rsAlias getFKAliases of + Just fkAliases -> rs{rsSpreadSel= addFilterToArrAgg fkAliases <$> rsSel} + _ -> rs + buildFKRelSelect rs = rs + addFilterToArrAgg fkAliases sel = case ssSelAggFunction sel of + Just (ArrayAgg _) -> sel{ssSelAggFunction = Just $ ArrayAgg fkAliases} + _ -> sel + -- When aggregates are present in a ReadPlan that will be spread, we "hoist" -- to the highest level possible so that their semantics make sense. For instance, -- imagine the user performs the following request: @@ -739,7 +811,7 @@ hoistIntoRelSelectFields _ r = r validateAggFunctions :: Bool -> ReadPlanTree -> Either ApiRequestError ReadPlanTree validateAggFunctions aggFunctionsAllowed (Node rp@ReadPlan {select} forest) - | not aggFunctionsAllowed && any (isJust . csAggFunction) select = Left AggregatesNotAllowed + | not aggFunctionsAllowed && any (maybe False (\case ArrayAgg _ -> False; _ -> True) . csAggFunction) select = Left AggregatesNotAllowed | otherwise = Node rp <$> traverse (validateAggFunctions aggFunctionsAllowed) forest addFilters :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree @@ -815,7 +887,7 @@ addRelatedOrders (Node rp@ReadPlan{order,from} forest) = do -- relName = "projects", -- relToParent = Nothing, -- relJoinConds = [], --- relAlias = Nothing, relAggAlias = "clients_projects_1", relHint = Nothing, relJoinType = Nothing, relIsSpread = False, depth = 1, +-- relAlias = Nothing, relAggAlias = "clients_projects_1", relHint = Nothing, relJoinType = Nothing, relIsSpread = False, relIsInToManySpread = False, depth = 1, -- relSelect = [] -- }, -- subForest = [] @@ -841,7 +913,7 @@ addRelatedOrders (Node rp@ReadPlan{order,from} forest) = do -- ) -- ], -- order = [], range_ = fullRange, relName = "clients", relToParent = Nothing, relJoinConds = [], relAlias = Nothing, relAggAlias = "", relHint = Nothing, --- relJoinType = Nothing, relIsSpread = False, depth = 0, +-- relJoinType = Nothing, relIsSpread = False, relIsInToManySpread = False, depth = 0, -- relSelect = [] -- }, -- subForest = subForst @@ -906,15 +978,6 @@ resolveLogicTree ctx (Expr b op lts) = CoercibleExpr b op (map (resolveLogicTree resolveFilter :: ResolverContext -> Filter -> CoercibleFilter resolveFilter ctx (Filter fld opExpr) = CoercibleFilter{field=resolveQueryInputField ctx fld, opExpr=opExpr} --- Validates that spread embeds are only done on to-one relationships -validateSpreadEmbeds :: ReadPlanTree -> Either ApiRequestError ReadPlanTree -validateSpreadEmbeds (Node rp@ReadPlan{relToParent=Nothing} forest) = Node rp <$> validateSpreadEmbeds `traverse` forest -validateSpreadEmbeds (Node rp@ReadPlan{relIsSpread,relToParent=Just rel,relName} forest) = do - validRP <- if relIsSpread && not (relIsToOne rel) - then Left $ SpreadNotToOne (qiName $ relTable rel) relName -- TODO using relTable is not entirely right because ReadPlan might have an alias, need to store the parent alias on ReadPlan - else Right rp - Node validRP <$> validateSpreadEmbeds `traverse` forest - -- Find a Node of the Tree and apply a function to it updateNode :: (a -> ReadPlanTree -> ReadPlanTree) -> (EmbedPath, a) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree updateNode f ([], a) rr = f a <$> rr diff --git a/src/PostgREST/Plan/ReadPlan.hs b/src/PostgREST/Plan/ReadPlan.hs index 854cf1ffa7..c4b5ebaca0 100644 --- a/src/PostgREST/Plan/ReadPlan.hs +++ b/src/PostgREST/Plan/ReadPlan.hs @@ -29,22 +29,24 @@ data JoinCondition = deriving (Eq, Show) data ReadPlan = ReadPlan - { select :: [CoercibleSelectField] - , from :: QualifiedIdentifier - , fromAlias :: Maybe Alias - , where_ :: [CoercibleLogicTree] - , order :: [CoercibleOrderTerm] - , range_ :: NonnegRange - , relName :: NodeName - , relToParent :: Maybe Relationship - , relJoinConds :: [JoinCondition] - , relAlias :: Maybe Alias - , relAggAlias :: Alias - , relHint :: Maybe Hint - , relJoinType :: Maybe JoinType - , relIsSpread :: Bool - , relSelect :: [RelSelectField] - , depth :: Depth + { select :: [CoercibleSelectField] + , from :: QualifiedIdentifier + , fromAlias :: Maybe Alias + , where_ :: [CoercibleLogicTree] + , order :: [CoercibleOrderTerm] + , range_ :: NonnegRange + , relName :: NodeName + , relToParent :: Maybe Relationship + , relJoinConds :: [JoinCondition] + , relAlias :: Maybe Alias + , relAggAlias :: Alias + , relHint :: Maybe Hint + , relJoinType :: Maybe JoinType + , relIsSpread :: Bool + , relIsInToManySpread :: Bool + -- ^ save in cache to avoid recursing the tree every time we need to check if the rel is nested in a to-many spread + , relSelect :: [RelSelectField] + , depth :: Depth -- ^ used for aliasing } deriving (Eq, Show) diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index 17c5854708..4845f97ded 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -114,7 +114,7 @@ actionQuery (DbCrud plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiReque resultSet <- lift . SQL.statement mempty $ Statements.prepareRead - (QueryBuilder.readPlanToQuery wrReadPlan) + (QueryBuilder.readPlanToQuery wrReadPlan wrHandler) (if preferCount == Just EstimatedCount then -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows) @@ -163,7 +163,7 @@ actionQuery (DbCall plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{ Statements.prepareCall crProc (QueryBuilder.callPlanToQuery crCallPlan pgVer) - (QueryBuilder.readPlanToQuery crReadPlan) + (QueryBuilder.readPlanToQuery crReadPlan crHandler) (QueryBuilder.readPlanToCountQuery crReadPlan) (shouldCount preferCount) crMedia @@ -198,7 +198,7 @@ writeQuery readPlan mutatePlan mType mHandler ApiRequest{iPreferences=Preference in lift . SQL.statement mempty $ Statements.prepareWrite - (QueryBuilder.readPlanToQuery readPlan) + (QueryBuilder.readPlanToQuery readPlan mHandler) (QueryBuilder.mutatePlanToQuery mutatePlan) isInsert isPut diff --git a/src/PostgREST/Query/QueryBuilder.hs b/src/PostgREST/Query/QueryBuilder.hs index 602ae27ef1..371838e4cf 100644 --- a/src/PostgREST/Query/QueryBuilder.hs +++ b/src/PostgREST/Query/QueryBuilder.hs @@ -32,7 +32,8 @@ import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..)) import PostgREST.SchemaCache.Relationship (Cardinality (..), Junction (..), Relationship (..)) -import PostgREST.SchemaCache.Routine (RoutineParam (..)) +import PostgREST.SchemaCache.Routine (MediaHandler, + RoutineParam (..)) import PostgREST.ApiRequest.Types import PostgREST.Plan.CallPlan @@ -44,8 +45,8 @@ import PostgREST.RangeQuery (allRange) import Protolude -readPlanToQuery :: ReadPlanTree -> SQL.Snippet -readPlanToQuery node@(Node ReadPlan{select,from=mainQi,fromAlias,where_=logicForest,order, range_=readRange, relToParent, relJoinConds, relSelect} forest) = +readPlanToQuery :: ReadPlanTree -> MediaHandler -> SQL.Snippet +readPlanToQuery node@(Node ReadPlan{select,from=mainQi,fromAlias,where_=logicForest,order, range_=readRange, relToParent, relJoinConds, relSelect} forest) handler = "SELECT " <> intercalateSnippet ", " ((pgFmtSelectItem qi <$> (if null select && null forest then defSelect else select)) ++ joinsSelects) <> " " <> fromFrag <> " " <> @@ -61,11 +62,11 @@ readPlanToQuery node@(Node ReadPlan{select,from=mainQi,fromAlias,where_=logicFor qi = getQualifiedIdentifier relToParent mainQi fromAlias -- gets all the columns in case of an empty select, ignoring/obtaining these columns is done at the aggregation stage defSelect = [CoercibleSelectField (unknownField "*" []) Nothing Nothing Nothing Nothing] - joins = getJoins node - joinsSelects = getJoinSelects node + joins = getJoins node handler + joinsSelects = getJoinSelects node handler -getJoinSelects :: ReadPlanTree -> [SQL.Snippet] -getJoinSelects (Node ReadPlan{relSelect} _) = +getJoinSelects :: ReadPlanTree -> MediaHandler -> [SQL.Snippet] +getJoinSelects (Node ReadPlan{relSelect} _) handler = mapMaybe relSelectToSnippet relSelect where relSelectToSnippet :: RelSelectField -> Maybe SQL.Snippet @@ -80,23 +81,23 @@ getJoinSelects (Node ReadPlan{relSelect} _) = JsonEmbed{rsSelName, rsEmbedMode = JsonArray} -> Just $ "COALESCE( " <> aggAlias <> "." <> aggAlias <> ", '[]') AS " <> pgFmtIdent rsSelName Spread{rsSpreadSel, rsAggAlias} -> - Just $ intercalateSnippet ", " (pgFmtSpreadSelectItem rsAggAlias <$> rsSpreadSel) + Just $ intercalateSnippet ", " (pgFmtSpreadSelectItem rsAggAlias handler <$> rsSpreadSel) -getJoins :: ReadPlanTree -> [SQL.Snippet] -getJoins (Node _ []) = [] -getJoins (Node ReadPlan{relSelect} forest) = +getJoins :: ReadPlanTree -> MediaHandler -> [SQL.Snippet] +getJoins (Node _ []) _ = [] +getJoins (Node ReadPlan{relSelect} forest) handler = map (\fld -> let alias = rsAggAlias fld matchingNode = fromJust $ find (\(Node ReadPlan{relAggAlias} _) -> alias == relAggAlias) forest - in getJoin fld matchingNode + in getJoin fld matchingNode handler ) relSelect -getJoin :: RelSelectField -> ReadPlanTree -> SQL.Snippet -getJoin fld node@(Node ReadPlan{relJoinType} _) = +getJoin :: RelSelectField -> ReadPlanTree -> MediaHandler -> SQL.Snippet +getJoin fld node@(Node ReadPlan{relJoinType} _) handler = let correlatedSubquery sub al cond = (if relJoinType == Just JTInner then "INNER" else "LEFT") <> " JOIN LATERAL ( " <> sub <> " ) AS " <> al <> " ON " <> cond - subquery = readPlanToQuery node + subquery = readPlanToQuery node handler aggAlias = pgFmtIdent $ rsAggAlias fld in case fld of diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index b2e5884140..76ad57067f 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -252,7 +252,7 @@ pgFmtCallUnary :: Text -> SQL.Snippet -> SQL.Snippet pgFmtCallUnary f x = SQL.sql (encodeUtf8 f) <> "(" <> x <> ")" pgFmtField :: QualifiedIdentifier -> CoercibleField -> SQL.Snippet -pgFmtField table CoercibleField{cfFullRow=True} = fromQi table +pgFmtField table CoercibleField{cfFullRow=True} = pgFmtIdent (qiName table) pgFmtField table CoercibleField{cfName=fn, cfJsonPath=[]} = pgFmtColumn table fn pgFmtField table CoercibleField{cfName=fn, cfToJson=doToJson, cfJsonPath=jp} | doToJson = "to_jsonb(" <> pgFmtColumn table fn <> ")" <> pgFmtJsonPath jp | otherwise = pgFmtColumn table fn <> pgFmtJsonPath jp @@ -271,9 +271,9 @@ pgFmtSelectItem :: QualifiedIdentifier -> CoercibleSelectField -> SQL.Snippet pgFmtSelectItem table CoercibleSelectField{csField=fld, csAggFunction=agg, csAggCast=aggCast, csCast=cast, csAlias=alias} = pgFmtApplyAggregate agg aggCast (pgFmtApplyCast cast (pgFmtTableCoerce table fld)) <> pgFmtAs alias -pgFmtSpreadSelectItem :: Alias -> SpreadSelectField -> SQL.Snippet -pgFmtSpreadSelectItem aggAlias SpreadSelectField{ssSelName, ssSelAggFunction, ssSelAggCast, ssSelAlias} = - pgFmtApplyAggregate ssSelAggFunction ssSelAggCast fullSelName <> pgFmtAs ssSelAlias +pgFmtSpreadSelectItem :: Alias -> MediaHandler -> SpreadSelectField -> SQL.Snippet +pgFmtSpreadSelectItem aggAlias handler SpreadSelectField{ssSelName, ssSelAggFunction, ssSelAggCast, ssSelAlias} = + pgFmtApplySpreadAggregate ssSelAggFunction ssSelAggCast aggAlias handler fullSelName <> pgFmtAs ssSelAlias where fullSelName = case ssSelName of "*" -> pgFmtIdent aggAlias <> ".*" @@ -284,11 +284,25 @@ pgFmtApplyAggregate Nothing _ snippet = snippet pgFmtApplyAggregate (Just agg) aggCast snippet = pgFmtApplyCast aggCast aggregatedSnippet where - convertAggFunction :: AggregateFunction -> SQL.Snippet - -- Convert from e.g. Sum (the data type) to SUM convertAggFunction = SQL.sql . BS.map toUpper . BS.pack . show aggregatedSnippet = convertAggFunction agg <> "(" <> snippet <> ")" +pgFmtApplySpreadAggregate :: Maybe AggregateFunction -> Maybe Cast -> Alias -> MediaHandler -> SQL.Snippet -> SQL.Snippet +pgFmtApplySpreadAggregate (Just (ArrayAgg flt)) aggCast relAlias handler snippet = + pgFmtApplyCast aggCast aggregatedSnippet + where + arrayAggStripNulls = case handler of + BuiltinAggArrayJsonStrip -> True + BuiltinAggSingleJson strip -> strip + _ -> False + arrayAggFilter + | arrayAggStripNulls = Just $ snippet <> " IS NOT NULL" + | not (null flt) = Just $ intercalateSnippet " AND " $ (\f -> pgFmtIdent relAlias <> "." <> pgFmtIdent f <> " IS NOT NULL") <$> flt + | otherwise = Nothing + fmtArrayAggFunction = "array_agg(" <> snippet <> ")" <> maybe mempty (\f -> " FILTER (WHERE " <> f <> ")") arrayAggFilter + aggregatedSnippet = "COALESCE(" <> fmtArrayAggFunction <> ",'{}')" +pgFmtApplySpreadAggregate agg aggCast _ _ snippet = pgFmtApplyAggregate agg aggCast snippet + pgFmtApplyCast :: Maybe Cast -> SQL.Snippet -> SQL.Snippet pgFmtApplyCast Nothing snippet = snippet -- Ideally we'd quote the cast with "pgFmtIdent cast". However, that would invalidate common casts such as "int", "bigint", etc. diff --git a/test/spec/Feature/Query/AggregateFunctionsSpec.hs b/test/spec/Feature/Query/AggregateFunctionsSpec.hs index def85cbd52..8f059858b8 100644 --- a/test/spec/Feature/Query/AggregateFunctionsSpec.hs +++ b/test/spec/Feature/Query/AggregateFunctionsSpec.hs @@ -141,155 +141,364 @@ allowed = { matchHeaders = [matchContentTypeJson] } context "performing aggregations on spreaded fields from an embedded resource" $ do - it "supports the use of aggregates on spreaded fields" $ do - get "/budget_expenses?select=total_expenses:expense_amount.sum(),...budget_categories(budget_owner,total_budget:budget_amount.sum())&order=budget_categories(budget_owner)" `shouldRespondWith` - [json|[ - {"total_expenses": 600.52,"budget_owner": "Brian Smith", "total_budget": 2000.42}, - {"total_expenses": 100.22, "budget_owner": "Jane Clarkson","total_budget": 7000.41}, - {"total_expenses": 900.27, "budget_owner": "Sally Hughes", "total_budget": 500.23}]|] - { matchHeaders = [matchContentTypeJson] } - it "supports the use of aggregates on spreaded fields when only aggregates are supplied" $ do - get "/budget_expenses?select=...budget_categories(total_budget:budget_amount.sum())" `shouldRespondWith` - [json|[{"total_budget": 9501.06}]|] - { matchHeaders = [matchContentTypeJson] } - it "supports aggregates from a spread relationships grouped by spreaded fields from other relationships" $ do - get "/processes?select=...process_costs(cost.sum()),...process_categories(name)" `shouldRespondWith` - [json|[ - {"sum": 400.00, "name": "Batch"}, - {"sum": 320.00, "name": "Mass"}]|] - { matchHeaders = [matchContentTypeJson] } - get "/processes?select=...process_costs(cost_sum:cost.sum()),...process_categories(category:name)" `shouldRespondWith` - [json|[ - {"cost_sum": 400.00, "category": "Batch"}, - {"cost_sum": 320.00, "category": "Mass"}]|] - { matchHeaders = [matchContentTypeJson] } - it "supports aggregates on spreaded fields from nested relationships" $ do - get "/process_supervisor?select=...processes(factory_id,...process_costs(cost.sum()))" `shouldRespondWith` - [json|[ - {"factory_id": 3, "sum": 120.00}, - {"factory_id": 2, "sum": 500.00}, - {"factory_id": 1, "sum": 350.00}]|] - { matchHeaders = [matchContentTypeJson] } - get "/process_supervisor?select=...processes(factory_id,...process_costs(cost_sum:cost.sum()))" `shouldRespondWith` - [json|[ - {"factory_id": 3, "cost_sum": 120.00}, - {"factory_id": 2, "cost_sum": 500.00}, - {"factory_id": 1, "cost_sum": 350.00}]|] - { matchHeaders = [matchContentTypeJson] } - it "supports aggregates on spreaded fields from nested relationships, grouped by a regular nested relationship" $ do - get "/process_supervisor?select=...processes(factories(name),...process_costs(cost.sum()))" `shouldRespondWith` - [json|[ - {"factories": {"name": "Factory A"}, "sum": 350.00}, - {"factories": {"name": "Factory B"}, "sum": 500.00}, - {"factories": {"name": "Factory C"}, "sum": 120.00}]|] - { matchHeaders = [matchContentTypeJson] } - get "/process_supervisor?select=...processes(factory:factories(name),...process_costs(cost_sum:cost.sum()))" `shouldRespondWith` - [json|[ - {"factory": {"name": "Factory A"}, "cost_sum": 350.00}, - {"factory": {"name": "Factory B"}, "cost_sum": 500.00}, - {"factory": {"name": "Factory C"}, "cost_sum": 120.00}]|] - { matchHeaders = [matchContentTypeJson] } - it "supports aggregates on spreaded fields from nested relationships, grouped by spreaded fields from other nested relationships" $ do - get "/process_supervisor?select=supervisor_id,...processes(...process_costs(cost.sum()),...process_categories(name))&order=supervisor_id" `shouldRespondWith` - [json|[ - {"supervisor_id": 1, "sum": 220.00, "name": "Batch"}, - {"supervisor_id": 2, "sum": 70.00, "name": "Batch"}, - {"supervisor_id": 2, "sum": 200.00, "name": "Mass"}, - {"supervisor_id": 3, "sum": 180.00, "name": "Batch"}, - {"supervisor_id": 3, "sum": 120.00, "name": "Mass"}, - {"supervisor_id": 4, "sum": 180.00, "name": "Batch"}]|] - { matchHeaders = [matchContentTypeJson] } - get "/process_supervisor?select=supervisor_id,...processes(...process_costs(cost_sum:cost.sum()),...process_categories(category:name))&order=supervisor_id" `shouldRespondWith` - [json|[ - {"supervisor_id": 1, "cost_sum": 220.00, "category": "Batch"}, - {"supervisor_id": 2, "cost_sum": 70.00, "category": "Batch"}, - {"supervisor_id": 2, "cost_sum": 200.00, "category": "Mass"}, - {"supervisor_id": 3, "cost_sum": 180.00, "category": "Batch"}, - {"supervisor_id": 3, "cost_sum": 120.00, "category": "Mass"}, - {"supervisor_id": 4, "cost_sum": 180.00, "category": "Batch"}]|] - { matchHeaders = [matchContentTypeJson] } - it "supports aggregates on spreaded fields from nested relationships, grouped by spreaded fields from other nested relationships, using a nested relationship as top parent" $ do - get "/supervisors?select=name,process_supervisor(...processes(...process_costs(cost.sum()),...process_categories(name)))" `shouldRespondWith` - [json|[ - {"name": "Mary", "process_supervisor": [{"name": "Batch", "sum": 220.00}]}, - {"name": "John", "process_supervisor": [{"name": "Batch", "sum": 70.00}, {"name": "Mass", "sum": 200.00}]}, - {"name": "Peter", "process_supervisor": [{"name": "Batch", "sum": 180.00}, {"name": "Mass", "sum": 120.00}]}, - {"name": "Sarah", "process_supervisor": [{"name": "Batch", "sum": 180.00}]}]|] - { matchHeaders = [matchContentTypeJson] } - get "/supervisors?select=name,process_supervisor(...processes(...process_costs(cost_sum:cost.sum()),...process_categories(category:name)))" `shouldRespondWith` - [json|[ - {"name": "Mary", "process_supervisor": [{"category": "Batch", "cost_sum": 220.00}]}, - {"name": "John", "process_supervisor": [{"category": "Batch", "cost_sum": 70.00}, {"category": "Mass", "cost_sum": 200.00}]}, - {"name": "Peter", "process_supervisor": [{"category": "Batch", "cost_sum": 180.00}, {"category": "Mass", "cost_sum": 120.00}]}, - {"name": "Sarah", "process_supervisor": [{"category": "Batch", "cost_sum": 180.00}]}]|] - { matchHeaders = [matchContentTypeJson] } + context "to-one spread relationships" $ do + it "supports the use of aggregates on spreaded fields" $ do + get "/budget_expenses?select=total_expenses:expense_amount.sum(),...budget_categories(budget_owner,total_budget:budget_amount.sum())&order=budget_categories(budget_owner)" `shouldRespondWith` + [json|[ + {"total_expenses": 600.52,"budget_owner": "Brian Smith", "total_budget": 2000.42}, + {"total_expenses": 100.22, "budget_owner": "Jane Clarkson","total_budget": 7000.41}, + {"total_expenses": 900.27, "budget_owner": "Sally Hughes", "total_budget": 500.23}]|] + { matchHeaders = [matchContentTypeJson] } + it "supports the use of aggregates on spreaded fields when only aggregates are supplied" $ do + get "/budget_expenses?select=...budget_categories(total_budget:budget_amount.sum())" `shouldRespondWith` + [json|[{"total_budget": 9501.06}]|] + { matchHeaders = [matchContentTypeJson] } + it "supports aggregates from a spread relationships grouped by spreaded fields from other relationships" $ do + get "/processes?select=...process_costs(cost.sum()),...process_categories(name)" `shouldRespondWith` + [json|[ + {"sum": 400.00, "name": "Batch"}, + {"sum": 350.00, "name": "Mass"}]|] + { matchHeaders = [matchContentTypeJson] } + get "/processes?select=...process_costs(cost_sum:cost.sum()),...process_categories(category:name)" `shouldRespondWith` + [json|[ + {"cost_sum": 400.00, "category": "Batch"}, + {"cost_sum": 350.00, "category": "Mass"}]|] + { matchHeaders = [matchContentTypeJson] } + it "supports aggregates on spreaded fields from nested relationships" $ do + get "/process_supervisor?select=...processes(factory_id,...process_costs(cost.sum()))" `shouldRespondWith` + [json|[ + {"factory_id": 3, "sum": 110.00}, + {"factory_id": 2, "sum": 500.00}, + {"factory_id": 1, "sum": 350.00}]|] + { matchHeaders = [matchContentTypeJson] } + get "/process_supervisor?select=...processes(factory_id,...process_costs(cost_sum:cost.sum()))" `shouldRespondWith` + [json|[ + {"factory_id": 3, "cost_sum": 110.00}, + {"factory_id": 2, "cost_sum": 500.00}, + {"factory_id": 1, "cost_sum": 350.00}]|] + { matchHeaders = [matchContentTypeJson] } + it "supports aggregates on spreaded fields from nested relationships, grouped by a regular nested relationship" $ do + get "/process_supervisor?select=...processes(factories(name),...process_costs(cost.sum()))" `shouldRespondWith` + [json|[ + {"factories": {"name": "Factory A"}, "sum": 350.00}, + {"factories": {"name": "Factory B"}, "sum": 500.00}, + {"factories": {"name": "Factory C"}, "sum": 110.00}]|] + { matchHeaders = [matchContentTypeJson] } + get "/process_supervisor?select=...processes(factory:factories(name),...process_costs(cost_sum:cost.sum()))" `shouldRespondWith` + [json|[ + {"factory": {"name": "Factory A"}, "cost_sum": 350.00}, + {"factory": {"name": "Factory B"}, "cost_sum": 500.00}, + {"factory": {"name": "Factory C"}, "cost_sum": 110.00}]|] + { matchHeaders = [matchContentTypeJson] } + it "supports aggregates on spreaded fields from nested relationships, grouped by spreaded fields from other nested relationships" $ do + get "/process_supervisor?select=supervisor_id,...processes(...process_costs(cost.sum()),...process_categories(name))&order=supervisor_id" `shouldRespondWith` + [json|[ + {"supervisor_id": 1, "sum": 220.00, "name": "Batch"}, + {"supervisor_id": 2, "sum": 70.00, "name": "Batch"}, + {"supervisor_id": 2, "sum": 200.00, "name": "Mass"}, + {"supervisor_id": 3, "sum": 180.00, "name": "Batch"}, + {"supervisor_id": 3, "sum": 110.00, "name": "Mass"}, + {"supervisor_id": 4, "sum": 180.00, "name": "Batch"}]|] + { matchHeaders = [matchContentTypeJson] } + get "/process_supervisor?select=supervisor_id,...processes(...process_costs(cost_sum:cost.sum()),...process_categories(category:name))&order=supervisor_id" `shouldRespondWith` + [json|[ + {"supervisor_id": 1, "cost_sum": 220.00, "category": "Batch"}, + {"supervisor_id": 2, "cost_sum": 70.00, "category": "Batch"}, + {"supervisor_id": 2, "cost_sum": 200.00, "category": "Mass"}, + {"supervisor_id": 3, "cost_sum": 180.00, "category": "Batch"}, + {"supervisor_id": 3, "cost_sum": 110.00, "category": "Mass"}, + {"supervisor_id": 4, "cost_sum": 180.00, "category": "Batch"}]|] + { matchHeaders = [matchContentTypeJson] } + it "supports aggregates on spreaded fields from nested relationships, grouped by spreaded fields from other nested relationships, using a nested relationship as top parent" $ do + get "/supervisors?select=name,process_supervisor(...processes(...process_costs(cost.sum()),...process_categories(name)))" `shouldRespondWith` + [json|[ + {"name": "Mary", "process_supervisor": [{"name": "Batch", "sum": 220.00}]}, + {"name": "John", "process_supervisor": [{"name": "Batch", "sum": 70.00}, {"name": "Mass", "sum": 200.00}]}, + {"name": "Peter", "process_supervisor": [{"name": "Batch", "sum": 180.00}, {"name": "Mass", "sum": 110.00}]}, + {"name": "Sarah", "process_supervisor": [{"name": "Batch", "sum": 180.00}]}, + {"name": "Jane", "process_supervisor": []}]|] + { matchHeaders = [matchContentTypeJson] } + get "/supervisors?select=name,process_supervisor(...processes(...process_costs(cost_sum:cost.sum()),...process_categories(category:name)))" `shouldRespondWith` + [json|[ + {"name": "Mary", "process_supervisor": [{"category": "Batch", "cost_sum": 220.00}]}, + {"name": "John", "process_supervisor": [{"category": "Batch", "cost_sum": 70.00}, {"category": "Mass", "cost_sum": 200.00}]}, + {"name": "Peter", "process_supervisor": [{"category": "Batch", "cost_sum": 180.00}, {"category": "Mass", "cost_sum": 110.00}]}, + {"name": "Sarah", "process_supervisor": [{"category": "Batch", "cost_sum": 180.00}]}, + {"name": "Jane", "process_supervisor": []}]|] + { matchHeaders = [matchContentTypeJson] } + + context "supports count() aggregate without specifying a field" $ do + it "works by itself in the embedded resource" $ do + get "/process_supervisor?select=supervisor_id,...processes(count())&order=supervisor_id" `shouldRespondWith` + [json|[ + {"supervisor_id": 1, "count": 2}, + {"supervisor_id": 2, "count": 2}, + {"supervisor_id": 3, "count": 3}, + {"supervisor_id": 4, "count": 1}]|] + { matchHeaders = [matchContentTypeJson] } + get "/process_supervisor?select=supervisor_id,...processes(processes_count:count())&order=supervisor_id" `shouldRespondWith` + [json|[ + {"supervisor_id": 1, "processes_count": 2}, + {"supervisor_id": 2, "processes_count": 2}, + {"supervisor_id": 3, "processes_count": 3}, + {"supervisor_id": 4, "processes_count": 1}]|] + { matchHeaders = [matchContentTypeJson] } + it "works alongside other columns in the embedded resource" $ do + get "/process_supervisor?select=...supervisors(id,count())&order=supervisors(id)" `shouldRespondWith` + [json|[ + {"id": 1, "count": 2}, + {"id": 2, "count": 2}, + {"id": 3, "count": 3}, + {"id": 4, "count": 1}]|] + { matchHeaders = [matchContentTypeJson] } + get "/process_supervisor?select=...supervisors(supervisor:id,supervisor_count:count())&order=supervisors(supervisor)" `shouldRespondWith` + [json|[ + {"supervisor": 1, "supervisor_count": 2}, + {"supervisor": 2, "supervisor_count": 2}, + {"supervisor": 3, "supervisor_count": 3}, + {"supervisor": 4, "supervisor_count": 1}]|] + { matchHeaders = [matchContentTypeJson] } + it "works on nested resources" $ do + get "/process_supervisor?select=supervisor_id,...processes(...process_costs(count()))&order=supervisor_id" `shouldRespondWith` + [json|[ + {"supervisor_id": 1, "count": 2}, + {"supervisor_id": 2, "count": 2}, + {"supervisor_id": 3, "count": 3}, + {"supervisor_id": 4, "count": 1}]|] + { matchHeaders = [matchContentTypeJson] } + get "/process_supervisor?select=supervisor:supervisor_id,...processes(...process_costs(process_costs_count:count()))&order=supervisor_id" `shouldRespondWith` + [json|[ + {"supervisor": 1, "process_costs_count": 2}, + {"supervisor": 2, "process_costs_count": 2}, + {"supervisor": 3, "process_costs_count": 3}, + {"supervisor": 4, "process_costs_count": 1}]|] + { matchHeaders = [matchContentTypeJson] } + it "works on nested resources grouped by spreaded fields" $ do + get "/process_supervisor?select=...processes(factory_id,...process_costs(count()))&order=processes(factory_id)" `shouldRespondWith` + [json|[ + {"factory_id": 1, "count": 2}, + {"factory_id": 2, "count": 4}, + {"factory_id": 3, "count": 2}]|] + { matchHeaders = [matchContentTypeJson] } + get "/process_supervisor?select=...processes(factory:factory_id,...process_costs(process_costs_count:count()))&order=processes(factory)" `shouldRespondWith` + [json|[ + {"factory": 1, "process_costs_count": 2}, + {"factory": 2, "process_costs_count": 4}, + {"factory": 3, "process_costs_count": 2}]|] + { matchHeaders = [matchContentTypeJson] } + it "works on different levels of the nested resources at the same time" $ + get "/process_supervisor?select=...processes(factory:factory_id,processes_count:count(),...process_costs(process_costs_count:count()))&order=processes(factory)" `shouldRespondWith` + [json|[ + {"factory": 1, "processes_count": 2, "process_costs_count": 2}, + {"factory": 2, "processes_count": 4, "process_costs_count": 4}, + {"factory": 3, "processes_count": 2, "process_costs_count": 2}]|] + { matchHeaders = [matchContentTypeJson] } - context "supports count() aggregate without specifying a field" $ do - it "works by itself in the embedded resource" $ do - get "/process_supervisor?select=supervisor_id,...processes(count())&order=supervisor_id" `shouldRespondWith` + context "to-many spread relationships" $ do + it "supports the use of aggregates on spreaded fields" $ do + get "/budget_categories?select=budget_owner,total_budget:budget_amount.sum(),...budget_expenses(total_expenses:expense_amount.sum())&order=budget_owner" `shouldRespondWith` [json|[ - {"supervisor_id": 1, "count": 2}, - {"supervisor_id": 2, "count": 2}, - {"supervisor_id": 3, "count": 3}, - {"supervisor_id": 4, "count": 1}]|] + {"budget_owner":"Brian Smith","total_budget":2000.42,"total_expenses":600.52}, + {"budget_owner":"Dana de Groot","total_budget":500.33,"total_expenses":null}, + {"budget_owner":"Jane Clarkson","total_budget":9000.53,"total_expenses":100.22}, + {"budget_owner":"Sally Hughes","total_budget":500.23,"total_expenses":900.27}]|] + { matchHeaders = [matchContentTypeJson] } + it "supports the use of aggregates on spreaded fields when only aggregates are supplied" $ do + get "/budget_categories?select=...budget_expenses(total_expense:expense_amount.sum())" `shouldRespondWith` + [json|[{"total_expense":1601.01}]|] { matchHeaders = [matchContentTypeJson] } - get "/process_supervisor?select=supervisor_id,...processes(processes_count:count())&order=supervisor_id" `shouldRespondWith` + it "supports aggregates from a spread relationships grouped by spreaded fields from other relationships" $ do + get "/processes?select=...supervisors(id.count()),...process_categories(name)" `shouldRespondWith` [json|[ - {"supervisor_id": 1, "processes_count": 2}, - {"supervisor_id": 2, "processes_count": 2}, - {"supervisor_id": 3, "processes_count": 3}, - {"supervisor_id": 4, "processes_count": 1}]|] + {"count":5,"name":"Batch"}, + {"count":3,"name":"Mass"}]|] { matchHeaders = [matchContentTypeJson] } - it "works alongside other columns in the embedded resource" $ do - get "/process_supervisor?select=...supervisors(id,count())&order=supervisors(id)" `shouldRespondWith` + get "/processes?select=...supervisors(supervisor_count:id.count()),...process_categories(process_category:name)" `shouldRespondWith` [json|[ - {"id": 1, "count": 2}, - {"id": 2, "count": 2}, - {"id": 3, "count": 3}, - {"id": 4, "count": 1}]|] + {"supervisor_count":5,"process_category":"Batch"}, + {"supervisor_count":3,"process_category":"Mass"}]|] { matchHeaders = [matchContentTypeJson] } - get "/process_supervisor?select=...supervisors(supervisor:id,supervisor_count:count())&order=supervisors(supervisor)" `shouldRespondWith` + it "supports aggregates on spreaded fields from nested relationships" $ do + get "/supervisors?select=name,...processes(...process_costs(cost.sum()))&limit=3" `shouldRespondWith` [json|[ - {"supervisor": 1, "supervisor_count": 2}, - {"supervisor": 2, "supervisor_count": 2}, - {"supervisor": 3, "supervisor_count": 3}, - {"supervisor": 4, "supervisor_count": 1}]|] + {"name":"Jane","sum":null}, + {"name":"Mary","sum":220.00}, + {"name":"Peter","sum":290.00}]|] { matchHeaders = [matchContentTypeJson] } - it "works on nested resources" $ do - get "/process_supervisor?select=supervisor_id,...processes(...process_costs(count()))&order=supervisor_id" `shouldRespondWith` + get "/supervisors?select=supervisor:name,...processes(...process_costs(cost_sum:cost.sum()))&limit=3" `shouldRespondWith` [json|[ - {"supervisor_id": 1, "count": 2}, - {"supervisor_id": 2, "count": 2}, - {"supervisor_id": 3, "count": 2}, - {"supervisor_id": 4, "count": 1}]|] + {"supervisor":"Jane","cost_sum":null}, + {"supervisor":"Mary","cost_sum":220.00}, + {"supervisor":"Peter","cost_sum":290.00}]|] { matchHeaders = [matchContentTypeJson] } - get "/process_supervisor?select=supervisor:supervisor_id,...processes(...process_costs(process_costs_count:count()))&order=supervisor_id" `shouldRespondWith` + it "supports aggregates on spreaded fields from nested relationships, grouped by a regular nested relationship" $ do + get "/process_supervisor?select=...processes(process_categories(name),...factories(...factory_buildings(size.sum())))" `shouldRespondWith` [json|[ - {"supervisor": 1, "process_costs_count": 2}, - {"supervisor": 2, "process_costs_count": 2}, - {"supervisor": 3, "process_costs_count": 2}, - {"supervisor": 4, "process_costs_count": 1}]|] + {"process_categories":{"name": "Mass"},"sum":830}, + {"process_categories":{"name": "Batch"},"sum":1030}]|] { matchHeaders = [matchContentTypeJson] } - it "works on nested resources grouped by spreaded fields" $ do - get "/process_supervisor?select=...processes(factory_id,...process_costs(count()))&order=processes(factory_id)" `shouldRespondWith` + get "/process_supervisor?select=...processes(category:process_categories(name),...factories(...factory_buildings(building_size_total:size.sum())))" `shouldRespondWith` [json|[ - {"factory_id": 1, "count": 2}, - {"factory_id": 2, "count": 4}, - {"factory_id": 3, "count": 1}]|] + {"category":{"name": "Mass"},"building_size_total":830}, + {"category":{"name": "Batch"},"building_size_total":1030}]|] { matchHeaders = [matchContentTypeJson] } - get "/process_supervisor?select=...processes(factory:factory_id,...process_costs(process_costs_count:count()))&order=processes(factory)" `shouldRespondWith` + it "supports aggregates on spreaded fields from nested relationships, grouped by spreaded fields from other nested relationships" $ do + get "/process_supervisor?select=supervisor_id,...processes(...factories(...factory_buildings(size.sum())),...process_categories(name))&order=supervisor_id" `shouldRespondWith` [json|[ - {"factory": 1, "process_costs_count": 2}, - {"factory": 2, "process_costs_count": 4}, - {"factory": 3, "process_costs_count": 1}]|] + {"supervisor_id":1,"sum":520,"name":"Batch"}, + {"supervisor_id":2,"sum":170,"name":"Batch"}, + {"supervisor_id":2,"sum":350,"name":"Mass"}, + {"supervisor_id":3,"sum":170,"name":"Batch"}, + {"supervisor_id":3,"sum":480,"name":"Mass"}, + {"supervisor_id":4,"sum":170,"name":"Batch"}]|] { matchHeaders = [matchContentTypeJson] } - it "works on different levels of the nested resources at the same time" $ - get "/process_supervisor?select=...processes(factory:factory_id,processes_count:count(),...process_costs(process_costs_count:count()))&order=processes(factory)" `shouldRespondWith` + get "/process_supervisor?select=supervisor_id,...processes(...factories(...factory_buildings(building_total_size:size.sum())),...process_categories(category:name))&order=supervisor_id" `shouldRespondWith` [json|[ - {"factory": 1, "processes_count": 2, "process_costs_count": 2}, - {"factory": 2, "processes_count": 4, "process_costs_count": 4}, - {"factory": 3, "processes_count": 2, "process_costs_count": 1}]|] + {"supervisor_id":1,"building_total_size":520,"category":"Batch"}, + {"supervisor_id":2,"building_total_size":170,"category":"Batch"}, + {"supervisor_id":2,"building_total_size":350,"category":"Mass"}, + {"supervisor_id":3,"building_total_size":170,"category":"Batch"}, + {"supervisor_id":3,"building_total_size":480,"category":"Mass"}, + {"supervisor_id":4,"building_total_size":170,"category":"Batch"}]|] { matchHeaders = [matchContentTypeJson] } + it "supports aggregates on spreaded fields from nested relationships, grouped by spreaded fields from other nested relationships, using a nested relationship as top parent" $ do + get "/supervisors?select=name,process_supervisor(...processes(...factories(...factory_buildings(size.sum())),...process_categories(name)))" `shouldRespondWith` + [json|[ + {"name":"Mary","process_supervisor":[{"sum": 520, "name": "Batch"}]}, + {"name":"John","process_supervisor":[{"sum": 170, "name": "Batch"}, {"sum": 350, "name": "Mass"}]}, + {"name":"Peter","process_supervisor":[{"sum": 170, "name": "Batch"}, {"sum": 480, "name": "Mass"}]}, + {"name":"Sarah","process_supervisor":[{"sum": 170, "name": "Batch"}]}, + {"name":"Jane","process_supervisor":[]}]|] + { matchHeaders = [matchContentTypeJson] } + get "/supervisors?select=name,process_supervisor(...processes(...factories(...factory_buildings(building_size_total:size.sum())),...process_categories(category:name)))" `shouldRespondWith` + [json|[ + {"name":"Mary","process_supervisor":[{"category": "Batch", "building_size_total": 520}]}, + {"name":"John","process_supervisor":[{"category": "Batch", "building_size_total": 170}, {"category": "Mass", "building_size_total": 350}]}, + {"name":"Peter","process_supervisor":[{"category": "Batch", "building_size_total": 170}, {"category": "Mass", "building_size_total": 480}]}, + {"name":"Sarah","process_supervisor":[{"category": "Batch", "building_size_total": 170}]}, + {"name":"Jane","process_supervisor":[]}]|] + { matchHeaders = [matchContentTypeJson] } + + context "supports count() aggregate without specifying a field" $ do + context "one-to-many" $ do + it "works by itself in the embedded resource" $ do + get "/factories?select=name,...processes(count())&order=name" `shouldRespondWith` + [json|[ + {"name":"Factory A","count":2}, + {"name":"Factory B","count":2}, + {"name":"Factory C","count":4}, + {"name":"Factory D","count":0}]|] + { matchHeaders = [matchContentTypeJson] } + get "/factories?select=factory:name,...processes(processes_count:count())&order=name" `shouldRespondWith` + [json|[ + {"factory":"Factory A","processes_count":2}, + {"factory":"Factory B","processes_count":2}, + {"factory":"Factory C","processes_count":4}, + {"factory":"Factory D","processes_count":0}]|] + { matchHeaders = [matchContentTypeJson] } + it "works alongside other aggregated columns in the embedded resource" $ do + get "/factories?select=name,...processes(id,count())&order=name" `shouldRespondWith` + [json|[ + {"name":"Factory A","id":[1,2],"count":2}, + {"name":"Factory B","id":[3,4],"count":2}, + {"name":"Factory C","id":[5,6,7,8],"count":4}, + {"name":"Factory D","id":[],"count":0}]|] + { matchHeaders = [matchContentTypeJson] } + get "/factories?select=factory:name,...processes(process:id,process_count:count())&order=name" `shouldRespondWith` + [json|[ + {"factory":"Factory A","process":[1,2],"process_count":2}, + {"factory":"Factory B","process":[3,4],"process_count":2}, + {"factory":"Factory C","process":[5,6,7,8],"process_count":4}, + {"factory":"Factory D","process":[],"process_count":0}]|] + { matchHeaders = [matchContentTypeJson] } + get "/factories?select=factory:name,...processes(*,process_count:count())&order=name" `shouldRespondWith` + [json|[ + {"factory":"Factory A","id":[1,2],"name":["Process A1","Process A2"],"factory_id":[1,1],"category_id":[1,2],"process_count":2}, + {"factory":"Factory B","id":[3,4],"name":["Process B1","Process B2"],"factory_id":[2,2],"category_id":[1,1],"process_count":2}, + {"factory":"Factory C","id":[5,6,7,8],"name":["Process C1","Process C2","Process XX","Process YY"],"factory_id":[3,3,3,3],"category_id":[2,2,2,2],"process_count":4}, + {"factory":"Factory D","id":[],"name":[],"factory_id":[],"category_id":[],"process_count":0}]|] + { matchHeaders = [matchContentTypeJson] } + it "works on nested resources" $ do + get "/processes?select=id,...factories(...factory_buildings(count()))&order=id" `shouldRespondWith` + [json|[ + {"id":1,"count":2}, + {"id":2,"count":2}, + {"id":3,"count":2}, + {"id":4,"count":2}, + {"id":5,"count":1}, + {"id":6,"count":1}, + {"id":7,"count":1}, + {"id":8,"count":1}]|] + { matchHeaders = [matchContentTypeJson] } + get "/processes?select=process:id,...factories(...factory_buildings(buildings_count:count()))&order=id" `shouldRespondWith` + [json|[ + {"process":1,"buildings_count":2}, + {"process":2,"buildings_count":2}, + {"process":3,"buildings_count":2}, + {"process":4,"buildings_count":2}, + {"process":5,"buildings_count":1}, + {"process":6,"buildings_count":1}, + {"process":7,"buildings_count":1}, + {"process":8,"buildings_count":1}]|] + { matchHeaders = [matchContentTypeJson] } + + context "many-to-many" $ do + it "works by itself in the embedded resource" $ do + get "/supervisors?select=name,...processes(count())&order=name" `shouldRespondWith` + [json|[ + {"name":"Jane","count":0}, + {"name":"John","count":2}, + {"name":"Mary","count":2}, + {"name":"Peter","count":3}, + {"name":"Sarah","count":1}]|] + { matchHeaders = [matchContentTypeJson] } + get "/supervisors?select=supervisor:name,...processes(processes_count:count())&order=name" `shouldRespondWith` + [json|[ + {"supervisor":"Jane","processes_count":0}, + {"supervisor":"John","processes_count":2}, + {"supervisor":"Mary","processes_count":2}, + {"supervisor":"Peter","processes_count":3}, + {"supervisor":"Sarah","processes_count":1}]|] + { matchHeaders = [matchContentTypeJson] } + it "works alongside other aggregated columns in the embedded resource" $ do + get "/supervisors?select=name,...processes(id,count())&order=name" `shouldRespondWith` + [json|[ + {"name":"Jane","id":[],"count":0}, + {"name":"John","id":[2,4],"count":2}, + {"name":"Mary","id":[1,4],"count":2}, + {"name":"Peter","id":[3,5,6],"count":3}, + {"name":"Sarah","id":[3],"count":1}]|] + { matchHeaders = [matchContentTypeJson] } + get "/supervisors?select=supervisor:name,...processes(process:id,process_count:count())&order=name" `shouldRespondWith` + [json|[ + {"supervisor":"Jane","process":[],"process_count":0}, + {"supervisor":"John","process":[2,4],"process_count":2}, + {"supervisor":"Mary","process":[1,4],"process_count":2}, + {"supervisor":"Peter","process":[3,5,6],"process_count":3}, + {"supervisor":"Sarah","process":[3],"process_count":1}]|] + { matchHeaders = [matchContentTypeJson] } + get "/supervisors?select=supervisor:name,...processes(*,process_count:count())&id=gte.4&order=name" `shouldRespondWith` + [json|[ + {"supervisor":"Jane","id":[],"name":[],"factory_id":[],"category_id":[],"process_count":0}, + {"supervisor":"Sarah","id":[3],"name":["Process B1"],"factory_id":[2],"category_id":[1],"process_count":1}]|] + { matchHeaders = [matchContentTypeJson] } + it "works on nested resources" $ do + get "/supervisors?select=id,...processes(...operators(count()))&order=id" `shouldRespondWith` + [json|[ + {"id":1,"count":4}, + {"id":2,"count":5}, + {"id":3,"count":3}, + {"id":4,"count":1}, + {"id":5,"count":0}]|] + { matchHeaders = [matchContentTypeJson] } + get "/supervisors?select=supervisor:id,...processes(...operators(operators_count:count()))&order=id" `shouldRespondWith` + [json|[ + {"supervisor":1,"operators_count":4}, + {"supervisor":2,"operators_count":5}, + {"supervisor":3,"operators_count":3}, + {"supervisor":4,"operators_count":1}, + {"supervisor":5,"operators_count":0}]|] + { matchHeaders = [matchContentTypeJson] } disallowed :: SpecWith ((), Application) disallowed = diff --git a/test/spec/Feature/Query/SpreadQueriesSpec.hs b/test/spec/Feature/Query/SpreadQueriesSpec.hs index 07a9c9d6d7..f02fa00379 100644 --- a/test/spec/Feature/Query/SpreadQueriesSpec.hs +++ b/test/spec/Feature/Query/SpreadQueriesSpec.hs @@ -1,6 +1,7 @@ module Feature.Query.SpreadQueriesSpec where -import Network.Wai (Application) +import Network.HTTP.Types (methodGet) +import Network.Wai (Application) import Test.Hspec import Test.Hspec.Wai @@ -63,28 +64,6 @@ spec = , matchHeaders = [matchContentTypeJson] } - it "fails when is not a to-one relationship" $ do - get "/clients?select=*,...projects(*)" `shouldRespondWith` - [json|{ - "code":"PGRST119", - "details":"'clients' and 'projects' do not form a many-to-one or one-to-one relationship", - "hint":null, - "message":"A spread operation on 'projects' is not possible" - }|] - { matchStatus = 400 - , matchHeaders = [matchContentTypeJson] - } - get "/designers?select=*,...computed_videogames(*)" `shouldRespondWith` - [json|{ - "code":"PGRST119", - "details":"'designers' and 'computed_videogames' do not form a many-to-one or one-to-one relationship", - "hint":null, - "message":"A spread operation on 'computed_videogames' is not possible" - }|] - { matchStatus = 400 - , matchHeaders = [matchContentTypeJson] - } - it "can include or exclude attributes of the junction on a m2m" $ do get "/users?select=*,tasks:users_tasks(*,...tasks(*))&limit=1" `shouldRespondWith` [json|[{ @@ -112,3 +91,374 @@ spec = { matchStatus = 200 , matchHeaders = [matchContentTypeJson] } + + context "one-to-many relationships as array aggregates" $ do + it "should aggregate a single spread column" $ do + get "/factories?select=factory:name,...processes(name)&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","name":["Process B1", "Process B2"]}, + {"factory":"Factory A","name":["Process A1", "Process A2"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + get "/factories?select=factory:name,...processes(processes:name)&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","processes":["Process B1", "Process B2"]}, + {"factory":"Factory A","processes":["Process A1", "Process A2"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate many spread columns" $ do + get "/factories?select=factory:name,...processes(name,category_id)&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","name":["Process B1", "Process B2"],"category_id":[1, 1]}, + {"factory":"Factory A","name":["Process A1", "Process A2"],"category_id":[1, 2]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + get "/factories?select=factory:name,...processes(processes:name,categories:category_id)&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","processes":["Process B1", "Process B2"],"categories":[1, 1]}, + {"factory":"Factory A","processes":["Process A1", "Process A2"],"categories":[1, 2]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should return an empty array when no elements are found" $ + get "/factories?select=factory:name,...processes(processes:name)&processes=is.null" `shouldRespondWith` + [json|[ + {"factory":"Factory D","processes":[]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should return a single null element array, not an empty one, when the row exists but the value happens to be null" $ + get "/managers?select=name,...organizations(organizations:name,referees:referee)&id=eq.1" `shouldRespondWith` + [json|[ + {"name":"Referee Manager","organizations":["Referee Org"],"referees":[null]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should work when selecting all columns, aggregating each one of them" $ + get "/factories?select=factory:name,...processes(*)&id=lte.2&order=name" `shouldRespondWith` + [json|[ + {"factory":"Factory A","id":[1,2],"name":["Process A1","Process A2"],"factory_id":[1,1],"category_id":[1,2]}, + {"factory":"Factory B","id":[3,4],"name":["Process B1","Process B2"],"factory_id":[2,2],"category_id":[1,1]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate spread columns from a nested one-to-one relationship" $ + get "/factories?select=factory:name,...processes(process:name,...process_costs(process_costs:cost))&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","process":["Process B1", "Process B2"],"process_costs":[180.00, 70.00]}, + {"factory":"Factory A","process":["Process A1", "Process A2"],"process_costs":[150.00, 200.00]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate spread columns from a nested many-to-one relationship" $ + get "/factories?select=factory:name,...processes(process:name,...process_categories(categories:name))&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","process":["Process B1", "Process B2"],"categories":["Batch", "Batch"]}, + {"factory":"Factory A","process":["Process A1", "Process A2"],"categories":["Batch", "Mass"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate spread columns from a nested one-to-many relationship" $ + get "/factories?select=factory:name,...processes(process:name,...process_supervisor(supervisor_ids:supervisor_id))&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","process":["Process B1", "Process B1", "Process B2", "Process B2"],"supervisor_ids":[3, 4, 1, 2]}, + {"factory":"Factory A","process":["Process A1", "Process A2"],"supervisor_ids":[1, 2]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate spread columns from a nested many-to-many relationship" $ do + get "/factories?select=factory:name,...processes(process:name,...supervisors(supervisors:name))&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","process":["Process B1", "Process B1", "Process B2", "Process B2"],"supervisors":["Peter", "Sarah", "Mary", "John"]}, + {"factory":"Factory A","process":["Process A1", "Process A2"],"supervisors":["Mary", "John"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate a nested non-spread one-to-one relationship into an array of objects" $ do + get "/factories?select=factory:name,...processes(process:name,process_costs(cost))&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","process":["Process B1", "Process B2"],"process_costs":[{"cost": 180.00}, {"cost": 70.00}]}, + {"factory":"Factory A","process":["Process A1", "Process A2"],"process_costs":[{"cost": 150.00}, {"cost": 200.00}]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate a nested non-spread many-to-one relationship into an array of objects" $ + get "/factories?select=factory:name,...processes(process:name,process_categories(name))&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","process":["Process B1", "Process B2"],"process_categories":[{"name": "Batch"}, {"name": "Batch"}]}, + {"factory":"Factory A","process":["Process A1", "Process A2"],"process_categories":[{"name": "Batch"}, {"name": "Mass"}]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate a nested non-spread one-to-many relationship into an array of objects" $ + get "/factories?select=factory:name,...processes(process:name,process_supervisor(supervisor_id))&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","process":["Process B1","Process B1","Process B2","Process B2"],"process_supervisor":[{"supervisor_id": 3},{"supervisor_id": 4},{"supervisor_id": 1},{"supervisor_id": 2}]}, + {"factory":"Factory A","process":["Process A1","Process A2"],"process_supervisor":[{"supervisor_id": 1},{"supervisor_id": 2}]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate a nested non-spread many-to-many relationship into an array of objects" $ + get "/factories?select=factory:name,...processes(process:name,supervisors(name))&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory B","process":["Process B1", "Process B1", "Process B2", "Process B2"],"supervisors":[{"name": "Peter"}, {"name": "Sarah"}, {"name": "Mary"}, {"name": "John"}]}, + {"factory":"Factory A","process":["Process A1", "Process A2"],"supervisors":[{"name": "Mary"}, {"name": "John"}]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should work when selecting all columns in a nested to-one resource, aggregating each one of them" $ + get "/factories?select=factory:name,...processes(*,...process_costs(*))&id=lte.2" `shouldRespondWith` + [json|[ + {"factory":"Factory A","id":[1,2],"name":["Process A1","Process A2"],"factory_id":[1,1],"category_id":[1,2],"process_id":[1,2],"cost":[150.00,200.00]}, + {"factory":"Factory B","id":[3,4],"name":["Process B1","Process B2"],"factory_id":[2,2],"category_id":[1,1],"process_id":[3,4],"cost":[180.00,70.00]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should work when selecting all columns in the top resource, grouping by each one of them" $ + get "/factories?select=*,...processes(process_ids:id,process_names:name)&id=lte.2&order=id" `shouldRespondWith` + [json|[ + {"id":1,"name":"Factory A","process_ids":[1,2],"process_names":["Process A1","Process A2"]}, + {"id":2,"name":"Factory B","process_ids":[3,4],"process_names":["Process B1","Process B2"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should work when selecting all columns in a non-spread embed resource, grouping by each one of them" $ + get "/factory_buildings?select=code,factories(*,...processes(process_ids:id,process_names:name))&factory_id=lte.2&order=factory_id" `shouldRespondWith` + [json|[ + {"code":"A001","factories":{"id": 1, "name": "Factory A", "process_ids": [1, 2], "process_names": ["Process A1", "Process A2"]}}, + {"code":"A002","factories":{"id": 1, "name": "Factory A", "process_ids": [1, 2], "process_names": ["Process A1", "Process A2"]}}, + {"code":"B001","factories":{"id": 2, "name": "Factory B", "process_ids": [3, 4], "process_names": ["Process B1", "Process B2"]}}, + {"code":"B002","factories":{"id": 2, "name": "Factory B", "process_ids": [3, 4], "process_names": ["Process B1", "Process B2"]}} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should not include nulls in the aggregated arrays when Accept: application/vnd.pgrst.array+json;nulls=stripped" $ + request methodGet "/factories?select=name,...processes(processes:name,...process_costs(process_costs:cost))&name=eq.Factory+C" + [("Accept", "application/vnd.pgrst.array+json;nulls=stripped")] + "" `shouldRespondWith` + [json|[ + {"name":"Factory C","processes":["Process C1","Process C2","Process XX","Process YY"],"process_costs":[40.00,70.00,40.00]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchCTArrayStrip] + } + it "should not include nulls in the aggregated arrays when Accept: application/vnd.pgrst.object+json;nulls=stripped" $ + request methodGet "/factories?select=name,...processes(processes:name,...process_costs(process_costs:cost))&name=eq.Factory+C" + [("Accept", "application/vnd.pgrst.object+json;nulls=stripped")] + "" `shouldRespondWith` + [json| + {"name":"Factory C","processes":["Process C1","Process C2","Process XX","Process YY"],"process_costs":[40.00,70.00,40.00]} + |] + { matchStatus = 200 + , matchHeaders = [matchCTSingularStrip] + } + + context "many-to-many relationships as array aggregates" $ do + it "should aggregate a single spread column" $ do + get "/operators?select=operator:name,...processes(name)&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","name":["Process A1","Process A2","Process B2"]}, + {"operator":"Louis","name":["Process A1","Process A2"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + get "/operators?select=operator:name,...processes(processes:name)&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","processes":["Process A1","Process A2","Process B2"]}, + {"operator":"Louis","processes":["Process A1","Process A2"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate many spread columns" $ do + get "/operators?select=operator:name,...processes(name,category_id)&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","name":["Process A1","Process A2","Process B2"],"category_id":[1,2,1]}, + {"operator":"Louis","name":["Process A1","Process A2"],"category_id":[1,2]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + get "/operators?select=operator:name,...processes(processes:name,categories:category_id)&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","processes":["Process A1","Process A2","Process B2"],"categories":[1,2,1]}, + {"operator":"Louis","processes":["Process A1","Process A2"],"categories":[1,2]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should return an empty array when no elements are found" $ + get "/operators?select=operator:name,...processes(processes:name)&processes=is.null" `shouldRespondWith` + [json|[ + {"operator":"Liz","processes":[]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should return a single null element array, not an empty one, when the row exists but the value happens to be null" $ + get "/operators?select=name,...processes(process:name,...process_costs(cost)))&id=eq.5&processes.id=eq.7" `shouldRespondWith` + [json|[ + {"name":"Alfred","process":["Process XX"],"cost":[null]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should work when selecting all columns, aggregating each one of them" $ + get "/operators?select=operator:name,...processes(*)&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","id":[1,2,4],"name":["Process A1","Process A2","Process B2"],"factory_id":[1,1,2],"category_id":[1,2,1]}, + {"operator":"Louis","id":[1,2],"name":["Process A1","Process A2"],"factory_id":[1,1],"category_id":[1,2]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate spread columns from a nested one-to-one relationship" $ + get "/operators?select=operator:name,...processes(process:name,...process_costs(process_costs:cost))&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","process":["Process A1","Process A2","Process B2"],"process_costs":[150.00,200.00,70.00]}, + {"operator":"Louis","process":["Process A1","Process A2"],"process_costs":[150.00,200.00]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate spread columns from a nested many-to-one relationship" $ + get "/operators?select=operator:name,...processes(process:name,...process_categories(categories:name))&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","process":["Process A1","Process A2","Process B2"],"categories":["Batch","Mass","Batch"]}, + {"operator":"Louis","process":["Process A1","Process A2"],"categories":["Batch","Mass"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate spread columns from a nested one-to-many relationship" $ + get "/operators?select=operator:name,...processes(process:name,...process_supervisor(supervisor_ids:supervisor_id))&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","process":["Process A1","Process A2","Process B2","Process B2"],"supervisor_ids":[1,2,1,2]}, + {"operator":"Louis","process":["Process A1","Process A2"],"supervisor_ids":[1,2]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate spread columns from a nested many-to-many relationship" $ do + get "/operators?select=operator:name,...processes(process:name,...supervisors(supervisors:name))&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","process":["Process A1","Process A2","Process B2","Process B2"],"supervisors":["Mary","John","Mary","John"]}, + {"operator":"Louis","process":["Process A1","Process A2"],"supervisors":["Mary","John"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate a nested non-spread one-to-one relationship into an array of objects" $ do + get "/operators?select=operator:name,...processes(process:name,process_costs(cost))&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","process":["Process A1","Process A2","Process B2"],"process_costs":[{"cost": 150.00},{"cost": 200.00},{"cost": 70.00}]}, + {"operator":"Louis","process":["Process A1","Process A2"],"process_costs":[{"cost": 150.00},{"cost": 200.00}]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate a nested non-spread many-to-one relationship into an array of objects" $ + get "/operators?select=operator:name,...processes(process:name,process_categories(name))&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","process":["Process A1","Process A2","Process B2"],"process_categories":[{"name": "Batch"},{"name": "Mass"},{"name": "Batch"}]}, + {"operator":"Louis","process":["Process A1","Process A2"],"process_categories":[{"name": "Batch"},{"name": "Mass"}]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate a nested non-spread one-to-many relationship into an array of objects" $ + get "/operators?select=operator:name,...processes(process:name,process_supervisor(supervisor_id))&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","process":["Process A1","Process A2","Process B2","Process B2"],"process_supervisor":[{"supervisor_id": 1},{"supervisor_id": 2},{"supervisor_id": 1},{"supervisor_id": 2}]}, + {"operator":"Louis","process":["Process A1","Process A2"],"process_supervisor":[{"supervisor_id": 1},{"supervisor_id": 2}]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate a nested non-spread many-to-many relationship into an array of objects" $ + get "/operators?select=operator:name,...processes(process:name,supervisors(name))&id=lte.2" `shouldRespondWith` + [json|[ + {"operator":"Anne","process":["Process A1","Process A2","Process B2","Process B2"],"supervisors":[{"name": "Mary"},{"name": "John"},{"name": "Mary"},{"name": "John"}]}, + {"operator":"Louis","process":["Process A1","Process A2"],"supervisors":[{"name": "Mary"},{"name": "John"}]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should not aggregate to-one relationships when they're nested inside a non-spread relationship, even if the latter is nested in a to-many spread" $ + get "/supervisors?select=name,...process_supervisor(processes(name,...process_costs(cost)))&id=lte.2" `shouldRespondWith` + [json|[ + {"name":"Mary","processes":[{"cost": 150.00, "name": "Process A1"}, {"cost": 70.00, "name": "Process B2"}]}, + {"name":"John","processes":[{"cost": 200.00, "name": "Process A2"}, {"cost": 70.00, "name": "Process B2"}]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should aggregate to-many relationships when they're nested inside a non-spread relationship" $ + get "/supervisors?select=name,...process_supervisor(processes(name,...operators(operators:name)))&id=lte.2" `shouldRespondWith` + [json|[ + {"name":"John","processes":[{"name": "Process A2", "operators": ["Anne", "Louis", "Jeff"]}, {"name": "Process B2", "operators": ["Anne", "Jeff"]}]}, + {"name":"Mary","processes":[{"name": "Process A1", "operators": ["Anne", "Louis"]}, {"name": "Process B2", "operators": ["Anne", "Jeff"]}]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should work when selecting all columns in the top resource, grouping by each one of them" $ + get "/processes?select=*,...operators(operator_ids:id,operator_names:name)&id=lte.2&order=id" `shouldRespondWith` + [json|[ + {"id":1,"name":"Process A1","factory_id":1,"category_id":1,"operator_ids":[1,2],"operator_names":["Anne","Louis"]}, + {"id":2,"name":"Process A2","factory_id":1,"category_id":2,"operator_ids":[1,2,3],"operator_names":["Anne","Louis","Jeff"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should work when selecting all columns in a non-spread embed resource, grouping by each one of them" $ + get "/supervisors?select=name,processes(*,...operators(operator_ids:id,operator_names:name))&id=lte.2&order=id" `shouldRespondWith` + [json|[ + {"name":"Mary","processes":[{"id": 1, "name": "Process A1", "factory_id": 1, "category_id": 1, "operator_ids": [1, 2], "operator_names": ["Anne", "Louis"]}, {"id": 4, "name": "Process B2", "factory_id": 2, "category_id": 1, "operator_ids": [1, 3], "operator_names": ["Anne", "Jeff"]}]}, + {"name":"John","processes":[{"id": 2, "name": "Process A2", "factory_id": 1, "category_id": 2, "operator_ids": [1, 2, 3], "operator_names": ["Anne", "Louis", "Jeff"]}, {"id": 4, "name": "Process B2", "factory_id": 2, "category_id": 1, "operator_ids": [1, 3], "operator_names": ["Anne", "Jeff"]}]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } + it "should not include nulls in the aggregated arrays when Accept: application/vnd.pgrst.array+json;nulls=stripped" $ + request methodGet "/operators?select=name,...processes(processes:name,...process_costs(process_costs:cost))&name=eq.Alfred" + [("Accept", "application/vnd.pgrst.array+json;nulls=stripped")] + "" `shouldRespondWith` + [json|[ + {"name":"Alfred","processes":["Process C2","Process XX"],"process_costs":[70.00]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchCTArrayStrip] + } + it "should not include nulls in the aggregated arrays when Accept: application/vnd.pgrst.object+json;nulls=stripped" $ + request methodGet "/operators?select=name,...processes(processes:name,...process_costs(process_costs:cost))&name=eq.Alfred" + [("Accept", "application/vnd.pgrst.object+json;nulls=stripped")] + "" `shouldRespondWith` + [json| + {"name":"Alfred","processes":["Process C2","Process XX"],"process_costs":[70.00]} + |] + { matchStatus = 200 + , matchHeaders = [matchCTSingularStrip] + } diff --git a/test/spec/fixtures/data.sql b/test/spec/fixtures/data.sql index f6adbdff53..b2216802e7 100644 --- a/test/spec/fixtures/data.sql +++ b/test/spec/fixtures/data.sql @@ -901,19 +901,24 @@ INSERT INTO processes VALUES (3, 'Process B1', 2, 1); INSERT INTO processes VALUES (4, 'Process B2', 2, 1); INSERT INTO processes VALUES (5, 'Process C1', 3, 2); INSERT INTO processes VALUES (6, 'Process C2', 3, 2); +INSERT INTO processes VALUES (7, 'Process XX', 3, 2); +INSERT INTO processes VALUES (8, 'Process YY', 3, 2); TRUNCATE TABLE process_costs CASCADE; INSERT INTO process_costs VALUES (1, 150.00); INSERT INTO process_costs VALUES (2, 200.00); INSERT INTO process_costs VALUES (3, 180.00); INSERT INTO process_costs VALUES (4, 70.00); -INSERT INTO process_costs VALUES (5, 120.00); +INSERT INTO process_costs VALUES (5, 40.00); +INSERT INTO process_costs VALUES (6, 70.00); +INSERT INTO process_costs VALUES (8, 40.00); TRUNCATE TABLE supervisors CASCADE; INSERT INTO supervisors VALUES (1, 'Mary'); INSERT INTO supervisors VALUES (2, 'John'); INSERT INTO supervisors VALUES (3, 'Peter'); INSERT INTO supervisors VALUES (4, 'Sarah'); +INSERT INTO supervisors VALUES (5, 'Jane'); TRUNCATE TABLE process_supervisor CASCADE; INSERT INTO process_supervisor VALUES (1, 1); @@ -924,3 +929,31 @@ INSERT INTO process_supervisor VALUES (4, 1); INSERT INTO process_supervisor VALUES (4, 2); INSERT INTO process_supervisor VALUES (5, 3); INSERT INTO process_supervisor VALUES (6, 3); + +TRUNCATE TABLE operators CASCADE; +INSERT INTO operators VALUES (1, 'Anne'); +INSERT INTO operators VALUES (2, 'Louis'); +INSERT INTO operators VALUES (3, 'Jeff'); +INSERT INTO operators VALUES (4, 'Liz'); +INSERT INTO operators VALUES (5, 'Alfred'); + +TRUNCATE TABLE process_operator CASCADE; +INSERT INTO process_operator VALUES (1,1); +INSERT INTO process_operator VALUES (1,2); +INSERT INTO process_operator VALUES (2,1); +INSERT INTO process_operator VALUES (2,2); +INSERT INTO process_operator VALUES (2,3); +INSERT INTO process_operator VALUES (3,3); +INSERT INTO process_operator VALUES (4,1); +INSERT INTO process_operator VALUES (4,3); +INSERT INTO process_operator VALUES (6,3); +INSERT INTO process_operator VALUES (6,5); +INSERT INTO process_operator VALUES (7,5); + +TRUNCATE TABLE factory_buildings CASCADE; +INSERT INTO factory_buildings VALUES (1, 'A001', 150, 1); +INSERT INTO factory_buildings VALUES (2, 'A002', 200, 1); +INSERT INTO factory_buildings VALUES (3, 'B001', 50, 2); +INSERT INTO factory_buildings VALUES (4, 'B002', 120, 2); +INSERT INTO factory_buildings VALUES (5, 'C001', 240, 3); +INSERT INTO factory_buildings VALUES (6, 'D001', 310, 4); diff --git a/test/spec/fixtures/schema.sql b/test/spec/fixtures/schema.sql index a3b6edda16..f32ca4193a 100644 --- a/test/spec/fixtures/schema.sql +++ b/test/spec/fixtures/schema.sql @@ -3782,3 +3782,21 @@ create table process_supervisor ( supervisor_id int references supervisors(id), primary key (process_id, supervisor_id) ); + +create table operators ( + id int primary key, + name text +); + +create table process_operator ( + process_id int references processes(id), + operator_id int references operators(id), + primary key (process_id, operator_id) +); + +create table factory_buildings ( + id int primary key, + code char(4), + size numeric, + factory_id int references factories(id) +);