Merge pull request #353 from calebmer/feature/view-relations

Better view relations

postgrest.cabal

@@ -70,7 +70,7 @@ executable postgrest
                      , PostgREST.Middleware
                      , PostgREST.Parsers
                      , PostgREST.PgQuery
-                     , PostgREST.PgStructure
+                     , PostgREST.DbStructure
                      , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
                      , PostgREST.Types
@@ -134,7 +134,7 @@ library
                      , PostgREST.Middleware
                      , PostgREST.Parsers
                      , PostgREST.PgQuery
-                     , PostgREST.PgStructure
+                     , PostgREST.DbStructure
                      , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
                      , PostgREST.Types
@@ -165,7 +165,7 @@ Test-Suite spec
                      , PostgREST.Middleware
                      , PostgREST.Parsers
                      , PostgREST.PgQuery
-                     , PostgREST.PgStructure
+                     , PostgREST.DbStructure
                      , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
                      , PostgREST.Types

src/PostgREST/App.hs

@@ -46,7 +46,7 @@ import qualified Hasql.Postgres            as P
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.Parsers
 import           PostgREST.PgQuery
-import           PostgREST.PgStructure
+import           PostgREST.DbStructure
 import           PostgREST.QueryBuilder
 import           PostgREST.RangeQuery
 import           PostgREST.Types
@@ -55,7 +55,7 @@ import           PostgREST.Auth (tokenJWT)
 import           Prelude
 
 app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
-app dbstructure conf reqBody req =
+app dbStructure conf reqBody req =
   case (path, verb) of
 
     ([table], "GET") ->
@@ -71,7 +71,7 @@ app dbstructure conf reqBody req =
                 to = frm+queryTotal-1
                 contentRange = contentRangeH frm to tableTotal
                 status = rangeStatus frm to tableTotal
-                canonical = urlEncodeVars -- should this be moved to the db (location)?
+                canonical = urlEncodeVars -- should this be moved to the dbStructure (location)?
                   . sortBy (comparing fst)
                   . map (join (***) cs)
                   . parseSimpleQuery
@@ -147,7 +147,7 @@ app dbstructure conf reqBody req =
       -- select * from public.proc(a := "foo"::undefined) where whereT limit limitT
 
     ([], _) -> do
-      body <- encode <$> tables (cs schema)
+      body <- encode <$> accessibleTables (filter ((== cs schema) . tableSchema) allTabs)
       return $ responseLBS status200 [jsonH] $ cs body
 
     ([table], "OPTIONS") -> do
@@ -160,12 +160,13 @@ app dbstructure conf reqBody req =
       return $ responseLBS status404 [] ""
 
   where
-    allRels = relations dbstructure
+    allTabs = dbTables dbStructure
-    allCols = columns dbstructure
+    allRels = dbRelations dbStructure
-    allPrKeys = primaryKeys dbstructure
+    allCols = dbColumns dbStructure
-    filterCol sc table (Column{colSchema=s, colTable=t}) =  s==sc && table==t
+    allPrKeys = dbPrimaryKeys dbStructure
+    filterCol sc table (Column{colTable=Table{tableSchema=s, tableName=t}}) = s==sc && table==t
     filterCol _ _ _ =  False
-    filterPk sc table pk = sc == pkSchema pk && table == pkTable pk
+    filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
     path          = pathInfo req
     verb          = requestMethod req
     hdrs          = requestHeaders req
@@ -289,7 +290,7 @@ convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
         a@(Array _) -> Right a
         _ -> Left invalidMsg
 
-augumentRequestWithJoin :: Text ->  [Relation] ->  ApiRequest -> Either Text ApiRequest
+augumentRequestWithJoin :: Schema ->  [Relation] ->  ApiRequest -> Either Text ApiRequest
 augumentRequestWithJoin schema allRels request =
   (first formatRelationError . addRelations schema allRels Nothing) request
   >>= addJoinConditions schema
@@ -332,10 +333,10 @@ addFilter (path, flt) (Node rn forest) =
       where maybeNode = find ((name==).fst.snd.rootLabel) forst
 
 toSourceRelation :: Text -> Relation -> Maybe Relation
-toSourceRelation mt r@(Relation _ t _ ft _ _ rt _ _)
+toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
-  | mt == t = Just $ r {relTable=sourceSubqueryName}
+  | mt == tableName t = Just $ r {relTable=t {tableName=sourceSubqueryName}}
-  | mt == ft = Just $ r {relFTable=sourceSubqueryName}
+  | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceSubqueryName}}
-  | Just mt == rt = Just $ r {relLTable=Just sourceSubqueryName}
+  | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceSubqueryName}) <$> rt}
   | otherwise = Nothing
 
 data TableOptions = TableOptions {
@@ -348,7 +349,7 @@ instance ToJSON TableOptions where
       "columns" .= tblOptcolumns t
     , "pkey"   .= tblOptpkey t ]
 
-parseRequest :: Text -> [Relation] -> NodeName -> Request -> BL.ByteString -> Either Text (Text, Text, Bool)
+parseRequest :: Schema -> [Relation] -> NodeName -> Request -> BL.ByteString -> Either Text (Text, Text, Bool)
 parseRequest schema allRels rootTableName httpRequest reqBody =
   (,,) <$> selectQuery
        <*> (if method == "GET" then pure "" else mutateQuery)

src/PostgREST/Config.hs

@@ -28,7 +28,7 @@ import           Data.Text                   (strip)
 import           Data.Version                (versionBranch)
 import           Network.Wai
 import           Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
-import           Options.Applicative         hiding (columns)
+import           Options.Applicative
 import           Paths_postgrest             (version)
 import           Prelude
 

src/PostgREST/DbStructure.hs

