Better relations for views

- Better column synonyms detection
- Raise relations to accessible schema when possible

src/PostgREST/DbStructure.hs

@@ -12,8 +12,8 @@ module PostgREST.DbStructure (
 import           Control.Applicative
 import           Control.Monad          (join)
 import           Data.Functor.Identity
-import           Data.List             (elemIndex, find, subsequences)
+import           Data.List              (elemIndex, find, subsequences, sort, transpose)
-import           Data.Maybe            (fromMaybe, fromJust, isJust, mapMaybe)
+import           Data.Maybe             (fromMaybe, fromJust, isJust, mapMaybe, listToMaybe)
 import           Data.Monoid
 import           Data.Text              (Text, split)
 import qualified Hasql                  as H
@@ -25,18 +25,23 @@ import           PostgREST.Types
 import           GHC.Exts               (groupWith)
 import           Prelude
 
-createDbStructure :: H.Tx P.Postgres s DbStructure
+createDbStructure :: Schema -> H.Tx P.Postgres s DbStructure
-createDbStructure = do
+createDbStructure schema = do
   tabs <- allTables
   cols <- allColumns tabs
+  syns <- allSynonyms cols
   rels <- allRelations tabs cols
   keys <- allPrimaryKeys tabs
 
+  let rels' = (manyToManyRelations . raiseRelations schema syns . parentRelations . synonymousRelations syns) rels
+      cols' = addForeignKeys rels' cols
+      keys' = synonymousPrimaryKeys syns keys
+
   return DbStructure {
       tables = tabs
-    , columns = addForeignKeys rels cols
+    , columns = cols'
-    , relations = rels
+    , relations = rels'
-    , primaryKeys = keys
+    , primaryKeys = keys'
     }
 
 doesProc :: forall c s. B.CxValue c Int =>
@@ -66,6 +71,16 @@ doesProcReturnJWT = doesProc [H.stmt|
       AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
     |]
 
+synonymousColumns :: [(Column,Column)] -> [Column] -> [[Column]]
+synonymousColumns allSyns cols = synCols'
+  where
+    syns = sort $ filter ((== colTable (head cols)) . colTable . fst) allSyns
+    synCols  = transpose $ map (\c -> map snd $ filter ((== c) . fst) syns) cols
+    synCols' = (filter sameTable . filter matchLength) synCols
+    matchLength cs = length cols == length cs
+    sameTable (c:cs) = all (\cc -> colTable c == colTable cc) (c:cs)
+    sameTable [] = False
+
 addForeignKeys :: [Relation] -> [Column] -> [Column]
 addForeignKeys rels = map addFk
   where
@@ -79,38 +94,52 @@ addForeignKeys rels = map addFk
         pos = elemIndex col cols
         colF = (colsF !!) <$> pos
 
-columnFromRow :: [Table] ->
+synonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation]
-                 (Text,       Text,      Text,
+synonymousRelations _ [] = []
-                  Int,        Bool,      Text,
+synonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ synonymousRelations syns rels
-                  Bool,       Maybe Int, Maybe Int,
-                  Maybe Text, Maybe Text)
-                 -> Column
-columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) =
-  Column table n pos nul typ u l p d (parseEnum e) Nothing
   where
-    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+    synRelsP = synRels (relColumns rel) (\t cs -> rel{relTable=t,relColumns=cs})
-    parseEnum :: Maybe Text -> [Text]
+    synRelsF = synRels (relFColumns rel) (\t cs -> rel{relFTable=t,relFColumns=cs})
-    parseEnum str = fromMaybe [] $ split (==',') <$> str
+    synRels cols mapFn = map (\cs -> mapFn (colTable $ head cs) cs) $ synonymousColumns syns cols
 
+parentRelations :: [Relation] -> [Relation]
+parentRelations [] = []
+parentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : parentRelations rels
 
-relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Relation
+manyToManyRelations :: [Relation] -> [Relation]
-relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) = Relation table cols tableF colsF Child Nothing Nothing Nothing
+manyToManyRelations rels = rels ++ mapMaybe link2Relation links
   where
