Revert to the old way of displaying the list of tables
This commit is contained in:
+2
-13
@@ -57,11 +57,7 @@ import Prelude
|
||||
app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
|
||||
app dbstructure conf reqBody req =
|
||||
case (path, verb) of
|
||||
-- ([table], v) ->
|
||||
-- case request of
|
||||
-- Left e -> return $ responseLBS status400 [jsonH] $ cs e
|
||||
-- Right (selectQuery, mutateQuery, isSingle) ->
|
||||
|
||||
|
||||
([table], "GET") ->
|
||||
if range == Just emptyRange
|
||||
then return $ responseLBS status416 [] "HTTP Range error"
|
||||
@@ -151,8 +147,7 @@ app dbstructure conf reqBody req =
|
||||
-- select * from public.proc(a := "foo"::undefined) where whereT limit limitT
|
||||
|
||||
([], _) -> do
|
||||
Identity (dbrole :: Text) <- H.singleEx $ [H.stmt|SELECT current_user|]
|
||||
let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTabs
|
||||
body <- encode <$> tables (cs schema)
|
||||
return $ responseLBS status200 [jsonH] $ cs body
|
||||
|
||||
([table], "OPTIONS") -> do
|
||||
@@ -165,20 +160,14 @@ app dbstructure conf reqBody req =
|
||||
return $ responseLBS status404 [] ""
|
||||
|
||||
where
|
||||
allTabs = tables dbstructure
|
||||
allRels = relations dbstructure
|
||||
allCols = columns dbstructure
|
||||
allPrKeys = primaryKeys dbstructure
|
||||
filterCol sc table (Column{colSchema=s, colTable=t}) = s==sc && table==t
|
||||
filterCol _ _ _ = False
|
||||
filterPk sc table pk = sc == pkSchema pk && table == pkTable pk
|
||||
|
||||
filterTableAcl :: Text -> Table -> Bool
|
||||
filterTableAcl r (Table{tableAcl=a}) = r `elem` a
|
||||
path = pathInfo req
|
||||
verb = requestMethod req
|
||||
--qq = queryString req
|
||||
--qualify = QualifiedIdentifier schema
|
||||
hdrs = requestHeaders req
|
||||
lookupHeader = flip lookup hdrs
|
||||
hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
|
||||
|
||||
@@ -81,19 +81,17 @@ main = do
|
||||
|
||||
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)
|
||||
return (rels, cols, keys)
|
||||
|
||||
|
||||
dbstructure <- either hasqlError
|
||||
(\(tabs, rels, cols, keys) ->
|
||||
(\(rels, cols, keys) ->
|
||||
|
||||
return DbStructure {
|
||||
tables=tabs
|
||||
, columns=cols
|
||||
columns=cols
|
||||
, relations=rels
|
||||
, primaryKeys=keys
|
||||
}
|
||||
|
||||
@@ -48,11 +48,8 @@ doesProcReturnJWT = doesProc [H.stmt|
|
||||
AND pg_catalog.pg_get_function_result(p.oid) = 'jwt_claims'
|
||||
|]
|
||||
|
||||
tableFromRow :: (Text, Text, Bool, Maybe Text) -> Table
|
||||
tableFromRow (s, n, i, a) = Table s n i (parseAcl a)
|
||||
where
|
||||
parseAcl :: Maybe Text -> [Text]
|
||||
parseAcl str = fromMaybe [] $ split (==',') <$> str
|
||||
tableFromRow :: (Text, Text, Bool) -> Table
|
||||
tableFromRow (s, n, i) = Table s n i
|
||||
|
||||
columnFromRow :: (Text, Text, Text,
|
||||
Int, Bool, Text,
|
||||
@@ -77,34 +74,62 @@ 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) )
|
||||
-- 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
|
||||
|
||||
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
|
||||
|
||||
@@ -6,8 +6,7 @@ import Data.Aeson
|
||||
import Data.Map
|
||||
|
||||
data DbStructure = DbStructure {
|
||||
tables :: [Table]
|
||||
, columns :: [Column]
|
||||
columns :: [Column]
|
||||
, relations :: [Relation]
|
||||
, primaryKeys :: [PrimaryKey]
|
||||
}
|
||||
@@ -17,7 +16,6 @@ data Table = Table {
|
||||
tableSchema :: Text
|
||||
, tableName :: Text
|
||||
, tableInsertable :: Bool
|
||||
, tableAcl :: [Text]
|
||||
} deriving (Show)
|
||||
|
||||
data ForeignKey = ForeignKey {
|
||||
|
||||
+3
-5
@@ -56,18 +56,16 @@ withApp perform = do
|
||||
|
||||
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)
|
||||
return (rels, cols, keys)
|
||||
|
||||
dbstructure <- case metadata of
|
||||
Left e -> fail $ show e
|
||||
Right (tabs, rels, cols, keys) ->
|
||||
Right (rels, cols, keys) ->
|
||||
return DbStructure {
|
||||
tables=tabs
|
||||
, columns=cols
|
||||
columns=cols
|
||||
, relations=rels
|
||||
, primaryKeys=keys
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user