From 466090c79bd6f1dca07032dc6e3ef0dd340fd571 Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Sun, 11 Sep 2016 12:33:19 -0700
Subject: [PATCH] Expose stored proc args properly as json body param

---
 src/PostgREST/OpenAPI.hs | 53 ++++++++++++++++++++--------------------
 1 file changed, 26 insertions(+), 27 deletions(-)

diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs
index 50e1e330d..3cb33fd35 100644
--- a/src/PostgREST/OpenAPI.hs
+++ b/src/PostgREST/OpenAPI.hs
@@ -37,6 +37,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
@@ -47,18 +54,18 @@ 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, (mempty :: Schema)
+    & type_ .~ SwaggerObject
+    & properties .~ (fromList $ map makeProcProperty (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 :: (PgArgName, PgArgType) -> (Text, Referenced Schema)
+makeProcProperty (n, t) = (n, Inline s)
+  where
+    s = (mempty :: Schema)
+          & type_ .~ toSwaggerType t
+          & format ?~ t
 
 makeOperatorPattern :: Text
 makeOperatorPattern =
@@ -174,19 +181,12 @@ 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) =
+makeProcParam :: Text -> Param
+makeProcParam refName =
   (mempty :: Param)
-    & name        .~ n
-    & required    ?~ True
-    -- & schema .~ ParamBody ((Ref (Reference refName))
-    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-      -- & in_ .~ ParamQuery
-      & type_ .~ toSwaggerType t)
+    & name     .~ "args"
+    & required ?~ True
+    & schema   .~ ParamBody (Ref (Reference refName))
 
 makeDeleteParams :: [Param]
 makeDeleteParams =
@@ -223,13 +223,12 @@ makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
 makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
   where
     postOp = (mempty :: Operation)
-      & parameters .~ map Inline (makeProcParams pd)
-      & tags .~ Set.fromList ["/rpc/" <> pdName pd]
+      & 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
@@ -261,7 +260,7 @@ postgrestSpec pds ti (s, h, p, b) = (mempty :: Swagger)
       & title .~ "PostgREST API"
       & description ?~ "This is a dynamic API generated by PostgREST")
   & host .~ h'
-  & definitions .~ makeDefinitions ti
+  & definitions .~ (fromList $ map makeTableDef ti <> map makeProcDef pds)
   & paths .~ makePathItems pds ti
     where
       s' = if s == "http" then Http else Https