refactor: make Junction non-recursive (#1818)

Also Cardinality now includes a Junction or ConstraintName
2021-04-16 13:12:58 -05:00
parent 1f206a560b
commit 698bfe6e7b
5 changed files with 101 additions and 113 deletions
@@ -51,7 +51,8 @@ import PostgREST.DbStructure.Proc        (PgArg (..), PgType (..),
                                          ProcVolatility (..),
                                          ProcsMap, RetType (..))
 import PostgREST.DbStructure.Relation    (Cardinality (..),
-                                          ForeignKey (..), Link (..),
+                                          ForeignKey (..),
+                                          Junction (..),
                                          PrimaryKey (..),
                                          Relation (..))
 import PostgREST.DbStructure.Table       (Column (..), Table (..))
@@ -79,8 +80,6 @@ tableCols dbs tSchema tName = filter (\Column{colTable=Table{tableSchema=s, tabl
 tablePKCols :: DbStructure -> Schema -> TableName -> [Text]
 tablePKCols dbs tSchema tName =  pkName <$> filter (\pk -> tSchema == (tableSchema . pkTable) pk && tName == (tableName . pkTable) pk) (dbPrimaryKeys dbs)

-
-
 -- | The source table column a view column refers to
 type SourceColumn = (Column, ViewColumn)
 type ViewColumn = Column
@@ -348,8 +347,10 @@ addForeignKeys rels = map addFk
    addFk col = col { colFK = fk col }
    fk col = find (lookupFn col) rels >>= relToFk col
    lookupFn :: Column -> Relation -> Bool
-    lookupFn c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==M2O
-    relToFk col Relation{relColumns=cols, relFColumns=colsF} = do
+    lookupFn c rel = case rel of
+      Relation{relColumns=cs, relCardinality=M2O _} -> c `elem` cs
+      _                                             -> False
+    relToFk col Relation{relColumns=cols, relForeignColumns=colsF} = do
      pos <- L.elemIndex col cols
      colF <- atMay colsF pos
      return $ ForeignKey colF
@@ -357,7 +358,7 @@ addForeignKeys rels = map addFk
 {-
 Adds Views M2O Relations based on SourceColumns found, the logic is as follows:

-Having a Relation{relTable=t1, relColumns=[c1], relFTable=t2, relFColumns=[c2], relType=M2O} represented by:
+Having a Relation{relTable=t1, relColumns=[c1], relFTable=t2, relFColumns=[c2], relCardinality=M2O} represented by:

 t1.c1------t2.c2

@@ -392,7 +393,7 @@ addViewM2ORels allSrcCols = concatMap (\rel@Relation{..} -> rel :
    srcColsGroupedByView relCols = L.groupBy (\(_, viewCol1) (_, viewCol2) -> colTable viewCol1 == colTable viewCol2) $
                   filter (\(c, _) -> c `elem` relCols) allSrcCols
    relSrcCols = srcColsGroupedByView relColumns
-    relFSrcCols = srcColsGroupedByView relFColumns
+    relFSrcCols = srcColsGroupedByView relForeignColumns
    getView :: [SourceColumn] -> Table
    getView = colTable . snd . unsafeHead
    srcCols `allSrcColsOf` cols = S.fromList (fst <$> srcCols) == S.fromList cols
@@ -404,38 +405,36 @@ addViewM2ORels allSrcCols = concatMap (\rel@Relation{..} -> rel :
    viewTableM2O =
      [ Relation
          (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
-          relFTable relFColumns
-          relType relLink
+          relForeignTable relForeignColumns relCardinality
      | srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ]

    tableViewM2O =
      [ Relation
          relTable relColumns
-          (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
-          relType relLink
-      | fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
+          (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relForeignColumns)
+          relCardinality
+      | fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relForeignColumns ]

    viewViewM2O =
      [ Relation
          (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
-          (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
-          relType relLink
+          (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relForeignColumns)
+          relCardinality
      | srcCols  <- relSrcCols, srcCols `allSrcColsOf` relColumns
-      , fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
+      , fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relForeignColumns ]

  in viewTableM2O ++ tableViewM2O ++ viewViewM2O)

 addO2MRels :: [Relation] -> [Relation]
-addO2MRels rels = rels ++ [ Relation ft fc t c O2M lnk
-                          | Relation t c ft fc typ lnk <- rels
-                          , typ == M2O]
+addO2MRels rels = rels ++ [ Relation ft fc t c (O2M cons)
+                          | Relation t c ft fc (M2O cons) <- rels ]

 addM2MRels :: [Relation] -> [Relation]
-addM2MRels rels = rels ++ [ Relation t c ft fc M2M (Junction jt1 lnk1 jc1 lnk2 jc2)
-                          | Relation jt1 jc1 t c _ lnk1 <- rels
-                          , Relation jt2 jc2 ft fc _ lnk2 <- rels
+addM2MRels rels = rels ++ [ Relation t c ft fc (M2M $ Junction jt1 cons1 jc1 cons2 jc2)
+                          | Relation jt1 jc1 t c (M2O cons1) <- rels
+                          , Relation jt2 jc2 ft fc (M2O cons2) <- rels
                          , jt1 == jt2
-                          , lnk1 /= lnk2]
+                          , cons1 /= cons2]

 addViewPrimaryKeys :: [SourceColumn] -> [PrimaryKey] -> [PrimaryKey]
 addViewPrimaryKeys srcCols = concatMap (\pk ->
@@ -632,7 +631,7 @@ allM2ORels tabs cols =

 relFromRow :: [Table] -> [Column] -> (Text, Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
 relFromRow allTabs allCols (rs, rt, cn, rcs, frs, frt, frcs) =
-  Relation <$> table <*> cols <*> tableF <*> colsF <*> pure M2O <*> pure (Constraint cn)
+  Relation <$> table <*> cols <*> tableF <*> colsF <*> pure (M2O cn)
  where
    findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
    findCol s t c = find (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col == c) allCols
@@ -3,11 +3,10 @@

 module PostgREST.DbStructure.Relation
  ( Cardinality(..)
-  , Constraint
  , ForeignKey(..)
-  , Link(..)
  , PrimaryKey(..)
  , Relation(..)
+  , Junction(..)
  , isSelfReference
  ) where

@@ -16,8 +15,6 @@ import qualified Data.Aeson as JSON
 import PostgREST.DbStructure.Table (Column (..), ForeignKey (..),
                                    Table (..))

-import qualified GHC.Show (show)
-
 import Protolude


@@ -28,49 +25,40 @@ import Protolude
 --
 -- TODO merge relColumns and relFColumns to a tuple or Data.Bimap
 data Relation = Relation
-  { relTable    :: Table
-  , relColumns  :: [Column]
-  , relFTable   :: Table
-  , relFColumns :: [Column]
-  , relType     :: Cardinality
-  , relLink     :: Link -- ^ Constraint on O2M/M2O, Junction for M2M Cardinality
+  { relTable          :: Table
+  , relColumns        :: [Column]
+  , relForeignTable   :: Table
+  , relForeignColumns :: [Column]
+  , relCardinality    :: Cardinality
  }
  deriving (Eq, Generic, JSON.ToJSON)

-type ConstraintName = Text
+-- | The relationship cardinality
+-- | https://en.wikipedia.org/wiki/Cardinality_(data_modeling)
+-- TODO: missing one-to-one
+data Cardinality
+  = O2M FKConstraint -- ^ one-to-many cardinality
+  | M2O FKConstraint -- ^ many-to-one cardinality
+  | M2M Junction     -- ^ many-to-many cardinality
+  deriving (Eq, Generic, JSON.ToJSON)
+
+type FKConstraint = Text

 -- | Junction table on an M2M relationship
-data Link
-  = Constraint
-      { constName :: ConstraintName }
-  | Junction
-      { junTable :: Table
-      , junLink1 :: Link
-      , junCols1 :: [Column]
-      , junLink2 :: Link
-      , junCols2 :: [Column]
-      }
+data Junction = Junction
+  { junTable       :: Table
+  , junConstraint1 :: FKConstraint
+  , junColumns1    :: [Column]
+  , junConstraint2 :: FKConstraint
+  , junColumns2    :: [Column]
+  }
  deriving (Eq, Generic, JSON.ToJSON)

+isSelfReference :: Relation -> Bool
+isSelfReference r = relTable r == relForeignTable r
+
 data PrimaryKey = PrimaryKey
  { pkTable :: Table
  , pkName  :: Text
  }
  deriving (Generic, JSON.ToJSON)
-
-- | The relationship
-- [cardinality](https://en.wikipedia.org/wiki/Cardinality_(data_modeling)).
-- TODO: missing one-to-one
-data Cardinality
-  = O2M -- ^ one-to-many,  previously known as Parent
-  | M2O -- ^ many-to-one,  previously known as Child
-  | M2M -- ^ many-to-many, previously known as Many
-  deriving (Eq, Generic, JSON.ToJSON)
-
-instance Show Cardinality where
-  show O2M = "o2m"
-  show M2O = "m2o"
-  show M2M = "m2m"
-
-isSelfReference :: Relation -> Bool
-isSelfReference r = relTable r == relFTable r
@@ -29,7 +29,8 @@ import Network.HTTP.Types.Header (Header)
 import           PostgREST.ContentType (ContentType (..))
 import qualified PostgREST.ContentType as ContentType

-import PostgREST.DbStructure.Relation (Link (..), Relation (..))
+import PostgREST.DbStructure.Relation (Cardinality (..),
+                                       Junction (..), Relation (..))
 import PostgREST.DbStructure.Table    (Column (..), Table (..))

 import Protolude      hiding (toS)
@@ -106,15 +107,20 @@ compressedRel Relation{..} =
  in
  JSON.object $ [
    "origin"      .= fmtTbl relTable
-  , "target"      .= fmtTbl relFTable
-  , "cardinality" .= (show relType :: Text)
+  , "target"      .= fmtTbl relForeignTable
  ] ++
-  case relLink of
-    Junction{..} -> [
-      "relationship" .= (fmtTbl junTable <> fmtEls [constName junLink1] <> fmtEls [constName junLink2])
+  case relCardinality of
+    M2M Junction{..} -> [
+        "cardinality" .= ("m2m" :: Text)
+      , "relationship" .= (fmtTbl junTable <> fmtEls [junConstraint1] <> fmtEls [junConstraint2])
      ]
-    Constraint{..} -> [
-      "relationship" .= (constName <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relFColumns))
+    M2O cons -> [
+        "cardinality" .= ("m2o" :: Text)
+      , "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))
+      ]
+    O2M cons -> [
+        "cardinality" .= ("o2m" :: Text)
+      , "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))
      ]

 data PgError = PgError Authenticated P.UsageError
@@ -53,10 +53,10 @@ readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicFores
    (joins, selects) = foldr getJoinsSelects ([],[]) forest

 getJoinsSelects :: ReadRequest -> ([H.Snippet], [H.Snippet]) -> ([H.Snippet], [H.Snippet])
-getJoinsSelects rr@(Node (_, (name, Just Relation{relType=relTyp,relTable=Table{tableName=table}}, alias, _, _)) _) (j,s) =
+getJoinsSelects rr@(Node (_, (name, Just Relation{relCardinality=card,relTable=Table{tableName=table}}, alias, _, _)) _) (j,s) =
  let subquery = readRequestToQuery rr in
-  case relTyp of
-    M2O ->
+  case card of
+    M2O _ ->
      let aliasOrName = fromMaybe name alias
          localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
          sel = H.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)
@@ -33,7 +33,8 @@ import Data.Tree               (Tree (..))
 import PostgREST.DbStructure.Identifiers (FieldName,
                                          QualifiedIdentifier (..),
                                          Schema, TableName)
-import PostgREST.DbStructure.Relation    (Cardinality (..), Link (..),
+import PostgREST.DbStructure.Relation    (Cardinality (..),
+                                          Junction (..),
                                          Relation (..))
 import PostgREST.DbStructure.Table       (Column (..), Table (..),
                                          tableQi)
@@ -125,7 +126,7 @@ addRels :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Ap
 addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, depth)) forest) =
  case parentNode of
    Just (Node (Select{from=parentNodeQi}, _) _) ->
-      let newFrom r = if qiName tbl == nodeName then tableQi (relFTable r) else tbl
+      let newFrom r = if qiName tbl == nodeName then tableQi (relForeignTable r) else tbl
          newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, Nothing, depth))) <$> rel
          rel = findRel schema allRels (qiName parentNodeQi) nodeName hint
      in
@@ -152,34 +153,38 @@ findRel schema allRels origin target hint =
  case rel of
    []  -> Left $ NoRelBetween origin target
    [r] -> Right r
-    rs  ->
-      -- Return error if more than one relationship is found, unless we're in a
-      -- self reference case.
-      --
-      -- Here we handle a self reference relationship to not cause a breaking
-      -- change: In a self reference we get two relationships with the same
-      -- foreign key and relTable/relFtable but with different
-      -- cardinalities(m2o/o2m) We output the O2M rel, the M2O rel can be
-      -- obtained by using the origin column as an embed hint.
-      let [rel0, rel1] = take 2 rs in
-      if length rs == 2 && relLink rel0 == relLink rel1 && relTable rel0 == relTable rel1 && relFTable rel0 == relFTable rel1
-        then note (NoRelBetween origin target) (find (\r -> relType r == O2M) rs)
-        else Left $ AmbiguousRelBetween origin target rs
+    -- Here we handle a self reference relationship to not cause a breaking
+    -- change: In a self reference we get two relationships with the same
+    -- foreign key and relTable/relFtable but with different
+    -- cardinalities(m2o/o2m) We output the O2M rel, the M2O rel can be
+    -- obtained by using the origin column as an embed hint.
+    rs@[rel0, rel1]  -> case (relCardinality rel0, relCardinality rel1, relTable rel0 == relTable rel1 && relForeignTable rel0 == relForeignTable rel1) of
+      (O2M cons1, M2O cons2, True) -> if cons1 == cons2 then Right rel0 else Left $ AmbiguousRelBetween origin target rs
+      (M2O cons1, O2M cons2, True) -> if cons1 == cons2 then Right rel1 else Left $ AmbiguousRelBetween origin target rs
+      _                            -> Left $ AmbiguousRelBetween origin target rs
+    rs -> Left $ AmbiguousRelBetween origin target rs
  where
    matchFKSingleCol hint_ cols = length cols == 1 && hint_ == (colName <$> head cols)
+    matchConstraint tar card = case card of
+      O2M cons -> tar == Just cons
+      M2O cons -> tar == Just cons
+      _        -> False
+    matchJunction hint_ card = case card of
+      M2M Junction{junTable} -> hint_ == Just (tableName junTable)
+      _                      -> False
    rel = filter (
      \Relation{..} ->
        -- Both relationship ends need to be on the exposed schema
-        schema == tableSchema relTable && schema == tableSchema relFTable &&
+        schema == tableSchema relTable && schema == tableSchema relForeignTable &&
        (
          -- /projects?select=clients(*)
          origin == tableName relTable  &&  -- projects
-          target == tableName relFTable ||  -- clients
+          target == tableName relForeignTable ||  -- clients

          -- /projects?select=projects_client_id_fkey(*)
          (
-            origin == tableName relTable && -- projects
-            Constraint target == relLink    -- projects_client_id_fkey
+            origin == tableName relTable &&              -- projects
+            matchConstraint (Just target) relCardinality -- projects_client_id_fkey
          ) ||
          -- /projects?select=client_id(*)
          (
@@ -190,20 +195,14 @@ findRel schema allRels origin target hint =
          isNothing hint || -- hint is optional

          -- /projects?select=clients!projects_client_id_fkey(*)
-          (
-            relType /= M2M &&
-            hint == Just (constName relLink) -- projects_client_id_fkey
-          ) ||
+          matchConstraint hint relCardinality || -- projects_client_id_fkey

          -- /projects?select=clients!client_id(*) or /projects?select=clients!id(*)
          matchFKSingleCol hint relColumns  || -- client_id
-          matchFKSingleCol hint relFColumns || -- id
+          matchFKSingleCol hint relForeignColumns || -- id

-          -- /users?select=tasks!users_tasks(*)
-          (
-            relType == M2M &&                           -- many-to-many between users and tasks
-            hint == Just (tableName $ junTable relLink) -- users_tasks
-          )
+          -- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
+          matchJunction hint relCardinality -- users_tasks
        )
      ) allRels

@@ -211,7 +210,7 @@ findRel schema allRels origin target hint =
 addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest
 addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, rel, _, _, depth)) forest) =
  case rel of
-    Just r@Relation{relType=M2M, relLink=Junction{junTable}} ->
+    Just r@Relation{relCardinality=M2M Junction{junTable}} ->
      let rq = augmentQuery r in
      Node (rq{implicitJoins=tableQi junTable:implicitJoins rq}, nodeProps) <$> updatedForest
    Just r -> Node (augmentQuery r, nodeProps) <$> updatedForest
@@ -231,11 +230,11 @@ addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_

 -- previousAlias and newAlias are used in the case of self joins
 getJoinConditions :: Maybe Alias -> Maybe Alias -> Relation -> [JoinCondition]
-getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fCols _ lnk) =
-  case lnk of
-    Junction Table{tableName=jtn} _ jc1 _ jc2 ->
+getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fCols card) =
+  case card of
+    M2M (Junction Table{tableName=jtn} _ jc1 _ jc2) ->
      zipWith (toJoinCondition tN jtn) cols jc1 ++ zipWith (toJoinCondition ftN jtn) fCols jc2
-    Constraint _ ->
+    _ ->
      zipWith (toJoinCondition tN ftN) cols fCols
  where
    toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
@@ -358,14 +357,10 @@ returningCols rr@(Node _ forest) pkCols
    -- be `RETURNING name`(see QueryBuilder).  This would make the embedding
    -- fail because the following JOIN would need the "client_id" column from
    -- projects.  So this adds the foreign key columns to ensure the embedding
-    -- succeeds, result would be `RETURNING name, client_id`.  This also works
-    -- for the other relType's.
+    -- succeeds, result would be `RETURNING name, client_id`.
    fkCols = concat $ mapMaybe (\case
-        Node (_, (_, Just Relation{relColumns=cols, relType=relTyp}, _, _, _)) _ -> case relTyp of
-          O2M -> Just cols
-          M2O -> Just cols
-          M2M -> Just cols
-        _ -> Nothing
+        Node (_, (_, Just Relation{relColumns=cols}, _, _, _)) _ -> Just cols
+        _                                                        -> Nothing
      ) forest
    -- However if the "client_id" is present, e.g. mutateRequest to
    -- /projects?select=client_id,name,clients(name) we would get `RETURNING