WIP: show procs in OpenAPI description

Thanks @LogvinovLeon

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

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

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 :: [ProcDescription] -> [(Table, [Column], [Text])] -> InsOrdHashMap FilePath PathItem
-makePathItems ti = fromList $ makeRootPathItem : map makePathItem ti
+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 :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Swagger
-postgrestSpec ti (s, h, p, b) = (mempty :: 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 :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> LByteString
-encodeOpenAPI ti uri = encode $ postgrestSpec ti uri
+encodeOpenAPI pds ti uri = encode $ postgrestSpec pds ti uri
 
 {-|
   Test whether a proxy uri is malformed or not.

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