diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs
index feb1b6023..46af40ac8 100644
--- a/src/PostgREST/DbStructure.hs
+++ b/src/PostgREST/DbStructure.hs
@@ -51,7 +51,6 @@ import PostgREST.DbStructure.Proc (PgArg (..), PgType (..),
ProcVolatility (..),
ProcsMap, RetType (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
- ForeignKey (..),
Junction (..),
PrimaryKey (..),
Relationship (..))
@@ -98,12 +97,11 @@ getDbStructure schemas extraSearchPath pgVer prepared = do
procs <- HT.statement schemas $ allProcs prepared
let rels = addO2MRels . addM2MRels $ addViewM2ORels srcCols m2oRels
- cols' = addForeignKeys rels cols
keys' = addViewPrimaryKeys srcCols keys
return $ removeInternal schemas $ DbStructure {
dbTables = tabs
- , dbColumns = cols'
+ , dbColumns = cols
, dbRelationships = rels
, dbPrimaryKeys = keys'
, dbProcs = procs
@@ -379,20 +377,6 @@ accessibleTables =
)
order by relname |]
-addForeignKeys :: [Relationship] -> [Column] -> [Column]
-addForeignKeys rels = map addFk
- where
- addFk col = col { colFK = fk col }
- fk col = find (lookupFn col) rels >>= relToFk col
- lookupFn :: Column -> Relationship -> Bool
- lookupFn c rel = case rel of
- Relationship{relColumns=cs, relCardinality=M2O _} -> c `elem` cs
- _ -> False
- relToFk col Relationship{relColumns=cols, relForeignColumns=colsF} = do
- pos <- L.elemIndex col cols
- colF <- atMay colsF pos
- return $ ForeignKey colF
-
{-
Adds Views M2O Relationships based on SourceColumns found, the logic is as follows:
@@ -675,7 +659,7 @@ columnFromRow :: [Table] ->
-> Maybe Column
columnFromRow tabs (s, t, n, desc, nul, typ, l, d, e) = buildColumn <$> table
where
- buildColumn tbl = Column tbl n desc nul typ l d (parseEnum e) Nothing
+ buildColumn tbl = Column tbl n desc nul typ l d (parseEnum e)
table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
parseEnum :: Maybe Text -> [Text]
parseEnum = maybe [] (split (==','))
diff --git a/src/PostgREST/DbStructure/Relationship.hs b/src/PostgREST/DbStructure/Relationship.hs
index 2c8f9d0bf..f765bb791 100644
--- a/src/PostgREST/DbStructure/Relationship.hs
+++ b/src/PostgREST/DbStructure/Relationship.hs
@@ -3,7 +3,6 @@
module PostgREST.DbStructure.Relationship
( Cardinality(..)
- , ForeignKey(..)
, PrimaryKey(..)
, Relationship(..)
, Junction(..)
@@ -12,8 +11,7 @@ module PostgREST.DbStructure.Relationship
import qualified Data.Aeson as JSON
-import PostgREST.DbStructure.Table (Column (..), ForeignKey (..),
- Table (..))
+import PostgREST.DbStructure.Table (Column (..), Table (..))
import Protolude
diff --git a/src/PostgREST/DbStructure/Table.hs b/src/PostgREST/DbStructure/Table.hs
index 973e1fbf9..2dab546df 100644
--- a/src/PostgREST/DbStructure/Table.hs
+++ b/src/PostgREST/DbStructure/Table.hs
@@ -3,7 +3,6 @@
module PostgREST.DbStructure.Table
( Column(..)
- , ForeignKey(..)
, Table(..)
, tableQi
) where
@@ -34,10 +33,6 @@ instance Eq Table where
tableQi :: Table -> QualifiedIdentifier
tableQi Table{tableSchema=s, tableName=n} = QualifiedIdentifier s n
-newtype ForeignKey = ForeignKey
- { fkCol :: Column }
- deriving (Eq, Ord, Generic, JSON.ToJSON)
-
data Column = Column
{ colTable :: Table
, colName :: FieldName
@@ -47,7 +42,6 @@ data Column = Column
, colMaxLen :: Maybe Int32
, colDefault :: Maybe Text
, colEnum :: [Text]
- , colFK :: Maybe ForeignKey
}
deriving (Ord, Generic, JSON.ToJSON)
diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs
index d82391623..a93f61a1f 100644
--- a/src/PostgREST/OpenAPI.hs
+++ b/src/PostgREST/OpenAPI.hs
@@ -2,6 +2,8 @@
Module : PostgREST.OpenAPI
Description : Generates the OpenAPI output
-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.OpenAPI (encode) where
@@ -27,10 +29,10 @@ import PostgREST.DbStructure (DbStructure (..),
tableCols, tablePKCols)
import PostgREST.DbStructure.Proc (PgArg (..),
ProcDescription (..))
-import PostgREST.DbStructure.Relationship (PrimaryKey (..))
-import PostgREST.DbStructure.Table (Column (..),
- ForeignKey (..),
- Table (..))
+import PostgREST.DbStructure.Relationship (Cardinality (..),
+ PrimaryKey (..),
+ Relationship (..))
+import PostgREST.DbStructure.Table (Column (..), Table (..))
import PostgREST.Version (docsVersion, prettyVersion)
import PostgREST.ContentType
@@ -42,6 +44,7 @@ encode :: AppConfig -> DbStructure -> [Table] -> Maybe Text -> HashMap.HashMap k
encode conf dbStructure tables schemaDescription procs =
JSON.encode $
postgrestSpec
+ (dbRelationships dbStructure)
(concat $ HashMap.elems procs)
(openApiTableInfo dbStructure <$> tables)
(proxyUri conf)
@@ -64,27 +67,38 @@ toSwaggerType "real" = SwaggerNumber
toSwaggerType "double precision" = SwaggerNumber
toSwaggerType _ = SwaggerString
-makeTableDef :: [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
-makeTableDef pks (t, cs, _) =
+makeTableDef :: [Relationship] -> [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
+makeTableDef rels pks (t, cs, _) =
let tn = tableName t in
(tn, (mempty :: Schema)
& description .~ tableDescription t
& type_ ?~ SwaggerObject
- & properties .~ fromList (fmap (makeProperty pks) cs)
+ & properties .~ fromList (fmap (makeProperty rels pks) cs)
& required .~ fmap colName (filter (not . colNullable) cs))
-makeProperty :: [PrimaryKey] -> Column -> (Text, Referenced Schema)
-makeProperty pks c = (colName c, Inline s)
+makeProperty :: [Relationship] -> [PrimaryKey] -> Column -> (Text, Referenced Schema)
+makeProperty rels pks c = (colName c, Inline s)
where
e = if null $ colEnum c then Nothing else JSON.decode $ JSON.encode $ colEnum c
- fk ForeignKey{fkCol=Column{colTable=Table{tableName=a}, colName=b}} =
- T.intercalate "" ["This is a Foreign Key to `", a, ".", b, "`."]
+ fk :: Maybe Text
+ fk =
+ let
+ -- Finds the relationship that has a single column foreign key
+ rel = find (\case
+ Relationship{relColumns, relCardinality=M2O _} -> [c] == relColumns
+ _ -> False
+ ) rels
+ fCol = colName <$> (headMay =<< (relForeignColumns <$> rel))
+ fTbl = tableName . relForeignTable <$> rel
+ fTblCol = (,) <$> fTbl <*> fCol
+ in
+ (\(a, b) -> T.intercalate "" ["This is a Foreign Key to `", a, ".", b, "`."]) <$> fTblCol
pk :: Bool
pk = any (\p -> pkTable p == colTable c && pkName p == colName c) pks
n = catMaybes
[ Just "Note:"
, if pk then Just "This is a Primary Key." else Nothing
- , fk <$> colFK c
+ , fk
]
d =
if length n > 1 then
@@ -294,8 +308,8 @@ escapeHostName "*6" = "0.0.0.0"
escapeHostName "!6" = "0.0.0.0"
escapeHostName h = h
-postgrestSpec :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> Swagger
-postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
+postgrestSpec :: [Relationship] -> [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> Swagger
+postgrestSpec rels pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
& basePath ?~ T.unpack b
& schemes ?~ [s']
& info .~ ((mempty :: Info)
@@ -306,7 +320,7 @@ postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
& description ?~ "PostgREST Documentation"
& url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
& host .~ h'
- & definitions .~ fromList (makeTableDef pks <$> ti)
+ & definitions .~ fromList (makeTableDef rels pks <$> ti)
& parameters .~ fromList (makeParamDefs ti)
& paths .~ makePathItems pds ti
& produces .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]