diff --git a/src/library/PostgREST/Response/OpenAPI.hs b/src/library/PostgREST/Response/OpenAPI.hs index 04a1ec21b..94336a335 100644 --- a/src/library/PostgREST/Response/OpenAPI.hs +++ b/src/library/PostgREST/Response/OpenAPI.hs @@ -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, "`." ] - 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." - | otherwise = Just $ "This is part of a composite unique constraint." - n = catMaybes - [ Just "Note:" - , if pk then Just "This is a Primary Key." 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] diff --git a/test/spec/Feature/OpenApi/OpenApiSpec.hs b/test/spec/Feature/OpenApi/OpenApiSpec.hs index 4381bdac1..551647657 100644 --- a/test/spec/Feature/OpenApi/OpenApiSpec.hs +++ b/test/spec/Feature/OpenApi/OpenApiSpec.hs @@ -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.", + "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`.", "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.", + "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`.", "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.\nThis is a Foreign Key to `second.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." - } - |] + 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." - } - |] - compoundKey2 `shouldBe` Just - [aesonQQ| - { - "format": "int32", - "type": "integer", - "description": "Note:\nThis is part of a composite unique constraint." - } - |] + 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." - } - |] - compoundKey1 `shouldBe` Just - [aesonQQ| - { - "format": "int32", - "type": "integer", - "description": "Note:\nThis is part of a composite unique constraint." - } - |] - compoundKey2 `shouldBe` Just - [aesonQQ| - { - "format": "int32", - "type": "integer", - "description": "Note:\nThis is part of a composite unique constraint." - } - |] - - 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.\nThis is a Foreign Key to `comp_product_instance.(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.\nThis is a Foreign Key to `comp_product.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`." - } + [ + { + "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`." - } + [ + { + "columns": [ + "client_id" + ], + "references": { + "table": "clients", + "columns": [ + "id" + ] + } + } + ] |] describe "PostgreSQL to Swagger Type Mapping" $ do diff --git a/test/spec/Feature/Query/MultipleSchemaSpec.hs b/test/spec/Feature/Query/MultipleSchemaSpec.hs index 3de964b4a..2d3f6b783 100644 --- a/test/spec/Feature/Query/MultipleSchemaSpec.hs +++ b/test/spec/Feature/Query/MultipleSchemaSpec.hs @@ -282,7 +282,6 @@ spec withConfig = withConfig (baseCfg { configDbSchemas = fromList ["v1", "v2", "type" : "object", "properties" : { "id" : { - "description" : "Note:\nThis is a Primary Key.", "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.", "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.", "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.", "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" : [] } |]