diff --git a/postgrest.cabal b/postgrest.cabal index 83eff1d4e..9db15172a 100644 --- a/postgrest.cabal +++ b/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 diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 2f1bf4b67..a395353a3 100644 --- a/src/PostgREST/App.hs +++ b/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 - allCols = columns dbstructure - allPrKeys = primaryKeys dbstructure - filterCol sc table (Column{colSchema=s, colTable=t}) = s==sc && table==t + allTabs = dbTables dbStructure + allRels = dbRelations dbStructure + allCols = dbColumns dbStructure + 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 _ _) - | mt == t = Just $ r {relTable=sourceSubqueryName} - | mt == ft = Just $ r {relFTable=sourceSubqueryName} - | Just mt == rt = Just $ r {relLTable=Just sourceSubqueryName} +toSourceRelation mt r@(Relation t _ ft _ _ rt _ _) + | mt == tableName t = Just $ r {relTable=t {tableName=sourceSubqueryName}} + | mt == tableName ft = Just $ r {relFTable=t {tableName=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) diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index a83ae50b9..17a94ff07 100644 --- a/src/PostgREST/Config.hs +++ b/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 diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs new file mode 100644 index 000000000..7eda5dc8a --- /dev/null +++ b/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 diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs index 15f3ca76d..4b12d07b8 100644 --- a/src/PostgREST/Main.hs +++ b/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.Types +import PostgREST.DbStructure 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 - rels <- allRelations - 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" + dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema conf) + dbStructure <- either hasqlError return dbOrError 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 diff --git a/src/PostgREST/MainTest.hs b/src/PostgREST/MainTest.hs deleted file mode 100644 index 55ebec5bc..000000000 --- a/src/PostgREST/MainTest.hs +++ /dev/null @@ -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 diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs index 9d66f6ecb..ebf68adea 100644 --- a/src/PostgREST/PgQuery.hs +++ b/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 <> ".*" diff --git a/src/PostgREST/PgStructure.hs b/src/PostgREST/PgStructure.hs deleted file mode 100644 index 74d620078..000000000 --- a/src/PostgREST/PgStructure.hs +++ /dev/null @@ -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 diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index cd04960fa..e80849091 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/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 - Parent -> zipWith (toFilter t ft) cs fcs - Many -> zipWith (toFilter t (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" lt)) fcs (fromMaybe [] lc2) + Child -> zipWith (toFilter tN ftN) cs fcs + Parent -> zipWith (toFilter tN ftN) cs fcs + Many -> zipWith (toFilter tN ltN) cs (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2) where - toFilter :: Text -> Text -> FieldName -> FieldName -> Filter - toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc)) + s = tableSchema t + 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 - Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(t,r)) <$> updatedForest - Just (Relation{relType=Parent}) -> Node (updatedQuery, (t,r)) <$> updatedForest + Nothing -> Node (updatedQuery, (n,r)) <$> updatedForest -- this is the root node + Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(n,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} - _ -> Left "unknow relation" + qq = q{from=tableName linkTable : from q} + _ -> 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 diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index 691efad99..19a8d05b0 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -6,65 +6,68 @@ import Data.Aeson import Data.Map data DbStructure = DbStructure { - columns :: [Column] -, relations :: [Relation] -, primaryKeys :: [PrimaryKey] -} - - -data Table = Table { - tableSchema :: Text -, tableName :: Text -, tableInsertable :: Bool -} deriving (Show) - -data ForeignKey = ForeignKey { - fkTable::Text, fkCol::Text + dbTables :: [Table] +, dbColumns :: [Column] +, dbRelations :: [Relation] +, dbPrimaryKeys :: [PrimaryKey] } deriving (Show, Eq) +type Schema = Text -data Column = Column { - colSchema :: Text -, colTable :: Text -, colName :: Text -, colPosition :: Int -, colNullable :: Bool -, colType :: Text -, colUpdatable :: Bool -, colMaxLen :: Maybe Int -, colPrecision :: Maybe Int -, colDefault :: Maybe Text -, colEnum :: [Text] -, colFK :: Maybe ForeignKey -} | Star {colSchema :: Text, colTable :: Text } deriving (Show) +data Table = Table { + tableSchema :: Schema +, tableName :: Text +, tableInsertable :: Bool +} deriving (Show, Ord) + +data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord) + +data Column = + Column { + colTable :: Table + , colName :: Text + , colPosition :: Int + , 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 :: Text -, relColumns :: [Text] -, relFTable :: Text -, relFColumns :: [Text] -, relType :: RelationType -, relLTable :: Maybe Text -, relLCols1 :: Maybe [Text] -, relLCols2 :: Maybe [Text] + relTable :: Table +, relColumns :: [Column] +, relFTable :: Table +, relFColumns :: [Column] +, relType :: RelationType +, relLTable :: Maybe Table +, relLCols1 :: Maybe [Column] +, relLCols2 :: Maybe [Column] } 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 diff --git a/src/mock.hs b/src/mock.hs deleted file mode 100644 index 411b3c309..000000000 --- a/src/mock.hs +++ /dev/null @@ -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" - |}] - |] diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index 2a28f43db..339a36044 100644 --- a/test/Feature/StructureSpec.hs +++ b/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, - "default":null, - "precision":64, - "updatable":false, - "schema":"test", - "name":"id", - "type":"bigint", - "maxLen":null, - "enum":[], - "nullable":true, - "position":1 + { + "references":null, + "default":null, + "precision":32, + "updatable":true, + "schema":"test", + "name":"id", + "type":"integer", + "maxLen":null, + "enum":[], + "nullable":true, + "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" }, - { - "references":{ - "column":"id", - "table":"auto_incrementing_pk" - }, - "default":null, - "precision":32, - "updatable":false, - "schema":"test", - "name":"auto_inc_fk", - "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 - } - ] + "default":null, + "precision":32, + "updatable":true, + "schema":"test", + "name":"client_id", + "type":"integer", + "maxLen":null, + "enum":[], + "nullable":true, + "position":3 + } + ] } |] @@ -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 + } + ] + } + |] diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 96dfdc5cb..8971b606f 100644 --- a/test/SpecHelper.hs +++ b/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.Types +import PostgREST.DbStructure 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 - rels <- allRelations - 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 - } + dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema cfg) + db <- either (fail . show) return dbOrError 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 diff --git a/test/Unit/PgStructureSpec.hx b/test/Unit/DbStructureSpec.hx similarity index 93% rename from test/Unit/PgStructureSpec.hx rename to test/Unit/DbStructureSpec.hx index b1c1570dd..6a8a9e4de 100644 --- a/test/Unit/PgStructureSpec.hx +++ b/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) diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index 0abf60888..5b44d64e0 100755 --- a/test/fixtures/schema.sql +++ b/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 - START WITH 1 - INCREMENT BY 1 - NO MINVALUE - NO MAXVALUE - CACHE 1; +CREATE TABLE article_stars ( + article_id int REFERENCES articles(id), + user_id int REFERENCES test.users(id), + created_at timestamp NOT NULL DEFAULT now(), + CONSTRAINT user_article PRIMARY KEY (article_id, user_id) +); +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); ----------------