-    findTable s t = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
+    links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
-    findCols s t cs = filter (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col `elem` cs) allCols
+    groupFn :: Relation -> Text
-    table  = findTable rs rt
+    groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t
-    tableF = findTable frs frt
+    combinations k ns = filter ((k==).length) (subsequences ns)
-    cols  = findCols rs rt rcs
+    link2Relation [
-    colsF = findCols frs frt frcs
+      Relation{relTable=lt, relColumns=lc1, relFTable=t,  relFColumns=c},
+      Relation{             relColumns=lc2, relFTable=ft, relFColumns=fc}
+      ]
+      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc Many (Just lt) (Just lc1) (Just lc2)
+      | otherwise = Nothing
+    link2Relation _ = Nothing
 
-pkFromRow :: [Table] -> (Schema, Text, Text) -> PrimaryKey
+raiseRelations :: Schema -> [(Column,Column)] -> [Relation] -> [Relation]
-pkFromRow tabs (s, t, n) = PrimaryKey table n
+raiseRelations schema syns = map raiseRel
   where
-    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+    raiseRel rel
+      | tableSchema table == schema = rel
+      | isJust newCols = rel{relFTable=fromJust newTable,relFColumns=fromJust newCols}
+      | otherwise = rel
+      where
+        cols = relFColumns rel
+        table = relFTable rel
+        newCols = listToMaybe $ filter ((== schema) . tableSchema . colTable . head) (synonymousColumns syns cols)
+        newTable = (colTable . head) <$> newCols
 
-
+synonymousPrimaryKeys :: [(Column,Column)] -> [PrimaryKey] -> [PrimaryKey]
-addParentRelation :: Relation -> [Relation] -> [Relation]
+synonymousPrimaryKeys _ [] = []
-addParentRelation rel@(Relation t c ft fc _ _ _ _) rels = Relation ft fc t c Parent Nothing Nothing Nothing : rel : rels
+synonymousPrimaryKeys syns (key:keys) = key : newKeys ++ synonymousPrimaryKeys syns keys
+  where
+    keySyns = filter ((\c -> colTable c == pkTable key && colName c == pkName key) . fst) syns
+    newKeys = map ((\c -> PrimaryKey{pkTable=colTable c,pkName=colName c}) . snd) keySyns
 
 allTables :: H.Tx P.Postgres s [Table]
 allTables = do
@@ -182,6 +211,19 @@ allColumns tabs = do
   |]
   return $ map (columnFromRow tabs) cols
 
+columnFromRow :: [Table] ->
+                 (Text,       Text,      Text,
+                  Int,        Bool,      Text,
+                  Bool,       Maybe Int, Maybe Int,
+                  Maybe Text, Maybe Text)
+                 -> Column
+columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) =
+  Column table n pos nul typ u l p d (parseEnum e) Nothing
+  where
+    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+    parseEnum :: Maybe Text -> [Text]
+    parseEnum str = fromMaybe [] $ split (==',') <$> str
+
 allRelations :: [Table] -> [Column] -> H.Tx P.Postgres s [Relation]
 allRelations tabs cols = do
   rels <- H.listEx $ [H.stmt|
@@ -210,20 +252,17 @@ allRelations tabs cols = do
     WHERE confrelid != 0
     ORDER BY (conrelid, column_info.nums)
   |]
-  let simpleRelations = foldr (addParentRelation . relationFromRow tabs cols) [] rels
+  return $ map (relationFromRow tabs cols) rels
-      links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
+
-  return $ simpleRelations ++ mapMaybe link2Relation links
+relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Relation
+relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) = Relation table cols tableF colsF Child Nothing Nothing Nothing
   where
-    groupFn :: Relation -> Text
+    findTable s t = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
-    groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t
+    findCols s t cs = filter (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col `elem` cs) allCols
-    combinations k ns = filter ((k==).length) (subsequences ns)
+    table  = findTable rs rt
-    link2Relation [
+    tableF = findTable frs frt
-      Relation{relTable=lt, relColumns=lc1, relFTable=t,  relFColumns=c},
+    cols  = findCols rs rt rcs
-      Relation{             relColumns=lc2, relFTable=ft, relFColumns=fc}
+    colsF = findCols frs frt frcs
-      ]
-      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc Many (Just lt) (Just lc1) (Just lc2)
-      | otherwise = Nothing
-    link2Relation _ = Nothing
 
 allPrimaryKeys :: [Table] -> H.Tx P.Postgres s [PrimaryKey]
 allPrimaryKeys tabs = do
@@ -243,3 +282,45 @@ allPrimaryKeys tabs = do
         kc.table_schema NOT IN ('pg_catalog', 'information_schema')
     |]
   return $ map (pkFromRow tabs) pks
