refactor: make Junction non-recursive (#1818)

Also Cardinality now includes a Junction or ConstraintName

src/PostgREST/DbStructure.hs

@@ -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
+    lookupFn c rel = case rel of
-    relToFk col Relation{relColumns=cols, relFColumns=colsF} = do
+      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
+          relForeignTable relForeignColumns relCardinality
-          relType relLink
       | srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ]
 
     tableViewM2O =
       [ Relation
           relTable relColumns
-          (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
+          (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relForeignColumns)
-          relType relLink
+          relCardinality
-      | fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
+      | fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relForeignColumns ]
 
     viewViewM2O =
       [ Relation
           (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
-          (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
+          (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relForeignColumns)
-          relType relLink
+          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
+addO2MRels rels = rels ++ [ Relation ft fc t c (O2M cons)
-                          | Relation t c ft fc typ lnk <- rels
+                          | Relation t c ft fc (M2O cons) <- rels ]
-                          , typ == M2O]
 
 addM2MRels :: [Relation] -> [Relation]
-addM2MRels rels = rels ++ [ Relation t c ft fc M2M (Junction jt1 lnk1 jc1 lnk2 jc2)
+addM2MRels rels = rels ++ [ Relation t c ft fc (M2M $ Junction jt1 cons1 jc1 cons2 jc2)
-                          | Relation jt1 jc1 t c _ lnk1 <- rels
+                          | Relation jt1 jc1 t c (M2O cons1) <- rels
-                          , Relation jt2 jc2 ft fc _ lnk2 <- 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

src/PostgREST/DbStructure/Relation.hs

@@ -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
 
 
@@ -30,47 +27,38 @@ import Protolude
 data Relation = Relation
   { relTable          :: Table
   , relColumns        :: [Column]
-  , relFTable   :: Table
+  , relForeignTable   :: Table
-  , relFColumns :: [Column]
+  , relForeignColumns :: [Column]
-  , relType     :: Cardinality
+  , relCardinality    :: Cardinality
-  , relLink     :: Link -- ^ Constraint on O2M/M2O, Junction for M2M 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
+data Junction = Junction
-  = Constraint
-      { constName :: ConstraintName }
-  | Junction
   { junTable       :: Table
-      , junLink1 :: Link
+  , junConstraint1 :: FKConstraint
-      , junCols1 :: [Column]
+  , junColumns1    :: [Column]
-      , junLink2 :: Link
+  , junConstraint2 :: FKConstraint
-      , junCols2 :: [Column]
+  , 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

src/PostgREST/Error.hs

@@ -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
+  , "target"      .= fmtTbl relForeignTable
-  , "cardinality" .= (show relType :: Text)
   ] ++
-  case relLink of
+  case relCardinality of
-    Junction{..} -> [
+    M2M Junction{..} -> [
-      "relationship" .= (fmtTbl junTable <> fmtEls [constName junLink1] <> fmtEls [constName junLink2])
+        "cardinality" .= ("m2m" :: Text)
+      , "relationship" .= (fmtTbl junTable <> fmtEls [junConstraint1] <> fmtEls [junConstraint2])
       ]
-    Constraint{..} -> [
+    M2O cons -> [
-      "relationship" .= (constName <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relFColumns))
+        "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

src/PostgREST/Query/QueryBuilder.hs

@@ -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
+  case card of
-    M2O ->
+    M2O _ ->
       let aliasOrName = fromMaybe name alias
           localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
           sel = H.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)

src/PostgREST/Request/DbRequestBuilder.hs

@@ -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
+    rs@[rel0, rel1]  -> case (relCardinality rel0, relCardinality rel1, relTable rel0 == relTable rel1 && relForeignTable rel0 == relForeignTable rel1) of
-      if length rs == 2 && relLink rel0 == relLink rel1 && relTable rel0 == relTable rel1 && relFTable rel0 == relFTable rel1
+      (O2M cons1, M2O cons2, True) -> if cons1 == cons2 then Right rel0 else Left $ AmbiguousRelBetween origin target rs
-        then note (NoRelBetween origin target) (find (\r -> relType r == O2M) rs)
+      (M2O cons1, O2M cons2, True) -> if cons1 == cons2 then Right rel1 else Left $ AmbiguousRelBetween origin target rs
-        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
+            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(*)
-          (
+          matchConstraint hint relCardinality || -- projects_client_id_fkey
-            relType /= M2M &&
-            hint == Just (constName relLink) -- 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(*)
+          -- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
-          (
+          matchJunction hint relCardinality -- users_tasks
-            relType == M2M &&                           -- many-to-many between users and tasks
-            hint == Just (tableName $ junTable relLink) -- 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) =
+getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fCols card) =
-  case lnk of
+  case card of
-    Junction Table{tableName=jtn} _ jc1 _ jc2 ->
+    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,13 +357,9 @@ 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
+    -- succeeds, result would be `RETURNING name, client_id`.
-    -- for the other relType's.
     fkCols = concat $ mapMaybe (\case
-        Node (_, (_, Just Relation{relColumns=cols, relType=relTyp}, _, _, _)) _ -> case relTyp of
+        Node (_, (_, Just Relation{relColumns=cols}, _, _, _)) _ -> Just cols
-          O2M -> Just cols
-          M2O -> Just cols
-          M2M -> Just cols
         _                                                        -> Nothing
       ) forest
     -- However if the "client_id" is present, e.g. mutateRequest to