Update OpenAPI (SQL COMMENT to description, constraints, cleaning up) (#885)

CHANGELOG.md

@@ -9,11 +9,13 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 - #889, Allow more than two conditions in a single and/or - @steve-chavez
 - #883, Binary output support for RPC - @steve-chavez
+- #885, Postgres COMMENTs on SCHEMA/TABLE/COLUMN are used for OpenAPI - @ldesgoui
 
 ### Fixed
 
 - #877, Base64 secret read from a file ending with a newline - @eric-brechemier
 - #896, Boolean env var interpolation in config file - @begriffs
+- #885, OpenAPI repetition reduced by using more definitions- @ldesgoui
 
 ## [0.4.2.0] - 2017-06-11
 

src/PostgREST/App.hs

@@ -267,8 +267,8 @@ app dbStructure conf apiRequest =
               uri Nothing = ("http", host, port, "/")
               uri (Just Proxy { proxyScheme = s, proxyHost = h, proxyPort = p, proxyPath = b }) = (s, h, p, b)
               uri' = uri proxy
-              encodeApi ti = encodeOpenAPI (M.elems allProcs) ti uri'
-          body <- encodeApi . toTableInfo <$> H.query schema accessibleTables
+              encodeApi ti sd = encodeOpenAPI (M.elems allProcs) (toTableInfo ti) uri' sd (dbPrimaryKeys dbStructure)
+          body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription
           return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
 
         _ -> return notFound

src/PostgREST/DbRequestBuilder.hs

@@ -149,7 +149,7 @@ addRelations schema allRelations parentNode (Node readNode@(query, (name, _, ali
     _ -> n' <$> updateForest (Just (n' forest))
       where
         n' = Node (query, (name, Just r, alias))
-        t = Table schema name True -- !!! TODO find another way to get the table from the query
+        t = Table schema name Nothing True -- !!! TODO find another way to get the table from the query
         r = Relation t [] t [] Root Nothing Nothing Nothing
   where
     updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]

src/PostgREST/DbStructure.hs

@@ -6,6 +6,7 @@
 module PostgREST.DbStructure (
   getDbStructure
 , accessibleTables
+, schemaDescription
 ) where
 
 import qualified Hasql.Decoders                as HD
@@ -52,7 +53,9 @@ decodeTables :: HD.Result [Table]
 decodeTables =
   HD.rowsList tblRow
  where
-  tblRow = Table <$> HD.value HD.text <*> HD.value HD.text
+  tblRow = Table <$> HD.value HD.text
+                 <*> HD.value HD.text
+                 <*> HD.nullableValue HD.text
                  <*> HD.value HD.bool
 
 decodeColumns :: [Table] -> HD.Result [Column]
@@ -60,11 +63,11 @@ decodeColumns tables =
   mapMaybe (columnFromRow tables) <$> HD.rowsList colRow
  where
   colRow =
-    (,,,,,,,,,,)
+    (,,,,,,,,,,,)
       <$> HD.value HD.text <*> HD.value HD.text
-      <*> HD.value HD.text <*> HD.value HD.int4
-      <*> HD.value HD.bool <*> HD.value HD.text
-      <*> HD.value HD.bool
+      <*> HD.value HD.text <*> HD.nullableValue HD.text
+      <*> HD.value HD.int4 <*> HD.value HD.bool
+      <*> HD.value HD.text <*> HD.value HD.bool
       <*> HD.nullableValue HD.int4
       <*> HD.nullableValue HD.int4
       <*> HD.nullableValue HD.text
@@ -103,6 +106,7 @@ accessibleProcs =
     (M.fromList . map addName <$>
       HD.rowsList (
         ProcDescription <$> HD.value HD.text
+                        <*> HD.nullableValue HD.text
                         <*> (parseArgs <$> HD.value HD.text)
                         <*> (parseRetType <$>
                             HD.value HD.text <*>
@@ -150,6 +154,7 @@ accessibleProcs =
 
   sql = [q|
   SELECT p.proname as "proc_name",
+         d.description as "proc_description",
          pg_get_function_arguments(p.oid) as "args",
          tn.nspname as "rettype_schema",
          coalesce(comp.relname, t.typname) as "rettype_name",
@@ -161,8 +166,22 @@ accessibleProcs =
     JOIN pg_type t ON t.oid = p.prorettype
     JOIN pg_namespace tn ON tn.oid = t.typnamespace
     LEFT JOIN pg_class comp ON comp.oid = t.typrelid
+    LEFT JOIN pg_catalog.pg_description as d on d.objoid = p.oid
   WHERE  pn.nspname = $1|]
 
+schemaDescription :: H.Query Schema (Maybe Text)
+schemaDescription =
+    H.statement sql (HE.value HE.text) (HD.singleRow $ HD.nullableValue HD.text) True
+  where
+    sql = [q|
+      select
+        description
+      from
+        pg_catalog.pg_namespace n
+        left join pg_catalog.pg_description d on d.objoid = n.oid
+      where
+        n.nspname = $1 |]
+
 accessibleTables :: H.Query Schema [Table]
 accessibleTables =
   H.statement sql (HE.value HE.text) decodeTables True
@@ -171,6 +190,7 @@ accessibleTables =
     select
       n.nspname as table_schema,
       relname as table_name,
+      d.description as table_description,
       c.relkind = 'r' or (c.relkind IN ('v', 'f')) and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8
       or (exists (
          select 1
@@ -180,6 +200,7 @@ accessibleTables =
     from
       pg_class c
       join pg_namespace n on n.oid = c.relnamespace
+      left join pg_catalog.pg_description as d on d.objoid = c.oid and d.objsubid = 0
     where
       c.relkind in ('v', 'r', 'm')
       and n.nspname = $1
@@ -271,6 +292,7 @@ allTables =
     SELECT
       n.nspname AS table_schema,
       c.relname AS table_name,
+      NULL AS table_description,
       c.relkind = 'r' OR (c.relkind IN ('v','f'))
       AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
       OR (EXISTS
@@ -294,6 +316,7 @@ allColumns tabs =
         info.table_schema AS schema,
         info.table_name AS table_name,
         info.column_name AS name,
+        info.description AS description,
         info.ordinal_position AS position,
         info.is_nullable::boolean AS nullable,
         info.data_type AS col_type,
@@ -311,6 +334,7 @@ allColumns tabs =
                 nc.nspname::information_schema.sql_identifier AS table_schema,
                 c.relname::information_schema.sql_identifier AS table_name,
                 a.attname::information_schema.sql_identifier AS column_name,
+                d.description::information_schema.sql_identifier AS description,
                 a.attnum::information_schema.cardinal_number AS ordinal_position,
                 pg_get_expr(ad.adbin, ad.adrelid)::information_schema.character_data AS column_default,
                     CASE
@@ -383,6 +407,7 @@ allColumns tabs =
                     ELSE 'NO'::text
                 END::information_schema.yes_or_no AS is_updatable
             FROM pg_attribute a
+               LEFT JOIN pg_catalog.pg_description AS d ON d.objoid = a.attrelid and d.objsubid = a.attnum
                LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum
                JOIN (pg_class c
                JOIN pg_namespace nc ON c.relnamespace = nc.oid) ON a.attrelid = c.oid
@@ -399,6 +424,7 @@ allColumns tabs =
             table_schema,
             table_name,
             column_name,
+            description,
             ordinal_position,
             is_nullable,
             data_type,
@@ -424,14 +450,14 @@ allColumns tabs =
     ORDER BY schema, position |]
 
 columnFromRow :: [Table] ->
-                 (Text,       Text,        Text,
-                  Int32,      Bool,        Text,
-                  Bool,       Maybe Int32, Maybe Int32,
-                  Maybe Text, Maybe Text)
+                 (Text,        Text,        Text,
+                  Maybe Text,  Int32,       Bool,
+                  Text,        Bool,        Maybe Int32,
+                  Maybe Int32, Maybe Text,  Maybe Text)
                  -> Maybe Column
-columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table
+columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table
   where
-    buildColumn tbl = Column tbl n pos nul typ u l p d (parseEnum e) Nothing
+    buildColumn tbl = Column tbl n desc pos nul typ u l p d (parseEnum e) Nothing
     table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
     parseEnum :: Maybe Text -> [Text]
     parseEnum str = fromMaybe [] $ split (==',') <$> str

src/PostgREST/OpenAPI.hs

@@ -8,23 +8,22 @@ module PostgREST.OpenAPI (
 
 import           Control.Lens
 import           Data.Aeson                  (decode, encode)
-import qualified Data.HashMap.Strict         as M
 import           Data.HashMap.Strict.InsOrd  (InsOrdHashMap, fromList)
 import           Data.Maybe                  (fromJust)
 import qualified Data.Set                    as Set
 import           Data.String                 (IsString (..))
-import           Data.Text                   (unpack, pack, concat, intercalate, init, tail, toLower)
+import           Data.Text                   (unpack, pack, init, tail, toLower, intercalate, append)
 import           Network.URI                 (parseURI, isAbsoluteURI,
                                               URI (..), URIAuth (..))
 
-import           Protolude hiding              (concat, (&), Proxy, get, intercalate)
+import           Protolude hiding              ((&), Proxy, get, intercalate)
 
 import           Data.Swagger
 
 import           PostgREST.ApiRequest        (ContentType(..))
 import           PostgREST.Config            (prettyVersion)
-import           PostgREST.Types             (Table(..), Column(..), PgArg(..),
-                                              Proxy(..), ProcDescription(..), toMime, operators)
+import           PostgREST.Types             (Table(..), Column(..), PgArg(..), ForeignKey(..),
+                                              PrimaryKey(..), Proxy(..), ProcDescription(..), toMime)
 
 makeMimeList :: [ContentType] -> MimeList
 makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
@@ -36,30 +35,48 @@ toSwaggerType "boolean"   = SwaggerBoolean
 toSwaggerType "numeric"   = SwaggerNumber
 toSwaggerType _           = SwaggerString
 
-makeTableDef :: (Table, [Column], [Text]) -> (Text, Schema)
-makeTableDef (t, cs, _) =
+makeTableDef :: [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
+makeTableDef pks (t, cs, _) =
   let tn = tableName t in
       (tn, (mempty :: Schema)
+        & description .~ tableDescription t
         & type_ .~ SwaggerObject
-        & properties .~ fromList (map makeProperty cs))
+        & properties .~ fromList (map (makeProperty pks) cs))
 
-makeProperty :: Column -> (Text, Referenced Schema)
-makeProperty c = (colName c, Inline u)
+makeProperty :: [PrimaryKey] -> Column -> (Text, Referenced Schema)
+makeProperty pks c = (colName c, Inline s)
   where
-    r = mempty :: Schema
-    s = if null $ colEnum c
-           then r
-           else r & enum_ .~ decode (encode (colEnum c))
-    t = s & type_ .~ toSwaggerType (colType c)
-    u = t & format ?~ colType c
+    e = if null $ colEnum c then Nothing else decode $ encode $ colEnum c
+    fk ForeignKey{fkCol=Column{colTable=Table{tableName=a}, colName=b}} =
+      intercalate "" ["This is a Foreign Key to `", a, ".", b, "`.<fk table='", a, "' column='", b, "'/>"]
+    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.<pk/>" else Nothing
+      , fk <$> colFK c
+      ]
+    d =
+      if length n > 1 then
+        Just $ append (fromMaybe "" ((`append` "\n\n") <$> colDescription c)) (intercalate "\n" n)
+      else
+        colDescription c
+    s =
+      (mempty :: Schema)
+        & default_ .~ (decode . toS =<< colDefault c)
+        & description .~ d
+        & enum_ .~ e
+        & format ?~ colType c
+        & maxLength .~ (fromIntegral <$> colMaxLen c)
+        & type_ .~ toSwaggerType (colType c)
 
-makeProcDef :: ProcDescription -> (Text, Schema)
-makeProcDef pd = ("(rpc) " <> pdName pd, s)
-  where
-    s = (mempty :: Schema)
-          & type_ .~ SwaggerObject
-          & properties .~ fromList (map makeProcProperty (pdArgs pd))
-          & required .~ map pgaName (filter pgaReq (pdArgs pd))
+makeProcSchema :: ProcDescription -> Schema
+makeProcSchema pd =
+  (mempty :: Schema)
+  & description .~ pdDescription pd
+  & type_ .~ SwaggerObject
+  & properties .~ fromList (map makeProcProperty (pdArgs pd))
+  & required .~ map pgaName (filter pgaReq (pdArgs pd))
 
 makeProcProperty :: PgArg -> (Text, Referenced Schema)
 makeProcProperty (PgArg n t _) = (n, Inline s)
@@ -68,68 +85,6 @@ makeProcProperty (PgArg n t _) = (n, Inline s)
           & type_ .~ toSwaggerType t
           & format ?~ t
 
-makeOperatorPattern :: Text
-makeOperatorPattern =
-  intercalate "|"
-  [ concat ["^", x, y, "[.]"] |
-    x <- ["not[.]", ""],
-    y <- M.keys operators ]
-
-makeRowFilter :: Column -> Param
-makeRowFilter c =
-  (mempty :: Param)
-  & name .~ colName c
-  & required ?~ False
-  & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-    & in_ .~ ParamQuery
-    & type_ .~ SwaggerString
-    & format ?~ colType c
-    & pattern ?~ makeOperatorPattern)
-
-makeRowFilters :: [Column] -> [Param]
-makeRowFilters = map makeRowFilter
-
-makeOrderItems :: [Column] -> [Text]
-makeOrderItems cs =
-  [ concat [x, y, z] |
-    x <- map colName cs,
-    y <- [".asc", ".desc", ""],
-    z <- [".nullsfirst", ".nulllast", ""]
-  ]
-
-makeRangeParams :: [Param]
-makeRangeParams =
-  [ (mempty :: Param)
-    & name        .~ "Range"
-    & description ?~ "Limiting and Pagination"
-    & required    ?~ False
-    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-      & in_ .~ ParamHeader
-      & type_ .~ SwaggerString)
-  , (mempty :: Param)
-    & name        .~ "Range-Unit"
-    & description ?~ "Limiting and Pagination"
-    & required    ?~ False
-    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-      & in_ .~ ParamHeader
-      & type_ .~ SwaggerString
-      & default_ .~ decode "\"items\"")
-  , (mempty :: Param)
-    & name        .~ "offset"
-    & description ?~ "Limiting and Pagination"
-    & required    ?~ False
-    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-      & in_ .~ ParamQuery
-      & type_ .~ SwaggerString)
-  , (mempty :: Param)
-    & name        .~ "limit"
-    & description ?~ "Limiting and Pagination"
-    & required    ?~ False
-    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-      & in_ .~ ParamQuery
-      & type_ .~ SwaggerString)
-  ]
-
 makePreferParam :: [Text] -> Param
 makePreferParam ts =
   (mempty :: Param)
@@ -141,92 +96,126 @@ makePreferParam ts =
     & type_ .~ SwaggerString
     & enum_ .~ decode (encode ts))
 
