diff --git a/CHANGELOG.md b/CHANGELOG.md index 1d9519712..a4aeed42e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ This project adheres to [Semantic Versioning](http://semver.org/). - Filtering, shaping and embedding with &select for the /rpc path - @ruslantalpa - Output names of used-defined types (instead of 'USER-DEFINED') - @martingms - Implement support for singular representation responses for POST/PATCH requests - @ehamberg +- Include RPC endpoints in OpenAPI output - @begriffs, @LogvinovLeon ### Fixed - Do not apply limit to parent items - @ruslantalpa diff --git a/postgrest.cabal b/postgrest.cabal index 697762dbe..6b2774b9c 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -151,6 +151,7 @@ Test-Suite spec , SpecHelper , TestTypes Build-Depends: aeson + , aeson-qq , async , base , protolude diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index cca8392a5..30ae755f7 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -213,7 +213,8 @@ app dbStructure conf apiRequest = singular = iPreferSingular apiRequest jwtSecret = configJwtSecret conf returnType = lookup (qiName qi) $ dbProcs dbStructure - returnsJWT = fromMaybe False $ isInfixOf "jwt_claims" <$> returnType + returnsJWT = fromMaybe False $ + isInfixOf "jwt_claims" . pdReturnType <$> returnType serves [CTApplicationJSON] (iAccepts apiRequest) $ \_ -> case readSqlParts of Left e -> return $ responseLBS status400 [jsonH] $ toS e Right (q,cq) -> respondToRange $ do @@ -233,7 +234,7 @@ 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 ti uri' + encodeApi ti = encodeOpenAPI (map snd $ dbProcs dbStructure) ti uri' serves [CTOpenAPI] (iAccepts apiRequest) $ \_ -> do body <- encodeApi . toTableInfo <$> H.query schema accessibleTables return $ responseLBS status200 [openapiH] $ toS body @@ -269,7 +270,8 @@ app dbStructure conf apiRequest = schema = toS $ configSchema conf shouldCount = iPreferCount apiRequest topLevelRange = fromMaybe allRange $ M.lookup "limit" $ iRange apiRequest - readDbRequest = DbRead <$> buildReadRequest (configMaxRows conf) (dbRelations dbStructure) (dbProcs dbStructure) apiRequest + mapSnd f (a, b) = (a, f b) + readDbRequest = DbRead <$> buildReadRequest (configMaxRows conf) (dbRelations dbStructure) (map (mapSnd pdReturnType) $ dbProcs dbStructure) apiRequest mutateDbRequest = DbMutate <$> buildMutateRequest apiRequest selectQuery = requestToQuery schema False <$> readDbRequest countQuery = requestToCountQuery schema <$> readDbRequest diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index 419de824f..72ae007b5 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -16,7 +16,9 @@ import Control.Applicative import Data.List (elemIndex) import Data.Maybe (fromJust) import Data.Monoid -import Data.Text (split) +import Data.Text (split, strip, + breakOn, dropAround) +import qualified Data.Text as T import qualified Hasql.Session as H import PostgREST.Types import Text.InterpolatedString.Perl6 (q) @@ -95,12 +97,32 @@ decodeSynonyms cols = <*> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text -accessibleProcs :: H.Query Schema [(Text, Text)] +accessibleProcs :: H.Query Schema [(Text, ProcDescription)] accessibleProcs = - H.statement sql (HE.value HE.text) (HD.rowsList ((,) <$> HD.value HD.text <*> HD.value HD.text)) True + H.statement sql (HE.value HE.text) + (map addName <$> HD.rowsList (ProcDescription <$> HD.value HD.text + <*> (parseArgs <$> HD.value HD.text) + <*> HD.value HD.text)) True where + addName :: ProcDescription -> (Text, ProcDescription) + addName pd = (pdName pd, pd) + + parseArgs :: Text -> [PgArg] + parseArgs = mapMaybe (parseArg . strip) . split (==',') + + parseArg :: Text -> Maybe PgArg + parseArg a = + let (body, def) = breakOn " DEFAULT " a + (name, typ) = breakOn " " body in + if T.null typ + then Nothing + else Just $ + PgArg (dropAround (== '"') name) (strip typ) (T.null def) + sql = [q| - SELECT p.proname as "proc_name", pg_get_function_result(p.oid) as "return_type" + SELECT p.proname as "proc_name", + pg_get_function_arguments(p.oid) as "args", + pg_get_function_result(p.oid) as "return_type" FROM pg_namespace n JOIN pg_proc p ON pronamespace = n.oid diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs index af2167f5e..bf43f3689 100644 --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -23,8 +23,8 @@ import Data.Swagger import PostgREST.ApiRequest (ContentType(..), toHeader) import PostgREST.Config (prettyVersion) import PostgREST.QueryBuilder (operators) -import PostgREST.Types (Table(..), Column(..), - Proxy(..)) +import PostgREST.Types (Table(..), Column(..), PgArg(..), + Proxy(..), ProcDescription(..)) makeMimeList :: [ContentType] -> MimeList makeMimeList cs = MimeList $ map (fromString . toS . toHeader) cs @@ -36,6 +36,13 @@ toSwaggerType "boolean" = SwaggerBoolean toSwaggerType "numeric" = SwaggerNumber toSwaggerType _ = SwaggerString +makeTableDef :: (Table, [Column], [Text]) -> (Text, Schema) +makeTableDef (t, cs, _) = + let tn = tableName t in + (tn, (mempty :: Schema) + & type_ .~ SwaggerObject + & properties .~ fromList (map makeProperty cs)) + makeProperty :: Column -> (Text, Referenced Schema) makeProperty c = (colName c, Inline u) where @@ -46,18 +53,20 @@ makeProperty c = (colName c, Inline u) t = s & type_ .~ toSwaggerType (colType c) u = t & format ?~ colType c -makeProperties :: [Column] -> InsOrdHashMap Text (Referenced Schema) -makeProperties cs = fromList $ map makeProperty cs +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)) -makeDefinition :: (Table, [Column], [Text]) -> (Text, Schema) -makeDefinition (t, cs, _) = - let tn = tableName t in - (tn, (mempty :: Schema) - & type_ .~ SwaggerObject - & properties .~ makeProperties cs) - -makeDefinitions :: [(Table, [Column], [Text])] -> InsOrdHashMap Text Schema -makeDefinitions ti = fromList $ map makeDefinition ti +makeProcProperty :: PgArg -> (Text, Referenced Schema) +makeProcProperty (PgArg n t _) = (n, Inline s) + where + s = (mempty :: Schema) + & type_ .~ toSwaggerType t + & format ?~ t makeOperatorPattern :: Text makeOperatorPattern = @@ -173,6 +182,13 @@ makePostParams tn = & schema .~ ParamBody (Ref (Reference tn)) ] +makeProcParam :: Text -> Param +makeProcParam refName = + (mempty :: Param) + & name .~ "args" + & required ?~ True + & schema .~ ParamBody (Ref (Reference refName)) + makeDeleteParams :: [Param] makeDeleteParams = [ makePreferParam ["return=representation", "return=minimal", "return=none"] ] @@ -204,6 +220,16 @@ makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t) rs = makeRowFilters cs tn = tableName t +makeProcPathItem :: ProcDescription -> (FilePath, PathItem) +makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe) + where + postOp = (mempty :: Operation) + & parameters .~ [Inline (makeProcParam $ "(rpc) " <> pdName pd)] + & tags .~ Set.fromList ["(rpc) " <> pdName pd] + & produces ?~ makeMimeList [CTApplicationJSON] + & at 200 ?~ "OK" + pe = (mempty :: PathItem) & post ?~ postOp + makeRootPathItem :: (FilePath, PathItem) makeRootPathItem = ("/", p) where @@ -214,8 +240,9 @@ makeRootPathItem = ("/", p) pr = (mempty :: PathItem) & get ?~ getOp p = pr -makePathItems :: [(Table, [Column], [Text])] -> InsOrdHashMap FilePath PathItem -makePathItems ti = fromList $ makeRootPathItem : map makePathItem ti +makePathItems :: [ProcDescription] -> [(Table, [Column], [Text])] -> InsOrdHashMap FilePath PathItem +makePathItems pds ti = fromList $ makeRootPathItem : + map makePathItem ti ++ map makeProcPathItem pds escapeHostName :: Text -> Text escapeHostName "*" = "0.0.0.0" @@ -225,8 +252,8 @@ escapeHostName "*6" = "0.0.0.0" escapeHostName "!6" = "0.0.0.0" escapeHostName h = h -postgrestSpec:: [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Swagger -postgrestSpec ti (s, h, p, b) = (mempty :: Swagger) +postgrestSpec :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Swagger +postgrestSpec pds ti (s, h, p, b) = (mempty :: Swagger) & basePath ?~ unpack b & schemes ?~ [s'] & info .~ ((mempty :: Info) @@ -234,14 +261,14 @@ postgrestSpec ti (s, h, p, b) = (mempty :: Swagger) & title .~ "PostgREST API" & description ?~ "This is a dynamic API generated by PostgREST") & host .~ h' - & definitions .~ makeDefinitions ti - & paths .~ makePathItems ti + & definitions .~ fromList (map makeTableDef ti <> map makeProcDef pds) + & paths .~ makePathItems pds ti where s' = if s == "http" then Http else Https h' = Just $ Host (unpack $ escapeHostName h) (Just (fromInteger p)) -encodeOpenAPI :: [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> LByteString -encodeOpenAPI ti uri = encode $ postgrestSpec ti uri +encodeOpenAPI :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> LByteString +encodeOpenAPI pds ti uri = encode $ postgrestSpec pds ti uri {-| Test whether a proxy uri is malformed or not. diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index 3788696a4..9aee6d9e5 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -13,7 +13,19 @@ data DbStructure = DbStructure { , dbColumns :: [Column] , dbRelations :: [Relation] , dbPrimaryKeys :: [PrimaryKey] -, dbProcs :: [(Text,Text)] +, dbProcs :: [(Text,ProcDescription)] +} deriving (Show, Eq) + +data PgArg = PgArg { + pgaName :: Text +, pgaType :: Text +, pgaReq :: Bool +} deriving (Show, Eq) + +data ProcDescription = ProcDescription { + pdName :: Text +, pdArgs :: [PgArg] +, pdReturnType :: Text } deriving (Show, Eq) type Schema = Text diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index 1fc60a0df..9c0f2acb3 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -4,10 +4,14 @@ import Test.Hspec hiding (pendingWith) import Test.Hspec.Wai import Network.HTTP.Types +import Control.Lens ((^?)) +import Data.Aeson.Lens +import Data.Aeson.QQ + import SpecHelper import Network.Wai (Application) -import Network.Wai.Test (SResponse(simpleHeaders)) +import Network.Wai.Test (SResponse(..)) spec :: SpecWith Application spec = do @@ -21,6 +25,63 @@ spec = do (acceptHdrs "application/openapi+json") "" `shouldRespondWith` 415 + describe "RPC" $ + + it "includes a representative function with parameters" $ do + r <- simpleBody <$> get "/" + let ref = r ^? key "paths" . key "/rpc/varied_arguments" + . key "post" . key "parameters" + . nth 0 . key "schema" + . key "$ref" . _String + args = r ^? key "definitions" . key "(rpc) varied_arguments" + + liftIO $ do + ref `shouldBe` Just "#/definitions/(rpc) varied_arguments" + args `shouldBe` Just + [aesonQQ| + { + "required": [ + "double", + "varchar", + "boolean", + "date", + "money", + "enum" + ], + "properties": { + "double": { + "format": "double precision", + "type": "string" + }, + "varchar": { + "format": "character varying", + "type": "string" + }, + "boolean": { + "format": "boolean", + "type": "boolean" + }, + "date": { + "format": "date", + "type": "string" + }, + "money": { + "format": "money", + "type": "string" + }, + "enum": { + "format": "test.enum_menagerie_type", + "type": "string" + }, + "integer": { + "format": "integer", + "type": "integer" + } + }, + "type": "object" + } + |] + describe "Allow header" $ do it "includes read/write verbs for writeable table" $ do diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index 7f81a58ac..2c162b41d 100755 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -215,6 +215,21 @@ SELECT rolname::text, id::text FROM postgrest.auth WHERE id = id AND pass = pass $$; +CREATE FUNCTION varied_arguments( + double double precision, + "varchar" character varying, + "boolean" boolean, + date date, + money money, + enum enum_menagerie_type, + "integer" integer default 42 +) RETURNS text + LANGUAGE sql +AS $_$ + SELECT 'Hi'::text; +$_$; + + -- -- Name: jwt_test(); Type: FUNCTION; Schema: test; Owner: - --