move pk unique and fk out of description and into table properties

This commit is contained in:
2026-09-05 08:40:02 +02:00
parent fe83013c37
commit 1225ff2a30
3 changed files with 292 additions and 190 deletions
+83 -69
View File
@@ -7,6 +7,8 @@ Description : Generates the OpenAPI output
module PostgREST.Response.OpenAPI (encode) where
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
@@ -42,14 +44,71 @@ import Protolude hiding (Proxy, get)
encode :: (Text, Text) -> AppConfig -> SchemaCache -> TablesMap -> TablesAccess -> HM.HashMap k [Routine] -> Maybe Text -> LBS.ByteString
encode versions conf sCache tables access procs schemaDescription =
JSON.encode $
postgrestSpec
versions
(dbRelationships sCache)
(concat $ HM.elems procs)
(fmap (\(_, t) -> (t, accessFor access t)) (HM.toList tables))
(proxyUri conf)
schemaDescription
(configOpenApiSecurityActive conf)
injectTableExtensions (dbRelationships sCache) tables $
JSON.toJSON $
postgrestSpec
versions
(concat $ HM.elems procs)
(fmap (\(_, t) -> (t, accessFor access t)) (HM.toList tables))
(proxyUri conf)
schemaDescription
(configOpenApiSecurityActive conf)
-- | Injects relationship metadata (primary key, unique constraints and foreign
-- keys) as vendor extensions on each table definition, so that clients can
-- reconstruct relationships without parsing description markers.
injectTableExtensions :: RelationshipsMap -> TablesMap -> JSON.Value -> JSON.Value
injectTableExtensions rels tables (JSON.Object root) =
JSON.Object $ case KM.lookup "definitions" root of
Nothing -> root
Just defs -> KM.insert "definitions" (injectDefinitions rels byName defs) root
where
byName = HM.fromList [ (tableName t, t) | t <- HM.elems tables ]
injectTableExtensions _ _ other = other
injectDefinitions :: RelationshipsMap -> HM.HashMap Text Table -> JSON.Value -> JSON.Value
injectDefinitions rels byName (JSON.Object defs) =
JSON.Object $ KM.mapWithKey injectTable defs
where
injectTable tblName (JSON.Object o) =
case HM.lookup (Key.toText tblName) byName of
Nothing -> JSON.Object o
Just t -> JSON.Object (KM.union o (tableExtension rels t))
injectTable _ other = other
injectDefinitions _ _ other = other
-- | The vendor extension object describing a table's relationships.
tableExtension :: RelationshipsMap -> Table -> KM.KeyMap JSON.Value
tableExtension rels t = KM.fromList
[ ("x-primary-key", JSON.toJSON (tablePKCols t))
, ("x-unique", JSON.toJSON (tableUniqueCols t))
, ("x-foreign-keys", JSON.toJSON (makeForeignKeys rels t))
]
makeForeignKeys :: RelationshipsMap -> Table -> [JSON.Value]
makeForeignKeys rels t = fkObj <$> selectedRels
where
searchedRels = fromMaybe mempty $ HM.lookup (QualifiedIdentifier (tableSchema t) (tableName t), tableSchema t) rels
-- Sorts the relationship list to get tables first
relsSortedByIsView = sortOn relFTableIsView [ r | r@Relationship{} <- searchedRels ]
-- The relationships this table participates in as the foreign key source
fkRels = filter (\case
Relationship{relCardinality=(M2O _ _)} -> True
Relationship{relCardinality=(O2O _ _ False)} -> True
_ -> False) relsSortedByIsView
-- Prefer real table relationships over the ones derived from views
tableRels = filter (not . relFTableIsView) fkRels
selectedRels = sortOn fkKey (if null tableRels then fkRels else tableRels)
fkKey r = (relForeignTable r, fst <$> relColumns (relCardinality r))
fkObj r = JSON.object
[ "columns" JSON..= (fst <$> cols)
, "references" JSON..= JSON.object
[ "table" JSON..= qiName (relForeignTable r)
, "columns" JSON..= (snd <$> cols)
]
]
where
cols = relColumns (relCardinality r)
-- | Get the access privileges for a table. When the table is not present in the
-- map(ignore-privileges mode), assume the role has full access to it.
@@ -107,12 +166,12 @@ parseDefault colType colDefault =
where
wrapInQuotations text = "\"" <> text <> "\""
makeTableDef :: RelationshipsMap -> (Table, TableAccess) -> (Text, Schema)
makeTableDef rels (t, access) =
makeTableDef :: (Table, TableAccess) -> (Text, Schema)
makeTableDef (t, access) =
(tn, (mempty :: Schema)
& description .~ tableDescription t
& type_ ?~ SwaggerObject
& properties .~ fromList (makeProperty t rels <$> cols)
& properties .~ fromList (makeProperty <$> cols)
& required .~ fmap colName (filter (not . colNullable) cols))
where
tn = tableName t
@@ -121,59 +180,14 @@ makeTableDef rels (t, access) =
accessibleCols :: Table -> [FieldName] -> [Column]
accessibleCols t cols = filter ((`elem` cols) . colName) (tableColumnsList t)
makeProperty :: Table -> RelationshipsMap -> Column -> (Text, Referenced Schema)
makeProperty tbl rels col = (colName col, Inline s)
makeProperty :: Column -> (Text, Referenced Schema)
makeProperty col = (colName col, Inline s)
where
e = if null $ colEnum col then Nothing else JSON.decode $ JSON.encode $ colEnum col
fks :: [Text]
fks =
let
searchedRels = fromMaybe mempty $ HM.lookup (QualifiedIdentifier (tableSchema tbl) (tableName tbl), tableSchema tbl) rels
-- Sorts the relationship list to get tables first
relsSortedByIsView = sortOn relFTableIsView [ r | r@Relationship{} <- searchedRels]
-- Finds the relationships that have this column among their foreign key columns
relsMatching = filter (\case
Relationship{relCardinality=(M2O _ relColumns)} -> colName col `elem` (fst <$> relColumns)
Relationship{relCardinality=(O2O _ relColumns False)} -> colName col `elem` (fst <$> relColumns)
_ -> False
) relsSortedByIsView
-- Prefer real table relationships over the ones derived from views
tableRels = filter (not . relFTableIsView) relsMatching
relsSelected = if null tableRels then relsMatching else tableRels
in
fkNote <$> [ (qiName (relForeignTable r), relColumns (relCardinality r)) | r@Relationship{} <- relsSelected ]
fkNote :: (Text, [(FieldName, FieldName)]) -> Text
fkNote (tblName, cols) =
T.intercalate ""
[ "This is a Foreign Key to `", tblName, ".", refCols, "`.<fk table='", tblName, "' columns='", colPairs, "'/>" ]
where
refCols = case snd <$> cols of
[refCol] -> refCol
cols' -> "(" <> T.intercalate ", " cols' <> ")"
colPairs = T.intercalate "," [ localCol <> ":" <> foreignCol | (localCol, foreignCol) <- cols ]
pk :: Bool
pk = colName col `elem` tablePKCols tbl
uniqueNotes :: [Text]
uniqueNotes = mapMaybe uniqueNote (filter (colName col `elem`) (tableUniqueCols tbl))
where
uniqueNote cols
| length cols == 1 = Just "This is a Unique column.<unique/>"
| otherwise = Just $ "This is part of a composite unique constraint.<unique cols='" <> T.intercalate "," cols <> "'/>"
n = catMaybes
[ Just "Note:"
, if pk then Just "This is a Primary Key.<pk/>" else Nothing
]
<> uniqueNotes
<> fks
d =
if length n > 1 then
Just $ T.append (maybe "" (`T.append` "\n\n") $ colDescription col) (T.intercalate "\n" n)
else
colDescription col
s =
(mempty :: Schema)
& default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType col) =<< colDefault col)
& description .~ d
& description .~ colDescription col
& enum_ .~ e
& format .~ toSwaggerFormat (colType col)
& maxLength .~ (fromIntegral <$> colMaxLen col)
@@ -253,8 +267,8 @@ makeProcPostParams pd =
, Ref $ Reference "preferParams"
]
makeParamDefs :: RelationshipsMap -> [(Table, TableAccess)] -> [(Text, Param)]
makeParamDefs rels tis =
makeParamDefs :: [(Table, TableAccess)] -> [(Text, Param)]
makeParamDefs tis =
-- TODO: create Prefer for each method (GET, PATCH, etc.)
[ ("preferParams", makePreferParam ["params"])
, ("preferReturn", makePreferParam ["return"])
@@ -311,12 +325,12 @@ makeParamDefs rels tis =
& in_ .~ ParamQuery
& type_ ?~ SwaggerString))
]
<> concat [ makeObjectBody rels t access <> makeRowFilters (tableName t) (accessibleCols t (taSelectCols access))
<> concat [ makeObjectBody t access <> makeRowFilters (tableName t) (accessibleCols t (taSelectCols access))
| (t, access) <- tis
]
makeObjectBody :: RelationshipsMap -> Table -> TableAccess -> [(Text, Param)]
makeObjectBody rels t access =
makeObjectBody :: Table -> TableAccess -> [(Text, Param)]
makeObjectBody t access =
[ ("body." <> tn, makeBodyParam (taInsertCols access))
, ("body." <> tn <> ".patch", makeBodyParam (taUpdateCols access))
]
@@ -330,7 +344,7 @@ makeObjectBody rels t access =
where
bodySchema = (mempty :: Schema)
& type_ ?~ SwaggerObject
& properties .~ fromList (makeProperty t rels <$> accessibleCols t cols)
& properties .~ fromList (makeProperty <$> accessibleCols t cols)
& required .~ fmap colName (filter (not . colNullable) (accessibleCols t cols))
makeRowFilter :: Text -> Column -> (Text, Param)
@@ -434,8 +448,8 @@ makeSecurityDefinitions secName allow
secSchType = SecuritySchemeApiKey (ApiKeyParams "Authorization" ApiKeyHeader)
secSchDescription = Just "Add the token prepending \"Bearer \" (without quotes) to it"
postgrestSpec :: (Text, Text) -> RelationshipsMap -> [Routine] -> [(Table, TableAccess)] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
postgrestSpec (prettyVersion, docsVersion) rels pds tis (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
postgrestSpec :: (Text, Text) -> [Routine] -> [(Table, TableAccess)] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
postgrestSpec (prettyVersion, docsVersion) pds tis (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
& basePath ?~ T.unpack b
& schemes ?~ [s']
& info .~ ((mempty :: Info)
@@ -446,8 +460,8 @@ postgrestSpec (prettyVersion, docsVersion) rels pds tis (s, h, p, b) sd allowSec
& description ?~ "PostgREST Documentation"
& url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/references/api.html"))
& host .~ h'
& definitions .~ fromList (makeTableDef rels <$> tis)
& parameters .~ fromList (makeParamDefs rels tis)
& definitions .~ fromList (makeTableDef <$> tis)
& parameters .~ fromList (makeParamDefs tis)
& paths .~ makePathItems pds tis
& produces .~ makeMimeList [MTApplicationJSON, MTVndSingularJSON True, MTVndSingularJSON False, MTTextCSV]
& consumes .~ makeMimeList [MTApplicationJSON, MTVndSingularJSON True, MTVndSingularJSON False, MTTextCSV]
+185 -113
View File
@@ -155,7 +155,7 @@ spec withConfig = withConfig baseCfg $ describe "OpenAPI" $ do
"description": "child_entities comment",
"properties": {
"id": {
"description": "child_entities id comment\n\nNote:\nThis is a Primary Key.<pk/>",
"description": "child_entities id comment",
"format": "int32",
"type": "integer"
},
@@ -165,13 +165,29 @@ spec withConfig = withConfig baseCfg $ describe "OpenAPI" $ do
"type": "string"
},
"parent_id": {
"description": "Note:\nThis is a Foreign Key to `entities.id`.<fk table='entities' columns='parent_id:id'/>",
"format": "int32",
"type": "integer"
}
},
"required": [
"id"
],
"x-primary-key": [
"id"
],
"x-unique": [],
"x-foreign-keys": [
{
"columns": [
"parent_id"
],
"references": {
"table": "entities",
"columns": [
"id"
]
}
}
]
}
|]
@@ -190,7 +206,7 @@ spec withConfig = withConfig baseCfg $ describe "OpenAPI" $ do
"description": "child_entities_view comment",
"properties": {
"id": {
"description": "child_entities_view id comment\n\nNote:\nThis is a Primary Key.<pk/>",
"description": "child_entities_view id comment",
"format": "int32",
"type": "integer"
},
@@ -200,11 +216,27 @@ spec withConfig = withConfig baseCfg $ describe "OpenAPI" $ do
"type": "string"
},
"parent_id": {
"description": "Note:\nThis is a Foreign Key to `entities.id`.<fk table='entities' columns='parent_id:id'/>",
"format": "int32",
"type": "integer"
}
}
},
"x-primary-key": [
"id"
],
"x-unique": [],
"x-foreign-keys": [
{
"columns": [
"parent_id"
],
"references": {
"table": "entities",
"columns": [
"id"
]
}
}
]
}
|]
@@ -274,122 +306,146 @@ spec withConfig = withConfig baseCfg $ describe "OpenAPI" $ do
filterEmail `shouldNotBe` Nothing
filterPassword `shouldBe` Nothing
it "includes a fk description for a O2O relationship" $ do
it "includes foreign key and unique metadata for a O2O relationship" $ do
r <- simpleBody <$> get "/"
let referralLink = r ^? key "definitions" . key "first" . key "properties" . key "second_id_1"
let firstFks = r ^? key "definitions" . key "first" . key "x-foreign-keys"
firstUniques = r ^? key "definitions" . key "first" . key "x-unique"
liftIO $
referralLink `shouldBe` Just
liftIO $ do
firstFks `shouldBe` Just
[aesonQQ|
{
"format": "int32",
"type": "integer",
"description": "Note:\nThis is a Unique column.<unique/>\nThis is a Foreign Key to `second.id`.<fk table='second' columns='second_id_1:id'/>"
}
[
{
"columns": [
"second_id_1"
],
"references": {
"table": "second",
"columns": [
"id"
]
}
},
{
"columns": [
"second_id_2"
],
"references": {
"table": "second",
"columns": [
"id"
]
}
}
]
|]
firstUniques `shouldBe` Just
[aesonQQ|[["second_id_1"], ["second_id_2"]]|]
it "includes a unique description for a column with a unique constraint" $ do
it "includes a unique column in the unique metadata" $ do
r <- simpleBody <$> get "/"
let uniqueKey = r ^? key "definitions" . key "single_unique" . key "properties" . key "unique_key"
let uniqueCols = r ^? key "definitions" . key "single_unique" . key "x-unique"
liftIO $
uniqueKey `shouldBe` Just
[aesonQQ|
{
"format": "int32",
"type": "integer",
"description": "Note:\nThis is a Unique column.<unique/>"
}
|]
uniqueCols `shouldBe` Just
[aesonQQ|[["unique_key"]]|]
it "includes the column list of a composite unique constraint" $ do
r <- simpleBody <$> get "/"
let compoundKey1 = r ^? key "definitions" . key "compound_unique" . key "properties" . key "key1"
compoundKey2 = r ^? key "definitions" . key "compound_unique" . key "properties" . key "key2"
let uniqueCols = r ^? key "definitions" . key "compound_unique" . key "x-unique"
liftIO $ do
compoundKey1 `shouldBe` Just
[aesonQQ|
{
"format": "int32",
"type": "integer",
"description": "Note:\nThis is part of a composite unique constraint.<unique cols='key1,key2'/>"
}
|]
compoundKey2 `shouldBe` Just
[aesonQQ|
{
"format": "int32",
"type": "integer",
"description": "Note:\nThis is part of a composite unique constraint.<unique cols='key1,key2'/>"
}
|]
liftIO $
uniqueCols `shouldBe` Just
[aesonQQ|[["key1", "key2"]]|]
it "includes the column list for mixed single and composite unique constraints" $ do
r <- simpleBody <$> get "/"
let uniqueCol = r ^? key "definitions" . key "mixed_unique" . key "properties" . key "id"
compoundKey1 = r ^? key "definitions" . key "mixed_unique" . key "properties" . key "key1"
compoundKey2 = r ^? key "definitions" . key "mixed_unique" . key "properties" . key "key2"
let uniqueCols = r ^? key "definitions" . key "mixed_unique" . key "x-unique"
liftIO $
uniqueCols `shouldBe` Just
[aesonQQ|[["id"], ["key1", "key2"]]|]
it "includes composite foreign key metadata with the full column mapping" $ do
r <- simpleBody <$> get "/"
let fks = r ^? key "definitions" . key "comp_component_instance" . key "x-foreign-keys"
liftIO $
fks `shouldBe` Just
[aesonQQ|
[
{
"columns": [
"product_id",
"component_id"
],
"references": {
"table": "comp_component",
"columns": [
"product_id",
"component_id"
]
}
},
{
"columns": [
"component_instance_id",
"component_id"
],
"references": {
"table": "comp_product_instance",
"columns": [
"id",
"product_id"
]
}
},
{
"columns": [
"product_instance_id",
"product_id"
],
"references": {
"table": "comp_product_instance",
"columns": [
"id",
"product_id"
]
}
}
]
|]
it "includes single column foreign key metadata with the unified format" $ do
r <- simpleBody <$> get "/"
let fks = r ^? key "definitions" . key "comp_product_instance" . key "x-foreign-keys"
uniques = r ^? key "definitions" . key "comp_product_instance" . key "x-unique"
liftIO $ do
uniqueCol `shouldBe` Just
fks `shouldBe` Just
[aesonQQ|
{
"format": "int32",
"type": "integer",
"description": "Note:\nThis is a Unique column.<unique/>"
}
|]
compoundKey1 `shouldBe` Just
[aesonQQ|
{
"format": "int32",
"type": "integer",
"description": "Note:\nThis is part of a composite unique constraint.<unique cols='key1,key2'/>"
}
|]
compoundKey2 `shouldBe` Just
[aesonQQ|
{
"format": "int32",
"type": "integer",
"description": "Note:\nThis is part of a composite unique constraint.<unique cols='key1,key2'/>"
}
|]
it "includes a composite foreign key marker with the full column mapping" $ do
r <- simpleBody <$> get "/"
let parentFk = r ^? key "definitions" . key "comp_component_instance" . key "properties" . key "product_instance_id"
liftIO $
parentFk `shouldBe` Just
[aesonQQ|
{
"format": "int32",
"type": "integer",
"description": "Note:\nThis is a Primary Key.<pk/>\nThis is a Foreign Key to `comp_product_instance.(id, product_id)`.<fk table='comp_product_instance' columns='product_instance_id:id,product_id:product_id'/>"
}
|]
it "includes a single column foreign key marker with the unified format" $ do
r <- simpleBody <$> get "/"
let productFk = r ^? key "definitions" . key "comp_product_instance" . key "properties" . key "product_id"
liftIO $
productFk `shouldBe` Just
[aesonQQ|
{
"format": "int32",
"type": "integer",
"description": "Note:\nThis is part of a composite unique constraint.<unique cols='id,product_id'/>\nThis is a Foreign Key to `comp_product.id`.<fk table='comp_product' columns='product_id:id'/>"
}
[
{
"columns": [
"product_id"
],
"references": {
"table": "comp_product",
"columns": [
"id"
]
}
}
]
|]
uniques `shouldBe` Just
[aesonQQ|[["id", "product_id"]]|]
describe "Foreign table" $
@@ -481,19 +537,27 @@ spec withConfig = withConfig baseCfg $ describe "OpenAPI" $ do
describe "VIEW that has a source FK based on a UNIQUE key" $
it "includes fk description" $ do
it "includes fk metadata" $ do
r <- simpleBody <$> get "/"
let referralLink = r ^? key "definitions" . key "referrals" . key "properties" . key "link"
let fks = r ^? key "definitions" . key "referrals" . key "x-foreign-keys"
liftIO $
referralLink `shouldBe` Just
fks `shouldBe` Just
[aesonQQ|
{
"format": "int32",
"type": "integer",
"description": "Note:\nThis is a Foreign Key to `pages.link`.<fk table='pages' columns='link:link'/>"
}
[
{
"columns": [
"link"
],
"references": {
"table": "pages",
"columns": [
"link"
]
}
}
]
|]
describe "VIEW created for a TABLE with a O2M relationship" $ do
@@ -501,16 +565,24 @@ spec withConfig = withConfig baseCfg $ describe "OpenAPI" $ do
it "fk points to destination TABLE instead of the VIEW" $ do
r <- simpleBody <$> get "/"
let referralLink = r ^? key "definitions" . key "projects" . key "properties" . key "client_id"
let fks = r ^? key "definitions" . key "projects" . key "x-foreign-keys"
liftIO $
referralLink `shouldBe` Just
fks `shouldBe` Just
[aesonQQ|
{
"format": "int32",
"type": "integer",
"description": "Note:\nThis is a Foreign Key to `clients.id`.<fk table='clients' columns='client_id:id'/>"
}
[
{
"columns": [
"client_id"
],
"references": {
"table": "clients",
"columns": [
"id"
]
}
}
]
|]
describe "PostgreSQL to Swagger Type Mapping" $ do
+24 -8
View File
@@ -282,7 +282,6 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
"type" : "object",
"properties" : {
"id" : {
"description" : "Note:\nThis is a Primary Key.<pk/>",
"format" : "int32",
"type" : "integer"
},
@@ -293,7 +292,12 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
},
"required" : [
"id"
]
],
"x-foreign-keys" : [],
"x-primary-key" : [
"id"
],
"x-unique" : []
}
|]
@@ -311,7 +315,6 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
"type" : "object",
"properties" : {
"id" : {
"description" : "Note:\nThis is a Primary Key.<pk/>",
"format" : "int32",
"type" : "integer"
},
@@ -322,7 +325,12 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
},
"required" : [
"id"
]
],
"x-foreign-keys" : [],
"x-primary-key" : [
"id"
],
"x-unique" : []
}
|]
@@ -340,7 +348,6 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
"type" : "object",
"properties" : {
"id" : {
"description" : "Note:\nThis is a Primary Key.<pk/>",
"format" : "int32",
"type" : "integer"
},
@@ -351,7 +358,12 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
},
"required" : [
"id"
]
],
"x-foreign-keys" : [],
"x-primary-key" : [
"id"
],
"x-unique" : []
}
|]
@@ -369,7 +381,6 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
"type" : "object",
"properties" : {
"id" : {
"description" : "Note:\nThis is a Primary Key.<pk/>",
"format" : "int32",
"type" : "integer"
},
@@ -380,7 +391,12 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
},
"required" : [
"id"
]
],
"x-foreign-keys" : [],
"x-primary-key" : [
"id"
],
"x-unique" : []
}
|]