jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: PKcols in table, ViewKeyDependency type

Browse Source 
* Get PKcols inside tables - done with SQL for tables and
  with an additional step in Haskell for views.

  This fixes an fk column being considered as a pk column on views
  and corrects the test added on
  https://github.com/PostgREST/postgrest/pull/1875/files/1d549768580310e18aac4ffa6dbd01c5b77934a7#r853674126

* classify view key dependencies in SQL

* remove Column from Relationship

* Merge cols/fcols in Relationship and
  ensure allM2ORels and allViewsKeyDependencies fk columns
  are ordered - done by attnum in SQL

* Cardinality now contains relColumns instead of Relationship -
  this simplifies getJoinConditions.
This commit is contained in:
steve-chavez
2022-04-21 14:44:45 -05:00
committed by Steve Chavez
parent 057e8d63bf
commit d2719420f4
11 changed files with 290 additions and 321 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/OpenAPI.hs
+26 -30
View File
@@ -3,7 +3,6 @@ Module : PostgREST.OpenAPI
Description : Generates the OpenAPI output
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.OpenAPI (encode) where
@@ -28,12 +27,11 @@ import Data.Swagger
import PostgREST.Config (AppConfig (..), Proxy (..),
isMalformedProxyUri, toURI)
import PostgREST.DbStructure (DbStructure (..),
tableCols, tablePKCols)
tableCols)
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcParam (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
PrimaryKey (..),
Relationship (..))
import PostgREST.DbStructure.Table (Column (..), Table (..),
TablesMap)
@@ -52,7 +50,6 @@ encode conf dbStructure tables procs schemaDescription =
(openApiTableInfo dbStructure <$> (snd <$> M.toList tables))
(proxyUri conf)
schemaDescription
(dbPrimaryKeys dbStructure)
makeMimeList :: [ContentType] -> MimeList
makeMimeList cs = MimeList $ fmap (fromString . BS.unpack . toMime) cs
@@ -83,34 +80,34 @@ parseDefault colType colDefault =
where
wrapInQuotations text = "\"" <> text <> "\""
makeTableDef :: [Relationship] -> [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
makeTableDef rels pks (t, cs, _) =
makeTableDef :: [Relationship] -> (Table, [Column]) -> (Text, Schema)
makeTableDef rels (t, cs) =
let tn = tableName t in
(tn, (mempty :: Schema)
& description .~ tableDescription t
& type_ ?~ SwaggerObject
& properties .~ fromList (fmap (makeProperty rels pks) cs)
& properties .~ fromList (fmap (makeProperty rels) cs)
& required .~ fmap colName (filter (not . colNullable) cs))
makeProperty :: [Relationship] -> [PrimaryKey] -> Column -> (Text, Referenced Schema)
makeProperty rels pks c = (colName c, Inline s)
makeProperty :: [Relationship] -> Column -> (Text, Referenced Schema)
makeProperty rels col = (colName col, Inline s)
where
e = if null $ colEnum c then Nothing else JSON.decode $ JSON.encode $ colEnum c
e = if null $ colEnum col then Nothing else JSON.decode $ JSON.encode $ colEnum col
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
Relationship{relCardinality=(M2O _ relColumns)} -> [colName col] == (fst <$> relColumns)
_ -> False
) rels
fCol = colName <$> (headMay . relForeignColumns =<< rel)
fCol = (headMay . (\r -> snd <$> relColumns (relCardinality r)) =<< rel)
fTbl = qiName . relForeignTable <$> rel
fTblCol = (,) <$> fTbl <*> fCol
in
(\(a, b) -> T.intercalate "" ["This is a Foreign Key to `", a, ".", b, "`.<fk table='", a, "' column='", b, "'/>"]) <$> fTblCol
pk :: Bool
pk = any (\p -> pkTable p == colTable c && pkName p == colName c) pks
pk = colName col `elem` tablePKCols (colTable col)
n = catMaybes
[ Just "Note:"
, if pk then Just "This is a Primary Key.<pk/>" else Nothing
@@ -118,17 +115,17 @@ makeProperty rels pks c = (colName c, Inline s)
]
d =
if length n > 1 then
Just $ T.append (maybe "" (`T.append` "\n\n") $ colDescription c) (T.intercalate "\n" n)
Just $ T.append (maybe "" (`T.append` "\n\n") $ colDescription col) (T.intercalate "\n" n)
else
colDescription c
colDescription col
s =
(mempty :: Schema)
& default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType c) =<< colDefault c)
& default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType col) =<< colDefault col)
& description .~ d
& enum_ .~ e
& format ?~ colType c
& maxLength .~ (fromIntegral <$> colMaxLen c)
& type_ .~ toSwaggerType (colType c)
& format ?~ colType col
& maxLength .~ (fromIntegral <$> colMaxLen col)
& type_ .~ toSwaggerType (colType col)
makeProcSchema :: ProcDescription -> Schema
makeProcSchema pd =
@@ -165,7 +162,7 @@ makeProcParam pd =
, Ref $ Reference "preferParams"
]
makeParamDefs :: [(Table, [Column], [Text])] -> [(Text, Param)]
makeParamDefs :: [(Table, [Column])] -> [(Text, Param)]
makeParamDefs ti =
[ ("preferParams", makePreferParam ["params=single-object"])
, ("preferReturn", makePreferParam ["return=representation", "return=minimal", "return=none"])
@@ -222,7 +219,7 @@ makeParamDefs ti =
& type_ ?~ SwaggerString))
]
<> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) cs
| (t, cs, _) <- ti
| (t, cs) <- ti
]
makeObjectBody :: Text -> (Text, Param)
@@ -247,8 +244,8 @@ makeRowFilter tn c =
makeRowFilters :: Text -> [Column] -> [(Text, Param)]
makeRowFilters tn = fmap (makeRowFilter tn)
makePathItem :: (Table, [Column], [Text]) -> (FilePath, PathItem)
makePathItem (t, cs, _) = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t || tableDeletable t)
makePathItem :: (Table, [Column]) -> (FilePath, PathItem)
makePathItem (t, cs) = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t || tableDeletable t)
where
-- Use first line of table description as summary; rest as description (if present)
-- We strip leading newlines from description so that users can include a blank line between summary and description
@@ -312,7 +309,7 @@ makeRootPathItem = ("/", p)
pr = (mempty :: PathItem) & get ?~ getOp
p = pr
makePathItems :: [ProcDescription] -> [(Table, [Column], [Text])] -> InsOrdHashMap FilePath PathItem
makePathItems :: [ProcDescription] -> [(Table, [Column])] -> InsOrdHashMap FilePath PathItem
makePathItems pds ti = fromList $ makeRootPathItem :
fmap makePathItem ti ++ fmap makeProcPathItem pds
@@ -324,8 +321,8 @@ escapeHostName "*6" = "0.0.0.0"
escapeHostName "!6" = "0.0.0.0"
escapeHostName h = h
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)
postgrestSpec :: [Relationship] -> [ProcDescription] -> [(Table, [Column])] -> (Text, Text, Integer, Text) -> Maybe Text -> Swagger
postgrestSpec rels pds ti (s, h, p, b) sd = (mempty :: Swagger)
& basePath ?~ T.unpack b
& schemes ?~ [s']
& info .~ ((mempty :: Info)
@@ -336,7 +333,7 @@ postgrestSpec rels 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 rels pks <$> ti)
& definitions .~ fromList (makeTableDef rels <$> ti)
& parameters .~ fromList (makeParamDefs ti)
& paths .~ makePathItems pds ti
& produces .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
@@ -383,9 +380,8 @@ proxyUri AppConfig{..} =
Nothing ->
("http", configServerHost, toInteger configServerPort, "/")
openApiTableInfo :: DbStructure -> Table -> (Table, [Column], [Text])
openApiTableInfo :: DbStructure -> Table -> (Table, [Column])
openApiTableInfo dbStructure table =
( table
, tableCols dbStructure (tableSchema table) (tableName table)
, tablePKCols dbStructure (tableSchema table) (tableName table)
)