Fix for #302

src/PostgREST/Config.hs

@@ -105,4 +105,4 @@ readOptions = customExecParser parserPrefs opts
 
 -- | Tells the minimum PostgreSQL version required by this version of PostgREST
 minimumPgVersion :: Integer
-minimumPgVersion = 90200
+minimumPgVersion = 90300

src/PostgREST/PgQuery.hs

@@ -10,7 +10,7 @@ import qualified Hasql                   as H
 import qualified Hasql.Backend           as B
 import qualified Hasql.Postgres          as P
 import           PostgREST.RangeQuery
-import           PostgREST.Types         (OrderTerm (..))
+import           PostgREST.Types         (OrderTerm (..), QualifiedIdentifier(..))
 
 import           Control.Monad           (join)
 import qualified Data.Aeson              as JSON
@@ -38,11 +38,6 @@ instance Monoid PStmt where
   mempty = B.Stmt "" empty True
 type StatementT = PStmt -> PStmt
 
-data QualifiedIdentifier = QualifiedIdentifier {
-  qiSchema :: T.Text
-, qiName   :: T.Text
-} deriving (Show)
-
 
 limitT :: Maybe NonnegRange -> StatementT
 limitT r q =

src/PostgREST/PgStructure.hs

@@ -6,8 +6,9 @@
 module PostgREST.PgStructure where
 
 import           Control.Applicative
+import           Control.Monad         (join)
 import           Data.Functor.Identity
-import           Data.List             (find)
+import           Data.List             (elemIndex, find)
 import           Data.Maybe            (fromMaybe, isJust, mapMaybe)
 import           Data.Monoid
 import           Data.Text             (Text, split)
@@ -52,8 +53,8 @@ columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) =
     parseEnum str = fromMaybe [] $ split (==',') <$> str
 
 
-relationFromRow :: (Text, Text, Text, Text, Text) -> Relation
+relationFromRow :: (Text, Text, [Text], Text, [Text]) -> Relation
-relationFromRow (s, t, c, ft, fc) = Relation s t c ft fc Child Nothing Nothing Nothing
+relationFromRow (s, t, cs, ft, fcs) = Relation s t cs ft fcs Child Nothing Nothing Nothing
 
 pkFromRow :: (Text, Text, Text) -> PrimaryKey
 pkFromRow (s, t, n) = PrimaryKey s t n
@@ -95,47 +96,65 @@ allRelations :: H.Tx P.Postgres s [Relation]
 allRelations = do
   rels <- H.listEx $ [H.stmt|
     WITH table_fk AS (
-        SELECT
+        SELECT ns.nspname AS table_schema,
-            tc.table_schema, tc.table_name, kcu.column_name,
+               tab.relname AS table_name,
-            ccu.table_name AS foreign_table_name,
+               column_info.cols AS columns,
-            ccu.column_name AS foreign_column_name
+               other.relname AS foreign_table_name,
-        FROM information_schema.table_constraints AS tc
+               column_info.refs AS foreign_columns
-        JOIN information_schema.key_column_usage AS kcu on tc.constraint_name = kcu.constraint_name
+        FROM pg_constraint,
-        JOIN information_schema.constraint_column_usage AS ccu on ccu.constraint_name = tc.constraint_name
+           LATERAL (SELECT array_agg(cols.attname) AS cols,
-        WHERE   constraint_type = 'FOREIGN KEY'
+                           array_agg(cols.attnum)  AS nums,
-            AND tc.table_schema NOT IN ('pg_catalog', 'information_schema')
+                           array_agg(refs.attname) AS refs
-        ORDER BY tc.table_schema, tc.table_name, kcu.column_name
+                      FROM unnest(conkey, confkey) AS _(col, ref),
+                           LATERAL (SELECT * FROM pg_attribute
+                                     WHERE attrelid = conrelid AND attnum = col)
+                                AS cols,
+                           LATERAL (SELECT * FROM pg_attribute
+                                     WHERE attrelid = confrelid AND attnum = ref)
+                                AS refs)
+                AS column_info,
+           LATERAL (SELECT * FROM pg_namespace
+                            WHERE pg_namespace.oid = connamespace) AS ns,
+           LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
+           LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other
+        WHERE confrelid != 0
+        ORDER BY (conrelid, column_info.nums)
     )
+
     SELECT * FROM table_fk
     UNION
     (
         SELECT
-            vcu.table_schema, vcu.view_name AS table_name, vcu.column_name,
+            vcu.table_schema,
+            vcu.view_name AS table_name,
+            array_agg(vcu.column_name::text) AS columns,
             table_fk.foreign_table_name,
-            table_fk.foreign_column_name
+            table_fk.foreign_columns
         FROM information_schema.view_column_usage as vcu
         JOIN table_fk ON
             table_fk.table_schema = vcu.view_schema AND
             table_fk.table_name = vcu.table_name AND
-            table_fk.column_name = vcu.column_name
+            vcu.column_name = ANY (table_fk.columns)
         WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
-        ORDER BY vcu.table_schema, vcu.view_name, vcu.column_name
+        AND columns = table_fk.columns
+        GROUP BY vcu.table_schema, vcu.view_name, table_fk.foreign_table_name, table_fk.foreign_columns
     )
     UNION
     (
         SELECT
             vcu.view_schema as table_schema,
             table_fk.table_name,
-            table_fk.column_name,
+            table_fk.columns,
             vcu.view_name as foreign_table_name,
-            vcu.column_name as foreign_column_name
+            array_agg(vcu.column_name::text) as foreign_columns
         FROM information_schema.view_column_usage as vcu
         JOIN table_fk ON
             table_fk.table_schema = vcu.view_schema AND
             table_fk.foreign_table_name = vcu.table_name AND
-            table_fk.foreign_column_name = vcu.column_name
+            vcu.column_name = ANY (table_fk.foreign_columns)
         WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
-        ORDER BY vcu.table_schema, vcu.view_name, vcu.column_name
+            AND foreign_columns = table_fk.foreign_columns
+        GROUP BY vcu.view_schema, table_fk.table_name, vcu.view_name, table_fk.columns
     )
   |]
   let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
