refactor: move isolation/settings logic to Plan.hs

src/PostgREST/App.hs

@@ -9,7 +9,6 @@ Some of its functionality includes:
 - Producing HTTP Headers according to RFCs.
 - Content Negotiation
 -}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 module PostgREST.App
  ( postgrest
@@ -24,7 +23,6 @@ import Data.String (IsString (..))
 import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
  setServerName)
 
-import qualified Data.HashMap.Strict as HM
 import qualified Data.Text.Encoding as T
 import qualified Hasql.Transaction.Sessions as SQL
 import qualified Network.Wai as Wai
@@ -54,7 +52,6 @@ import PostgREST.Query (DbHandler)
 import PostgREST.Response.Performance (ServerTiming (..),
  serverTimingHeader)
 import PostgREST.SchemaCache (SchemaCache (..))
-import PostgREST.SchemaCache.Routine (Routine (..))
 import PostgREST.Version (docsVersion, prettyVersion)
 
 import qualified Data.ByteString.Char8 as BS
@@ -172,7 +169,10 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A
  case iAction of
  ActDb dbAct -> do
  (planTime', plan) <- withTiming $ liftEither $ Plan.actionPlan dbAct conf apiReq sCache
- (txTime', queryResult) <- withTiming $ runQuery (planIsoLvl plan) (planFunSettings plan) (Plan.actionPlanTxMode plan) $ Query.actionQuery plan conf apiReq pgVer sCache
+ (txTime', queryResult) <- withTiming $ runDbHandler appState conf (Plan.planIsoLvl conf authRole plan) (Plan.planTxMode plan) authenticated prepared observer $ do
+ Query.setPgLocals plan conf authClaims authRole apiReq
+ Query.runPreReq conf
+ Query.actionQuery plan conf apiReq pgVer sCache
  (respTime', pgrst) <- withTiming $ liftEither $ Response.actionResponse queryResult (dbActQi dbAct) apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache iSchema iNegotiatedByProfile
  return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst
 
@@ -190,20 +190,6 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A
  return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst
 
  where
- roleSettings = fromMaybe mempty (HM.lookup authRole $ configRoleSettings conf)
- roleIsoLvl = HM.findWithDefault SQL.ReadCommitted authRole $ configRoleIsoLvl conf
- runQuery isoLvl funcSets mode query =
- runDbHandler appState conf isoLvl mode authenticated prepared observer $ do
- Query.setPgLocals conf authClaims authRole (HM.toList roleSettings) funcSets apiReq
- Query.runPreReq conf
- query
-
- planIsoLvl (Plan.Db Plan.CallReadPlan{crProc}) = fromMaybe roleIsoLvl $ pdIsoLvl crProc
- planIsoLvl _ = roleIsoLvl
-
- planFunSettings (Plan.Db Plan.CallReadPlan{crProc}) = pdFuncSettings crProc
- planFunSettings _ = mempty
-
  pgrstResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response
  pgrstResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled conf])) bod
 

src/PostgREST/Plan.hs

@@ -22,7 +22,8 @@ module PostgREST.Plan
  , InspectPlan(..)
  , inspectPlan
  , callReadPlan
- , actionPlanTxMode
+ , planTxMode
+ , planIsoLvl
  ) where
 
 import qualified Data.ByteString.Lazy as LBS
@@ -127,9 +128,16 @@ data InspectPlan = InspectPlan {
 
 data ActionPlan = Db DbActionPlan | MaybeDb InspectPlan
 
-actionPlanTxMode :: ActionPlan -> SQL.Mode
-actionPlanTxMode (Db x) = pTxMode x
-actionPlanTxMode (MaybeDb x) = ipTxmode x
+planTxMode :: ActionPlan -> SQL.Mode
+planTxMode (Db x) = pTxMode x
+planTxMode (MaybeDb x) = ipTxmode x
+
+planIsoLvl :: AppConfig -> ByteString -> ActionPlan -> SQL.IsolationLevel
+planIsoLvl AppConfig{configRoleIsoLvl} role actPlan = case actPlan of
+ Db CallReadPlan{crProc} -> fromMaybe roleIsoLvl $ pdIsoLvl crProc
+ _ -> roleIsoLvl
+ where
+ roleIsoLvl = HM.findWithDefault SQL.ReadCommitted role configRoleIsoLvl
 
 actionPlan :: DbAction -> AppConfig -> ApiRequest -> SchemaCache -> Either Error ActionPlan
 actionPlan dbAct conf apiReq sCache = case dbAct of

src/PostgREST/Query.hs

@@ -53,7 +53,8 @@ import PostgREST.Query.SqlFragment (escapeIdentList, fromQi,
 import PostgREST.Query.Statements (ResultSet (..))
 import PostgREST.SchemaCache (SchemaCache (..))
 import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
-import PostgREST.SchemaCache.Routine (MediaHandler, RoutineMap)
+import PostgREST.SchemaCache.Routine (MediaHandler, Routine (..),
+ RoutineMap)
 import PostgREST.SchemaCache.Table (TablesMap)
 
 import Protolude hiding (Handler)
@@ -238,9 +239,8 @@ optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} = do
  preferTransaction == Just Rollback
 
 -- | Set transaction scoped settings
-setPgLocals :: AppConfig -> KM.KeyMap JSON.Value -> BS.ByteString -> [(ByteString, ByteString)] ->
- [(Text,Text)] -> ApiRequest -> DbHandler ()
-setPgLocals AppConfig{..} claims role roleSettings funcSettings ApiRequest{..} = lift $
+setPgLocals :: ActionPlan -> AppConfig -> KM.KeyMap JSON.Value -> BS.ByteString -> ApiRequest -> DbHandler ()
+setPgLocals actPlan AppConfig{..} claims role ApiRequest{..} = lift $
  SQL.statement mempty $ SQL.dynamicallyParameterized
  -- To ensure `GRANT SET ON PARAMETER <superuser_setting> TO authenticator` works, the role settings must be set before the impersonated role.
  -- Otherwise the GRANT SET would have to be applied to the impersonated role. See https://github.com/PostgREST/postgrest/issues/3045
@@ -253,13 +253,16 @@ setPgLocals AppConfig{..} claims role roleSettings funcSettings ApiRequest{..} =
  cookiesSql = setConfigWithConstantNameJSON "request.cookies" iCookies
  claimsSql = [setConfigWithConstantName ("request.jwt.claims", LBS.toStrict $ JSON.encode claims)]
  roleSql = [setConfigWithConstantName ("role", role)]
- roleSettingsSql = setConfigWithDynamicName <$> roleSettings
+ roleSettingsSql = setConfigWithDynamicName <$> HM.toList (fromMaybe mempty $ HM.lookup role configRoleSettings)
  appSettingsSql = setConfigWithDynamicName <$> (join bimap toUtf8 <$> configAppSettings)
  timezoneSql = maybe mempty (\(PreferTimezone tz) -> [setConfigWithConstantName ("timezone", tz)]) $ preferTimezone iPreferences
  funcSettingsSql = setConfigWithDynamicName <$> (join bimap toUtf8 <$> funcSettings)
  searchPathSql =
  let schemas = escapeIdentList (iSchema : configDbExtraSearchPath) in
  setConfigWithConstantName ("search_path", schemas)
+ funcSettings = case actPlan of
+ Db CallReadPlan{crProc} -> pdFuncSettings crProc
+ _ -> mempty
 
 -- | Runs the pre-request function.
 runPreReq :: AppConfig -> DbHandler ()