-makeSelectParam :: Param
-makeSelectParam =
-  (mempty :: Param)
-    & name        .~ "select"
-    & description ?~ "Filtering Columns"
-    & required    ?~ False
-    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-      & in_ .~ ParamQuery
-      & type_ .~ SwaggerString)
-
-makeGetParams :: [Column] -> [Param]
-makeGetParams [] =
-  makeRangeParams ++
-  [ makeSelectParam
-  , makePreferParam ["count=none"]
+makeProcParam :: ProcDescription -> [Referenced Param]
+makeProcParam pd =
+  [ Inline $ (mempty :: Param)
+    & name     .~ "args"
+    & required ?~ True
+    & schema   .~ (ParamBody $ Inline $ makeProcSchema pd)
+  , Ref $ Reference "preferParams"
   ]
-makeGetParams cs =
-  makeRangeParams ++
-  [ makeSelectParam
-  , (mempty :: Param)
-    & name        .~ "order"
-    & description ?~ "Ordering"
-    & required    ?~ False
+
+makeParamDefs :: [(Table, [Column], [Text])] -> [(Text, Param)]
+makeParamDefs ti =
+  [ ("preferParams", makePreferParam ["params=single-object"])
+  , ("preferReturn", makePreferParam ["return=representation", "return=minimal", "return=none"])
+  , ("preferCount", makePreferParam ["count=none"])
+  , ("select", (mempty :: Param)
+      & name        .~ "select"
+      & description ?~ "Filtering Columns"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamQuery
+        & type_ .~ SwaggerString))
+  , ("order", (mempty :: Param)
+      & name        .~ "order"
+      & description ?~ "Ordering"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamQuery
+        & type_ .~ SwaggerString))
+  , ("range", (mempty :: Param)
+      & name        .~ "Range"
+      & description ?~ "Limiting and Pagination"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamHeader
+        & type_ .~ SwaggerString))
+  , ("rangeUnit", (mempty :: Param)
+      & name        .~ "Range-Unit"
+      & description ?~ "Limiting and Pagination"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamHeader
+        & type_ .~ SwaggerString
+        & default_ .~ decode "\"items\""))
+  , ("offset", (mempty :: Param)
+      & name        .~ "offset"
+      & description ?~ "Limiting and Pagination"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamQuery
+        & type_ .~ SwaggerString))
+  , ("limit", (mempty :: Param)
+      & name        .~ "limit"
+      & description ?~ "Limiting and Pagination"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamQuery
+        & type_ .~ SwaggerString))
+  ]
+  <> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) cs
+            | (t, cs, _) <- ti
+            ]
+
+makeObjectBody :: Text -> (Text, Param)
+makeObjectBody tn =
+  ("body." <> tn, (mempty :: Param)
+     & name .~ tn
+     & description ?~ tn
+     & required ?~ False
+     & schema .~ ParamBody (Ref (Reference tn)))
+
+makeRowFilter :: Text -> Column -> (Text, Param)
+makeRowFilter tn c =
+  (intercalate "." ["rowFilter", tn, colName c], (mempty :: Param)
+    & name .~ colName c
+    & description .~ colDescription c
+    & required ?~ False
     & schema .~ ParamOther ((mempty :: ParamOtherSchema)
       & in_ .~ ParamQuery
       & type_ .~ SwaggerString
-      & enum_ .~ decode (encode $ makeOrderItems cs))
-  , makePreferParam ["count=none"]
-  ]
+      & format ?~ colType c))
 
