all tests passing after moving table structure detection at load time

src/PostgREST/App.hs

@@ -65,7 +65,7 @@ app dbstructure conf reqBody role req =
     --     $ encode (TableOptions cols pkey)
 
     ([], _) -> do
-      let body = encode $ filter (filterTableAcl allTablesAcl role) $ filter (((cs schema)==).tableSchema) allTables
+      let body = encode $ filter (filterTableAcl role) $ filter (((cs schema)==).tableSchema) allTables
       return $ responseLBS status200 [jsonH, ("Custom", "header")] $ cs body
 
     ([table], "OPTIONS") -> do
@@ -261,12 +261,12 @@ app dbstructure conf reqBody role req =
     allRelations = relations dbstructure
     allColumns = columns dbstructure
     allPrimaryKeys = primaryKeys dbstructure
-    allTablesAcl = tablesAcl dbstructure
+    --allTablesAcl = tablesAcl dbstructure
     filterCol schema table (Column{colSchema=s, colTable=t}) =  s==schema && table==t
     filterPk schema table (PrimaryKey{pkSchema=s, pkTable=t}) =  s==schema && table==t
 
-    filterTableAcl :: [(Text, Text, Text)] -> Text -> Table -> Bool
+    filterTableAcl :: Text -> Table -> Bool
-    filterTableAcl acl r (Table{tableSchema=s, tableName=n}) = isJust $ find (\(as,an,ar)->as==s && an==n && ar==r) acl
+    filterTableAcl r (Table{tableAcl=a}) = r `elem` a
     path          = pathInfo req
     verb          = requestMethod req
     qq            = queryString req

src/PostgREST/Main.hs

@@ -99,16 +99,17 @@ main = do
   pkRes <-  H.session pool $ H.tx txParam $ allprimaryKeys
   let allPrimaryKeys = either (fail . show) id pkRes
 
-  tableAclRes <-  H.session pool $ H.tx txParam $ alltablesAcl
+  -- tableAclRes <-  H.session pool $ H.tx txParam $ alltablesAcl
-  let allTablesAcl = either (fail . show) id tableAclRes
+  -- let allTablesAcl = either (fail . show) id tableAclRes
 
 
   let dbstructure = DbStructure {
-    tables=allTables,
+      tables=allTables
-    columns=allColumns,
+    , columns=allColumns
-    relations=allRelations,
+    , relations=allRelations
-    primaryKeys=allPrimaryKeys,
+    , primaryKeys=allPrimaryKeys
-    tablesAcl=allTablesAcl}
+    --, tablesAcl=allTablesAcl
+    }
 
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req

src/PostgREST/PgStructure.hs

@@ -138,8 +138,11 @@ doesProcExist schema proc = do
   return $ isJust row
 
 
