feat: WIP allow spread operators in to-many relationships

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

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"

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

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} ->

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

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

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]
+        }

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