From f49c6aa0f31574994aaace674763e2932f8a6e60 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Thu, 8 Sep 2016 21:23:16 -0700 Subject: [PATCH] WIP: show procs in OpenAPI description Thanks @LogvinovLeon --- src/PostgREST/App.hs | 8 +++++--- src/PostgREST/DbStructure.hs | 14 +++++++++++--- src/PostgREST/OpenAPI.hs | 28 ++++++++++++++++++++-------- src/PostgREST/Types.hs | 8 +++++++- 4 files changed, 43 insertions(+), 15 deletions(-) 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..b57f5d398 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -95,12 +95,20 @@ 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 + <*> HD.value HD.text + <*> HD.value HD.text)) True where + addName :: ProcDescription -> (Text, ProcDescription) + addName pd = (pdName pd, pd) + 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..daba8a247 100644 --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -24,7 +24,7 @@ import PostgREST.ApiRequest (ContentType(..), toHeader) import PostgREST.Config (prettyVersion) import PostgREST.QueryBuilder (operators) import PostgREST.Types (Table(..), Column(..), - Proxy(..)) + Proxy(..), ProcDescription(..)) makeMimeList :: [ContentType] -> MimeList makeMimeList cs = MimeList $ map (fromString . toS . toHeader) cs @@ -204,6 +204,17 @@ 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 .~ [] + & 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 +225,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 +237,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) @@ -235,13 +247,13 @@ postgrestSpec ti (s, h, p, b) = (mempty :: Swagger) & description ?~ "This is a dynamic API generated by PostgREST") & host .~ h' & definitions .~ makeDefinitions ti - & paths .~ makePathItems ti + & 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..c5f30a099 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -13,7 +13,13 @@ data DbStructure = DbStructure { , dbColumns :: [Column] , dbRelations :: [Relation] , dbPrimaryKeys :: [PrimaryKey] -, dbProcs :: [(Text,Text)] +, dbProcs :: [(Text,ProcDescription)] +} deriving (Show, Eq) + +data ProcDescription = ProcDescription { + pdName :: Text +, pdArgs :: Text +, pdReturnType :: Text } deriving (Show, Eq) type Schema = Text