-makePostParams :: Text -> [Param]
-makePostParams tn =
-  [ makePreferParam ["return=representation",
-                     "return=minimal", "return=none"]
-  , (mempty :: Param)
-    & name        .~ "body"
-    & description ?~ tn
-    & required    ?~ False
-    & schema .~ ParamBody (Ref (Reference tn))
-  ]
-
-makeProcParam :: Text -> [Param]
-makeProcParam refName =
-  [ makePreferParam ["params=single-object"]
-  , (mempty :: Param)
-    & name     .~ "args"
-    & required ?~ True
-    & schema   .~ ParamBody (Ref (Reference refName))
-  ]
-
-makeDeleteParams :: [Param]
-makeDeleteParams =
-  [ makePreferParam ["return=representation", "return=minimal", "return=none"] ]
+makeRowFilters :: Text -> [Column] -> [(Text, Param)]
+makeRowFilters tn = map (makeRowFilter tn)
 
 makePathItem :: (Table, [Column], [Text]) -> (FilePath, PathItem)
 makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t)
   where
     tOp = (mempty :: Operation)
       & tags .~ Set.fromList [tn]
-      & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-      & at 200 ?~ "OK"
+      & description .~ tableDescription t
     getOp = tOp
-      & parameters .~ map Inline (makeGetParams cs ++ rs)
+      & parameters .~ map ref (rs <> ["select", "order", "range", "rangeUnit", "offset", "limit", "preferCount"])
       & at 206 ?~ "Partial Content"
