Refactor DbStructure

- Rename `dbstructure` to `db` in App.hs
- Rename PgStructure* to DbStructure*
- Move `DbStructure` creation to DbStructure.hs
This commit is contained in:
calebmer
2015-11-11 09:03:06 -05:00
parent 3f1d2d8ed9
commit 7560fafbab
11 changed files with 81 additions and 99 deletions
+3 -3
View File
@@ -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
+6 -6
View File
@@ -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
View File
@@ -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
+4 -4
View File
@@ -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)
+1 -1
View File
@@ -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
+7 -7
View File
@@ -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
View File
@@ -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 [
+2
View File
@@ -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
View File
@@ -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)