From 6e6470736f630dee0eab3a2142b3ec0738ea74bb Mon Sep 17 00:00:00 2001 From: Laurence Isla Date: Fri, 6 Sep 2024 19:48:16 -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 | 67 +++++++---- src/PostgREST/Query/QueryBuilder.hs | 1 + src/PostgREST/Query/SqlFragment.hs | 7 +- .../Feature/Query/AggregateFunctionsSpec.hs | 6 +- test/spec/Feature/Query/SpreadQueriesSpec.hs | 112 ++++++++++++++++-- test/spec/Main.hs | 8 +- test/spec/fixtures/data.sql | 24 ++++ test/spec/fixtures/schema.sql | 18 +++ 10 files changed, 201 insertions(+), 55 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..1b93c720ca 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -334,12 +334,12 @@ readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows, configDbAggregate treeRestrictRange configDbMaxRows (iAction apiRequest) =<< hoistSpreadAggFunctions =<< validateAggFunctions configDbAggregates =<< - addRelSelects =<< + addRelSelects False =<< addNullEmbedFilters =<< - validateSpreadEmbeds =<< addRelatedOrders =<< addAliases =<< expandStars ctx =<< + addJsonAggToManySpread False =<< addRels qiSchema (iAction apiRequest) dbRelationships Nothing =<< addLogicTrees ctx apiRequest =<< addRanges apiRequest =<< @@ -616,32 +616,51 @@ findRel schema allRels origin target hint = ) ) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels - -addRelSelects :: ReadPlanTree -> Either ApiRequestError ReadPlanTree -addRelSelects node@(Node rp forest) +-- 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 :: Bool -> ReadPlanTree -> Either ApiRequestError ReadPlanTree +addJsonAggToManySpread isNested (Node rp@ReadPlan{select} forest) = + let newForest = addJsonAggToManySpread shouldAddJsonAgg `traverse` forest + newSelects + | shouldAddJsonAgg = fieldToJsonAgg <$> select + | otherwise = select + in Node rp { select = newSelects } <$> newForest + where + -- TODO: Needs a test like '/table?select=...to_many_rel(normal_rel(*,...to_one_rel())' <- 'to_one_rel' should not be aggregate + shouldAddJsonAgg = spreadRelIsInToMany isNested rp + fieldToJsonAgg field + | isJust $ csAggFunction field = field + | otherwise = field { csAggFunction = Just JsonAgg, csAlias = newAlias (csAlias field) (cfName $ csField field) } + newAlias alias fieldName = maybe (Just fieldName) pure alias + +addRelSelects :: Bool -> ReadPlanTree -> Either ApiRequestError ReadPlanTree +addRelSelects isNestedInToManySpread node@(Node rp forest) | null forest = Right node | otherwise = - let newForest = rights $ addRelSelects <$> forest - newRelSelects = mapMaybe generateRelSelectField newForest + let spreadInToMany = spreadRelIsInToMany isNestedInToManySpread rp + newForest = rights $ addRelSelects spreadInToMany <$> forest + newRelSelects = mapMaybe (generateRelSelectField spreadInToMany) newForest in Right $ Node rp { relSelect = newRelSelects } newForest -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 :: Bool -> ReadPlanTree -> Maybe RelSelectField +generateRelSelectField isNestedInToManySpread (Node rp@ReadPlan{relToParent=Just _, relAggAlias, relIsSpread = True} _) = + Just $ Spread { rsSpreadSel = generateSpreadSelectFields isNestedInToManySpread rp, rsAggAlias = relAggAlias } +generateRelSelectField isNestedInToManySpread (Node ReadPlan{relToParent=Just rel, select, relName, relAlias, relAggAlias, relIsSpread = False} 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 || isNestedInToManySpread then JsonObject else JsonArray rsEmptyEmbed = hasOnlyNullEmbed (null select) forest hasOnlyNullEmbed = foldr checkIfNullEmbed checkIfNullEmbed :: ReadPlanTree -> Bool -> Bool checkIfNullEmbed (Node ReadPlan{select=s} f) isNullEmbed = isNullEmbed && hasOnlyNullEmbed (null s) f -generateRelSelectField _ = Nothing +generateRelSelectField _ _ = Nothing -generateSpreadSelectFields :: ReadPlan -> [SpreadSelectField] -generateSpreadSelectFields ReadPlan{select, relSelect} = +generateSpreadSelectFields :: Bool -> ReadPlan -> [SpreadSelectField] +generateSpreadSelectFields isNestedInToManySpread rp@ReadPlan{select, relSelect} = -- We combine the select and relSelect fields into a single list of SpreadSelectField. selectSpread ++ relSelectSpread where @@ -653,10 +672,17 @@ 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 shouldAddJsonAgg = spreadRelIsInToMany isNestedInToManySpread rp + (aggFun, alias) = if shouldAddJsonAgg then (Just JsonAgg, Just rsSelName) else (Nothing, Nothing) in + [SpreadSelectField { ssSelName = rsSelName, ssSelAggFunction = aggFun, ssSelAggCast = Nothing, ssSelAlias = alias }] relSelectToSpread (Spread{rsSpreadSel}) = rsSpreadSel +spreadRelIsInToMany :: Bool -> ReadPlan -> Bool +spreadRelIsInToMany isNested ReadPlan{relIsSpread, relToParent} = + relIsSpread && (isNested || Just False == (relIsToOne <$> relToParent)) + -- 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: @@ -906,15 +932,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/Query/QueryBuilder.hs b/src/PostgREST/Query/QueryBuilder.hs index 602ae27ef1..ad49a0c6a0 100644 --- a/src/PostgREST/Query/QueryBuilder.hs +++ b/src/PostgREST/Query/QueryBuilder.hs @@ -75,6 +75,7 @@ getJoinSelects (Node ReadPlan{relSelect} _) = case fld of JsonEmbed{rsEmptyEmbed = True} -> Nothing + -- Maybe there needs to be a flag here or treat as a Spread? JsonEmbed{rsSelName, rsEmbedMode = JsonObject} -> Just $ "row_to_json(" <> aggAlias <> ".*)::jsonb AS " <> pgFmtIdent rsSelName JsonEmbed{rsSelName, rsEmbedMode = JsonArray} -> 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..16c6f37a9d 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,25 +63,37 @@ spec = , matchHeaders = [matchContentTypeJson] } - it "fails when is not a to-one relationship" $ do + it "fails when it's a one-to-many 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 + { 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 + { 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,81 @@ spec = { matchStatus = 200 , matchHeaders = [matchContentTypeJson] } + +aggEnabledSpec :: SpecWith ((), Application) +aggEnabledSpec = + describe "spread embeds" $ do +-- it "works on a one-to-many relationship" $ do +-- get "/factories?select=id,...processes(name)" `shouldRespondWith` +-- [json|[ +-- +-- ]|] +-- { matchStatus = 200 +-- , matchHeaders = [matchContentTypeJson] +-- } +-- get "/" `shouldRespondWith` +-- [json|[ +-- {"id":1,"project":["Windows 7", "Windows 10"]}, +-- {"id":2,"project":["IOS", "OSX"]} +-- ]|] +-- { matchStatus = 200 +-- , matchHeaders = [matchContentTypeJson] +-- } +-- get "/" `shouldRespondWith` +-- [json|[ +-- {"id":1,"name":["Windows 7", "Windows 10"],"client_id": [1]}, +-- {"id":2,"name":["IOS", "OSX"],"client_id": [2]} +-- ]|] +-- { matchStatus = 200 +-- , matchHeaders = [matchContentTypeJson] +-- } + it "works on a one-to-many relationship" $ do + get "/clients?select=id,...projects(name)" `shouldRespondWith` + [json|[ + {"id":1,"name":["Windows 7", "Windows 10"]}, + {"id":2,"name":["IOS", "OSX"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } +-- Nested not working as expected: +-- get "/entities?select=name,...child_entities(child_name:name,...grandchild_entities(grandchild_name:name))&limit=3" `shouldRespondWith` +-- [json|[ +-- {"name":"entity 1","child_name":"child entity 1","grandchild_name":"grandchild entity 1"}, +-- {"name":"entity 2","child_name":"child entity 1","grandchild_name":"grandchild entity 1"}, +-- {"name":"entity 3","child_name":"child entity 2","grandchild_name":"grandchild entity 1"} +-- ]|] +-- { matchStatus = 200 +-- , matchHeaders = [matchContentTypeJson] +-- } +-- get "/videogames?select=name,...computed_designers(designer_name:name)" `shouldRespondWith` +-- [json|[ +-- {"name":"Civilization I","designer_name":"Sid Meier"}, +-- {"name":"Civilization II","designer_name":"Sid Meier"}, +-- {"name":"Final Fantasy I","designer_name":"Hironobu Sakaguchi"}, +-- {"name":"Final Fantasy II","designer_name":"Hironobu Sakaguchi"} +-- ]|] +-- { matchStatus = 200 +-- , matchHeaders = [matchContentTypeJson] +-- } + + +-- it "works inside a normal embed" $ +-- get "/grandchild_entities?select=name,child_entity:child_entities(name,...entities(parent_name:name))&limit=1" `shouldRespondWith` +-- [json|[ +-- {"name":"grandchild entity 1","child_entity":{"name":"child entity 1","parent_name":"entity 1"}} +-- ]|] +-- { matchStatus = 200 +-- , matchHeaders = [matchContentTypeJson] +-- } + + it "works on a many-to-many relationship" $ + get "/users?select=name,...projects(projects:name)" `shouldRespondWith` + [json|[ + {"name":"Dwight Schrute","projects":["Windows 7", "IOS"]}, + {"name":"Angela Martin","projects":["Windows 7", "Windows 10"]}, + {"name":"Michael Scott","projects":["IOS", "OSX"]} + ]|] + { matchStatus = 200 + , matchHeaders = [matchContentTypeJson] + } 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) +);