+      & at 200 ?~ Inline ((mempty :: Response)
+        & description .~ "OK"
+        & schema ?~ (Ref $ Reference $ tableName t)
+        )
     postOp = tOp
-      & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-      & parameters .~ map Inline (makePostParams tn)
+      & parameters .~ map ref ["body." <> tn, "preferReturn"]
       & at 201 ?~ "Created"
     patchOp = tOp
-      & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-      & parameters .~ map Inline (makePostParams tn ++ rs)
+      & parameters .~ map ref (rs <> ["body." <> tn, "preferReturn"])
       & at 204 ?~ "No Content"
     deletOp = tOp
-      & parameters .~ map Inline (makeDeleteParams ++ rs)
+      & parameters .~ map ref (rs <> ["preferReturn"])
+      & at 204 ?~ "No Content"
     pr = (mempty :: PathItem) & get ?~ getOp
     pw = pr & post ?~ postOp & patch ?~ patchOp & delete ?~ deletOp
     p False = pr
     p True  = pw
-    rs = makeRowFilters cs
     tn = tableName t
+    rs = [ intercalate "." ["rowFilter", tn, colName c ] | c <- cs ]
+    ref = Ref . Reference
 
 makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
 makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
   where
     postOp = (mempty :: Operation)
-      & parameters .~ map Inline (makeProcParam $ "(rpc) " <> pdName pd)
+      & description .~ pdDescription pd
+      & parameters .~ makeProcParam pd
       & tags .~ Set.fromList ["(rpc) " <> pdName pd]
       & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON]
       & at 200 ?~ "OK"
