From b912c0b5defb708058e9bc00501f801ee4e53cc9 Mon Sep 17 00:00:00 2001 From: Laurence Isla Date: Sat, 14 Sep 2024 19:39:43 -0500 Subject: [PATCH] feat: WIP allow spread operators in to-many relationships --- src/PostgREST/ApiRequest/Types.hs | 3 +- src/PostgREST/Error.hs | 10 +- src/PostgREST/Plan.hs | 54 ++++--- src/PostgREST/Plan/ReadPlan.hs | 1 + src/PostgREST/Query/SqlFragment.hs | 7 +- .../Feature/Query/AggregateFunctionsSpec.hs | 6 +- test/spec/Feature/Query/SpreadQueriesSpec.hs | 135 ++++++++++++++++-- test/spec/Main.hs | 8 +- test/spec/fixtures/data.sql | 24 ++++ test/spec/fixtures/schema.sql | 18 +++ 10 files changed, 219 insertions(+), 47 deletions(-) diff --git a/src/PostgREST/ApiRequest/Types.hs b/src/PostgREST/ApiRequest/Types.hs index e4fb6dc323..e5eb0bf139 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 | JsonAgg 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..fcb69328e6 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -336,10 +336,10 @@ readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows, configDbAggregate validateAggFunctions configDbAggregates =<< addRelSelects =<< addNullEmbedFilters =<< - validateSpreadEmbeds =<< addRelatedOrders =<< addAliases =<< expandStars ctx =<< + addJsonAggToManySpread =<< addRels qiSchema (iAction apiRequest) dbRelationships Nothing =<< addLogicTrees ctx apiRequest =<< addRanges apiRequest =<< @@ -352,7 +352,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 @@ -474,18 +474,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 +509,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 +620,24 @@ findRel schema allRels origin target hint = ) ) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels +-- Add JsonAgg 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 +addJsonAggToManySpread :: ReadPlanTree -> Either ApiRequestError ReadPlanTree +addJsonAggToManySpread (Node rp@ReadPlan{select} forest) = + let newForest = addJsonAggToManySpread `traverse` forest + newSelects + | shouldAddJsonAgg = fieldToJsonAgg <$> select + | otherwise = select + in Node rp { select = newSelects } <$> newForest + where + shouldAddJsonAgg = spreadRelIsNestedInToMany rp + fieldToJsonAgg field + | isJust $ csAggFunction field = field + | otherwise = field { csAggFunction = Just JsonAgg, csAlias = newAlias (csAlias field) (cfName $ csField field) } + newAlias :: Maybe Alias -> FieldName -> Maybe Alias + newAlias _ "*" = Nothing + 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,7 +676,9 @@ 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 usin `json_agg()` + let (aggFun, alias) = if spreadRelIsNestedInToMany rp then (Just JsonAgg, Just rsSelName) else (Nothing, Nothing) in + [SpreadSelectField { ssSelName = rsSelName, ssSelAggFunction = aggFun, ssSelAggCast = Nothing, ssSelAlias = alias }] relSelectToSpread (Spread{rsSpreadSel}) = rsSpreadSel @@ -906,15 +931,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..c199b1f500 100644 --- a/src/PostgREST/Plan/ReadPlan.hs +++ b/src/PostgREST/Plan/ReadPlan.hs @@ -43,6 +43,7 @@ data ReadPlan = ReadPlan , relHint :: Maybe Hint , relJoinType :: Maybe JoinType , relIsSpread :: Bool + , relIsInToManySpread :: Bool , relSelect :: [RelSelectField] , depth :: Depth -- ^ used for aliasing diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index b2e5884140..94f2fd593c 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -284,10 +284,11 @@ pgFmtApplyAggregate Nothing _ snippet = snippet pgFmtApplyAggregate (Just agg) aggCast snippet = pgFmtApplyCast aggCast aggregatedSnippet where - convertAggFunction :: AggregateFunction -> SQL.Snippet + aggregatedSnippet = aggFunction <> "(" <> aggArgument <> ")" <> aggFilter -- Convert from e.g. Sum (the data type) to SUM - convertAggFunction = SQL.sql . BS.map toUpper . BS.pack . show - aggregatedSnippet = convertAggFunction agg <> "(" <> snippet <> ")" + (aggFunction, aggArgument, aggFilter) = case agg of + JsonAgg -> (SQL.sql "json_agg", snippet, mempty) + a -> (SQL.sql . BS.map toUpper . BS.pack $ show a, snippet, mempty) pgFmtApplyCast :: Maybe Cast -> SQL.Snippet -> SQL.Snippet pgFmtApplyCast Nothing snippet = snippet diff --git a/test/spec/Feature/Query/AggregateFunctionsSpec.hs b/test/spec/Feature/Query/AggregateFunctionsSpec.hs index def85cbd52..1a55a0ffa9 100644 --- a/test/spec/Feature/Query/AggregateFunctionsSpec.hs +++ b/test/spec/Feature/Query/AggregateFunctionsSpec.hs @@ -214,14 +214,16 @@ allowed = {"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}]}]|] + {"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": 120.00}]}, - {"name": "Sarah", "process_supervisor": [{"category": "Batch", "cost_sum": 180.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 diff --git a/test/spec/Feature/Query/SpreadQueriesSpec.hs b/test/spec/Feature/Query/SpreadQueriesSpec.hs index 07a9c9d6d7..8b90ddfe6b 100644 --- a/test/spec/Feature/Query/SpreadQueriesSpec.hs +++ b/test/spec/Feature/Query/SpreadQueriesSpec.hs @@ -9,8 +9,8 @@ import Test.Hspec.Wai.JSON import Protolude hiding (get) import SpecHelper -spec :: SpecWith ((), Application) -spec = +aggDisabledSpec :: SpecWith ((), Application) +aggDisabledSpec = describe "spread embeds" $ do it "works on a many-to-one relationship" $ do get "/projects?select=id,...clients(client_name:name)" `shouldRespondWith` @@ -63,23 +63,35 @@ spec = , matchHeaders = [matchContentTypeJson] } - it "fails when is not a to-one relationship" $ do + it "fails when it's a many-to-one relationship and aggregates are disabled" $ 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" + "details":null, + "code":"PGRST123", + "message":"Use of aggregate functions is not allowed" }|] { 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" + "details":null, + "code":"PGRST123", + "message":"Use of aggregate functions is not allowed" + }|] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + + it "fails when it's a many-to-many relationship and aggregates are disabled" $ do + get "/supervisors?select=*,...processes(*)" `shouldRespondWith` + [json|{ + "hint":null, + "details":null, + "code":"PGRST123", + "message":"Use of aggregate functions is not allowed" }|] { matchStatus = 400 , matchHeaders = [matchContentTypeJson] @@ -112,3 +124,108 @@ spec = { matchStatus = 200 , matchHeaders = [matchContentTypeJson] } + +aggEnabledSpec :: SpecWith ((), Application) +aggEnabledSpec = + describe "spread embeds" $ do + context "many-to-one 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 aggregate spread columns from a nested one-to-one relationship" $ do + 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" $ do + 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] + } +-- One to many missing + 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" $ do + 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 many-to-many relationship into an array of objects" $ do + 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 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" $ do + 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] + } + + -- context "many-to-many relationship as spread aggregates" $ diff --git a/test/spec/Main.hs b/test/spec/Main.hs index 526bd45dcc..dca3bb2e89 100644 --- a/test/spec/Main.hs +++ b/test/spec/Main.hs @@ -160,7 +160,6 @@ main = do , ("Feature.Query.RelatedQueriesSpec" , Feature.Query.RelatedQueriesSpec.spec) , ("Feature.Query.RpcSpec" , Feature.Query.RpcSpec.spec) , ("Feature.Query.SingularSpec" , Feature.Query.SingularSpec.spec) - , ("Feature.Query.SpreadQueriesSpec" , Feature.Query.SpreadQueriesSpec.spec) , ("Feature.Query.UpdateSpec" , Feature.Query.UpdateSpec.spec) , ("Feature.Query.UpsertSpec" , Feature.Query.UpsertSpec.spec) ] @@ -248,11 +247,14 @@ main = do parallel $ before serverTiming $ describe "Feature.Query.ServerTimingSpec.spec" Feature.Query.ServerTimingSpec.spec - parallel $ before aggregatesEnabled $ + -- this test runs with db-aggregates-enabled set + parallel $ before aggregatesEnabled $ do describe "Feature.Query.AggregateFunctionsSpec" Feature.Query.AggregateFunctionsSpec.allowed + describe "Feature.Query.SpreadQueriesAggregatesEnabledSpec" Feature.Query.SpreadQueriesSpec.aggEnabledSpec - parallel $ before withApp $ + parallel $ before withApp $ do describe "Feature.Query.AggregateFunctionsDisallowedSpec." Feature.Query.AggregateFunctionsSpec.disallowed + describe "Feature.Query.SpreadQueriesAggregatesDisabledSpec" Feature.Query.SpreadQueriesSpec.aggDisabledSpec -- Note: the rollback tests can not run in parallel, because they test persistance and -- this results in race conditions diff --git a/test/spec/fixtures/data.sql b/test/spec/fixtures/data.sql index f6adbdff53..2d559fc12a 100644 --- a/test/spec/fixtures/data.sql +++ b/test/spec/fixtures/data.sql @@ -901,6 +901,7 @@ 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); TRUNCATE TABLE process_costs CASCADE; INSERT INTO process_costs VALUES (1, 150.00); @@ -914,6 +915,7 @@ 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 +926,25 @@ 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 machinery CASCADE; +INSERT INTO machinery VALUES (1, 'Excavator'); +INSERT INTO machinery VALUES (2, 'Bulldozer'); +INSERT INTO machinery VALUES (3, 'Drum mixer'); + +TRUNCATE TABLE factory_machinery CASCADE; +INSERT INTO factory_machinery VALUES (1, 1); +INSERT INTO factory_machinery VALUES (2, 1); +INSERT INTO factory_machinery VALUES (2, 3); +INSERT INTO factory_machinery VALUES (3, 2); +INSERT INTO factory_machinery VALUES (4, 1); +INSERT INTO factory_machinery VALUES (4, 2); +INSERT INTO factory_machinery VALUES (4, 3); + +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..839d92c26d 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 machinery ( + id int primary key, + name text +); + +create table factory_machinery ( + factory_id int references factories(id), + machinery_id int references machinery(id), + primary key (factory_id, machinery_id) +); + +create table factory_buildings ( + id int primary key, + code char(4), + size numeric, + factory_id int references factories(id) +);