@@ -0,0 +1,354 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+module PostgREST.DbStructure (
+  getDbStructure
+, accessibleTables
+, doesProcExist
+, doesProcReturnJWT
+) where
+
+import           Control.Applicative
+import           Control.Monad          (join)
+import           Data.Functor.Identity
+import           Data.List              (elemIndex, find, subsequences, sort, transpose)
+import           Data.Maybe             (fromMaybe, fromJust, isJust, mapMaybe, listToMaybe)
+import           Data.Monoid
+import           Data.Text              (Text, split)
+import qualified Hasql                  as H
+import qualified Hasql.Postgres         as P
+import qualified Hasql.Backend          as B
+import           PostgREST.PgQuery      ()
+import           PostgREST.Types
+
+import           GHC.Exts               (groupWith)
+import           Prelude
+
+getDbStructure :: Schema -> H.Tx P.Postgres s DbStructure
+getDbStructure schema = do
+  tabs <- allTables
+  cols <- allColumns tabs
+  syns <- allSynonyms cols
+  rels <- allRelations tabs cols
+  keys <- allPrimaryKeys tabs
+
+  let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
+      cols' = addForeignKeys rels' cols
+      keys' = synonymousPrimaryKeys syns keys
+
+  return DbStructure {
+      dbTables = tabs
+    , dbColumns = cols'
+    , dbRelations = rels'
+    , dbPrimaryKeys = keys'
+    }
+
+doesProc :: forall c s. B.CxValue c Int =>
+            (Text -> Text -> B.Stmt c) -> Text -> Text -> H.Tx c s Bool
+doesProc stmt schema proc = do
+  row :: Maybe (Identity Int) <- H.maybeEx $ stmt schema proc
+  return $ isJust row
+
+doesProcExist :: Text -> Text -> H.Tx P.Postgres s Bool
+doesProcExist = doesProc [H.stmt|
+      SELECT 1
+      FROM   pg_catalog.pg_namespace n
+      JOIN   pg_catalog.pg_proc p
+      ON     pronamespace = n.oid
+      WHERE  nspname = ?
+      AND    proname = ?
+    |]
+
+doesProcReturnJWT :: Text -> Text -> H.Tx P.Postgres s Bool
+doesProcReturnJWT = doesProc [H.stmt|
+      SELECT 1
+      FROM   pg_catalog.pg_namespace n
+      JOIN   pg_catalog.pg_proc p
+      ON     pronamespace = n.oid
+      WHERE  nspname = ?
+      AND    proname = ?
+      AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
+    |]
+
+accessibleTables :: [Table] -> H.Tx P.Postgres s [Table]
+accessibleTables allTabs = do
+  accessible <- H.listEx $ [H.stmt|
+      SELECT
+        n.nspname AS table_schema,
+        c.relname AS table_name
+      FROM pg_class c
+      JOIN pg_namespace n ON n.oid = c.relnamespace
+      WHERE
+        c.relkind IN ('v','r','m') AND
+        n.nspname NOT IN ('pg_catalog', 'information_schema') AND (
+          pg_has_role(c.relowner, 'USAGE'::text) OR
+          has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR
+          has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
+        )
+      ORDER BY table_schema, table_name
+    |]
+  let isAccessible table = isJust $ find (\(s,n) -> tableSchema table == s && tableName table == n) accessible
+  return $ filter isAccessible allTabs
+
+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
+    addFk col = col { colFK = fk col }
+    fk col = join $ relToFk col <$> find (lookupFn col) rels
+    lookupFn :: Column -> Relation -> Bool
+    lookupFn c (Relation{relColumns=cs, relType=rty}) = c `elem` cs && rty==Child
+    -- lookupFn _ _ = False
+    relToFk col (Relation{relColumns=cols, relFColumns=colsF}) = ForeignKey <$> colF
+      where
+        pos = elemIndex col cols
+        colF = (colsF !!) <$> pos
+
+addSynonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation]
+addSynonymousRelations _ [] = []
+addSynonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ addSynonymousRelations syns rels
+  where
+    synRelsP = synRels (relColumns rel) (\t cs -> rel{relTable=t,relColumns=cs})
+    synRelsF = synRels (relFColumns rel) (\t cs -> rel{relFTable=t,relFColumns=cs})
+    synRels cols mapFn = map (\cs -> mapFn (colTable $ head cs) cs) $ synonymousColumns syns cols
+
+addParentRelations :: [Relation] -> [Relation]
+addParentRelations [] = []
+addParentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : addParentRelations rels
+
+addManyToManyRelations :: [Relation] -> [Relation]
+addManyToManyRelations rels = rels ++ mapMaybe link2Relation links
+  where
+    links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
+    groupFn :: Relation -> Text
+    groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t
+    combinations k ns = filter ((k==).length) (subsequences ns)
+    link2Relation [
+      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
+
+raiseRelations :: Schema -> [(Column,Column)] -> [Relation] -> [Relation]
+raiseRelations schema syns = map raiseRel
+  where
+    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]
+synonymousPrimaryKeys _ [] = []
+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
+    rows <- H.listEx $ [H.stmt|
+      SELECT
+        n.nspname AS table_schema,
+        c.relname AS table_name,
+        c.relkind = 'r' OR (c.relkind IN ('v','f'))
+        AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
+        OR (EXISTS
+          ( SELECT 1
+            FROM pg_trigger
+            WHERE pg_trigger.tgrelid = c.oid
+            AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable
+      FROM pg_class c
+      JOIN pg_namespace n ON n.oid = c.relnamespace
+      WHERE c.relkind IN ('v','r','m')
+        AND n.nspname NOT IN ('pg_catalog', 'information_schema')
+      GROUP BY table_schema, table_name, insertable
+      ORDER BY table_schema, table_name
+    |]
+    return $ map tableFromRow rows
+
+tableFromRow :: (Text, Text, Bool) -> Table
+tableFromRow (s, n, i) = Table s n i
+
+allColumns :: [Table] -> H.Tx P.Postgres s [Column]
+allColumns tabs = do
+  cols <- H.listEx $ [H.stmt|
+      SELECT DISTINCT
+          info.table_schema AS schema,
+          info.table_name AS table_name,
+          info.column_name AS name,
+          info.ordinal_position AS position,
+          info.is_nullable::boolean AS nullable,
+          info.data_type AS col_type,
+          info.is_updatable::boolean AS updatable,
+          info.character_maximum_length AS max_len,
+          info.numeric_precision AS precision,
+          info.column_default AS default_value,
+          array_to_string(enum_info.vals, ',') AS enum
+      FROM (
+          SELECT
+              table_schema,
+              table_name,
+              column_name,
+              ordinal_position,
+              is_nullable,
+              data_type,
+              is_updatable,
+              character_maximum_length,
+              numeric_precision,
+              column_default,
+              udt_name
+          FROM information_schema.columns
+          WHERE table_schema NOT IN ('pg_catalog', 'information_schema')
+      ) AS info
+      LEFT OUTER JOIN (
+          SELECT
+              n.nspname AS s,
+              t.typname AS n,
+              array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals
+          FROM pg_type t
+          JOIN pg_enum e ON t.oid = e.enumtypid
+          JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace
+          GROUP BY s,n
+      ) AS enum_info ON (info.udt_name = enum_info.n)
+      ORDER BY schema, position
+  |]
+  return $ mapMaybe (columnFromRow tabs) cols
+
+columnFromRow :: [Table] ->
+                 (Text,       Text,      Text,
+                  Int,        Bool,      Text,
+                  Bool,       Maybe Int, Maybe Int,
+                  Maybe Text, Maybe Text)
+                 -> Maybe Column
+columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table
+  where
+    buildColumn tbl = Column tbl n pos nul typ u l p d (parseEnum e) Nothing
+    table = 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|
+    SELECT ns1.nspname AS table_schema,
+           tab.relname AS table_name,
+           column_info.cols AS columns,
+           ns2.nspname AS foreign_table_schema,
+           other.relname AS foreign_table_name,
+           column_info.refs AS foreign_columns
+    FROM pg_constraint,
+       LATERAL (SELECT array_agg(cols.attname) AS cols,
+                       array_agg(cols.attnum)  AS nums,
+                       array_agg(refs.attname) AS refs
+                  FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
+                       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 ns1,
+       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
+       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
+       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
+    WHERE confrelid != 0
+    ORDER BY (conrelid, column_info.nums)
+  |]
+  return $ mapMaybe (relationFromRow tabs cols) rels
+
+relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
+relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
+  if isJust table && isJust tableF && length cols == length rcs && length colsF == length frcs
+    then Just $ Relation (fromJust table) cols (fromJust tableF) colsF Child Nothing Nothing Nothing
+    else Nothing
+  where
+    findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
+    findCols s t cs = filter (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col `elem` cs) allCols
+    table  = findTable rs rt
+    tableF = findTable frs frt
+    cols  = findCols rs rt rcs
+    colsF = findCols frs frt frcs
+
+allPrimaryKeys :: [Table] -> H.Tx P.Postgres s [PrimaryKey]
+allPrimaryKeys tabs = do
+  pks <- H.listEx $ [H.stmt|
+    SELECT
+        kc.table_schema,
+        kc.table_name,
+        kc.column_name
+    FROM
+        information_schema.table_constraints tc,
+        information_schema.key_column_usage kc
+    WHERE
+        tc.constraint_type = 'PRIMARY KEY' AND
+        kc.table_name = tc.table_name AND
+        kc.table_schema = tc.table_schema AND
+        kc.constraint_name = tc.constraint_name AND
+        kc.table_schema NOT IN ('pg_catalog', 'information_schema')
+    |]
+  return $ mapMaybe (pkFromRow tabs) pks
+
+pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
+pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
+  where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+
+allSynonyms :: [Column] -> H.Tx P.Postgres s [(Column,Column)]
+allSynonyms allCols = do
+  syns <- 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 $ mapMaybe (synonymFromRow allCols) syns
+
+synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column)
+synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
+  where
+    col1 = findCol s1 t1 c1
+    col2 = findCol s2 t2 c2
+    findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols

src/PostgREST/Main.hs

@@ -8,8 +8,7 @@ import           PostgREST.Config                     (AppConfig (..),
                                                        readOptions)
 import           PostgREST.Error                      (errResponse, PgError)
 import           PostgREST.Middleware
-import           PostgREST.PgStructure
+import           PostgREST.DbStructure
-import           PostgREST.Types
 
 import           Control.Monad                        (unless)
 import           Control.Monad.IO.Class               (liftIO)
@@ -26,7 +25,6 @@ import           Network.Wai.Middleware.RequestLogger (logStdout)
 import           System.IO                            (BufferMode (..),
                                                        hSetBuffering, stderr,
                                                        stdin, stdout)
--- import Data.Maybe (mapMaybe)
 
 isServerVersionSupported :: H.Session P.Postgres IO Bool
 isServerVersionSupported = do
@@ -70,30 +68,11 @@ main = do
     ) supportedOrError
 
   let txSettings = Just (H.ReadCommitted, Just True)
