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..09aa3bf7a0 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") diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index 2e3587e988..4f2f0ff84a 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 False =<< addRels qiSchema (iAction apiRequest) dbRelationships Nothing =<< addLogicTrees ctx apiRequest =<< addRanges apiRequest =<< @@ -604,6 +604,22 @@ 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: +-- * Belong to a spread to-many relationship +-- * Are to-one spread but are nested inside a spread to-many relationship +addJsonAggToManySpread :: Bool -> ReadPlanTree -> Either ApiRequestError ReadPlanTree +addJsonAggToManySpread isNestedInToManyRel (Node rp@ReadPlan{select, relIsSpread, relToParent} forest) = + let shouldAddJsonAgg = relIsSpread && (isNestedInToManyRel || Just False == (relIsToOne <$> relToParent)) + newForest = rights $ addJsonAggToManySpread shouldAddJsonAgg <$> forest + newSelects + | shouldAddJsonAgg = fieldToJsonAgg <$> select + | otherwise = select + in Right $ Node rp { select = newSelects } newForest + where + 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 :: ReadPlanTree -> Either ApiRequestError ReadPlanTree addRelSelects node@(Node rp forest) @@ -896,15 +912,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/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index 39b869d5d9..7f954ccfaf 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -283,10 +283,12 @@ pgFmtApplyAggregate Nothing _ snippet = snippet pgFmtApplyAggregate (Just agg) aggCast snippet = pgFmtApplyCast aggCast aggregatedSnippet where + aggregatedSnippet = convertAggFunction agg <> "(" <> snippet <> ")" 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 <> ")" + convertAggFunction = \case + JsonAgg -> SQL.sql "json_agg" + a -> SQL.sql . BS.map toUpper . BS.pack $ show a 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 5c9a6488c0..701599dc06 100644 --- a/test/spec/Feature/Query/AggregateFunctionsSpec.hs +++ b/test/spec/Feature/Query/AggregateFunctionsSpec.hs @@ -211,6 +211,58 @@ allowed = {"name": "Sarah", "process_supervisor": [{"category": "Batch", "cost_sum": 180.00}]}]|] { matchHeaders = [matchContentTypeJson] } + context "performing json_agg() aggregations on to-many spread embeds" $ do + 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] + } + disallowed :: SpecWith ((), Application) disallowed = describe "attempting to use an aggregate when aggregate functions are disallowed" $ do diff --git a/test/spec/Feature/Query/SpreadQueriesSpec.hs b/test/spec/Feature/Query/SpreadQueriesSpec.hs index 07a9c9d6d7..73fc351da3 100644 --- a/test/spec/Feature/Query/SpreadQueriesSpec.hs +++ b/test/spec/Feature/Query/SpreadQueriesSpec.hs @@ -63,25 +63,25 @@ spec = , matchHeaders = [matchContentTypeJson] } - it "fails when is not a to-one relationship" $ do + it "fails when it's a 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] }