refactor: move txMode to Plan

src/PostgREST/App.hs

@@ -149,7 +149,7 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jsonDbS pgVer aut
       ApiRequest.userApiRequest conf sCache req body
 
   Response.optionalRollback conf apiRequest $
-    handleRequest authResult conf appState (Query.txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements jsonDbS pgVer apiRequest sCache
+    handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements jsonDbS pgVer apiRequest sCache
 
 runDbHandler :: AppState.AppState -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
 runDbHandler appState mode authenticated prepared handler = do
@@ -163,41 +163,41 @@ runDbHandler appState mode authenticated prepared handler = do
 
   liftEither resp
 
-handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> SQL.Mode -> Bool -> Bool -> ByteString -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response
+handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> ByteString -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response
-handleRequest AuthResult{..} conf appState mode authenticated prepared jsonDbS pgVer apiReq@ApiRequest{..} sCache =
+handleRequest AuthResult{..} conf appState authenticated prepared jsonDbS pgVer apiReq@ApiRequest{..} sCache =
   case (iAction, iTarget) of
     (ActionRead headersOnly, TargetIdent identifier) -> do
       rPlan <- liftEither $ Plan.readPlan identifier conf sCache apiReq
-      resultSet <- runQuery $ Query.readQuery rPlan conf apiReq
+      resultSet <- runQuery Plan.readPlanTxMode $ Query.readQuery rPlan conf apiReq
       return $ Response.readResponse headersOnly identifier apiReq resultSet
 
     (ActionMutate MutationCreate, TargetIdent identifier) -> do
       mrPlan <- liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache
-      resultSet <- runQuery $ Query.createQuery mrPlan apiReq conf
+      resultSet <- runQuery (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf
       return $ Response.createResponse identifier mrPlan apiReq resultSet
 
     (ActionMutate MutationUpdate, TargetIdent identifier) -> do
       mrPlan <- liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache
-      resultSet <- runQuery $ Query.updateQuery mrPlan apiReq conf
+      resultSet <- runQuery (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf
       return $ Response.updateResponse apiReq resultSet
 
     (ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do
       mrPlan <- liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache
-      resultSet <- runQuery $ Query.singleUpsertQuery mrPlan apiReq conf
+      resultSet <- runQuery (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf
       return $ Response.singleUpsertResponse apiReq resultSet
 
     (ActionMutate MutationDelete, TargetIdent identifier) -> do
       mrPlan <- liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache
-      resultSet <- runQuery $ Query.deleteQuery mrPlan apiReq conf
+      resultSet <- runQuery (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf
       return $ Response.deleteResponse apiReq resultSet
 
     (ActionInvoke invMethod, TargetProc proc _) -> do
-      cPlan <- liftEither $ Plan.callReadPlan proc conf sCache apiReq
+      cPlan <- liftEither $ Plan.callReadPlan proc conf sCache apiReq invMethod
-      resultSet <- runQuery $ Query.invokeQuery proc cPlan apiReq conf
+      resultSet <- runQuery (Plan.crTxMode cPlan) $ Query.invokeQuery proc cPlan apiReq conf
       return $ Response.invokeResponse invMethod proc apiReq resultSet
 
     (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
-      oaiResult <- runQuery $ Query.openApiQuery sCache pgVer conf tSchema
+      oaiResult <- runQuery Plan.inspectPlanTxMode $ Query.openApiQuery sCache pgVer conf tSchema
       return $ Response.openApiResponse headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile
 
     (ActionInfo, _) ->
@@ -208,7 +208,7 @@ handleRequest AuthResult{..} conf appState mode authenticated prepared jsonDbS p
       -- TODO Refactor the Action/Target types to remove this line
       throwError $ Error.ApiRequestError ApiRequestTypes.NotFound
   where
-    runQuery query =
+    runQuery mode query =
       runDbHandler appState mode authenticated prepared $ do
         Query.setPgLocals conf authClaims authRole apiReq jsonDbS pgVer
         query

src/PostgREST/Plan.hs

@@ -21,6 +21,8 @@ module PostgREST.Plan
   , callReadPlan
   , MutateReadPlan(..)
   , CallReadPlan(..)
+  , readPlanTxMode
+  , inspectPlanTxMode
   ) where
 
 import qualified Data.HashMap.Strict        as HM
@@ -33,6 +35,7 @@ import Data.Tree               (Tree (..))
 
 import PostgREST.ApiRequest               (Action (..),
                                            ApiRequest (..),
+                                           InvokeMethod (..),
                                            Mutation (..),
                                            Payload (..))
 import PostgREST.Config                   (AppConfig (..))
@@ -63,6 +66,7 @@ import PostgREST.Plan.MutatePlan
 import PostgREST.Plan.ReadPlan          as ReadPlan
 import PostgREST.Plan.Types
 
+import qualified Hasql.Transaction.Sessions       as SQL
 import qualified PostgREST.ApiRequest.QueryParams as QueryParams
 
 import Protolude hiding (from)
@@ -70,25 +74,39 @@ import Protolude hiding (from)
 data MutateReadPlan = MutateReadPlan {
   mrReadPlan   :: ReadPlanTree
 , mrMutatePlan :: MutatePlan
+, mrTxMode     :: SQL.Mode
 }
 
 data CallReadPlan = CallReadPlan {
   crReadPlan :: ReadPlanTree
 , crCallPlan :: CallPlan
+, crTxMode   :: SQL.Mode
 }
 
 mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error MutateReadPlan
 mutateReadPlan  mutation apiRequest identifier conf sCache = do
   rPlan <- readPlan identifier conf sCache apiRequest
   mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan
-  return $ MutateReadPlan rPlan mPlan
+  return $ MutateReadPlan rPlan mPlan SQL.Write
 
-callReadPlan :: ProcDescription -> AppConfig -> SchemaCache -> ApiRequest -> Either Error CallReadPlan
+callReadPlan :: ProcDescription -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan
-callReadPlan proc conf sCache apiRequest = do
+callReadPlan proc conf sCache apiRequest invMethod = do
   let identifier = QualifiedIdentifier (pdSchema proc) (fromMaybe (pdName proc) $ Proc.procTableName proc)
   rPlan <- readPlan identifier conf sCache apiRequest
   let cPlan = callPlan proc apiRequest rPlan
-  return $ CallReadPlan rPlan cPlan
+      txMode = case (invMethod, Proc.pdVolatility proc) of
+          (InvGet,  _)              -> SQL.Read
+          (InvHead, _)              -> SQL.Read
+          (InvPost, Proc.Stable)    -> SQL.Read
+          (InvPost, Proc.Immutable) -> SQL.Read
+          (InvPost, Proc.Volatile)  -> SQL.Write
+  return $ CallReadPlan rPlan cPlan txMode
+
+readPlanTxMode :: SQL.Mode
+readPlanTxMode = SQL.Read
+
+inspectPlanTxMode :: SQL.Mode
+inspectPlanTxMode = SQL.Read
 
 -- | Builds the ReadPlan tree on a number of stages.
 -- | Adds filters, order, limits on its respective nodes.

src/PostgREST/Query.hs

@@ -7,7 +7,6 @@ module PostgREST.Query
   , openApiQuery
   , readQuery
   , singleUpsertQuery
-  , txMode
   , updateQuery
   , setPgLocals
   , DbHandler
@@ -24,7 +23,6 @@ import qualified Hasql.Decoders                    as HD
 import qualified Hasql.DynamicStatements.Snippet   as SQL (Snippet)
 import qualified Hasql.DynamicStatements.Statement as SQL
 import qualified Hasql.Transaction                 as SQL
-import qualified Hasql.Transaction.Sessions        as SQL
 
 import qualified PostgREST.Error              as Error
 import qualified PostgREST.Query.QueryBuilder as QueryBuilder
@@ -35,9 +33,7 @@ import qualified PostgREST.SchemaCache.Proc   as Proc
 
 import Data.Scientific (FPFormat (..), formatScientific, isInteger)
 
-import PostgREST.ApiRequest              (Action (..),
+import PostgREST.ApiRequest              (ApiRequest (..),
-                                          ApiRequest (..),
-                                          InvokeMethod (..),
                                           Target (..))
 import PostgREST.ApiRequest.Preferences  (PreferCount (..),
                                           PreferParameters (..),
@@ -62,7 +58,6 @@ import PostgREST.SchemaCache             (SchemaCache (..))
 import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
                                           Schema)
 import PostgREST.SchemaCache.Proc        (ProcDescription (..),
-                                          ProcVolatility (..),
                                           ProcsMap)
 import PostgREST.SchemaCache.Table       (TablesMap)
 
@@ -192,24 +187,6 @@ openApiQuery sCache pgVer AppConfig{..} tSchema =
     OADisabled ->
       pure Nothing
 
-txMode :: ApiRequest -> SQL.Mode
-txMode ApiRequest{..} =
-  case (iAction, iTarget) of
-    (ActionRead _, _) ->
-      SQL.Read
-    (ActionInspect _, _) ->
-      SQL.Read
-    (ActionInvoke InvGet, _) ->
-      SQL.Read
-    (ActionInvoke InvHead, _) ->
-      SQL.Read
-    (ActionInvoke InvPost, TargetProc ProcDescription{pdVolatility=Stable} _) ->
-      SQL.Read
-    (ActionInvoke InvPost, TargetProc ProcDescription{pdVolatility=Immutable} _) ->
-      SQL.Read
-    _ ->
-      SQL.Write
-
 writeQuery :: MutateReadPlan -> ApiRequest -> AppConfig  -> DbHandler ResultSet
 writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan} apiReq conf =
   let

test/spec/fixtures/schema.sql

@@ -26,7 +26,7 @@ CREATE SCHEMA "EXTRA ""@/\#~_-";
 COMMENT ON SCHEMA v1 IS 'v1 schema';
 COMMENT ON SCHEMA v2 IS 'v2 schema';
 
-COMMENT ON SCHEMA test IS 
+COMMENT ON SCHEMA test IS
 $$My API title
 
 My API description
@@ -3111,4 +3111,4 @@ create view test.alpha_projects as
 -- view's name is alphabetically after projects
 create view test.zeta_projects as
   select c.id, p.name as pro_name, c.name as cli_name
-  from projects p join clients c on p.client_id = c.id;
+  from projects p join clients c on p.client_id = c.id;