Refactor DbStructure
- Rename `dbstructure` to `db` in App.hs - Rename PgStructure* to DbStructure* - Move `DbStructure` creation to DbStructure.hs
This commit is contained in:
+3
-3
@@ -70,7 +70,7 @@ executable postgrest
|
|||||||
, PostgREST.Middleware
|
, PostgREST.Middleware
|
||||||
, PostgREST.Parsers
|
, PostgREST.Parsers
|
||||||
, PostgREST.PgQuery
|
, PostgREST.PgQuery
|
||||||
, PostgREST.PgStructure
|
, PostgREST.DbStructure
|
||||||
, PostgREST.QueryBuilder
|
, PostgREST.QueryBuilder
|
||||||
, PostgREST.RangeQuery
|
, PostgREST.RangeQuery
|
||||||
, PostgREST.Types
|
, PostgREST.Types
|
||||||
@@ -134,7 +134,7 @@ library
|
|||||||
, PostgREST.Middleware
|
, PostgREST.Middleware
|
||||||
, PostgREST.Parsers
|
, PostgREST.Parsers
|
||||||
, PostgREST.PgQuery
|
, PostgREST.PgQuery
|
||||||
, PostgREST.PgStructure
|
, PostgREST.DbStructure
|
||||||
, PostgREST.QueryBuilder
|
, PostgREST.QueryBuilder
|
||||||
, PostgREST.RangeQuery
|
, PostgREST.RangeQuery
|
||||||
, PostgREST.Types
|
, PostgREST.Types
|
||||||
@@ -165,7 +165,7 @@ Test-Suite spec
|
|||||||
, PostgREST.Middleware
|
, PostgREST.Middleware
|
||||||
, PostgREST.Parsers
|
, PostgREST.Parsers
|
||||||
, PostgREST.PgQuery
|
, PostgREST.PgQuery
|
||||||
, PostgREST.PgStructure
|
, PostgREST.DbStructure
|
||||||
, PostgREST.QueryBuilder
|
, PostgREST.QueryBuilder
|
||||||
, PostgREST.RangeQuery
|
, PostgREST.RangeQuery
|
||||||
, PostgREST.Types
|
, PostgREST.Types
|
||||||
|
|||||||
@@ -46,7 +46,7 @@ import qualified Hasql.Postgres as P
|
|||||||
import PostgREST.Config (AppConfig (..))
|
import PostgREST.Config (AppConfig (..))
|
||||||
import PostgREST.Parsers
|
import PostgREST.Parsers
|
||||||
import PostgREST.PgQuery
|
import PostgREST.PgQuery
|
||||||
import PostgREST.PgStructure
|
import PostgREST.DbStructure
|
||||||
import PostgREST.QueryBuilder
|
import PostgREST.QueryBuilder
|
||||||
import PostgREST.RangeQuery
|
import PostgREST.RangeQuery
|
||||||
import PostgREST.Types
|
import PostgREST.Types
|
||||||
@@ -55,7 +55,7 @@ import PostgREST.Auth (tokenJWT)
|
|||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
|
app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
|
||||||
app dbstructure conf reqBody req =
|
app db conf reqBody req =
|
||||||
case (path, verb) of
|
case (path, verb) of
|
||||||
|
|
||||||
([table], "GET") ->
|
([table], "GET") ->
|
||||||
@@ -160,9 +160,9 @@ app dbstructure conf reqBody req =
|
|||||||
return $ responseLBS status404 [] ""
|
return $ responseLBS status404 [] ""
|
||||||
|
|
||||||
where
|
where
|
||||||
allRels = relations dbstructure
|
allRels = relations db
|
||||||
allCols = columns dbstructure
|
allCols = columns db
|
||||||
allPrKeys = primaryKeys dbstructure
|
allPrKeys = primaryKeys db
|
||||||
filterCol sc table (Column{colSchema=s, colTable=t}) = s==sc && table==t
|
filterCol sc table (Column{colSchema=s, colTable=t}) = s==sc && table==t
|
||||||
filterCol _ _ _ = False
|
filterCol _ _ _ = False
|
||||||
filterPk sc table pk = sc == pkSchema pk && table == pkTable pk
|
filterPk sc table pk = sc == pkSchema pk && table == pkTable pk
|
||||||
@@ -332,7 +332,7 @@ addFilter (path, flt) (Node rn forest) =
|
|||||||
where maybeNode = find ((name==).fst.snd.rootLabel) forst
|
where maybeNode = find ((name==).fst.snd.rootLabel) forst
|
||||||
|
|
||||||
toSourceRelation :: Text -> Relation -> Maybe Relation
|
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 == t = Just $ r {relTable=sourceSubqueryName}
|
||||||
| mt == ft = Just $ r {relFTable=sourceSubqueryName}
|
| mt == ft = Just $ r {relFTable=sourceSubqueryName}
|
||||||
| Just mt == rt = Just $ r {relLTable=Just sourceSubqueryName}
|
| Just mt == rt = Just $ r {relLTable=Just sourceSubqueryName}
|
||||||
|
|||||||
@@ -3,7 +3,7 @@
|
|||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeSynonymInstances #-}
|
{-# LANGUAGE TypeSynonymInstances #-}
|
||||||
module PostgREST.PgStructure where
|
module PostgREST.DbStructure where
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Monad (join)
|
import Control.Monad (join)
|
||||||
@@ -21,6 +21,20 @@ import PostgREST.Types
|
|||||||
import GHC.Exts (groupWith)
|
import GHC.Exts (groupWith)
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
|
createDbStructure :: H.Tx P.Postgres s DbStructure
|
||||||
|
createDbStructure = do
|
||||||
|
tabs <- allTables
|
||||||
|
rels <- allRelations
|
||||||
|
cols <- allColumns rels
|
||||||
|
keys <- allPrimaryKeys
|
||||||
|
|
||||||
|
return DbStructure {
|
||||||
|
tables = tabs
|
||||||
|
, columns = cols
|
||||||
|
, relations = rels
|
||||||
|
, primaryKeys = keys
|
||||||
|
}
|
||||||
|
|
||||||
doesProc :: forall c s. B.CxValue c Int =>
|
doesProc :: forall c s. B.CxValue c Int =>
|
||||||
(Text -> Text -> B.Stmt c) -> Text -> Text -> H.Tx c s Bool
|
(Text -> Text -> B.Stmt c) -> Text -> Text -> H.Tx c s Bool
|
||||||
doesProc stmt schema proc = do
|
doesProc stmt schema proc = do
|
||||||
@@ -64,15 +78,15 @@ columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) =
|
|||||||
parseEnum str = fromMaybe [] $ split (==',') <$> str
|
parseEnum str = fromMaybe [] $ split (==',') <$> str
|
||||||
|
|
||||||
|
|
||||||
relationFromRow :: (Text, Text, [Text], Text, [Text]) -> Relation
|
relationFromRow :: (Text, Text, [Text], Text, Text, [Text]) -> Relation
|
||||||
relationFromRow (s, t, cs, ft, fcs) = Relation s t cs ft fcs Child Nothing Nothing Nothing
|
relationFromRow (s, t, cs, fs, ft, fcs) = Relation s t cs fs ft fcs Child Nothing Nothing Nothing Nothing
|
||||||
|
|
||||||
pkFromRow :: (Text, Text, Text) -> PrimaryKey
|
pkFromRow :: (Text, Text, Text) -> PrimaryKey
|
||||||
pkFromRow (s, t, n) = PrimaryKey s t n
|
pkFromRow (s, t, n) = PrimaryKey s t n
|
||||||
|
|
||||||
|
|
||||||
addParentRelation :: Relation -> [Relation] -> [Relation]
|
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
|
addParentRelation rel@(Relation s t c fs ft fc _ _ _ _ _) rels = Relation fs ft fc s t c Parent Nothing Nothing Nothing Nothing:rel:rels
|
||||||
|
|
||||||
-- allTables :: H.Tx P.Postgres s [Table]
|
-- allTables :: H.Tx P.Postgres s [Table]
|
||||||
-- allTables = do
|
-- allTables = do
|
||||||
@@ -135,9 +149,10 @@ allRelations :: H.Tx P.Postgres s [Relation]
|
|||||||
allRelations = do
|
allRelations = do
|
||||||
rels <- H.listEx $ [H.stmt|
|
rels <- H.listEx $ [H.stmt|
|
||||||
WITH table_fk AS (
|
WITH table_fk AS (
|
||||||
SELECT ns.nspname AS table_schema,
|
SELECT ns1.nspname AS table_schema,
|
||||||
tab.relname AS table_name,
|
tab.relname AS table_name,
|
||||||
column_info.cols AS columns,
|
column_info.cols AS columns,
|
||||||
|
ns2.nspname AS foreign_table_schema,
|
||||||
other.relname AS foreign_table_name,
|
other.relname AS foreign_table_name,
|
||||||
column_info.refs AS foreign_columns
|
column_info.refs AS foreign_columns
|
||||||
FROM pg_constraint,
|
FROM pg_constraint,
|
||||||
@@ -152,10 +167,10 @@ allRelations = do
|
|||||||
WHERE attrelid = confrelid AND attnum = ref)
|
WHERE attrelid = confrelid AND attnum = ref)
|
||||||
AS refs)
|
AS refs)
|
||||||
AS column_info,
|
AS column_info,
|
||||||
LATERAL (SELECT * FROM pg_namespace
|
LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
|
||||||
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 = conrelid) AS tab,
|
||||||
LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other
|
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
|
WHERE confrelid != 0
|
||||||
ORDER BY (conrelid, column_info.nums)
|
ORDER BY (conrelid, column_info.nums)
|
||||||
)
|
)
|
||||||
@@ -167,33 +182,35 @@ allRelations = do
|
|||||||
vcu.table_schema,
|
vcu.table_schema,
|
||||||
vcu.view_name AS table_name,
|
vcu.view_name AS table_name,
|
||||||
array_agg(vcu.column_name::text) AS columns,
|
array_agg(vcu.column_name::text) AS columns,
|
||||||
|
table_fk.foreign_table_schema,
|
||||||
table_fk.foreign_table_name,
|
table_fk.foreign_table_name,
|
||||||
table_fk.foreign_columns
|
table_fk.foreign_columns
|
||||||
FROM information_schema.view_column_usage as vcu
|
FROM information_schema.view_column_usage AS vcu
|
||||||
JOIN table_fk ON
|
JOIN table_fk ON
|
||||||
table_fk.table_schema = vcu.view_schema AND
|
table_fk.table_schema = vcu.view_schema AND
|
||||||
table_fk.table_name = vcu.table_name AND
|
table_fk.table_name = vcu.table_name AND
|
||||||
vcu.column_name = ANY (table_fk.columns)
|
vcu.column_name = ANY (table_fk.columns)
|
||||||
WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
|
WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
|
||||||
AND columns = table_fk.columns
|
AND columns = table_fk.columns
|
||||||
GROUP BY vcu.table_schema, vcu.view_name, table_fk.foreign_table_name, table_fk.foreign_columns
|
GROUP BY vcu.table_schema, vcu.view_name, table_fk.foreign_table_schema, table_fk.foreign_table_name, table_fk.foreign_columns
|
||||||
)
|
)
|
||||||
UNION
|
UNION
|
||||||
(
|
(
|
||||||
SELECT
|
SELECT
|
||||||
vcu.view_schema as table_schema,
|
table_fk.table_schema,
|
||||||
table_fk.table_name,
|
table_fk.table_name,
|
||||||
table_fk.columns,
|
table_fk.columns,
|
||||||
vcu.view_name as foreign_table_name,
|
vcu.view_schema AS foreign_table_schema,
|
||||||
array_agg(vcu.column_name::text) as foreign_columns
|
vcu.view_name AS foreign_table_name,
|
||||||
FROM information_schema.view_column_usage as vcu
|
array_agg(vcu.column_name::text) AS foreign_columns
|
||||||
|
FROM information_schema.view_column_usage AS vcu
|
||||||
JOIN table_fk ON
|
JOIN table_fk ON
|
||||||
table_fk.table_schema = vcu.view_schema AND
|
table_fk.table_schema = vcu.view_schema AND
|
||||||
table_fk.foreign_table_name = vcu.table_name AND
|
table_fk.foreign_table_name = vcu.table_name AND
|
||||||
vcu.column_name = ANY (table_fk.foreign_columns)
|
vcu.column_name = ANY (table_fk.foreign_columns)
|
||||||
WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
|
WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
|
||||||
AND foreign_columns = table_fk.foreign_columns
|
AND foreign_columns = table_fk.foreign_columns
|
||||||
GROUP BY vcu.view_schema, table_fk.table_name, vcu.view_name, table_fk.columns
|
GROUP BY table_fk.table_schema, table_fk.table_name, vcu.view_schema, vcu.view_name, table_fk.columns
|
||||||
)
|
)
|
||||||
|]
|
|]
|
||||||
let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
|
let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
|
||||||
@@ -204,10 +221,10 @@ allRelations = do
|
|||||||
groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
|
groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
|
||||||
combinations k ns = filter ((k==).length) (subsequences ns)
|
combinations k ns = filter ((k==).length) (subsequences ns)
|
||||||
link2Relation [
|
link2Relation [
|
||||||
Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c},
|
Relation{relSchema=ls, relTable=lt, relColumns=lc1, relFSchema=s, relFTable=t, relFColumns=c},
|
||||||
Relation{ relColumns=lc2, relFTable=ft, relFColumns=fc}
|
Relation{ relColumns=lc2, relFSchema=fs, 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)
|
| lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation s t c fs ft fc Many (Just ls) (Just lt) (Just lc1) (Just lc2)
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
link2Relation _ = Nothing
|
link2Relation _ = Nothing
|
||||||
|
|
||||||
@@ -264,7 +281,7 @@ allColumns rels = do
|
|||||||
lookupFn (Column{colSchema=cs, colTable=ct, colName=cn}) (Relation{relSchema=rs, relTable=rt, relColumns=rc, relType=rty}) =
|
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
|
cs==rs && ct==rt && cn `elem` rc && rty==Child
|
||||||
lookupFn _ _ = False
|
lookupFn _ _ = False
|
||||||
relToFk cName (Relation{relFTable=t, relColumns=cs, relFColumns=fcs}) = ForeignKey t <$> c
|
relToFk cName (Relation{relSchema=s, relFTable=t, relColumns=cs, relFColumns=fcs}) = ForeignKey s t <$> c
|
||||||
where
|
where
|
||||||
pos = elemIndex cName cs
|
pos = elemIndex cName cs
|
||||||
c = (fcs !!) <$> pos
|
c = (fcs !!) <$> pos
|
||||||
+4
-32
@@ -2,14 +2,13 @@ module Main where
|
|||||||
|
|
||||||
|
|
||||||
import PostgREST.App
|
import PostgREST.App
|
||||||
-- import PostgREST.QueryBuilder
|
|
||||||
import PostgREST.Config (AppConfig (..),
|
import PostgREST.Config (AppConfig (..),
|
||||||
minimumPgVersion,
|
minimumPgVersion,
|
||||||
prettyVersion,
|
prettyVersion,
|
||||||
readOptions)
|
readOptions)
|
||||||
import PostgREST.Error (errResponse, PgError)
|
import PostgREST.Error (errResponse, PgError)
|
||||||
import PostgREST.Middleware
|
import PostgREST.Middleware
|
||||||
import PostgREST.PgStructure
|
import PostgREST.DbStructure
|
||||||
import PostgREST.Types
|
import PostgREST.Types
|
||||||
|
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
@@ -27,7 +26,6 @@ import Network.Wai.Middleware.RequestLogger (logStdout)
|
|||||||
import System.IO (BufferMode (..),
|
import System.IO (BufferMode (..),
|
||||||
hSetBuffering, stderr,
|
hSetBuffering, stderr,
|
||||||
stdin, stdout)
|
stdin, stdout)
|
||||||
-- import Data.Maybe (mapMaybe)
|
|
||||||
|
|
||||||
isServerVersionSupported :: H.Session P.Postgres IO Bool
|
isServerVersionSupported :: H.Session P.Postgres IO Bool
|
||||||
isServerVersionSupported = do
|
isServerVersionSupported = do
|
||||||
@@ -70,38 +68,12 @@ main = do
|
|||||||
<> show minimumPgVersion)
|
<> show minimumPgVersion)
|
||||||
) supportedOrError
|
) 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)
|
let txSettings = Just (H.ReadCommitted, Just True)
|
||||||
metadata <- H.session pool $ H.tx txSettings $ do
|
dbOrError <- H.session pool $ H.tx txSettings createDbStructure
|
||||||
rels <- allRelations
|
db <- 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
|
runSettings appSettings $ middle $ \ req respond -> do
|
||||||
body <- strictRequestBody req
|
body <- strictRequestBody req
|
||||||
resOrError <- liftIO $ H.session pool $ H.tx txSettings $
|
resOrError <- liftIO $ H.session pool $ H.tx txSettings $
|
||||||
runWithClaims conf (app dbstructure conf body) req
|
runWithClaims conf (app db conf body) req
|
||||||
either (respond . errResponse) respond resOrError
|
either (respond . errResponse) respond resOrError
|
||||||
|
|||||||
@@ -8,7 +8,7 @@ import PostgREST.Config (AppConfig (..),
|
|||||||
readOptions)
|
readOptions)
|
||||||
import PostgREST.Error (errResponse, PgError)
|
import PostgREST.Error (errResponse, PgError)
|
||||||
import PostgREST.Middleware
|
import PostgREST.Middleware
|
||||||
import PostgREST.PgStructure
|
import PostgREST.DbStructure
|
||||||
import PostgREST.Types
|
import PostgREST.Types
|
||||||
|
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
@@ -94,7 +94,7 @@ main = do
|
|||||||
return (tabs, rels, cols, keys)
|
return (tabs, rels, cols, keys)
|
||||||
|
|
||||||
|
|
||||||
dbstructure <- either hasqlError
|
db <- either hasqlError
|
||||||
(\(tabs, rels, cols, keys) ->
|
(\(tabs, rels, cols, keys) ->
|
||||||
|
|
||||||
return DbStructure {
|
return DbStructure {
|
||||||
@@ -107,10 +107,10 @@ main = do
|
|||||||
runSettings appSettings $ middle $ \ req respond -> do
|
runSettings appSettings $ middle $ \ req respond -> do
|
||||||
body <- strictRequestBody req
|
body <- strictRequestBody req
|
||||||
resOrError <- liftIO $ H.session pool $ H.tx txSettings $
|
resOrError <- liftIO $ H.session pool $ H.tx txSettings $
|
||||||
runWithClaims conf (app dbstructure conf body) req
|
runWithClaims conf (app db conf body) req
|
||||||
either (respond . errResponse) respond resOrError
|
either (respond . errResponse) respond resOrError
|
||||||
|
|
||||||
--let allRels = relations dbstructure
|
--let allRels = relations db
|
||||||
-- links = join $ map (combinations 2) $ filter ((>=1).length) $ groupWith groupFn $ filter ( (==Child). relType) allRels
|
-- links = join $ map (combinations 2) $ filter ((>=1).length) $ groupWith groupFn $ filter ( (==Child). relType) allRels
|
||||||
-- combinations k ns = filter ((k==).length) (subsequences ns)
|
-- combinations k ns = filter ((k==).length) (subsequences ns)
|
||||||
|
|
||||||
|
|||||||
@@ -281,7 +281,7 @@ pgFmtCondition table (Filter (col,jp) ops val) =
|
|||||||
_ -> ""
|
_ -> ""
|
||||||
valToStr v = case v of
|
valToStr v = case v of
|
||||||
VText s -> pgFmtValue opCode s
|
VText s -> pgFmtValue opCode s
|
||||||
VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn qi fc
|
VForeignKey (QualifiedIdentifier s _) (ForeignKey _ ft fc) -> pgFmtColumn qi fc
|
||||||
where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
|
where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
|
||||||
|
|
||||||
pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
|
pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
|
||||||
|
|||||||
@@ -35,14 +35,14 @@ addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) for
|
|||||||
updatedForest = mapM (addRelations schema allRelations (Just node)) forest
|
updatedForest = mapM (addRelations schema allRelations (Just node)) forest
|
||||||
|
|
||||||
getJoinConditions :: Relation -> [Filter]
|
getJoinConditions :: Relation -> [Filter]
|
||||||
getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) =
|
getJoinConditions (Relation s t cs fs ft fcs typ ls lt lc1 lc2) =
|
||||||
case typ of
|
case typ of
|
||||||
Child -> zipWith (toFilter t ft) cs fcs
|
Child -> zipWith (toFilter t fs ft) cs fcs
|
||||||
Parent -> zipWith (toFilter t ft) cs fcs
|
Parent -> zipWith (toFilter t fs ft) cs fcs
|
||||||
Many -> zipWith (toFilter t (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" lt)) fcs (fromMaybe [] lc2)
|
Many -> zipWith (toFilter t (fromMaybe "" ls) (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" ls) (fromMaybe "" lt)) fcs (fromMaybe [] lc2)
|
||||||
where
|
where
|
||||||
toFilter :: Text -> Text -> FieldName -> FieldName -> Filter
|
toFilter :: Text -> Text -> Text -> FieldName -> FieldName -> Filter
|
||||||
toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc))
|
toFilter tb fsc ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fsc ftb fc))
|
||||||
|
|
||||||
addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest
|
addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest
|
||||||
addJoinConditions schema (Node (query, (t, r)) forest) =
|
addJoinConditions schema (Node (query, (t, r)) forest) =
|
||||||
@@ -55,7 +55,7 @@ addJoinConditions schema (Node (query, (t, r)) forest) =
|
|||||||
where
|
where
|
||||||
q = addCond updatedQuery (getJoinConditions rel)
|
q = addCond updatedQuery (getJoinConditions rel)
|
||||||
qq = q{from=linkTable:from q}
|
qq = q{from=linkTable:from q}
|
||||||
_ -> Left "unknow relation"
|
_ -> Left "unknown relation"
|
||||||
where
|
where
|
||||||
-- add parentTable and parentJoinConditions to the query
|
-- add parentTable and parentJoinConditions to the query
|
||||||
updatedQuery = foldr (flip addCond) (query{from = parentTables ++ from query}) parentJoinConditions
|
updatedQuery = foldr (flip addCond) (query{from = parentTables ++ from query}) parentJoinConditions
|
||||||
|
|||||||
+12
-8
@@ -19,7 +19,9 @@ data Table = Table {
|
|||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
data ForeignKey = ForeignKey {
|
data ForeignKey = ForeignKey {
|
||||||
fkTable::Text, fkCol::Text
|
fkSchema :: Text,
|
||||||
|
fkTable :: Text,
|
||||||
|
fkCol :: Text
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
|
||||||
@@ -36,7 +38,7 @@ data Column = Column {
|
|||||||
, colDefault :: Maybe Text
|
, colDefault :: Maybe Text
|
||||||
, colEnum :: [Text]
|
, colEnum :: [Text]
|
||||||
, colFK :: Maybe ForeignKey
|
, colFK :: Maybe ForeignKey
|
||||||
} | Star {colSchema :: Text, colTable :: Text } deriving (Show)
|
} | Star { colSchema :: Text, colTable :: Text } deriving (Show)
|
||||||
|
|
||||||
data PrimaryKey = PrimaryKey {
|
data PrimaryKey = PrimaryKey {
|
||||||
pkSchema::Text, pkTable::Text, pkName::Text
|
pkSchema::Text, pkTable::Text, pkName::Text
|
||||||
@@ -56,13 +58,15 @@ data QualifiedIdentifier = QualifiedIdentifier {
|
|||||||
|
|
||||||
data RelationType = Child | Parent | Many deriving (Show, Eq)
|
data RelationType = Child | Parent | Many deriving (Show, Eq)
|
||||||
data Relation = Relation {
|
data Relation = Relation {
|
||||||
relSchema :: Text
|
relSchema :: Text
|
||||||
, relTable :: Text
|
, relTable :: Text
|
||||||
, relColumns :: [Text]
|
, relColumns :: [Text]
|
||||||
, relFTable :: Text
|
, relFSchema :: Text
|
||||||
|
, relFTable :: Text
|
||||||
, relFColumns :: [Text]
|
, relFColumns :: [Text]
|
||||||
, relType :: RelationType
|
, relType :: RelationType
|
||||||
, relLTable :: Maybe Text
|
, relLSchema :: Maybe Text
|
||||||
|
, relLTable :: Maybe Text
|
||||||
, relLCols1 :: Maybe [Text]
|
, relLCols1 :: Maybe [Text]
|
||||||
, relLCols2 :: Maybe [Text]
|
, relLCols2 :: Maybe [Text]
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
@@ -101,7 +105,7 @@ instance ToJSON Column where
|
|||||||
, "enum" .= colEnum c ]
|
, "enum" .= colEnum c ]
|
||||||
|
|
||||||
instance ToJSON ForeignKey where
|
instance ToJSON ForeignKey where
|
||||||
toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
|
toJSON fk = object ["schema".=fkSchema fk, "table".=fkTable fk, "column".=fkCol fk]
|
||||||
|
|
||||||
instance ToJSON Table where
|
instance ToJSON Table where
|
||||||
toJSON v = object [
|
toJSON v = object [
|
||||||
|
|||||||
@@ -175,6 +175,7 @@ spec = around withApp $ do
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"references":{
|
"references":{
|
||||||
|
"schema":"test",
|
||||||
"column":"id",
|
"column":"id",
|
||||||
"table":"auto_incrementing_pk"
|
"table":"auto_incrementing_pk"
|
||||||
},
|
},
|
||||||
@@ -191,6 +192,7 @@ spec = around withApp $ do
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"references":{
|
"references":{
|
||||||
|
"schema":"test",
|
||||||
"column":"k",
|
"column":"k",
|
||||||
"table":"simple_pk"
|
"table":"simple_pk"
|
||||||
},
|
},
|
||||||
|
|||||||
+4
-17
@@ -30,8 +30,7 @@ import PostgREST.App (app)
|
|||||||
import PostgREST.Config (AppConfig(..))
|
import PostgREST.Config (AppConfig(..))
|
||||||
import PostgREST.Middleware
|
import PostgREST.Middleware
|
||||||
import PostgREST.Error(errResponse)
|
import PostgREST.Error(errResponse)
|
||||||
import PostgREST.PgStructure
|
import PostgREST.DbStructure
|
||||||
import PostgREST.Types
|
|
||||||
|
|
||||||
dbString :: String
|
dbString :: String
|
||||||
dbString = "postgres://postgrest_test@localhost:5432/postgrest_test"
|
dbString = "postgres://postgrest_test@localhost:5432/postgrest_test"
|
||||||
@@ -55,25 +54,13 @@ withApp perform = do
|
|||||||
<- H.acquirePool pgSettings testPoolOpts
|
<- H.acquirePool pgSettings testPoolOpts
|
||||||
|
|
||||||
let txSettings = Just (H.ReadCommitted, Just True)
|
let txSettings = Just (H.ReadCommitted, Just True)
|
||||||
metadata <- H.session pool $ H.tx txSettings $ do
|
dbOrError <- H.session pool $ H.tx txSettings createDbStructure
|
||||||
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
|
perform $ middle $ \req resp -> do
|
||||||
body <- strictRequestBody req
|
body <- strictRequestBody req
|
||||||
result <- liftIO $ H.session pool $ H.tx txSettings
|
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
|
either (resp . errResponse) resp result
|
||||||
|
|
||||||
where middle = defaultMiddle
|
where middle = defaultMiddle
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
module Unit.PgStructureSpec where
|
module Unit.DbStructureSpec where
|
||||||
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import PgStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
|
import DbStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
|
||||||
foreignKeys)
|
foreignKeys)
|
||||||
|
|
||||||
import Database.HDBC (quickQuery)
|
import Database.HDBC (quickQuery)
|
||||||
Reference in New Issue
Block a user