-  metadata <- H.session pool $ H.tx txSettings $ do
+  dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema conf)
-    rels <- allRelations
+  dbStructure <- either hasqlError return dbOrError
-    cols <- allColumns rels
-    keys <- allPrimaryKeys
-    return (rels, cols, keys)
-
-
-  dbstructure <- either hasqlError
-    (\(rels, cols, keys) ->
-
-      return DbStructure {
-          columns=cols
-        , relations=rels
-        , primaryKeys=keys
-        }
-    ) metadata
-
-  -- let allRels = relations dbstructure
-  --     fakeRels = mapMaybe (toSourceRelation "projects") allRels
-  --
-  -- print $ findRelation (fakeRels ++ allRels) "test" "pg_source" "clients"
 
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf (app dbstructure conf body) req
+      runWithClaims conf (app dbStructure conf body) req
     either (respond . errResponse) respond resOrError

src/PostgREST/MainTest.hs

@@ -1,129 +0,0 @@
-module Main where
-
-
-import           PostgREST.App
-import           PostgREST.Config                     (AppConfig (..),
-                                                       minimumPgVersion,
-                                                       prettyVersion,
-                                                       readOptions)
-import           PostgREST.Error                      (errResponse, PgError)
-import           PostgREST.Middleware
-import           PostgREST.PgStructure
-import           PostgREST.Types
-
-import           Control.Monad                        (unless)
-import           Control.Monad.IO.Class               (liftIO)
-import           Data.Aeson                           (encode)
-import           Data.Functor.Identity
-import           Data.Monoid                          ((<>))
-import           Data.String.Conversions              (cs)
-import           Data.Text                            (Text)
-import qualified Hasql                                as H
-import qualified Hasql.Postgres                       as P
-import           Network.Wai
-import           Network.Wai.Handler.Warp             hiding (Connection)
-import           Network.Wai.Middleware.RequestLogger (logStdout)
-import           System.IO                            (BufferMode (..),
-                                                       hSetBuffering, stderr,
-                                                       stdin, stdout)
--- import Data.Maybe (mapMaybe)
--- import Data.List (subsequences)
--- import Control.Monad (join)
--- import PostgREST.QueryBuilder
--- import           GHC.Exts              (groupWith)
-
-
-isServerVersionSupported :: H.Session P.Postgres IO Bool
-isServerVersionSupported = do
-  Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|]
-  return $ read (cs row) >= minimumPgVersion
-
-hasqlError :: PgError -> IO a
-hasqlError = error . cs . encode
-
-
-main :: IO ()
-main = do
-  hSetBuffering stdout LineBuffering
-  hSetBuffering stdin  LineBuffering
-  hSetBuffering stderr NoBuffering
-
-  -- let dbString = "postgres://postgrest_test@localhost:5432/postgrest_test" :: String
-  --     conf = AppConfig dbString 3000 "postgrest_anonymous" "test" False "safe" 10 :: AppConfig
-
-  conf <- readOptions
-  let port = configPort conf
-
-  unless ("secret" /= configJwtSecret conf) $
-    putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
-  Prelude.putStrLn $ "Listening on port " ++
-    (show $ configPort conf :: String)
-
-  let pgSettings = P.StringSettings $ cs (configDatabase conf)
-      appSettings = setPort port
-                  . setServerName (cs $ "postgrest/" <> prettyVersion)
-                  $ defaultSettings
-      middle = logStdout . defaultMiddle
-
-  poolSettings <- maybe (fail "Improper session settings") return $
-    H.poolSettings (fromIntegral $ configPool conf) 30
-  pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
-
-  supportedOrError <- H.session pool isServerVersionSupported
-  either hasqlError
-    (\supported ->
-      unless supported $
-        error (
-          "Cannot run in this PostgreSQL version, PostgREST needs at least "
-          <> show minimumPgVersion)
-    ) supportedOrError
-
-  -- what was this code for?
-  -- roleOrError <- H.session pool $ do
-  --   Identity (role :: Text) <- H.tx Nothing $ H.singleEx
-  --     [H.stmt|SELECT SESSION_USER|]
-  --   return role
-  -- authenticator <- either hasqlError return roleOrError
-
-  let txSettings = Just (H.ReadCommitted, Just True)
-  metadata <- H.session pool $ H.tx txSettings $ do
-    tabs <- allTables
-    rels <- allRelations
-    cols <- allColumns rels
-    keys <- allPrimaryKeys
-    return (tabs, rels, cols, keys)
-
-
-  dbstructure <- either hasqlError
-    (\(tabs, rels, cols, keys) ->
-
-      return DbStructure {
-          tables=tabs
-        , columns=cols
-        , relations=rels
-        , primaryKeys=keys
-        }
-    ) metadata
-  runSettings appSettings $ middle $ \ req respond -> do
-    body <- strictRequestBody req
-    resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf (app dbstructure conf body) req
-    either (respond . errResponse) respond resOrError
-
-  --let allRels = relations dbstructure
-      -- links = join $ map (combinations 2) $ filter ((>=1).length) $ groupWith groupFn $ filter ( (==Child). relType) allRels
-      -- combinations k ns = filter ((k==).length) (subsequences ns)
-
-  --print $ findRelation allRels "test" "projects" "users"
-  --mapM_ print $ mapMaybe link2Relation links
-
-  -- where
-  --   groupFn :: Relation -> Text
-  --   groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
-  --   link2Relation [
-  --     Relation{relSchema=sc, 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 sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
-  --     | otherwise = Nothing
-  --   link2Relation _ = Nothing

src/PostgREST/PgQuery.hs

@@ -281,8 +281,9 @@ pgFmtCondition table (Filter (col,jp) ops val) =
       _      -> ""
     valToStr v = case v of
       VText s -> pgFmtValue opCode s
-      VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn qi fc
+      VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
         where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
+      _ -> ""
 
 pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
 pgFmtColumn table "*" = fromQi table <> ".*"

src/PostgREST/PgStructure.hs

@@ -1,307 +0,0 @@
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE QuasiQuotes           #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TypeSynonymInstances  #-}
-module PostgREST.PgStructure where
-
-import           Control.Applicative
-import           Control.Monad         (join)
-import           Data.Functor.Identity
-import           Data.List             (elemIndex, find, subsequences)
-import           Data.Maybe            (fromMaybe, isJust, mapMaybe)
-import           Data.Monoid
-import           Data.Text             (Text, split)
-import qualified Hasql                 as H
-import qualified Hasql.Postgres        as P
-import qualified Hasql.Backend         as B
-import           PostgREST.PgQuery     ()
-import           PostgREST.Types
-
-import           GHC.Exts              (groupWith)
-import           Prelude
-
-doesProc :: forall c s. B.CxValue c Int =>
-            (Text -> Text -> B.Stmt c) -> Text -> Text -> H.Tx c s Bool
-doesProc stmt schema proc = do
-  row :: Maybe (Identity Int) <- H.maybeEx $ stmt schema proc
-  return $ isJust row
-
-doesProcExist :: Text -> Text -> H.Tx P.Postgres s Bool
-doesProcExist = doesProc [H.stmt|
-      SELECT 1
-      FROM   pg_catalog.pg_namespace n
-      JOIN   pg_catalog.pg_proc p
-      ON     pronamespace = n.oid
-      WHERE  nspname = ?
-      AND    proname = ?
-    |]
-
-doesProcReturnJWT :: Text -> Text -> H.Tx P.Postgres s Bool
-doesProcReturnJWT = doesProc [H.stmt|
-      SELECT 1
-      FROM   pg_catalog.pg_namespace n
-      JOIN   pg_catalog.pg_proc p
-      ON     pronamespace = n.oid
-      WHERE  nspname = ?
-      AND    proname = ?
-      AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
-    |]
-
-tableFromRow :: (Text, Text, Bool) -> Table
-tableFromRow (s, n, i) = Table s n i
-
-columnFromRow :: (Text,       Text,      Text,
-                  Int,        Bool,      Text,
-                  Bool,       Maybe Int, Maybe Int,
-                  Maybe Text, Maybe Text)
-              -> Column
-columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) =
-  Column s t n pos nul typ u l p d (parseEnum e) Nothing
-
-  where
-    parseEnum :: Maybe Text -> [Text]
-    parseEnum str = fromMaybe [] $ split (==',') <$> str
-
-
-relationFromRow :: (Text, Text, [Text], Text, [Text]) -> Relation
-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
-
-
-addParentRelation :: Relation -> [Relation] -> [Relation]
-addParentRelation rel@(Relation s t c ft fc _ _ _ _) rels = Relation s ft fc t c Parent Nothing Nothing Nothing:rel:rels
-
--- allTables :: H.Tx P.Postgres s [Table]
--- allTables = do
---     rows <- H.listEx $ [H.stmt|
---       SELECT
---         n.nspname AS table_schema,
---         c.relname AS table_name,
---         c.relkind = 'r' OR (c.relkind IN ('v','f'))
---         AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
---         OR (EXISTS
---           ( SELECT 1
---             FROM pg_trigger
---             WHERE pg_trigger.tgrelid = c.oid
---             AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable,
---         array_to_string(array_agg(r.rolname), ',') AS acl
---       FROM pg_class c
---       CROSS JOIN pg_roles r
---       JOIN pg_namespace n ON n.oid = c.relnamespace
---       WHERE c.relkind IN ('v','r','m')
---         AND n.nspname NOT IN ('pg_catalog', 'information_schema')
---         AND (
---           pg_has_role(r.rolname, c.relowner, 'USAGE'::text) OR
---           has_table_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR
---           has_any_column_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text) )
---
---       GROUP BY table_schema, table_name, insertable
---       ORDER BY table_schema, table_name
---     |]
---     return $ map tableFromRow rows
-
-tables :: Text -> H.Tx P.Postgres s [Table]
-tables schema = do
-  rows <- H.listEx $
-    [H.stmt|
-      select
-        n.nspname as table_schema,
-        relname as table_name,
-        c.relkind = 'r' or (c.relkind IN ('v', 'f')) and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8
-        or (exists (
-           select 1
-           from pg_trigger
-           where pg_trigger.tgrelid = c.oid and (pg_trigger.tgtype::integer & 69) = 69)
-        ) as insertable
-      from
-        pg_class c
-        join pg_namespace n on n.oid = c.relnamespace
-      where
-        c.relkind in ('v', 'r', 'm')
-        and n.nspname = ?
-        and (
-          pg_has_role(c.relowner, 'USAGE'::text)
-          or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text)
-          or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
-        )
-      order by relname
-    |] schema
-  return $ map tableFromRow rows
-
-allRelations :: H.Tx P.Postgres s [Relation]
-allRelations = do
-  rels <- H.listEx $ [H.stmt|
-    WITH table_fk AS (
-        SELECT ns.nspname AS table_schema,
-               tab.relname AS table_name,
-               column_info.cols AS columns,
-               other.relname AS foreign_table_name,
-               column_info.refs AS foreign_columns
-        FROM pg_constraint,
-           LATERAL (SELECT array_agg(cols.attname) AS cols,
-                           array_agg(cols.attnum)  AS nums,
-                           array_agg(refs.attname) AS refs
-                      FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
-                           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,
-            array_agg(vcu.column_name::text) AS columns,
-            table_fk.foreign_table_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
-            vcu.column_name = ANY (table_fk.columns)
-        WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
-        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.columns,
-            vcu.view_name as foreign_table_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
-            vcu.column_name = ANY (table_fk.foreign_columns)
-        WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
-            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
-      links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
-  return $ simpleRelations ++ mapMaybe link2Relation links
-  where
-    groupFn :: Relation -> Text
-    groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
-    combinations k ns = filter ((k==).length) (subsequences ns)
-    link2Relation [
-      Relation{relSchema=sc, 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 sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
-      | otherwise = Nothing
-    link2Relation _ = Nothing
-
-
-allColumns :: [Relation] -> H.Tx P.Postgres s [Column]
-allColumns rels = do
-  cols <- H.listEx $ [H.stmt|
-      SELECT DISTINCT
-          info.table_schema AS schema,
-          info.table_name AS table_name,
-          info.column_name AS name,
-          info.ordinal_position AS position,
-          info.is_nullable::boolean AS nullable,
-          info.data_type AS col_type,
-          info.is_updatable::boolean AS updatable,
-          info.character_maximum_length AS max_len,
-          info.numeric_precision AS precision,
-          info.column_default AS default_value,
-          array_to_string(enum_info.vals, ',') AS enum
-      FROM (
-          SELECT
-              table_schema,
-              table_name,
-              column_name,
-              ordinal_position,
-              is_nullable,
-              data_type,
-              is_updatable,
-              character_maximum_length,
-              numeric_precision,
-              column_default,
-              udt_name
-          FROM information_schema.columns
-          WHERE table_schema NOT IN ('pg_catalog', 'information_schema')
-      ) AS info
-      LEFT OUTER JOIN (
-          SELECT
-              n.nspname AS s,
-              t.typname AS n,
-              array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals
-          FROM pg_type t
-          JOIN pg_enum e ON t.oid = e.enumtypid
-          JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace
-          GROUP BY s,n
-      ) AS enum_info ON (info.udt_name = enum_info.n)
-      ORDER BY schema, position
-  |]
-  return $ map (addFK . columnFromRow) cols
-
-  where
-    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, relColumns=rc, relType=rty}) =
-      cs==rs && ct==rt && cn `elem` rc && rty==Child
-    lookupFn _ _ = False
-    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
-  pks <- H.listEx $ [H.stmt|
-    WITH table_pk AS (
-        SELECT
-            kc.table_schema,
-            kc.table_name,
-            kc.column_name
-        FROM
-            information_schema.table_constraints tc,
-            information_schema.key_column_usage kc
-        WHERE
-            tc.constraint_type = 'PRIMARY KEY' AND
-            kc.table_name = tc.table_name AND
-            kc.table_schema = tc.table_schema AND
-            kc.constraint_name = tc.constraint_name AND
-            kc.table_schema NOT IN ('pg_catalog', 'information_schema')
-    )
-    SELECT table_schema,
-           table_name,
-           column_name
-    FROM table_pk
-    UNION (
-        SELECT
-            vcu.view_schema,
-            vcu.view_name,
-            vcu.column_name
-         FROM information_schema.view_column_usage AS vcu
-         JOIN
-            table_pk ON table_pk.table_schema = vcu.view_schema AND
-            table_pk.table_name = vcu.table_name AND
-            table_pk.column_name = vcu.column_name
-         WHERE vcu.view_schema NOT IN ('pg_catalog','information_schema')
-    )
-    |]
-  return $ map pkFromRow pks

src/PostgREST/QueryBuilder.hs

@@ -7,7 +7,7 @@ import           Control.Error
 import           Data.List         (find)
 import           Data.Monoid
 import           Data.Text         hiding (filter, find, foldr, head, last, map,
-                                    null, zipWith)
+                                    null, zipWith, concatMap)
 import           Control.Applicative
 import           Data.Tree
 import           PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem,
@@ -16,11 +16,11 @@ import           PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem,
 import           PostgREST.Types
 import qualified Data.Map as M
 
-findRelation :: [Relation] -> Text -> Text -> Text -> Maybe Relation
+findRelation :: [Relation] -> Schema -> Text -> Text -> Maybe Relation
 findRelation allRelations s t1 t2 =
-  find (\r -> s == relSchema r && t1 == relTable r && t2 == relFTable r) allRelations
+  find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations
 
-addRelations :: Text -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
+addRelations :: Schema -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
 addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) =
   case parentNode of
     Nothing -> Node (query, (table, Nothing)) <$> updatedForest
@@ -35,34 +35,38 @@ addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) for
     updatedForest = mapM (addRelations schema allRelations (Just node)) forest
 
 getJoinConditions :: Relation -> [Filter]
-getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) =
+getJoinConditions (Relation t cs ft fcs typ lt lc1 lc2) =
   case typ of