-tableFromRow :: (Text, Text, Bool) -> Table
+tableFromRow :: (Text, Text, Bool, Maybe Text) -> Table
-tableFromRow (s, n, i) = Table s n i
+tableFromRow (s, n, i, a) = Table s n i (parseAcl a)
+  where
+    parseAcl :: Maybe Text -> [Text]
+    parseAcl str = fromMaybe [] $ split (==',') <$> str
 
 columnFromRow :: (Text,       Text,      Text,
                   Int,        Bool,      Text,
@@ -192,25 +195,30 @@ addFlippedRelation rel@(Relation s t c ft fc _) rels = Relation s ft fc t c "par
 alltables :: H.Tx P.Postgres s [Table]
 alltables = do
     rows <- H.listEx $ [H.stmt|
-            SELECT  n.nspname AS table_schema,
+      SELECT
-                    relname   AS TABLE_NAME,
+        n.nspname AS table_schema,
-                    c.relkind = 'r' OR (c.relkind IN ('v','f'))
+        c.relname AS table_name,
-                    AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
+        c.relkind = 'r' OR (c.relkind IN ('v','f'))
-                    OR (EXISTS ( SELECT 1
+        AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
-                                 FROM pg_trigger
+        OR (EXISTS
-                                 WHERE pg_trigger.tgrelid = c.oid
+          ( SELECT 1
-                                 AND (pg_trigger.tgtype::integer & 69) = 69)
+            FROM pg_trigger
-                    ) AS insertable
+            WHERE pg_trigger.tgrelid = c.oid
-            FROM pg_class c
+            AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable,
-            JOIN pg_namespace n ON n.oid = c.relnamespace
+        array_to_string(array_agg(r.rolname), ',') AS acl
-            WHERE   c.relkind IN ('v','r','m')
+      FROM pg_class c
-                AND n.nspname NOT IN ('information_schema','pg_catalog')
+      CROSS JOIN pg_roles r
-                AND (  pg_has_role(c.relowner, 'USAGE'::text)
+      JOIN pg_namespace n ON n.oid = c.relnamespace
-                    OR has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text)
+      WHERE c.relkind IN ('v','r','m')
-                    OR has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
+        AND n.nspname NOT IN ('pg_catalog', 'information_schema')
-                    )
+        AND (
-            ORDER BY relname
+          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
 
 allrelations :: H.Tx P.Postgres s [Relation]
@@ -312,16 +320,16 @@ allprimaryKeys = do
   |]
   return $ map pkFromRow pks
 
-alltablesAcl :: H.Tx P.Postgres s [(Text, Text, Text)]
+-- alltablesAcl :: H.Tx P.Postgres s [(Text, Text, Text)]
-alltablesAcl = do
+-- alltablesAcl = do
-  acl <- H.listEx $ [H.stmt|
+--   acl <- H.listEx $ [H.stmt|
-    SELECT
+--     SELECT
-      table_schema,
+--       table_schema,
-      table_name,
+--       table_name,
-      grantee as role
+--       grantee as role
-    FROM information_schema.role_table_grants
+--     FROM information_schema.role_table_grants
-    WHERE
+--     WHERE
-      table_schema NOT IN ('pg_catalog', 'information_schema') AND
+--       table_schema NOT IN ('pg_catalog', 'information_schema') AND
-      privilege_type = 'SELECT'
+--       privilege_type = 'SELECT'
-  |]
+--   |]
-  return acl
+--   return acl

src/PostgREST/Types.hs

@@ -6,13 +6,14 @@ data DbStructure = DbStructure {
 , columns :: [Column]
 , relations :: [Relation]
 , primaryKeys :: [PrimaryKey]
-, tablesAcl :: [(Text, Text, Text)]
+--, tablesAcl :: [(Text, Text, Text)]
 }
 
 data Table = Table {
   tableSchema :: Text
 , tableName :: Text
 , tableInsertable :: Bool
+, tableAcl :: [Text]
 } deriving (Show)
 
 data ForeignKey = ForeignKey {

test/SpecHelper.hs

@@ -69,16 +69,17 @@ withApp perform = do
   pkRes <-  H.session pool $ H.tx txParam $ allprimaryKeys
   let allPrimaryKeys = either (fail . show) id pkRes
 
-  tableAclRes <-  H.session pool $ H.tx txParam $ alltablesAcl
+  -- tableAclRes <-  H.session pool $ H.tx txParam $ alltablesAcl
-  let allTablesAcl = either (fail . show) id tableAclRes
+  -- let allTablesAcl = either (fail . show) id tableAclRes
 
 
   let dbstructure = DbStructure {
-    tables=allTables,
+      tables=allTables
-    columns=allColumns,
+    , columns=allColumns
-    relations=allRelations,
+    , relations=allRelations
-    primaryKeys=allPrimaryKeys,
+    , primaryKeys=allPrimaryKeys
-    tablesAcl=allTablesAcl}
+    --, tablesAcl=allTablesAcl
+    }
 
 
   perform $ middle $ \req resp -> do