+
+pkFromRow :: [Table] -> (Schema, Text, Text) -> PrimaryKey
+pkFromRow tabs (s, t, n) = PrimaryKey table n
+  where
+    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+
+allSynonyms :: [Column] -> H.Tx P.Postgres s [(Column,Column)]
+allSynonyms allCols = do
+  srcSyns <- H.listEx $ [H.stmt|
+    WITH synonyms AS (
+      SELECT
+        vcu.table_schema AS src_table_schema,
+        vcu.table_name AS src_table_name,
+        vcu.column_name AS src_column_name,
+        view.table_schema AS syn_table_schema,
+        view.table_name AS syn_table_name,
+        view.view_definition AS view_definition
+      FROM
+        information_schema.views AS view,
+        information_schema.view_column_usage AS vcu
+      WHERE
+        view.table_schema = vcu.view_schema AND
+        view.table_name = vcu.view_name AND
+        view.table_schema NOT IN ('pg_catalog', 'information_schema') AND
+        (SELECT COUNT(*) FROM information_schema.view_table_usage WHERE view_schema = view.table_schema AND view_name = view.table_name) = 1
+    )
+    SELECT
+      src_table_schema, src_table_name, src_column_name,
+      syn_table_schema, syn_table_name,
+      (regexp_matches(view_definition, CONCAT('\.(', src_column_name, ')(?=,|$)'), 'gn'))[1]
+    FROM synonyms
+    UNION (
+      SELECT
+        src_table_schema, src_table_name, src_column_name,
+        syn_table_schema, syn_table_name,
+        (regexp_matches(view_definition, CONCAT('\.', src_column_name, '\sAS\s("?)(.+?)\1(,|$)'), 'gn'))[2] /* " <- for syntax highlighting */
+      FROM synonyms
+    )
+    |]
+  return $ map (\(a,b,c,d,e,f) -> (findCol a b c,findCol d e f)) srcSyns
+  where
+    findCol s t c = fromJust $ find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols

src/PostgREST/Main.hs

@@ -9,7 +9,6 @@ import           PostgREST.Config                     (AppConfig (..),
 import           PostgREST.Error                      (errResponse, PgError)
 import           PostgREST.Middleware
 import           PostgREST.DbStructure
-import           PostgREST.Types
 
 import           Control.Monad                        (unless)
 import           Control.Monad.IO.Class               (liftIO)
@@ -69,7 +68,7 @@ main = do
     ) supportedOrError
 
   let txSettings = Just (H.ReadCommitted, Just True)
-  dbOrError <- H.session pool $ H.tx txSettings createDbStructure
+  dbOrError <- H.session pool $ H.tx txSettings $ createDbStructure (cs $ configSchema conf)
   db <- either hasqlError return dbOrError
 
   runSettings appSettings $ middle $ \ req respond -> do

src/PostgREST/Types.hs

@@ -17,9 +17,9 @@ data Table = Table {
   tableSchema     :: Schema
 , tableName       :: Text
 , tableInsertable :: Bool
-} deriving (Show)
+} deriving (Show, Ord)
 
-data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq)
+data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
 
 data Column =
     Column {
@@ -36,7 +36,9 @@ data Column =
     , colFK        :: Maybe ForeignKey
     }
   | Star { colTable :: Table }
-  deriving (Show, Eq)
+  deriving (Show, Ord)
+
+type Synonym = (Column,Column)
 
 data PrimaryKey = PrimaryKey {
     pkTable :: Table
@@ -116,3 +118,10 @@ instance ToJSON Table where
       "schema"     .= tableSchema v
     , "name"       .= tableName v
     , "insertable" .= tableInsertable v ]
+
+instance Eq Table where
+  Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
+
+instance Eq Column where
+  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
+  _ == _ = False

test/Feature/StructureSpec.hs

@@ -14,7 +14,9 @@ spec = around withApp $ do
     it "lists views in schema" $
       request methodGet "/" [] ""
         `shouldRespondWith` [json| [
-          {"schema":"test","name":"auto_incrementing_pk","insertable":true}
+          {"schema":"test","name":"articleStars","insertable":true}
+        , {"schema":"test","name":"articles","insertable":true}
+        , {"schema":"test","name":"auto_incrementing_pk","insertable":true}
         , {"schema":"test","name":"clients","insertable":true}
         , {"schema":"test","name":"comments","insertable":true}
         , {"schema":"test","name":"complex_items","insertable":true}
@@ -48,7 +50,6 @@ spec = around withApp $ do
         ] |]
         {matchStatus = 200}
 