-    Child  -> zipWith (toFilter t ft) cs fcs
+    Child  -> zipWith (toFilter tN ftN) cs fcs
-    Parent -> zipWith (toFilter t ft) cs fcs
+    Parent -> zipWith (toFilter tN ftN) cs fcs
-    Many   -> zipWith (toFilter t (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" lt)) fcs (fromMaybe [] lc2)
+    Many   -> zipWith (toFilter tN ltN) cs (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
   where
-    toFilter :: Text -> Text -> FieldName -> FieldName -> Filter
+    s = tableSchema t
-    toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc))
+    tN = tableName t
+    ftN = tableName ft
+    ltN = fromMaybe "" (tableName <$> lt)
+    toFilter :: Text -> Text -> Column -> Column -> Filter
+    toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
 
 addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest
-addJoinConditions schema (Node (query, (t, r)) forest) =
+addJoinConditions schema (Node (query, (n, r)) forest) =
   case r of
-    Nothing -> Node (updatedQuery, (t, r))  <$> updatedForest -- this is the root node
+    Nothing -> Node (updatedQuery, (n,r))  <$> updatedForest -- this is the root node
-    Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(t,r)) <$> updatedForest
+    Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(n,r)) <$> updatedForest
-    Just (Relation{relType=Parent}) -> Node (updatedQuery, (t,r)) <$> updatedForest
+    Just (Relation{relType=Parent}) -> Node (updatedQuery, (n,r)) <$> updatedForest
     Just rel@(Relation{relType=Many, relLTable=(Just linkTable)}) ->