@@ -145,8 +164,8 @@ allRelations = do
     groupFn :: Relation -> Text
     groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
     link2Relation [
-      Relation{relSchema=sc, relTable=lt, relColumn=lc1, relFTable=t, relFColumn=c},
+      Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c},
-      Relation{                           relColumn=lc2, relFTable=ft, relFColumn=fc}
+      Relation{                           relColumns=lc2, relFTable=ft, relFColumns=fc}
       ] = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
     link2Relation _ = Nothing
 
@@ -196,12 +215,16 @@ allColumns rels = do
   return $ map (addFK . columnFromRow) cols
 
   where
-    addFK col = col { colFK = relToFk <$> find (lookupFn col) rels }
+    addFK col = col { colFK = fk col }
+    fk col = join $ relToFk (colName col) <$> find (lookupFn col) rels
     lookupFn :: Column -> Relation -> Bool
-    lookupFn (Column{colSchema=cs, colTable=ct, colName=cn})  (Relation{relSchema=rs, relTable=rt, relColumn=rc, relType=rty}) =
+    lookupFn (Column{colSchema=cs, colTable=ct, colName=cn})  (Relation{relSchema=rs, relTable=rt, relColumns=rc, relType=rty}) =
-      cs==rs && ct==rt && cn==rc && rty==Child
+      cs==rs && ct==rt && cn `elem` rc && rty==Child
     lookupFn _ _ = False
-    relToFk (Relation{relFTable=t, relFColumn=c}) = ForeignKey t c
+    relToFk cName (Relation{relFTable=t, relColumns=cs, relFColumns=fcs}) = ForeignKey t <$> c
+      where
+        pos = elemIndex cName cs
+        c = (fcs !!) <$> pos
 
 allPrimaryKeys :: H.Tx P.Postgres s [PrimaryKey]
 allPrimaryKeys = do

src/PostgREST/QueryBuilder.hs

@@ -6,10 +6,10 @@ import           Control.Error
 import           Data.List         (find)
 import           Data.Monoid
 import           Data.Text         hiding (filter, find, foldr, head, last, map,
-                                    null)
+                                    null, zipWith)
 import           Control.Applicative
 import           Data.Tree
