Fix #396 include records with missing parents and remove CTE related to parent relation

CHANGELOG.md

@@ -8,8 +8,9 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 ### Fixed
 - Miscalculation of time used for expiring tokens - @calebmer
 - Remove bcrypt dependency to fix Windows build - @begriffs
-- Detect relations event when authenticator does not have rights to intermediate tables - @ruslantalpa 
+- Detect relations event when authenticator does not have rights to intermediate tables - @ruslantalpa
 - Ensure db connections released on sigint - @begriffs
+- Fix #396 include records with missing parents - @ruslantalpa
 
 ### Added
 - Allow order by computed columns - @diogob

src/PostgREST/QueryBuilder.hs

@@ -35,12 +35,13 @@ import qualified Data.Aeson              as JSON
 import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset)
 import           Control.Error           (note, fromMaybe, mapMaybe)
 import qualified Data.HashMap.Strict     as HM
-import           Data.List               (find)
+import           Data.List               (find, (\\))
 import           Data.Monoid             ((<>))
 import           Data.Text               (Text, intercalate, unwords, replace, isInfixOf, toLower, split)
 import qualified Data.Text as T          (map, takeWhile)
 import           Data.String.Conversions (cs)
 import           Control.Applicative     (empty, (<|>))
+import           Control.Monad           (join)
 import           Data.Tree               (Tree(..))
 import qualified Data.Vector as V
 import           PostgREST.Types
@@ -193,10 +194,10 @@ requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (mai
     qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
     toQi t = QualifiedIdentifier (tblSchema t) t
     query = unwords [
-      ("WITH " <> intercalate ", " (map fst withs)) `emptyOnNull` withs,
       "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
-      "FROM ", intercalate ", " (map (fromQi . toQi) tbls ++ map snd withs),
+      "FROM ", intercalate ", " (map (fromQi . toQi) tbls),
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      unwords (map joinStr joins),
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) localConditions )) `emptyOnNull` localConditions,
       orderF (fromMaybe [] ord)
       ]
     orderF ts =
@@ -210,26 +211,37 @@ requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (mai
                 <> cs (pgFmtColumn qi $ otTerm t) <> " "
                 <> (cs.show) (otDirection t) <> " "
                 <> maybe "" (cs.show) (otNullOrder t) <> " "
-    (withs, selects) = foldr getQueryParts ([],[]) forest
+    (joins, selects) = foldr getQueryParts ([],[]) forest
-    getQueryParts :: Tree ReadNode -> ([(SqlFragment, Text)], [SqlFragment]) -> ([(SqlFragment,Text)], [SqlFragment])
+    parentTables = map snd joins
-    getQueryParts (Node n@(_, (table, Just (Relation {relType=Child}))) forst) (w,s) = (w,sel:s)
+    parentConditions = join $ map (( `filter` conditions ) . filterParentConditions) parentTables
+    localConditions = conditions \\ parentConditions
+    joinStr :: (SqlFragment, TableName) -> SqlFragment
+    joinStr (sql, t) = "LEFT OUTER JOIN " <> sql <> " ON " <>
+      intercalate " AND " ( map (pgFmtCondition qi ) joinConditions )
       where
-        sel = "("
+        joinConditions = filter (filterParentConditions t) conditions
+    filterParentConditions parentTable (Filter _ _ (VForeignKey (QualifiedIdentifier "" t) _)) =
+      parentTable == t
+    filterParentConditions _ _ = False
+    getQueryParts :: Tree ReadNode -> ([(SqlFragment, TableName)], [SqlFragment]) -> ([(SqlFragment,TableName)], [SqlFragment])
+    getQueryParts (Node n@(_, (table, Just (Relation {relType=Child}))) forst) (j,s) = (j,sel:s)
+      where
+        sel = "COALESCE(("
            <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
            <> "FROM (" <> subquery <> ") " <> table
-           <> ") AS " <> table
+           <> "), '[]') AS " <> table
            where subquery = requestToQuery schema (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (table, Just (Relation {relType=Parent}))) forst) (w,s) = (wit:w,sel:s)
+    getQueryParts (Node n@(_, (table, Just (Relation {relType=Parent}))) forst) (j,s) = (joi:j,sel:s)
       where
         sel = "row_to_json(" <> table <> ".*) AS "<>table --TODO must be singular