-      Node (qq, (t, r)) <$> updatedForest
+      Node (qq, (n, r)) <$> updatedForest
       where
          q = addCond updatedQuery (getJoinConditions rel)
-         qq = q{from=linkTable:from q}
+         qq = q{from=tableName linkTable : from q}
-    _ -> Left "unknow relation"
+    _ -> Left "unknown relation"
   where
     -- add parentTable and parentJoinConditions to the query
     updatedQuery = foldr (flip addCond) (query{from = parentTables ++ from query}) parentJoinConditions
       where
-        parentJoinConditions = map (getJoinConditions.snd) parents
+        parentJoinConditions = map (getJoinConditions . snd) parents
         parentTables = map fst parents
-        parents = mapMaybe (getParents.rootLabel) forest
+        parents = mapMaybe (getParents . rootLabel) forest
         getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel)
         getParents _ = Nothing
     updatedForest = mapM (addJoinConditions schema) forest

src/PostgREST/Types.hs

@@ -6,65 +6,68 @@ import Data.Aeson
 import Data.Map
 
 data DbStructure = DbStructure {
-  columns :: [Column]
+  dbTables :: [Table]
-, relations :: [Relation]
+, dbColumns :: [Column]
-, primaryKeys :: [PrimaryKey]
+, dbRelations :: [Relation]
-}
+, dbPrimaryKeys :: [PrimaryKey]
-
-
-data Table = Table {
-  tableSchema :: Text
-, tableName :: Text
-, tableInsertable :: Bool
-} deriving (Show)
-
-data ForeignKey = ForeignKey {
-  fkTable::Text, fkCol::Text
 } deriving (Show, Eq)
 