@@ -236,7 +225,8 @@ makeRootPathItem :: (FilePath, PathItem)
 makeRootPathItem = ("/", p)
   where
     getOp = (mempty :: Operation)
-      & tags .~ Set.fromList ["/"]
+      & tags .~ Set.fromList ["Introspection"]
+      & summary ?~ "OpenAPI description (this document)"
       & produces ?~ makeMimeList [CTOpenAPI, CTApplicationJSON]
       & at 200 ?~ "OK"
     pr = (mempty :: PathItem) & get ?~ getOp
@@ -254,23 +244,30 @@ escapeHostName "*6" = "0.0.0.0"
 escapeHostName "!6" = "0.0.0.0"
 escapeHostName h    = h
 
-postgrestSpec :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Swagger
-postgrestSpec pds ti (s, h, p, b) = (mempty :: Swagger)
+postgrestSpec :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> Swagger
+postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
   & basePath ?~ unpack b
   & schemes ?~ [s']
   & info .~ ((mempty :: Info)
       & version .~ prettyVersion
       & title .~ "PostgREST API"
-      & description ?~ "This is a dynamic API generated by PostgREST")
+      & description ?~ d)
+  & externalDocs ?~ ((mempty :: ExternalDocs)
+    & description ?~ "PostgREST Documentation"
+    & url .~ URL "https://postgrest.com/en/latest/api.html")
   & host .~ h'
