Update OpenAPI (SQL COMMENT to description, constraints, cleaning up) (#885)
This commit is contained in:
Lucas Desgouilles
committed by
Joe Nelson
Joe Nelson
parent
7fcdbf9153
commit
6d5f72bf5f
+147
-150
@@ -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.
|
||||
|
||||
Reference in New Issue
Block a user