+type Schema = Text
 
-data Column = Column {
+data Table = Table {
-  colSchema :: Text
+  tableSchema     :: Schema
-, colTable :: Text
+, tableName       :: Text
-, colName :: Text
+, tableInsertable :: Bool
-, colPosition :: Int
+} deriving (Show, Ord)
-, colNullable :: Bool
+
-, colType :: Text
+data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
-, colUpdatable :: Bool
+
-, colMaxLen :: Maybe Int
+data Column =
-, colPrecision :: Maybe Int
+    Column {
-, colDefault :: Maybe Text
+      colTable     :: Table
-, colEnum :: [Text]
+    , colName      :: Text
-, colFK :: Maybe ForeignKey
+    , colPosition  :: Int
-} | Star {colSchema :: Text, colTable :: Text } deriving (Show)
+    , colNullable  :: Bool
+    , colType      :: Text
+    , colUpdatable :: Bool
+    , colMaxLen    :: Maybe Int
+    , colPrecision :: Maybe Int
+    , colDefault   :: Maybe Text
+    , colEnum      :: [Text]
+    , colFK        :: Maybe ForeignKey
+    }
+  | Star { colTable :: Table }
+  deriving (Show, Ord)
+
+type Synonym = (Column,Column)
 
 data PrimaryKey = PrimaryKey {
-  pkSchema::Text, pkTable::Text, pkName::Text
+    pkTable :: Table
-}
+  , pkName  :: Text
+} deriving (Show, Eq)
 
 data OrderTerm = OrderTerm {
-  otTerm :: Text
+  otTerm      :: Text
 , otDirection :: BS.ByteString
 , otNullOrder :: Maybe BS.ByteString
 } deriving (Show, Eq)
 
 data QualifiedIdentifier = QualifiedIdentifier {
-  qiSchema :: Text
+  qiSchema :: Schema
 , qiName   :: Text
 } deriving (Show, Eq)
 
 
 data RelationType = Child | Parent | Many deriving (Show, Eq)
 data Relation = Relation {
-  relSchema  :: Text
+  relTable    :: Table
-, relTable   :: Text
+, relColumns  :: [Column]
-, relColumns  :: [Text]
+, relFTable   :: Table
-, relFTable  :: Text
+, relFColumns :: [Column]
-, relFColumns :: [Text]
+, relType     :: RelationType
-, relType    :: RelationType
+, relLTable   :: Maybe Table
-, relLTable  :: Maybe Text
+, relLCols1   :: Maybe [Column]
-, relLCols1   :: Maybe [Text]
+, relLCols2   :: Maybe [Column]
-, relLCols2   :: Maybe [Text]
 } deriving (Show, Eq)
 
 