-
   describe "Table info" $ do
     it "is available with OPTIONS verb" $
       request methodOptions "/menagerie" [] "" `shouldRespondWith`
@@ -153,7 +154,7 @@ spec = around withApp $ do
       |]
 
     it "it includes primary and foreign keys for views" $
-      request methodOptions "/insertable_view_with_join" [] "" `shouldRespondWith`
+      request methodOptions "/projects_view" [] "" `shouldRespondWith`
       [json|
       {
          "pkey":[
@@ -163,88 +164,45 @@ spec = around withApp $ do
           {
             "references":null,
             "default":null,
-               "precision":64,
+            "precision":32,
-               "updatable":false,
+            "updatable":true,
             "schema":"test",
             "name":"id",
-               "type":"bigint",
+            "type":"integer",
             "maxLen":null,
             "enum":[],
             "nullable":true,
             "position":1
           },
           {
-               "references":{
+            "references":null,
-                  "schema":"test",
-                  "column":"id",
-                  "table":"auto_incrementing_pk"
-               },
             "default":null,
-               "precision":32,
+            "precision":null,
-               "updatable":false,
+            "updatable":true,
             "schema":"test",
-               "name":"auto_inc_fk",
+            "name":"name",
-               "type":"integer",
+            "type":"text",
             "maxLen":null,
             "enum":[],
             "nullable":true,
             "position":2
           },
           {
-               "references":{
+            "references": {
               "schema":"test",
-                  "column":"k",
+              "column":"id",
-                  "table":"simple_pk"
+              "table":"clients"
             },
             "default":null,
-               "precision":null,
+            "precision":32,
-               "updatable":false,
+            "updatable":true,
             "schema":"test",
-               "name":"simple_fk",
+            "name":"client_id",
-               "type":"character varying",
+            "type":"integer",
-               "maxLen":255,
+            "maxLen":null,
             "enum":[],
             "nullable":true,
             "position":3
-            },
-            {
-               "references":null,
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"test",
-               "name":"nullable_string",
-               "type":"character varying",
-               "maxLen":null,
-               "enum":[],
-               "nullable":true,
-               "position":4
-            },
-            {
-               "references":null,
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"test",
-               "name":"non_nullable_string",
-               "type":"character varying",
-               "maxLen":null,
-               "enum":[],
-               "nullable":true,
-               "position":5
-            },
-            {
-               "references":null,
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"test",
-               "name":"inserted_at",
-               "type":"timestamp with time zone",
-               "maxLen":null,
-               "enum":[],
-               "nullable":true,
-               "position":6
           }
         ]
       }
@@ -298,3 +256,63 @@ spec = around withApp $ do
         ]
       }
       |]
+
+    it "includes all information on views for renamed columns, and raises relations to correct schema" $
+      request methodOptions "/articleStars" [] ""
+        `shouldRespondWith` [json|
+          {
+            "pkey": [
+              "articleId",
+              "userId"
+            ],
+            "columns": [
+              {
+                "references": {
+                  "schema": "test",
+                  "column": "id",
+                  "table": "articles"
+                },
+                "default": null,
+                "precision": 32,
+                "updatable": true,
+                "schema": "test",
+                "name": "articleId",
+                "type": "integer",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 1
+              },
+              {
+                "references": {
+                  "schema": "test",
+                  "column": "id",
+                  "table": "users"
+                },
+                "default": null,
+                "precision": 32,
+                "updatable": true,
+                "schema": "test",
+                "name": "userId",
+                "type": "integer",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 2
+              },
+              {
+                "references": null,
+                "default": null,
+                "precision": null,
+                "updatable": true,
+                "schema": "test",
+                "name": "createdAt",
+                "type": "timestamp without time zone",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 3
+              }
+            ]
+          }
+        |]

test/SpecHelper.hs

@@ -54,7 +54,7 @@ withApp perform = do
     <- H.acquirePool pgSettings testPoolOpts
 
   let txSettings = Just (H.ReadCommitted, Just True)
-  dbOrError <- H.session pool $ H.tx txSettings createDbStructure
+  dbOrError <- H.session pool $ H.tx txSettings $ createDbStructure (cs $ configSchema cfg)
   db <- either (fail . show) return dbOrError
 
   perform $ middle $ \req resp -> do

test/fixtures/schema.sql