-  & definitions .~ fromList (map makeTableDef ti <> map makeProcDef pds)
+  & definitions .~ fromList (map (makeTableDef pks) ti)
+  & parameters .~ fromList (makeParamDefs ti)
   & paths .~ makePathItems pds ti
+  & produces .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+  & consumes .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
     where
       s' = if s == "http" then Http else Https
       h' = Just $ Host (unpack $ escapeHostName h) (Just (fromInteger p))
+      d = fromMaybe "This is a dynamic API generated by PostgREST" sd
 
-encodeOpenAPI :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> LByteString
-encodeOpenAPI pds ti uri = encode $ postgrestSpec pds ti uri
+encodeOpenAPI :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] ->  LByteString
+encodeOpenAPI pds ti uri sd pks = encode $ postgrestSpec pds ti uri sd pks
 
 {-|
   Test whether a proxy uri is malformed or not.

src/PostgREST/Types.hs

@@ -46,10 +46,11 @@ data ProcVolatility = Volatile | Stable | Immutable
   deriving (Eq, Show)
 
 data ProcDescription = ProcDescription {
-  pdName       :: Text
-, pdArgs       :: [PgArg]
-, pdReturnType :: RetType
-, pdVolatility :: ProcVolatility
+  pdName        :: Text
+, pdDescription :: Maybe Text
+, pdArgs        :: [PgArg]
+, pdReturnType  :: RetType
+, pdVolatility  :: ProcVolatility
 } deriving (Show, Eq)
 
 type Schema = Text
@@ -59,26 +60,28 @@ type SqlFragment = Text
 type RequestBody = BL.ByteString
 
 data Table = Table {
-  tableSchema     :: Schema
-, tableName       :: TableName
-, tableInsertable :: Bool
+  tableSchema      :: Schema
+, tableName        :: TableName
+, tableDescription :: Maybe Text
+, tableInsertable  :: Bool
 } deriving (Show, Ord)
 
 newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
 
 data Column =
     Column {
-      colTable     :: Table
-    , colName      :: Text
-    , colPosition  :: Int32
-    , colNullable  :: Bool
-    , colType      :: Text
-    , colUpdatable :: Bool
-    , colMaxLen    :: Maybe Int32
-    , colPrecision :: Maybe Int32
-    , colDefault   :: Maybe Text
-    , colEnum      :: [Text]
-    , colFK        :: Maybe ForeignKey
+      colTable       :: Table
+    , colName        :: Text
+    , colDescription :: Maybe Text
+    , colPosition    :: Int32
+    , colNullable    :: Bool
+    , colType        :: Text
+    , colUpdatable   :: Bool
+    , colMaxLen      :: Maybe Int32
+    , colPrecision   :: Maybe Int32
+    , colDefault     :: Maybe Text
+    , colEnum        :: [Text]
+    , colFK          :: Maybe ForeignKey
     } deriving (Show, Ord)
 
 type Synonym = (Column,Column)
@@ -193,37 +196,6 @@ type ReadRequest = Tree ReadNode
 type MutateRequest = MutateQuery
 data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
 
-instance ToJSON Column where
-  toJSON c = object [
-      "schema"    .= tableSchema t
-    , "name"      .= colName c
-    , "position"  .= colPosition c
-    , "nullable"  .= colNullable c
-    , "type"      .= colType c
-    , "updatable" .= colUpdatable c
-    , "maxLen"    .= colMaxLen c
-    , "precision" .= colPrecision c
-    , "references".= colFK c
-    , "default"   .= colDefault c
-    , "enum"      .= colEnum c ]
-    where
-      t = colTable c
-
-instance ToJSON ForeignKey where
-  toJSON fk = object [
-      "schema" .= tableSchema t
-    , "table"  .= tableName t
-    , "column" .= colName c ]
-    where
-      c = fkCol fk
-      t = colTable c
-
-instance ToJSON Table where
-  toJSON v = object [
-      "schema"     .= tableSchema v
-    , "name"       .= tableName v
-    , "insertable" .= tableInsertable v ]
-
 instance Eq Table where
   Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
 

test/Feature/StructureSpec.hs

@@ -27,18 +27,82 @@ spec = do
               (acceptHdrs "application/openapi+json") ""
         `shouldRespondWith` 415
 
-    describe "RPC" $
+    describe "table" $
 
-      it "includes a representative function with parameters" $ do
+      it "includes paths to tables" $ do
         r <- simpleBody <$> get "/"
-        let ref = r ^? key "paths" . key "/rpc/varied_arguments"
-                     . key "post"  . key "parameters"
-                     . nth 1       . key "schema"
-                     . key "$ref"  . _String
-            args = r ^? key "definitions" . key "(rpc) varied_arguments"
+
+        let method s = key "paths" . key "/child_entities" . key s
+            getParameters = r ^? method "get" . key "parameters"
+            postResponse = r ^? method "post" . key "responses" . key "201" . key "description"
+            patchResponse = r ^? method "patch" . key "responses" . key "204" . key "description"
+            deleteResponse = r ^? method "delete" . key "responses" . key "204" . key "description"
 
         liftIO $ do
-          ref `shouldBe` Just "#/definitions/(rpc) varied_arguments"
+
+          getParameters `shouldBe` Just
+            [aesonQQ|
+              [
+                { "$ref": "#/parameters/rowFilter.child_entities.id" },
+                { "$ref": "#/parameters/rowFilter.child_entities.name" },
+                { "$ref": "#/parameters/rowFilter.child_entities.parent_id" },
+                { "$ref": "#/parameters/select" },
+                { "$ref": "#/parameters/order" },
+                { "$ref": "#/parameters/range" },
+                { "$ref": "#/parameters/rangeUnit" },
+                { "$ref": "#/parameters/offset" },
+                { "$ref": "#/parameters/limit" },
+                { "$ref": "#/parameters/preferCount" }
+              ]
+            |]
+
+          postResponse `shouldBe` Just "Created"
+
+          patchResponse `shouldBe` Just "No Content"
+
+          deleteResponse `shouldBe` Just "No Content"
+
+    it "includes definitions to tables" $ do
+        r <- simpleBody <$> get "/"
+
+        let def = r ^? key "definitions" . key "child_entities"
+
+        liftIO $
+
+          def `shouldBe` Just
+            [aesonQQ|
+              {
+                "type": "object",
+                "description": "child_entities comment",
+                "properties": {
+                  "id": {
+                    "description": "child_entities id comment\n\nNote:\nThis is a Primary Key.<pk/>",
+                    "format": "integer",
+                    "type": "integer"
+                  },
+                  "name": {
+                    "description": "child_entities name comment",
+                    "format": "text",
+                    "type": "string"
+                  },
+                  "parent_id": {
+                    "description": "Note:\nThis is a Foreign Key to `entities.id`.<fk table='entities' column='id'/>",
+                    "format": "integer",
+                    "type": "integer"
+                  }
+                }
+              }
+            |]
+
+    describe "RPC" $
+
+      it "includes body schema for arguments" $ do
+        r <- simpleBody <$> get "/"
+        let args = r ^? key "paths" . key "/rpc/varied_arguments"
+                      . key "post"  . key "parameters"
+                      . nth 0       . key "schema"
+
+        liftIO $
           args `shouldBe` Just
             [aesonQQ|
               {

test/fixtures/schema.sql

@@ -1215,6 +1215,12 @@ create table grandchild_entities (
   jsonb_col jsonb
 );
 
+-- OpenAPI description tests
+
+comment on table child_entities is 'child_entities comment';
+comment on column child_entities.id is 'child_entities id comment';
+comment on column child_entities.name is 'child_entities name comment';
+
 -- Used for testing that having the same return column name as the proc name
 -- doesn't conflict with the required output, details in #901
 create function test.test() returns table(test text, value int) as $$