move pk unique and fk out of description and into table properties
This commit is contained in:
@@ -7,6 +7,8 @@ Description : Generates the OpenAPI output
|
|||||||
module PostgREST.Response.OpenAPI (encode) where
|
module PostgREST.Response.OpenAPI (encode) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
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.Char8 as BS
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.HashMap.Strict as HM
|
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 :: (Text, Text) -> AppConfig -> SchemaCache -> TablesMap -> TablesAccess -> HM.HashMap k [Routine] -> Maybe Text -> LBS.ByteString
|
||||||
encode versions conf sCache tables access procs schemaDescription =
|
encode versions conf sCache tables access procs schemaDescription =
|
||||||
JSON.encode $
|
JSON.encode $
|
||||||
postgrestSpec
|
injectTableExtensions (dbRelationships sCache) tables $
|
||||||
versions
|
JSON.toJSON $
|
||||||
(dbRelationships sCache)
|
postgrestSpec
|
||||||
(concat $ HM.elems procs)
|
versions
|
||||||
(fmap (\(_, t) -> (t, accessFor access t)) (HM.toList tables))
|
(concat $ HM.elems procs)
|
||||||
(proxyUri conf)
|
(fmap (\(_, t) -> (t, accessFor access t)) (HM.toList tables))
|
||||||
schemaDescription
|
(proxyUri conf)
|
||||||
(configOpenApiSecurityActive 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
|
-- | 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.
|
-- map(ignore-privileges mode), assume the role has full access to it.
|
||||||
@@ -107,12 +166,12 @@ parseDefault colType colDefault =
|
|||||||
where
|
where
|
||||||
wrapInQuotations text = "\"" <> text <> "\""
|
wrapInQuotations text = "\"" <> text <> "\""
|
||||||
|
|
||||||
makeTableDef :: RelationshipsMap -> (Table, TableAccess) -> (Text, Schema)
|
makeTableDef :: (Table, TableAccess) -> (Text, Schema)
|
||||||
makeTableDef rels (t, access) =
|
makeTableDef (t, access) =
|
||||||
(tn, (mempty :: Schema)
|
(tn, (mempty :: Schema)
|
||||||
& description .~ tableDescription t
|
& description .~ tableDescription t
|
||||||
& type_ ?~ SwaggerObject
|
& type_ ?~ SwaggerObject
|
||||||
& properties .~ fromList (makeProperty t rels <$> cols)
|
& properties .~ fromList (makeProperty <$> cols)
|
||||||
& required .~ fmap colName (filter (not . colNullable) cols))
|
& required .~ fmap colName (filter (not . colNullable) cols))
|
||||||
where
|
where
|
||||||
tn = tableName t
|
tn = tableName t
|
||||||
@@ -121,59 +180,14 @@ makeTableDef rels (t, access) =
|
|||||||
accessibleCols :: Table -> [FieldName] -> [Column]
|
accessibleCols :: Table -> [FieldName] -> [Column]
|
||||||
accessibleCols t cols = filter ((`elem` cols) . colName) (tableColumnsList t)
|
accessibleCols t cols = filter ((`elem` cols) . colName) (tableColumnsList t)
|
||||||
|
|
||||||
makeProperty :: Table -> RelationshipsMap -> Column -> (Text, Referenced Schema)
|
makeProperty :: Column -> (Text, Referenced Schema)
|
||||||
makeProperty tbl rels col = (colName col, Inline s)
|
makeProperty col = (colName col, Inline s)
|
||||||
where
|
where
|
||||||
e = if null $ colEnum col then Nothing else JSON.decode $ JSON.encode $ colEnum col
|
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 =
|
s =
|
||||||
(mempty :: Schema)
|
(mempty :: Schema)
|
||||||
& default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType col) =<< colDefault col)
|
& default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType col) =<< colDefault col)
|
||||||
& description .~ d
|
& description .~ colDescription col
|
||||||
& enum_ .~ e
|
& enum_ .~ e
|
||||||
& format .~ toSwaggerFormat (colType col)
|
& format .~ toSwaggerFormat (colType col)
|
||||||
& maxLength .~ (fromIntegral <$> colMaxLen col)
|
& maxLength .~ (fromIntegral <$> colMaxLen col)
|
||||||
@@ -253,8 +267,8 @@ makeProcPostParams pd =
|
|||||||
, Ref $ Reference "preferParams"
|
, Ref $ Reference "preferParams"
|
||||||
]
|
]
|
||||||
|
|
||||||
makeParamDefs :: RelationshipsMap -> [(Table, TableAccess)] -> [(Text, Param)]
|
makeParamDefs :: [(Table, TableAccess)] -> [(Text, Param)]
|
||||||
makeParamDefs rels tis =
|
makeParamDefs tis =
|
||||||
-- TODO: create Prefer for each method (GET, PATCH, etc.)
|
-- TODO: create Prefer for each method (GET, PATCH, etc.)
|
||||||
[ ("preferParams", makePreferParam ["params"])
|
[ ("preferParams", makePreferParam ["params"])
|
||||||
, ("preferReturn", makePreferParam ["return"])
|
, ("preferReturn", makePreferParam ["return"])
|
||||||
@@ -311,12 +325,12 @@ makeParamDefs rels tis =
|
|||||||
& in_ .~ ParamQuery
|
& in_ .~ ParamQuery
|
||||||
& type_ ?~ SwaggerString))
|
& 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
|
| (t, access) <- tis
|
||||||
]
|
]
|
||||||
|
|
||||||
makeObjectBody :: RelationshipsMap -> Table -> TableAccess -> [(Text, Param)]
|
makeObjectBody :: Table -> TableAccess -> [(Text, Param)]
|
||||||
makeObjectBody rels t access =
|
makeObjectBody t access =
|
||||||
[ ("body." <> tn, makeBodyParam (taInsertCols access))
|
[ ("body." <> tn, makeBodyParam (taInsertCols access))
|
||||||
, ("body." <> tn <> ".patch", makeBodyParam (taUpdateCols access))
|
, ("body." <> tn <> ".patch", makeBodyParam (taUpdateCols access))
|
||||||
]
|
]
|
||||||
@@ -330,7 +344,7 @@ makeObjectBody rels t access =
|
|||||||
where
|
where
|
||||||
bodySchema = (mempty :: Schema)
|
bodySchema = (mempty :: Schema)
|
||||||
& type_ ?~ SwaggerObject
|
& 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))
|
& required .~ fmap colName (filter (not . colNullable) (accessibleCols t cols))
|
||||||
|
|
||||||
makeRowFilter :: Text -> Column -> (Text, Param)
|
makeRowFilter :: Text -> Column -> (Text, Param)
|
||||||
@@ -434,8 +448,8 @@ makeSecurityDefinitions secName allow
|
|||||||
secSchType = SecuritySchemeApiKey (ApiKeyParams "Authorization" ApiKeyHeader)
|
secSchType = SecuritySchemeApiKey (ApiKeyParams "Authorization" ApiKeyHeader)
|
||||||
secSchDescription = Just "Add the token prepending \"Bearer \" (without quotes) to it"
|
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 :: (Text, Text) -> [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 (prettyVersion, docsVersion) pds tis (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
|
||||||
& basePath ?~ T.unpack b
|
& basePath ?~ T.unpack b
|
||||||
& schemes ?~ [s']
|
& schemes ?~ [s']
|
||||||
& info .~ ((mempty :: Info)
|
& info .~ ((mempty :: Info)
|
||||||
@@ -446,8 +460,8 @@ postgrestSpec (prettyVersion, docsVersion) rels pds tis (s, h, p, b) sd allowSec
|
|||||||
& description ?~ "PostgREST Documentation"
|
& description ?~ "PostgREST Documentation"
|
||||||
& url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/references/api.html"))
|
& url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/references/api.html"))
|
||||||
& host .~ h'
|
& host .~ h'
|
||||||
& definitions .~ fromList (makeTableDef rels <$> tis)
|
& definitions .~ fromList (makeTableDef <$> tis)
|
||||||
& parameters .~ fromList (makeParamDefs rels tis)
|
& parameters .~ fromList (makeParamDefs tis)
|
||||||
& paths .~ makePathItems pds tis
|
& paths .~ makePathItems pds tis
|
||||||
& produces .~ makeMimeList [MTApplicationJSON, MTVndSingularJSON True, MTVndSingularJSON False, MTTextCSV]
|
& produces .~ makeMimeList [MTApplicationJSON, MTVndSingularJSON True, MTVndSingularJSON False, MTTextCSV]
|
||||||
& consumes .~ makeMimeList [MTApplicationJSON, MTVndSingularJSON True, MTVndSingularJSON False, MTTextCSV]
|
& consumes .~ makeMimeList [MTApplicationJSON, MTVndSingularJSON True, MTVndSingularJSON False, MTTextCSV]
|
||||||
|
|||||||
@@ -155,7 +155,7 @@ spec withConfig = withConfig baseCfg $ describe "OpenAPI" $ do
|
|||||||
"description": "child_entities comment",
|
"description": "child_entities comment",
|
||||||
"properties": {
|
"properties": {
|
||||||
"id": {
|
"id": {
|
||||||
"description": "child_entities id comment\n\nNote:\nThis is a Primary Key.<pk/>",
|
"description": "child_entities id comment",
|
||||||
"format": "int32",
|
"format": "int32",
|
||||||
"type": "integer"
|
"type": "integer"
|
||||||
},
|
},
|
||||||
@@ -165,13 +165,29 @@ spec withConfig = withConfig baseCfg $ describe "OpenAPI" $ do
|
|||||||
"type": "string"
|
"type": "string"
|
||||||
},
|
},
|
||||||
"parent_id": {
|
"parent_id": {
|
||||||
"description": "Note:\nThis is a Foreign Key to `entities.id`.<fk table='entities' columns='parent_id:id'/>",
|
|
||||||
"format": "int32",
|
"format": "int32",
|
||||||
"type": "integer"
|
"type": "integer"
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
"required": [
|
"required": [
|
||||||
"id"
|
"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",
|
"description": "child_entities_view comment",
|
||||||
"properties": {
|
"properties": {
|
||||||
"id": {
|
"id": {
|
||||||
"description": "child_entities_view id comment\n\nNote:\nThis is a Primary Key.<pk/>",
|
"description": "child_entities_view id comment",
|
||||||
"format": "int32",
|
"format": "int32",
|
||||||
"type": "integer"
|
"type": "integer"
|
||||||
},
|
},
|
||||||
@@ -200,11 +216,27 @@ spec withConfig = withConfig baseCfg $ describe "OpenAPI" $ do
|
|||||||
"type": "string"
|
"type": "string"
|
||||||
},
|
},
|
||||||
"parent_id": {
|
"parent_id": {
|
||||||
"description": "Note:\nThis is a Foreign Key to `entities.id`.<fk table='entities' columns='parent_id:id'/>",
|
|
||||||
"format": "int32",
|
"format": "int32",
|
||||||
"type": "integer"
|
"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
|
filterEmail `shouldNotBe` Nothing
|
||||||
filterPassword `shouldBe` 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 "/"
|
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 $
|
liftIO $ do
|
||||||
referralLink `shouldBe` Just
|
firstFks `shouldBe` Just
|
||||||
[aesonQQ|
|
[aesonQQ|
|
||||||
{
|
[
|
||||||
"format": "int32",
|
{
|
||||||
"type": "integer",
|
"columns": [
|
||||||
"description": "Note:\nThis is a Unique column.<unique/>\nThis is a Foreign Key to `second.id`.<fk table='second' columns='second_id_1:id'/>"
|
"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 "/"
|
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 $
|
liftIO $
|
||||||
uniqueKey `shouldBe` Just
|
uniqueCols `shouldBe` Just
|
||||||
[aesonQQ|
|
[aesonQQ|[["unique_key"]]|]
|
||||||
{
|
|
||||||
"format": "int32",
|
|
||||||
"type": "integer",
|
|
||||||
"description": "Note:\nThis is a Unique column.<unique/>"
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
|
|
||||||
it "includes the column list of a composite unique constraint" $ do
|
it "includes the column list of a composite unique constraint" $ do
|
||||||
r <- simpleBody <$> get "/"
|
r <- simpleBody <$> get "/"
|
||||||
|
|
||||||
let compoundKey1 = r ^? key "definitions" . key "compound_unique" . key "properties" . key "key1"
|
let uniqueCols = r ^? key "definitions" . key "compound_unique" . key "x-unique"
|
||||||
compoundKey2 = r ^? key "definitions" . key "compound_unique" . key "properties" . key "key2"
|
|
||||||
|
|
||||||
liftIO $ do
|
liftIO $
|
||||||
compoundKey1 `shouldBe` Just
|
uniqueCols `shouldBe` Just
|
||||||
[aesonQQ|
|
[aesonQQ|[["key1", "key2"]]|]
|
||||||
{
|
|
||||||
"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 the column list for mixed single and composite unique constraints" $ do
|
it "includes the column list for mixed single and composite unique constraints" $ do
|
||||||
r <- simpleBody <$> get "/"
|
r <- simpleBody <$> get "/"
|
||||||
|
|
||||||
let uniqueCol = r ^? key "definitions" . key "mixed_unique" . key "properties" . key "id"
|
let uniqueCols = r ^? key "definitions" . key "mixed_unique" . key "x-unique"
|
||||||
compoundKey1 = r ^? key "definitions" . key "mixed_unique" . key "properties" . key "key1"
|
|
||||||
compoundKey2 = r ^? key "definitions" . key "mixed_unique" . key "properties" . key "key2"
|
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
|
liftIO $ do
|
||||||
uniqueCol `shouldBe` Just
|
fks `shouldBe` Just
|
||||||
[aesonQQ|
|
[aesonQQ|
|
||||||
{
|
[
|
||||||
"format": "int32",
|
{
|
||||||
"type": "integer",
|
"columns": [
|
||||||
"description": "Note:\nThis is a Unique column.<unique/>"
|
"product_id"
|
||||||
}
|
],
|
||||||
|]
|
"references": {
|
||||||
compoundKey1 `shouldBe` Just
|
"table": "comp_product",
|
||||||
[aesonQQ|
|
"columns": [
|
||||||
{
|
"id"
|
||||||
"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'/>"
|
|
||||||
}
|
|
||||||
|]
|
|]
|
||||||
|
uniques `shouldBe` Just
|
||||||
|
[aesonQQ|[["id", "product_id"]]|]
|
||||||
|
|
||||||
describe "Foreign table" $
|
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" $
|
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 "/"
|
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 $
|
liftIO $
|
||||||
referralLink `shouldBe` Just
|
fks `shouldBe` Just
|
||||||
[aesonQQ|
|
[aesonQQ|
|
||||||
{
|
[
|
||||||
"format": "int32",
|
{
|
||||||
"type": "integer",
|
"columns": [
|
||||||
"description": "Note:\nThis is a Foreign Key to `pages.link`.<fk table='pages' columns='link:link'/>"
|
"link"
|
||||||
}
|
],
|
||||||
|
"references": {
|
||||||
|
"table": "pages",
|
||||||
|
"columns": [
|
||||||
|
"link"
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|]
|
|]
|
||||||
|
|
||||||
describe "VIEW created for a TABLE with a O2M relationship" $ do
|
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
|
it "fk points to destination TABLE instead of the VIEW" $ do
|
||||||
r <- simpleBody <$> get "/"
|
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 $
|
liftIO $
|
||||||
referralLink `shouldBe` Just
|
fks `shouldBe` Just
|
||||||
[aesonQQ|
|
[aesonQQ|
|
||||||
{
|
[
|
||||||
"format": "int32",
|
{
|
||||||
"type": "integer",
|
"columns": [
|
||||||
"description": "Note:\nThis is a Foreign Key to `clients.id`.<fk table='clients' columns='client_id:id'/>"
|
"client_id"
|
||||||
}
|
],
|
||||||
|
"references": {
|
||||||
|
"table": "clients",
|
||||||
|
"columns": [
|
||||||
|
"id"
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|]
|
|]
|
||||||
|
|
||||||
describe "PostgreSQL to Swagger Type Mapping" $ do
|
describe "PostgreSQL to Swagger Type Mapping" $ do
|
||||||
|
|||||||
@@ -282,7 +282,6 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
|
|||||||
"type" : "object",
|
"type" : "object",
|
||||||
"properties" : {
|
"properties" : {
|
||||||
"id" : {
|
"id" : {
|
||||||
"description" : "Note:\nThis is a Primary Key.<pk/>",
|
|
||||||
"format" : "int32",
|
"format" : "int32",
|
||||||
"type" : "integer"
|
"type" : "integer"
|
||||||
},
|
},
|
||||||
@@ -293,7 +292,12 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
|
|||||||
},
|
},
|
||||||
"required" : [
|
"required" : [
|
||||||
"id"
|
"id"
|
||||||
]
|
],
|
||||||
|
"x-foreign-keys" : [],
|
||||||
|
"x-primary-key" : [
|
||||||
|
"id"
|
||||||
|
],
|
||||||
|
"x-unique" : []
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
@@ -311,7 +315,6 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
|
|||||||
"type" : "object",
|
"type" : "object",
|
||||||
"properties" : {
|
"properties" : {
|
||||||
"id" : {
|
"id" : {
|
||||||
"description" : "Note:\nThis is a Primary Key.<pk/>",
|
|
||||||
"format" : "int32",
|
"format" : "int32",
|
||||||
"type" : "integer"
|
"type" : "integer"
|
||||||
},
|
},
|
||||||
@@ -322,7 +325,12 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
|
|||||||
},
|
},
|
||||||
"required" : [
|
"required" : [
|
||||||
"id"
|
"id"
|
||||||
]
|
],
|
||||||
|
"x-foreign-keys" : [],
|
||||||
|
"x-primary-key" : [
|
||||||
|
"id"
|
||||||
|
],
|
||||||
|
"x-unique" : []
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
@@ -340,7 +348,6 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
|
|||||||
"type" : "object",
|
"type" : "object",
|
||||||
"properties" : {
|
"properties" : {
|
||||||
"id" : {
|
"id" : {
|
||||||
"description" : "Note:\nThis is a Primary Key.<pk/>",
|
|
||||||
"format" : "int32",
|
"format" : "int32",
|
||||||
"type" : "integer"
|
"type" : "integer"
|
||||||
},
|
},
|
||||||
@@ -351,7 +358,12 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
|
|||||||
},
|
},
|
||||||
"required" : [
|
"required" : [
|
||||||
"id"
|
"id"
|
||||||
]
|
],
|
||||||
|
"x-foreign-keys" : [],
|
||||||
|
"x-primary-key" : [
|
||||||
|
"id"
|
||||||
|
],
|
||||||
|
"x-unique" : []
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
@@ -369,7 +381,6 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
|
|||||||
"type" : "object",
|
"type" : "object",
|
||||||
"properties" : {
|
"properties" : {
|
||||||
"id" : {
|
"id" : {
|
||||||
"description" : "Note:\nThis is a Primary Key.<pk/>",
|
|
||||||
"format" : "int32",
|
"format" : "int32",
|
||||||
"type" : "integer"
|
"type" : "integer"
|
||||||
},
|
},
|
||||||
@@ -380,7 +391,12 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2",
|
|||||||
},
|
},
|
||||||
"required" : [
|
"required" : [
|
||||||
"id"
|
"id"
|
||||||
]
|
],
|
||||||
|
"x-foreign-keys" : [],
|
||||||
|
"x-primary-key" : [
|
||||||
|
"id"
|
||||||
|
],
|
||||||
|
"x-unique" : []
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user