diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index b57f5d398..b677f7090 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -16,7 +16,7 @@ import Control.Applicative import Data.List (elemIndex) import Data.Maybe (fromJust) import Data.Monoid -import Data.Text (split) +import Data.Text (split, strip) import qualified Hasql.Session as H import PostgREST.Types import Text.InterpolatedString.Perl6 (q) @@ -99,12 +99,21 @@ accessibleProcs :: H.Query Schema [(Text, ProcDescription)] accessibleProcs = 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 + <*> (parseArgs <$> HD.value HD.text) + <*> HD.value HD.text)) True where addName :: ProcDescription -> (Text, ProcDescription) addName pd = (pdName pd, pd) + parseArgs :: Text -> [(PgArgName, PgArgType)] + parseArgs = mapMaybe list2pair + . map (split (==' ') . strip) + . split (==',') + + list2pair :: [a] -> Maybe (a,a) + list2pair (x:y:_) = Just (x,y) + list2pair _ = Nothing + sql = [q| SELECT p.proname as "proc_name", pg_get_function_arguments(p.oid) as "args", diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs index daba8a247..50e1e330d 100644 --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -24,7 +24,8 @@ import PostgREST.ApiRequest (ContentType(..), toHeader) import PostgREST.Config (prettyVersion) import PostgREST.QueryBuilder (operators) import PostgREST.Types (Table(..), Column(..), - Proxy(..), ProcDescription(..)) + Proxy(..), ProcDescription(..), + PgArgName, PgArgType) makeMimeList :: [ContentType] -> MimeList makeMimeList cs = MimeList $ map (fromString . toS . toHeader) cs @@ -173,6 +174,20 @@ makePostParams tn = & schema .~ ParamBody (Ref (Reference tn)) ] +makeProcParams :: ProcDescription -> [Param] +makeProcParams pd = + map (makeProcParam $ pdName pd) (pdArgs pd) + +makeProcParam :: Text -> (PgArgName, PgArgType) -> Param +makeProcParam refName (n, t) = + (mempty :: Param) + & name .~ n + & required ?~ True + -- & schema .~ ParamBody ((Ref (Reference refName)) + & schema .~ ParamOther ((mempty :: ParamOtherSchema) + -- & in_ .~ ParamQuery + & type_ .~ toSwaggerType t) + makeDeleteParams :: [Param] makeDeleteParams = [ makePreferParam ["return=representation", "return=minimal", "return=none"] ] @@ -208,7 +223,7 @@ makeProcPathItem :: ProcDescription -> (FilePath, PathItem) makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe) where postOp = (mempty :: Operation) - & parameters .~ [] + & parameters .~ map Inline (makeProcParams pd) & tags .~ Set.fromList ["/rpc/" <> pdName pd] & produces ?~ makeMimeList [CTApplicationJSON] & at 200 ?~ "OK" diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index c5f30a099..7c5af1032 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -16,9 +16,12 @@ data DbStructure = DbStructure { , dbProcs :: [(Text,ProcDescription)] } deriving (Show, Eq) +type PgArgName = Text +type PgArgType = Text + data ProcDescription = ProcDescription { pdName :: Text -, pdArgs :: Text +, pdArgs :: [(PgArgName, PgArgType)] , pdReturnType :: Text } deriving (Show, Eq)