-        wit = (table <> " AS ( " <> subquery <> " )", table)
+        joi = ("( " <> subquery <> " ) AS " <> table, table)
           where subquery = requestToQuery schema (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (table, Just (Relation {relType=Many}))) forst) (w,s) = (w,sel:s)
+    getQueryParts (Node n@(_, (table, Just (Relation {relType=Many}))) forst) (j,s) = (j,sel:s)
       where
-        sel = "("
+        sel = "COALESCE (("
            <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
            <> "FROM (" <> subquery <> ") " <> table
-           <> ") AS " <> table
+           <> "), '[]') AS " <> table
            where subquery = requestToQuery schema (DbRead (Node n forst))
     --the following is just to remove the warning
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only

test/Feature/InsertSpec.hs

@@ -45,10 +45,10 @@ spec = beforeAll_ resetDb $ around (withApp cfgDefault) $ do
 
       it "includes related data after insert" $
         request methodPost "/projects?select=id,name,clients{id,name}" [("Prefer", "return=representation")]
-          [str|{"id":5,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
+          [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|{"id":5,"name":"New Project","clients":{"id":2,"name":"Apple"}}|]
+            matchBody    = Just [str|{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}|]
           , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json", "Location" <:> "/projects?id=eq.5"]
+          , matchHeaders = ["Content-Type" <:> "application/json", "Location" <:> "/projects?id=eq.6"]
           }
 
 

test/Feature/QuerySpec.hs

@@ -195,13 +195,21 @@ spec = around (withApp cfgDefault) $ do
       get "/projects?id=eq.1&select=id, name, clients{id}" `shouldRespondWith`
         "[{\"id\":1,\"name\":\"Windows 7\",\"clients\":{\"id\":1}}]"
 
+    it "rows with missing parents are included" $
+      get "/projects?id=in.1,5&select=id,clients{id}" `shouldRespondWith`
+        "[{\"id\":1,\"clients\":{\"id\":1}},{\"id\":5,\"clients\":null}]"
+
+    it "rows with no children return [] instead of null" $
+      get "/projects?id=in.5&select=id,tasks{id}" `shouldRespondWith`
+        [str|[{"id":5,"tasks":[]}]|]
+
     it "requesting children 2 levels" $
       get "/clients?id=eq.1&select=id,projects{id,tasks{id}}" `shouldRespondWith`
         "[{\"id\":1,\"projects\":[{\"id\":1,\"tasks\":[{\"id\":1},{\"id\":2}]},{\"id\":2,\"tasks\":[{\"id\":3},{\"id\":4}]}]}]"
 
     it "requesting many<->many relation" $
       get "/tasks?select=id,users{id}" `shouldRespondWith`
-        "[{\"id\":1,\"users\":[{\"id\":1},{\"id\":3}]},{\"id\":2,\"users\":[{\"id\":1}]},{\"id\":3,\"users\":[{\"id\":1}]},{\"id\":4,\"users\":[{\"id\":1}]},{\"id\":5,\"users\":[{\"id\":2},{\"id\":3}]},{\"id\":6,\"users\":[{\"id\":2}]},{\"id\":7,\"users\":[{\"id\":2}]},{\"id\":8,\"users\":null}]"
+        "[{\"id\":1,\"users\":[{\"id\":1},{\"id\":3}]},{\"id\":2,\"users\":[{\"id\":1}]},{\"id\":3,\"users\":[{\"id\":1}]},{\"id\":4,\"users\":[{\"id\":1}]},{\"id\":5,\"users\":[{\"id\":2},{\"id\":3}]},{\"id\":6,\"users\":[{\"id\":2}]},{\"id\":7,\"users\":[{\"id\":2}]},{\"id\":8,\"users\":[]}]"
 
     it "requesting parents and children on views" $
       get "/projects_view?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`

test/fixtures/data.sql

@@ -99,6 +99,7 @@ INSERT INTO projects VALUES (1, 'Windows 7', 1);
 INSERT INTO projects VALUES (2, 'Windows 10', 1);
 INSERT INTO projects VALUES (3, 'IOS', 2);
 INSERT INTO projects VALUES (4, 'OSX', 2);
+INSERT INTO projects VALUES (5, 'Orphan', NULL);
 
 
 --
@@ -263,4 +264,3 @@ INSERT INTO users_projects VALUES (3, 3);
 --
 -- PostgreSQL database dump complete
 --
-

test/fixtures/schema.sql

@@ -890,4 +890,3 @@ ALTER TABLE ONLY users_tasks
 --
 -- PostgreSQL database dump complete
 --
-