-import           PostgREST.PgQuery (PStmt, QualifiedIdentifier (..), fromQi,
+import           PostgREST.PgQuery (PStmt, fromQi,
                                     orderT, pgFmtIdent, pgFmtLit, pgFmtOperator,
                                     pgFmtValue, whiteList)
 import           PostgREST.Types
@@ -34,6 +34,16 @@ addRelations schema allRelations parentNode node@(Node query@(Select {mainTable=
   where
     updatedForest = mapM (addRelations schema allRelations (Just node)) forest
 
+getJoinConditions :: Relation -> [Filter]
+getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) =
+  case typ of
+    Child  -> zipWith (toFilter t ft) cs fcs
+    Parent -> zipWith (toFilter t ft) cs fcs
+    Many   -> zipWith (toFilter t (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" lt)) fcs (fromMaybe [] lc2)
+  where
+    toFilter :: Text -> Text -> FieldName -> FieldName -> Filter
+    toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc))
+
 addJoinConditions :: Text -> [Column] -> ApiRequest -> Either Text ApiRequest
 addJoinConditions schema allColumns (Node query@(Select{relation=r}) forest) =
   case r of
@@ -56,15 +66,6 @@ addJoinConditions schema allColumns (Node query@(Select{relation=r}) forest) =
         getParents qq@(Select{relation=(Just rel@(Relation{relType=Parent}))}) = Just (mainTable qq, rel)
         getParents _ = Nothing
     updatedForest = mapM (addJoinConditions schema allColumns) forest
-    getJoinConditions :: Relation -> [Filter]
-    getJoinConditions rel@(Relation _ _ c _ _ Child _ _ _) = [Filter (c, Nothing) "=" (VForeignKey rel)]
-    getJoinConditions rel@(Relation _ _ c _ _ Parent _ _ _) = [Filter (c, Nothing) "=" (VForeignKey rel)]
-    getJoinConditions     (Relation s t c ft fc Many (Just lt) (Just lc1) (Just lc2)) =
-      [
-        Filter (c, Nothing) "=" (VForeignKey (Relation s t c lt lc1 Child Nothing Nothing Nothing)),
-        Filter (fc, Nothing) "=" (VForeignKey (Relation s ft fc lt lc2 Child Nothing Nothing Nothing))
-      ]
-    getJoinConditions _ = []
     addCond q con = q{filters=con ++ filters q}
 
 requestToCountQuery :: Text -> ApiRequest -> PStmt
@@ -80,7 +81,7 @@ requestToCountQuery schema (Node (Select mainTbl _ _ conditions _ _) _) =
     localConditions = filter fn conditions
       where
         fn  (Filter{value=VText _}) = True
-        fn  (Filter{value=VForeignKey _}) = False
+        fn  (Filter{value=VForeignKey _ _}) = False
 
 requestToQuery :: Text -> ApiRequest -> PStmt
 requestToQuery schema (Node (Select mainTbl colSelects tbls conditions ord _) forest) =
@@ -134,14 +135,14 @@ pgFmtCondition table (Filter (col,jp) ops val) =
     notOp       = hasNot headPredicate ""
     sqlCol = case val of
       VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
-      VForeignKey (Relation s t c _ _ _ _ _ _) -> pgFmtColumn (QualifiedIdentifier s t) c
+      VForeignKey qi _ -> pgFmtColumn qi col
     sqlValue = valToStr val
     getInner v = case v of
       VText s -> s
       _      -> ""
     valToStr v = case v of
       VText s -> pgFmtValue opCode s
-      VForeignKey (Relation{relSchema=s, relFTable=ft, relFColumn=fc}) -> pgFmtColumn (QualifiedIdentifier s ft) fc
+      VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn (QualifiedIdentifier s ft) fc
 
 pgFmtColumn :: QualifiedIdentifier -> Text -> Text
 pgFmtColumn table "*" = fromQi table <> ".*"

src/PostgREST/Types.hs

@@ -21,7 +21,7 @@ data Table = Table {
 
 data ForeignKey = ForeignKey {
   fkTable::Text, fkCol::Text
-} deriving (Show)
+} deriving (Show, Eq)
 
 
 data Column = Column {
@@ -49,22 +49,28 @@ data OrderTerm = OrderTerm {
 , otNullOrder :: Maybe BS.ByteString
 } deriving (Show, Eq)
 
+data QualifiedIdentifier = QualifiedIdentifier {
+  qiSchema :: Text
+, qiName   :: Text
+} deriving (Show, Eq)
+
+
 data RelationType = Child | Parent | Many deriving (Show, Eq)
 data Relation = Relation {
   relSchema  :: Text
 , relTable   :: Text
-, relColumn  :: Text
+, relColumns  :: [Text]
 , relFTable  :: Text
-, relFColumn :: Text
+, relFColumns :: [Text]
 , relType    :: RelationType
 , relLTable  :: Maybe Text
-, relLCol1   :: Maybe Text
+, relLCols1   :: Maybe [Text]
-, relLCol2   :: Maybe Text
+, relLCols2   :: Maybe [Text]
 } deriving (Show, Eq)
 
 
 type Operator = Text
-data FValue = VText Text | VForeignKey Relation deriving (Show, Eq)
+data FValue = VText Text | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)
 type FieldName = Text
 type JsonPath = [Text]
 type Field = (FieldName, Maybe JsonPath)

test/Feature/QuerySpec.hs

@@ -198,10 +198,9 @@ spec =
       get "/projects_view?id=eq.1&select=id, name, clients(*), tasks(id, name)" `shouldRespondWith`
         "[{\"id\":1,\"name\":\"Windows 7\",\"clients\":{\"id\":1,\"name\":\"Microsoft\"},\"tasks\":[{\"id\":1,\"name\":\"Design w7\"},{\"id\":2,\"name\":\"Code w7\"}]}]"
 
-    it "requesting children with composite key" $ do
+    it "requesting children with composite key" $
-      pendingWith "have to resolve issue #302"
       get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments(content)" `shouldRespondWith`
-        [json| [{"user_id":2,"task_id":6,"comments":[{"content": "Needs to be delivered ASAP"}]}] |]
+        "[{\"user_id\":2,\"task_id\":6,\"comments\":[{\"content\":\"Needs to be delivered ASAP\"}]}]"
 
 
   describe "ordering response" $ do