@@ -88,7 +91,7 @@ type ApiRequest = Tree ApiNode
 
 instance ToJSON Column where
   toJSON c = object [
-      "schema"    .= colSchema c
+      "schema"    .= tableSchema t
     , "name"      .= colName c
     , "position"  .= colPosition c
     , "nullable"  .= colNullable c
@@ -99,12 +102,27 @@ instance ToJSON Column where
     , "references".= colFK c
     , "default"   .= colDefault c
     , "enum"      .= colEnum c ]
+    where
+      t = colTable c
 
 instance ToJSON ForeignKey where
-  toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
+  toJSON fk = object [
+      "schema" .= tableSchema t
+    , "table"  .= tableName t
+    , "column" .= colName c ]
+    where
+      c = fkCol fk
+      t = colTable c
 
 instance ToJSON Table where
   toJSON v = object [
       "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

src/mock.hs

@@ -1,43 +0,0 @@
-arr = eitherDecode "[{\"a\":10},{\"a\":20}]" :: Either String Value
-ob = eitherDecode "{\"a\":10}"::Either String Value
-
-rc :: Request
-rc =  Request {
-  -- | Request method such as GET.
-     requestMethod = "POST"
-  ,  pathInfo = ["menagerie"]
-  ,  requestHeaders = [("Content-Type", "text/csv")] --      :: H.RequestHeaders
-  }
-bc :: BL.ByteString
-bc = [str|integer->sub->sub2,double,varchar,boolean,date,money,enum
-         |13,3.14159,testing!,false,1900-01-01,$3.99,foo
-         |12,0.1,NULL,true,1929-10-01,12,bar
-         |]
-
-rj :: Request
-rj =  Request {
- -- | Request method such as GET.
-     requestMethod = "POST"
-  ,  pathInfo = ["menagerie"]
-  ,  requestHeaders = [("Content-Type", "application/json")] --      :: H.RequestHeaders
-  }
-bj :: BL.ByteString
-bj = [str|{
-         |  "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
-         |  , "boolean": false, "date": "1900-01-01", "money": "$3.99"
-         |  , "enum": "foo"
-         |}
-         |]
-bj2 :: BL.ByteString
-bj2 = [str|[
-          |{
-          |  "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
-          |  , "boolean": false, "date": "1900-01-01", "money": "$3.99"
-          |  , "enum": "foo"
-          |},
-          |{
-          |  "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
-          |  , "boolean": false, "date": "1900-01-01", "money": "$3.99"
-          |  , "enum": "foo"
-          |}]
-          |]

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,98 +154,57 @@ 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":[
             "id"
          ],
          "columns":[
-            {
+          {
-               "references":null,
+            "references":null,
-               "default":null,
+            "default":null,
-               "precision":64,
+            "precision":32,
-               "updatable":false,
+            "updatable":true,
-               "schema":"test",
+            "schema":"test",
-               "name":"id",
+            "name":"id",
-               "type":"bigint",
+            "type":"integer",
-               "maxLen":null,
+            "maxLen":null,
-               "enum":[],
+            "enum":[],
-               "nullable":true,
+            "nullable":true,
-               "position":1
+            "position":1
+          },
+          {
+            "references":null,
+            "default":null,
+            "precision":null,
+            "updatable":true,
+            "schema":"test",
+            "name":"name",
+            "type":"text",
+            "maxLen":null,
+            "enum":[],
+            "nullable":true,
+            "position":2
+          },
+          {
+            "references": {
+              "schema":"test",
+              "column":"id",
+              "table":"clients"
             },
-            {
+            "default":null,
-               "references":{
+            "precision":32,
-                  "column":"id",
+            "updatable":true,
-                  "table":"auto_incrementing_pk"
+            "schema":"test",
-               },
+            "name":"client_id",
-               "default":null,
+            "type":"integer",
-               "precision":32,
+            "maxLen":null,
-               "updatable":false,
+            "enum":[],
-               "schema":"test",
+            "nullable":true,
-               "name":"auto_inc_fk",
+            "position":3
-               "type":"integer",
+          }
-               "maxLen":null,
+        ]
-               "enum":[],
-               "nullable":true,
-               "position":2
-            },
-            {
-               "references":{
-                  "column":"k",
-                  "table":"simple_pk"
-               },
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"test",
-               "name":"simple_fk",
-               "type":"character varying",
-               "maxLen":255,
-               "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
-            }
-         ]
       }
       |]
 
