embed entities to the results returned by procs

src/PostgREST/App.hs

@@ -14,7 +14,7 @@ import           Data.List                 (find, delete)
 import           Data.Maybe                (fromMaybe, fromJust, mapMaybe)
 import           Data.Ranged.Ranges        (emptyRange)
 import           Data.String.Conversions   (cs)
-import           Data.Text                 (Text, replace, strip)
+import           Data.Text                 (Text, replace, strip, isInfixOf, dropWhile, drop)
 import           Data.Tree
 
 import qualified Hasql.Pool                as P
@@ -62,7 +62,7 @@ import           PostgREST.QueryBuilder ( callProc
 import           PostgREST.Types
 import           PostgREST.OpenAPI
 
-import           Prelude
+import           Prelude                hiding (dropWhile, drop)
 
 
 postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> Application
@@ -189,17 +189,17 @@ app dbStructure conf apiRequest =
         let p = V.head payload
             singular = iPreferSingular apiRequest
             jwtSecret = configJwtSecret conf
-            returnJWT = qiName qi `elem` dbProcsReturningJWT dbStructure
+            returnType = lookup (qiName qi) $ dbProcs dbStructure
+            returnsJWT = fromMaybe False $ isInfixOf "jwt_claims" <$> returnType
         case readSqlParts of
           Left e -> return $ responseLBS status400 [jsonH] $ cs e
           Right (q,cq) -> respondToRange $ do
             row <- H.query () (callProc qi p q cq topLevelRange shouldCount singular)
-            --returnJWT <- H.query qi doesProcReturnJWT
             let (tableTotal, queryTotal, body) = fromMaybe (Just 0, 0, emptyArray) row
                 (status, contentRange) = rangeHeader queryTotal tableTotal
               in
               return $ responseLBS status [jsonH, contentRange]
-                      (if returnJWT
+                      (if returnsJWT
                       then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
                       else cs $ encode body)
 
@@ -241,7 +241,7 @@ app dbStructure conf apiRequest =
   schema = cs $ configSchema conf
   shouldCount = iPreferCount apiRequest
   topLevelRange = fromMaybe allRange $ M.lookup "limit" $ iRange apiRequest
-  readDbRequest = DbRead <$> buildReadRequest (configMaxRows conf) (dbRelations dbStructure) apiRequest
+  readDbRequest = DbRead <$> buildReadRequest (configMaxRows conf) (dbRelations dbStructure) (dbProcs dbStructure) apiRequest
   mutateDbRequest = DbMutate <$> buildMutateRequest apiRequest
   selectQuery = requestToQuery schema False <$> readDbRequest
   countQuery = requestToCountQuery schema <$> readDbRequest
@@ -341,8 +341,8 @@ treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` re
     nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
     nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
 
-buildReadRequest :: Maybe Integer -> [Relation] -> ApiRequest -> Either Text ReadRequest
-buildReadRequest maxRows allRels apiRequest  =
+buildReadRequest :: Maybe Integer -> [Relation] -> [(Text, Text)] -> ApiRequest -> Either Text ReadRequest
+buildReadRequest maxRows allRels allProcs apiRequest  =
   treeRestrictRange maxRows =<<
   augumentRequestWithJoin schema relations =<<
   first formatParserError readRequest
@@ -351,7 +351,13 @@ buildReadRequest maxRows allRels apiRequest  =
       let target = iTarget apiRequest in
       case target of
         (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
-        (TargetProc  (QualifiedIdentifier s p) ) -> Just (s, p)
+        (TargetProc  (QualifiedIdentifier s p) ) -> Just (s, t)
+          where
+            returnType = fromMaybe "" $ lookup p allProcs
+            -- we are looking for results looking like "SETOF schema.tablename" and want to extract tablename
+            t = if "SETOF " `isInfixOf` returnType
+              then drop 1 $ dropWhile (/= '.') returnType
+              else p
 
         _ -> Nothing
 
@@ -372,6 +378,7 @@ buildReadRequest maxRows allRels apiRequest  =
       ActionCreate -> fakeSourceRelations ++ allRels
       ActionUpdate -> fakeSourceRelations ++ allRels
       ActionDelete -> fakeSourceRelations ++ allRels
+      ActionInvoke -> fakeSourceRelations ++ allRels
       _       -> allRels
       where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation
 

src/PostgREST/DbStructure.hs

@@ -35,7 +35,7 @@ getDbStructure schema = do
   syns <- H.query () $ allSynonyms cols
   rels <- H.query () $ allRelations tabs cols
   keys <- H.query () $ allPrimaryKeys tabs
-  retJwt <- H.query schema procsReturningJWT
+  procs <- H.query schema accessibleProcs
 
   let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
       cols' = addForeignKeys rels' cols
@@ -46,7 +46,7 @@ getDbStructure schema = do
     , dbColumns = cols'
     , dbRelations = rels'
     , dbPrimaryKeys = keys'
-    , dbProcsReturningJWT = retJwt
+    , dbProcs = procs
     }
 
 decodeTables :: HD.Result [Table]
@@ -98,16 +98,16 @@ decodeSynonyms cols =
     <*> HD.value HD.text <*> HD.value HD.text
     <*> HD.value HD.text <*> HD.value HD.text
 
-procsReturningJWT :: H.Query Schema [Text]
-procsReturningJWT =
-  H.statement sql (HE.value HE.text) (HD.rowsList (HD.value HD.text)) True
+accessibleProcs :: H.Query Schema [(Text, Text)]
+accessibleProcs =
+  H.statement sql (HE.value HE.text) (HD.rowsList ((,) <$> HD.value HD.text <*> HD.value HD.text)) True
  where
   sql = [q|
-    SELECT p.proname
+    SELECT p.proname as "proc_name", pg_get_function_result(p.oid) as "return_type"
     FROM   pg_namespace n
     JOIN   pg_proc p
     ON     pronamespace = n.oid
-    WHERE  n.nspname = $1 AND pg_get_function_result(p.oid) like '%jwt_claims'|]
+    WHERE  n.nspname = $1|]
 
 accessibleTables :: H.Query Schema [Table]
 accessibleTables =

src/PostgREST/Types.hs

@@ -13,7 +13,7 @@ data DbStructure = DbStructure {
 , dbColumns     :: [Column]
 , dbRelations   :: [Relation]
 , dbPrimaryKeys :: [PrimaryKey]
-, dbProcsReturningJWT :: [Text]
+, dbProcs       :: [(Text,Text)]
 } deriving (Show, Eq)
 
 type Schema = Text

test/Feature/QuerySpec.hs

@@ -484,7 +484,7 @@ spec = do
 
       it "can embed foreign entities to the items returned by a proc" $
         post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith`
-          [json|[{"id":1,"name":"Windows 7","client":{"id":2},"tasks":[{"id":1}]}]|]
+          [json|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
 
     context "a proc that returns an empty rowset" $
       it "returns empty json array" $