diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index d684d880d..7c05402fa 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -429,25 +429,17 @@ handleInvoke invMethod proc context@RequestContext{..} = do (pdSchema proc) (fromMaybe (pdName proc) $ Proc.procTableName proc) - returnsSingle (ApiRequest.TargetProc target _) = Proc.procReturnsSingle target - returnsSingle _ = False - req <- readRequest identifier context bField <- binaryField context req + let callReq = ReqBuilder.callRequest proc ctxApiRequest req + (tableTotal, queryTotal, body, gucHeaders, gucStatus) <- lift . SQL.statement mempty $ Statements.callProcStatement - (returnsScalar iTarget) - (returnsSingle iTarget) - (QueryBuilder.requestToCallProcQuery - (QualifiedIdentifier (pdSchema proc) (pdName proc)) - (Proc.specifiedProcParams iColumns proc) - iPayload - (returnsScalar iTarget) - iPreferParameters - (ReqBuilder.returningCols req []) - ) + (Proc.procReturnsScalar proc) + (Proc.procReturnsSingle proc) + (QueryBuilder.requestToCallProcQuery callReq) (QueryBuilder.readRequestToQuery req) (QueryBuilder.readRequestToCountQuery req) (shouldCount iPreferCount) diff --git a/src/PostgREST/DbStructure/Proc.hs b/src/PostgREST/DbStructure/Proc.hs index d2cf7a073..12850161f 100644 --- a/src/PostgREST/DbStructure/Proc.hs +++ b/src/PostgREST/DbStructure/Proc.hs @@ -11,15 +11,12 @@ module PostgREST.DbStructure.Proc , procReturnsScalar , procReturnsSingle , procTableName - , specifiedProcParams ) where import qualified Data.Aeson as JSON import qualified Data.HashMap.Strict as M -import qualified Data.Set as S -import PostgREST.DbStructure.Identifiers (FieldName, - QualifiedIdentifier (..), +import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..), Schema, TableName) import Protolude @@ -70,14 +67,6 @@ instance Ord ProcDescription where -- | It uses a HashMap for a faster lookup. type ProcsMap = M.HashMap QualifiedIdentifier [ProcDescription] -{-| - Search the procedure parameters by matching them with the specified keys. - If the key doesn't match a parameter, a parameter with a default type "text" is assumed. --} -specifiedProcParams :: S.Set FieldName -> ProcDescription -> [ProcParam] -specifiedProcParams keys proc = - (\k -> fromMaybe (ProcParam k "text" True False) (find ((==) k . ppName) (pdParams proc))) <$> S.toList keys - procReturnsScalar :: ProcDescription -> Bool procReturnsScalar proc = case proc of ProcDescription{pdReturnType = (Single Scalar)} -> True diff --git a/src/PostgREST/Query/QueryBuilder.hs b/src/PostgREST/Query/QueryBuilder.hs index 5df062b16..9eb30cf60 100644 --- a/src/PostgREST/Query/QueryBuilder.hs +++ b/src/PostgREST/Query/QueryBuilder.hs @@ -21,15 +21,12 @@ import qualified Hasql.DynamicStatements.Snippet as H import Data.Tree (Tree (..)) -import PostgREST.DbStructure.Identifiers (FieldName, - QualifiedIdentifier (..)) +import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..)) import PostgREST.DbStructure.Proc (ProcParam (..)) import PostgREST.DbStructure.Relationship (Cardinality (..), Relationship (..)) import PostgREST.DbStructure.Table (Table (..)) -import PostgREST.Request.ApiRequest (PayloadJSON (..)) -import PostgREST.Request.Preferences (PreferParameters (..), - PreferResolution (..)) +import PostgREST.Request.Preferences (PreferResolution (..)) import PostgREST.Query.SqlFragment import PostgREST.Request.Types @@ -118,38 +115,34 @@ mutateRequestToQuery (Delete mainQi logicForest returnings) = (if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree mainQi) logicForest)) <> " " <> H.sql (returningF mainQi returnings) -requestToCallProcQuery :: QualifiedIdentifier -> [ProcParam] -> Maybe PayloadJSON -> Bool -> Maybe PreferParameters -> [FieldName] -> H.Snippet -requestToCallProcQuery qi procParams pj returnsScalar preferParams returnings = - prmsCTE <> sourceBody +requestToCallProcQuery :: CallRequest -> H.Snippet +requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall singleParam returnings) = + prmsCTE <> argsBody where - body = pjRaw <$> pj - paramsAsSingleObject = preferParams == Just SingleObject - paramsAsMultipleObjects = preferParams == Just MultipleObjects - - (prmsCTE, args) - | null procParams = (mempty, mempty) - | paramsAsSingleObject = ("WITH pgrst_args AS (SELECT NULL)", jsonPlaceHolder body) + (prmsCTE, argFrag) + | null params = (mempty, mempty) + | singleParam = ("WITH pgrst_args AS (SELECT NULL)", jsonPlaceHolder args) | otherwise = ( - "WITH " <> normalizedBody body <> ", " <> + "WITH " <> normalizedBody args <> ", " <> H.sql ( BS.unwords [ "pgrst_args AS (", "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtParams (const mempty) (\a -> " " <> encodeUtf8 (ppType a)) <> ")", ")"]) - , H.sql $ if paramsAsMultipleObjects + , H.sql $ if multipleCall then fmtParams varadicPrefix (\a -> " := pgrst_args." <> pgFmtIdent (ppName a)) else fmtParams varadicPrefix (\a -> " := (SELECT " <> pgFmtIdent (ppName a) <> " FROM pgrst_args LIMIT 1)") ) fmtParams :: (ProcParam -> SqlFragment) -> (ProcParam -> SqlFragment) -> SqlFragment - fmtParams prmFragPre prmFragSuf = BS.intercalate ", " ((\a -> prmFragPre a <> pgFmtIdent (ppName a) <> prmFragSuf a) <$> procParams) + fmtParams prmFragPre prmFragSuf = BS.intercalate ", " ((\a -> prmFragPre a <> pgFmtIdent (ppName a) <> prmFragSuf a) <$> params) varadicPrefix :: ProcParam -> SqlFragment varadicPrefix a = if ppVar a then "VARIADIC " else mempty - sourceBody :: H.Snippet - sourceBody - | paramsAsMultipleObjects = + argsBody :: H.Snippet + argsBody + | multipleCall = if returnsScalar then "SELECT " <> callIt <> " AS pgrst_scalar FROM pgrst_args" else "SELECT pgrst_lat_args.* FROM pgrst_args, " <> @@ -160,7 +153,7 @@ requestToCallProcQuery qi procParams pj returnsScalar preferParams returnings = else "SELECT " <> returnedColumns <> " FROM " <> callIt callIt :: H.Snippet - callIt = H.sql (fromQi qi) <> "(" <> args <> ")" + callIt = H.sql (fromQi qi) <> "(" <> argFrag <> ")" returnedColumns :: H.Snippet returnedColumns diff --git a/src/PostgREST/Request/DbRequestBuilder.hs b/src/PostgREST/Request/DbRequestBuilder.hs index abd44c325..6f43b9fcc 100644 --- a/src/PostgREST/Request/DbRequestBuilder.hs +++ b/src/PostgREST/Request/DbRequestBuilder.hs @@ -18,7 +18,7 @@ resource. module PostgREST.Request.DbRequestBuilder ( readRequest , mutateRequest - , returningCols + , callRequest ) where import qualified Data.HashMap.Strict as M @@ -33,6 +33,9 @@ import Data.Tree (Tree (..)) import PostgREST.DbStructure.Identifiers (FieldName, QualifiedIdentifier (..), Schema, TableName) +import PostgREST.DbStructure.Proc (ProcDescription (..), + ProcParam (..), + procReturnsScalar) import PostgREST.DbStructure.Relationship (Cardinality (..), Junction (..), Relationship (..)) @@ -343,6 +346,23 @@ mutateRequest schema tName apiRequest pkCols readReq = mapLeft ApiRequestError $ onlyRoot = filter (not . ( "." `isInfixOf` ) . fst) body = pjRaw <$> iPayload apiRequest +callRequest :: ProcDescription -> ApiRequest -> ReadRequest -> CallRequest +callRequest proc apiReq readReq = FunctionCall { + funCQi = QualifiedIdentifier (pdSchema proc) (pdName proc) +, funCParams = specifiedParams +, funCArgs = pjRaw <$> iPayload apiReq +, funCScalar = procReturnsScalar proc +, funCMultipleCall = iPreferParameters apiReq == Just MultipleObjects +, funCSingleParam = paramsAsSingleObject +, funCReturning = returningCols readReq [] +} + where + paramsAsSingleObject = iPreferParameters apiReq == Just SingleObject + specifiedParams = + if paramsAsSingleObject + then pdParams proc + else filter (\x -> ppName x `S.member` iColumns apiReq) $ pdParams proc + returningCols :: ReadRequest -> [FieldName] -> [FieldName] returningCols rr@(Node _ forest) pkCols -- if * is part of the select, we must not add pk or fk columns manually - diff --git a/src/PostgREST/Request/Types.hs b/src/PostgREST/Request/Types.hs index c833ee470..ea4735b98 100644 --- a/src/PostgREST/Request/Types.hs +++ b/src/PostgREST/Request/Types.hs @@ -6,6 +6,8 @@ module PostgREST.Request.Types , EmbedPath , Field , Filter(..) + , CallQuery(..) + , CallRequest , JoinCondition(..) , JsonOperand(..) , JsonOperation(..) @@ -38,6 +40,7 @@ import qualified GHC.Show (show) import PostgREST.DbStructure.Identifiers (FieldName, QualifiedIdentifier) +import PostgREST.DbStructure.Proc (ProcParam) import PostgREST.DbStructure.Relationship (Relationship) import PostgREST.RangeQuery (NonnegRange) import PostgREST.Request.Preferences (PreferResolution) @@ -47,6 +50,7 @@ import Protolude type ReadRequest = Tree ReadNode type MutateRequest = MutateQuery +type CallRequest = CallQuery type ReadNode = (ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe EmbedHint, Depth)) @@ -121,6 +125,16 @@ data MutateQuery , returning :: [FieldName] } +data CallQuery = FunctionCall + { funCQi :: QualifiedIdentifier + , funCParams :: [ProcParam] + , funCArgs :: Maybe BL.ByteString + , funCScalar :: Bool + , funCMultipleCall :: Bool + , funCSingleParam :: Bool + , funCReturning :: [FieldName] + } + -- | The select value in `/tbl?select=alias:field::cast` type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe EmbedHint) diff --git a/test/QueryCost.hs b/test/QueryCost.hs index 7d1ce99dd..451fa48e2 100644 --- a/test/QueryCost.hs +++ b/test/QueryCost.hs @@ -15,11 +15,10 @@ import Protolude hiding (get, toS) import Protolude.Conv (toS) import PostgREST.Query.QueryBuilder (requestToCallProcQuery) -import PostgREST.Request.ApiRequest (PayloadJSON (..)) +import PostgREST.Request.Types (CallQuery (..)) import PostgREST.DbStructure.Identifiers import PostgREST.DbStructure.Proc -import PostgREST.Request.Preferences import SpecHelper (getEnvVarWithDefault) @@ -34,29 +33,30 @@ main = do context "call proc query" $ do it "should not exceed cost when calling setof composite proc" $ do cost <- exec pool $ - requestToCallProcQuery (QualifiedIdentifier "test" "get_projects_below") [ProcParam "id" "int" True False] - (Just $ RawJSON [str| {"id": 3} |]) False Nothing [] + requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below") [ProcParam "id" "int" True False] + (Just [str| {"id": 3} |]) False False False []) liftIO $ cost `shouldSatisfy` (< Just 40) it "should not exceed cost when calling setof composite proc with empty params" $ do cost <- exec pool $ - requestToCallProcQuery (QualifiedIdentifier "test" "getallprojects") [] Nothing False Nothing [] + requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "getallprojects") [] Nothing False False False []) liftIO $ cost `shouldSatisfy` (< Just 30) it "should not exceed cost when calling scalar proc" $ do cost <- exec pool $ - requestToCallProcQuery (QualifiedIdentifier "test" "add_them") [ProcParam "a" "int" True False, ProcParam "b" "int" True False] - (Just $ RawJSON [str| {"a": 3, "b": 4} |]) True Nothing [] + requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "add_them") + [ProcParam "a" "int" True False, ProcParam "b" "int" True False] + (Just [str| {"a": 3, "b": 4} |]) True False False []) liftIO $ cost `shouldSatisfy` (< Just 10) context "params=multiple-objects" $ do it "should not exceed cost when calling setof composite proc" $ do cost <- exec pool $ - requestToCallProcQuery (QualifiedIdentifier "test" "get_projects_below") [ProcParam "id" "int" True False] - (Just $ RawJSON [str| [{"id": 1}, {"id": 4}] |]) False (Just MultipleObjects) [] + requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below") [ProcParam "id" "int" True False] + (Just [str| [{"id": 1}, {"id": 4}] |]) False True False []) liftIO $ do -- lower bound needed for now to make sure that cost is not Nothing cost `shouldSatisfy` (> Just 2000) @@ -64,8 +64,9 @@ main = do it "should not exceed cost when calling scalar proc" $ do cost <- exec pool $ - requestToCallProcQuery (QualifiedIdentifier "test" "add_them") [ProcParam "a" "int" True False, ProcParam "b" "int" True False] - (Just $ RawJSON [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |]) True Nothing [] + requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "add_them") + [ProcParam "a" "int" True False, ProcParam "b" "int" True False] + (Just [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |]) True False False []) liftIO $ cost `shouldSatisfy` (< Just 10)