@@ -296,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

@@ -30,8 +30,7 @@ import PostgREST.App (app)
 import PostgREST.Config (AppConfig(..))
 import PostgREST.Middleware
 import PostgREST.Error(errResponse)
-import PostgREST.PgStructure
+import PostgREST.DbStructure
-import PostgREST.Types
 
 dbString :: String
 dbString = "postgres://postgrest_test@localhost:5432/postgrest_test"
@@ -55,25 +54,13 @@ withApp perform = do
     <- H.acquirePool pgSettings testPoolOpts
 
   let txSettings = Just (H.ReadCommitted, Just True)
-  metadata <- H.session pool $ H.tx txSettings $ do
+  dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema cfg)
-    rels <- allRelations
+  db <- either (fail . show) return dbOrError
-    cols <- allColumns rels
-    keys <- allPrimaryKeys
-    return (rels, cols, keys)
-
-  dbstructure <- case metadata of
-    Left e -> fail $ show e
-    Right (rels, cols, keys) ->
-      return DbStructure {
-          columns=cols
-        , relations=rels
-        , primaryKeys=keys
-        }
 
   perform $ middle $ \req resp -> do
     body <- strictRequestBody req
     result <- liftIO $ H.session pool $ H.tx txSettings
-      $ runWithClaims cfg (app dbstructure cfg body) req
+      $ runWithClaims cfg (app db cfg body) req
     either (resp . errResponse) resp result
 
   where middle = defaultMiddle

test/Unit/DbStructureSpec.hx

@@ -1,7 +1,7 @@
-module Unit.PgStructureSpec where
+module Unit.DbStructureSpec where
 
 import Test.Hspec
-import PgStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
+import DbStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
   foreignKeys)
 
 import Database.HDBC (quickQuery)

test/fixtures/schema.sql

@@ -383,8 +383,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
 );
 
@@ -392,59 +392,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);
 
 
@@ -467,10 +451,6 @@ SET search_path = private, pg_catalog;
 
 
 
-
-SELECT pg_catalog.setval('articles_id_seq', 1, false);
-
-
 SET search_path = test, pg_catalog;
 
 CREATE FUNCTION public.always_true(test.items) RETURNS boolean
@@ -531,10 +511,6 @@ ALTER TABLE ONLY auth
 SET search_path = private, pg_catalog;
 
 
-ALTER TABLE ONLY articles
-    ADD CONSTRAINT articles_pkey PRIMARY KEY (id);
-
-
 SET search_path = postgrest, pg_catalog;
 
 
@@ -655,6 +631,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;
 ---------
 
 
@@ -774,4 +758,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);
 ----------------