@@ -382,8 +382,8 @@ SET search_path = private, pg_catalog;
 
 
 CREATE TABLE articles (
+    id integer PRIMARY KEY NOT NULL,
     body text,
-    id integer NOT NULL,
     owner name NOT NULL
 );
 
@@ -391,59 +391,43 @@ CREATE TABLE articles (
 ALTER TABLE private.articles OWNER TO postgrest_test;
 
 
-CREATE SEQUENCE articles_id_seq
+CREATE TABLE article_stars (
-    START WITH 1
+  article_id int REFERENCES articles(id),
-    INCREMENT BY 1
+  user_id int REFERENCES test.users(id),
-    NO MINVALUE
+  created_at timestamp NOT NULL DEFAULT now(),
-    NO MAXVALUE
+  CONSTRAINT user_article PRIMARY KEY (article_id, user_id)
-    CACHE 1;
+);
 
+ALTER TABLE private.article_stars OWNER TO postgrest_test;
 
-ALTER TABLE private.articles_id_seq OWNER TO postgrest_test;
-
-
-ALTER SEQUENCE articles_id_seq OWNED BY articles.id;
 
 
 SET search_path = test, pg_catalog;
 
 
+
+CREATE VIEW "articleStars" AS
+  SELECT article_id AS "articleId", user_id AS "userId", created_at AS "createdAt"
+  FROM private.article_stars;
+
+ALTER TABLE test."articleStars" OWNER TO postgrest_test;
+
+CREATE VIEW articles AS
+  SELECT *
+  FROM private.articles;
+
+ALTER TABLE test.articles OWNER TO postgrest_test;
+
 ALTER TABLE ONLY auto_incrementing_pk ALTER COLUMN id SET DEFAULT nextval('auto_incrementing_pk_id_seq'::regclass);
 
 
 
 ALTER TABLE ONLY has_fk ALTER COLUMN id SET DEFAULT nextval('has_fk_id_seq'::regclass);
 
-
-
 ALTER TABLE ONLY items ALTER COLUMN id SET DEFAULT nextval('items_id_seq'::regclass);
 
-
-SET search_path = private, pg_catalog;
-
-
-ALTER TABLE ONLY articles ALTER COLUMN id SET DEFAULT nextval('articles_id_seq'::regclass);
-
-
-SET search_path = test, pg_catalog;
-
-
-
-
-
-
-
-
 SELECT pg_catalog.setval('auto_incrementing_pk_id_seq', 1, true);
 
-
-
-
-
-
-
-
-
 SELECT pg_catalog.setval('has_fk_id_seq', 1, false);
 
 
@@ -654,6 +638,14 @@ REVOKE ALL ON TABLE projects_view FROM PUBLIC;
 REVOKE ALL ON TABLE projects_view FROM postgrest_test;
 GRANT ALL ON TABLE projects_view TO postgrest_test;
 GRANT ALL ON TABLE projects_view TO postgrest_anonymous;
+REVOKE ALL ON TABLE articles FROM PUBLIC;
+REVOKE ALL ON TABLE articles FROM postgrest_test;
+GRANT ALL ON TABLE  articles TO postgrest_test;
+GRANT ALL ON TABLE  articles TO postgrest_anonymous;
+REVOKE ALL ON TABLE "articleStars" FROM PUBLIC;
+REVOKE ALL ON TABLE "articleStars" FROM postgrest_test;
+GRANT ALL ON TABLE  "articleStars" TO postgrest_test;
+GRANT ALL ON TABLE  "articleStars" TO postgrest_anonymous;
 ---------
 
 
@@ -773,4 +765,6 @@ INSERT INTO users_projects VALUES(1,1),(1,2),(2,3),(2,4),(3,1),(3,3);
 INSERT INTO users_tasks VALUES(1,1),(1,2),(1,3),(1,4),(2,5),(2,6),(2,7),(3,1),(3,5);
 INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP');
 INSERT INTO postgrest.auth (id, pass, rolname) VALUES ('jdoe', '1234', 'postgrest_test_author');
+INSERT INTO private.articles (id, body, owner) VALUES (1, 'No… It''s a thing; it''s like a plan, but with more greatness.', 2), (2, 'Stop talking, brain thinking. Hush.', 3), (3, 'It''s a fez. I wear a fez now. Fezes are cool.', 1);
+INSERT INTO private.article_stars (article_id, user_id) VALUES (1,1), (1,2), (2,3), (3,2), (1,3);
 ----------------