refactor: one entrypoint for Plan/Response/Query

- deduplicates timing calculation for the different steps
- enabling query logging later on will be simpler

src/PostgREST/ApiRequest.hs

@@ -99,7 +99,7 @@ data DbAction
 data Action
   = ActDb           DbAction
   | ActRelationInfo QualifiedIdentifier
-  | ActRoutineInfo  QualifiedIdentifier
+  | ActRoutineInfo  QualifiedIdentifier InvokeMethod
   | ActSchemaInfo
 
 {-|
@@ -178,7 +178,7 @@ getAction resource schema method =
     (ResourceRoutine rout, "HEAD")    -> Right . ActDb $ ActRoutine (qi rout) $ InvRead True
     (ResourceRoutine rout, "GET")     -> Right . ActDb $ ActRoutine (qi rout) $ InvRead False
     (ResourceRoutine rout, "POST")    -> Right . ActDb $ ActRoutine (qi rout) Inv
-    (ResourceRoutine rout, "OPTIONS") -> Right $ ActRoutineInfo (qi rout)
+    (ResourceRoutine rout, "OPTIONS") -> Right $ ActRoutineInfo (qi rout) $ InvRead True
     (ResourceRoutine _, _)            -> Left $ InvalidRpcMethod method
 
     (ResourceRelation rel, "HEAD")    -> Right . ActDb $ ActRelationRead (qi rel) True

src/PostgREST/App.hs

@@ -23,10 +23,9 @@ import Data.String              (IsString (..))
 import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
                                  setServerName)
 
-import qualified Data.Text.Encoding         as T
+import qualified Data.Text.Encoding       as T
-import qualified Hasql.Transaction.Sessions as SQL
+import qualified Network.Wai              as Wai
-import qualified Network.Wai                as Wai
+import qualified Network.Wai.Handler.Warp as Warp
-import qualified Network.Wai.Handler.Warp   as Warp
 
 import qualified PostgREST.Admin      as Admin
 import qualified PostgREST.ApiRequest as ApiRequest
@@ -40,15 +39,13 @@ import qualified PostgREST.Query      as Query
 import qualified PostgREST.Response   as Response
 import qualified PostgREST.Unix       as Unix (installSignalHandlers)
 
-import PostgREST.ApiRequest           (Action (..), ApiRequest (..),
+import PostgREST.ApiRequest           (ApiRequest (..))
-                                       DbAction (..))
 import PostgREST.AppState             (AppState)
 import PostgREST.Auth                 (AuthResult (..))
 import PostgREST.Config               (AppConfig (..), LogLevel (..))
 import PostgREST.Config.PgVersion     (PgVersion (..))
 import PostgREST.Error                (Error)
 import PostgREST.Observation          (Observation (..))
-import PostgREST.Query                (DbHandler)
 import PostgREST.Response.Performance (ServerTiming (..),
                                        serverTimingHeader)
 import PostgREST.SchemaCache          (SchemaCache (..))
@@ -143,66 +140,27 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@
 
   body <- lift $ Wai.strictRequestBody req
 
-  (parseTime, apiRequest) <-
-    calcTiming configServerTimingEnabled $
-      liftEither . mapLeft Error.ApiRequestError $
-        ApiRequest.userApiRequest conf req body sCache
-
   let jwtTime = if configServerTimingEnabled then Auth.getJwtDur req else Nothing
-  handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache jwtTime parseTime observer
 
-runDbHandler :: AppState.AppState -> AppConfig -> SQL.IsolationLevel -> SQL.Mode -> Bool -> Bool -> (Observation -> IO ()) -> DbHandler b -> Handler IO b
+  (parseTime, apiReq@ApiRequest{..}) <- withTiming $ liftEither . mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf req body sCache
-runDbHandler appState config isoLvl mode authenticated prepared observer handler = do
+  (planTime, plan)                   <- withTiming $ liftEither $ Plan.actionPlan iAction conf apiReq sCache
-  dbResp <- lift $ do
+  (queryTime, queryResult)           <- withTiming $ Query.runQuery appState conf authResult apiReq plan sCache pgVer (Just authRole /= configDbAnonRole) observer
-    let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
+  (respTime, resp)                   <- withTiming $ liftEither $ Response.actionResponse queryResult apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache iSchema iNegotiatedByProfile
-    AppState.usePool appState config (transaction isoLvl mode $ runExceptT handler) observer
 
-  resp <-
+  return $ toWaiResponse (ServerTiming jwtTime parseTime planTime queryTime respTime) resp
-    liftEither . mapLeft Error.PgErr $
-      mapLeft (Error.PgError authenticated) dbResp
-
-  liftEither resp
-
-handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache ->
-                Maybe Double -> Maybe Double -> (Observation -> IO ()) -> Handler IO Wai.Response
-handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache jwtTime parseTime observer =
-  case iAction of
-    ActDb dbAct -> do
-      (planTime', plan) <- withTiming $ liftEither $ Plan.actionPlan dbAct conf apiReq 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
-
-    ActRelationInfo identifier -> do
-      (respTime', pgrst) <- withTiming $ liftEither $ Response.infoIdentResponse identifier sCache
-      return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst
-
-    ActRoutineInfo identifier -> do
-      (planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq $ ApiRequest.InvRead True
-      (respTime', pgrst) <- withTiming $ liftEither $ Response.infoProcResponse (Plan.crProc cPlan)
-      return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' Nothing respTime') pgrst
-
-    ActSchemaInfo -> do
-      (respTime', pgrst) <- withTiming $ liftEither Response.infoRootResponse
-      return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst
 
   where
-    pgrstResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response
+    toWaiResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response
-    pgrstResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled conf])) bod
+    toWaiResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled])) bod
 
-    withTiming = calcTiming $ configServerTimingEnabled conf
+    withTiming :: Handler IO a -> Handler IO (Maybe Double, a)
-
+    withTiming f = if configServerTimingEnabled
-calcTiming :: Bool -> Handler IO a -> Handler IO (Maybe Double, a)
+        then do
-calcTiming timingEnabled f = if timingEnabled
+          (t, r) <- timeItT f
-    then do
+          pure (Just t, r)
-      (t, r) <- timeItT f
+        else do
-      pure (Just t, r)
+          r <- f
-    else do
+          pure (Nothing, r)
-      r <- f
-      pure (Nothing, r)
 
 traceHeaderMiddleware :: AppState -> Wai.Middleware
 traceHeaderMiddleware appState app req respond = do

src/PostgREST/Plan.hs

@@ -20,10 +20,9 @@ module PostgREST.Plan
   , ActionPlan(..)
   , DbActionPlan(..)
   , InspectPlan(..)
-  , inspectPlan
+  , InfoPlan(..)
-  , callReadPlan
+  , CrudPlan(..)
-  , planTxMode
+  , CallReadPlan(..)
-  , planIsoLvl
   ) where
 
 import qualified Data.ByteString.Lazy          as LBS
@@ -93,13 +92,14 @@ import Protolude hiding (from)
 -- Setup for doctests
 -- >>> import Data.Ranged.Ranges (fullRange)
 
-data DbActionPlan
+data CrudPlan
   = WrappedReadPlan
   { wrReadPlan :: ReadPlanTree
   , pTxMode    :: SQL.Mode
   , wrHandler  :: MediaHandler
   , wrMedia    :: MediaType
   , wrHdrsOnly :: Bool
+  , crudQi     :: QualifiedIdentifier
   }
   | MutateReadPlan {
     mrReadPlan   :: ReadPlanTree
@@ -108,15 +108,18 @@ data DbActionPlan
   , mrHandler    :: MediaHandler
   , mrMedia      :: MediaType
   , mrMutation   :: Mutation
+  , crudQi       :: QualifiedIdentifier
   }
-  | CallReadPlan {
+
+data CallReadPlan = CallReadPlan {
     crReadPlan :: ReadPlanTree
   , crCallPlan :: CallPlan
-  , pTxMode    :: SQL.Mode
+  , crTxMode   :: SQL.Mode
   , crProc     :: Routine
   , crHandler  :: MediaHandler
   , crMedia    :: MediaType
   , crInvMthd  :: InvokeMethod
+  , crQi       :: QualifiedIdentifier
   }
 
 data InspectPlan = InspectPlan {
@@ -126,46 +129,44 @@ data InspectPlan = InspectPlan {
   , ipSchema   :: Schema
   }
 
-data ActionPlan = Db DbActionPlan | MaybeDb InspectPlan
+data DbActionPlan = DbCrud CrudPlan | DbCall CallReadPlan | MaybeDb InspectPlan
+data InfoPlan     = RelInfoPlan QualifiedIdentifier | RoutineInfoPlan CallReadPlan | SchemaInfoPlan
+data ActionPlan   = Db DbActionPlan | NoDb InfoPlan
 
-planTxMode :: ActionPlan -> SQL.Mode
+actionPlan :: Action -> AppConfig -> ApiRequest -> SchemaCache -> Either Error ActionPlan
-planTxMode (Db x)      = pTxMode x
+actionPlan act conf apiReq sCache = case act of
-planTxMode (MaybeDb x) = ipTxmode x
+    ActDb dbAct              -> Db <$> dbActionPlan dbAct conf apiReq sCache
+    ActRelationInfo ident    -> pure . NoDb $ RelInfoPlan ident
+    ActRoutineInfo ident inv -> NoDb . RoutineInfoPlan <$> callReadPlan ident conf sCache apiReq inv
+    ActSchemaInfo            -> pure $ NoDb SchemaInfoPlan
 
-planIsoLvl :: AppConfig -> ByteString -> ActionPlan -> SQL.IsolationLevel
+dbActionPlan :: DbAction -> AppConfig -> ApiRequest -> SchemaCache -> Either Error DbActionPlan
-planIsoLvl AppConfig{configRoleIsoLvl} role actPlan = case actPlan of
+dbActionPlan dbAct conf apiReq sCache = case dbAct 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
   ActRelationRead identifier headersOnly ->
-    Db <$> wrappedReadPlan identifier conf sCache apiReq headersOnly
+    DbCrud <$> wrappedReadPlan identifier conf sCache apiReq headersOnly
   ActRelationMut identifier mut ->
-    Db <$> mutateReadPlan mut apiReq identifier conf sCache
+    DbCrud <$> mutateReadPlan mut apiReq identifier conf sCache
   ActRoutine identifier invMethod ->
-    Db <$> callReadPlan identifier conf sCache apiReq invMethod
+    DbCall <$> callReadPlan identifier conf sCache apiReq invMethod
   ActSchemaRead tSchema headersOnly ->
     MaybeDb <$> inspectPlan apiReq headersOnly tSchema
 
-wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Bool -> Either Error DbActionPlan
+wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Bool -> Either Error CrudPlan
 wrappedReadPlan  identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} headersOnly = do
   rPlan <- readPlan identifier conf sCache apiRequest
   (handler, mediaType)  <- mapLeft ApiRequestError $ negotiateContent conf apiRequest identifier iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan)
   if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestError $ InvalidPreferences invalidPrefs else Right ()
-  return $ WrappedReadPlan rPlan SQL.Read handler mediaType headersOnly
+  return $ WrappedReadPlan rPlan SQL.Read handler mediaType headersOnly identifier
 
-mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error DbActionPlan
+mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error CrudPlan
 mutateReadPlan  mutation apiRequest@ApiRequest{iPreferences=Preferences{..},..} identifier conf sCache = do
   rPlan <- readPlan identifier conf sCache apiRequest
   mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan
   if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestError $ InvalidPreferences invalidPrefs else Right ()
   (handler, mediaType)  <- mapLeft ApiRequestError $ negotiateContent conf apiRequest identifier iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan)
-  return $ MutateReadPlan rPlan mPlan SQL.Write handler mediaType mutation
+  return $ MutateReadPlan rPlan mPlan SQL.Write handler mediaType mutation identifier
 
-callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error DbActionPlan
+callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan
 callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} invMethod = do
   let paramKeys = case invMethod of
         InvRead _ -> S.fromList $ fst <$> qsParams'
@@ -186,7 +187,7 @@ callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferenc
       cPlan = callPlan proc apiRequest paramKeys args rPlan
   (handler, mediaType)  <- mapLeft ApiRequestError $ negotiateContent conf apiRequest relIdentifier iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan)
   if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestError $ InvalidPreferences invalidPrefs else Right ()
-  return $ CallReadPlan rPlan cPlan txMode proc handler mediaType invMethod
+  return $ CallReadPlan rPlan cPlan txMode proc handler mediaType invMethod identifier
   where
     qsParams' = QueryParams.qsParams iQueryParams
 

src/PostgREST/Query.hs

@@ -1,25 +1,26 @@
 {-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE RecordWildCards #-}
 module PostgREST.Query
-  ( actionQuery
+  ( QueryResult (..)
-  , setPgLocals
+  , runQuery
-  , runPreReq
-  , DbHandler
-  , QueryResult (..)
   ) where
 
+import           Control.Monad.Except              (liftEither)
 import qualified Data.Aeson                        as JSON
 import qualified Data.Aeson.KeyMap                 as KM
 import qualified Data.ByteString                   as BS
 import qualified Data.ByteString.Lazy.Char8        as LBS
+import           Data.Either.Combinators           (mapLeft)
 import qualified Data.HashMap.Strict               as HM
 import qualified Data.Set                          as S
 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.ApiRequest.Types   as ApiRequestTypes
+import qualified PostgREST.AppState           as AppState
 import qualified PostgREST.Error              as Error
 import qualified PostgREST.Query.QueryBuilder as QueryBuilder
 import qualified PostgREST.Query.Statements   as Statements
@@ -35,13 +36,18 @@ import PostgREST.ApiRequest.Preferences  (PreferCount (..),
                                           PreferTransaction (..),
                                           Preferences (..),
                                           shouldCount)
+import PostgREST.Auth                    (AuthResult (..))
 import PostgREST.Config                  (AppConfig (..),
                                           OpenAPIMode (..))
 import PostgREST.Config.PgVersion        (PgVersion (..))
 import PostgREST.Error                   (Error)
 import PostgREST.MediaType               (MediaType (..))
+import PostgREST.Observation             (Observation (..))
 import PostgREST.Plan                    (ActionPlan (..),
+                                          CallReadPlan (..),
+                                          CrudPlan (..),
                                           DbActionPlan (..),
+                                          InfoPlan (..),
                                           InspectPlan (..))
 import PostgREST.Plan.MutatePlan         (MutatePlan (..))
 import PostgREST.Plan.ReadPlan           (ReadPlanTree)
@@ -62,12 +68,48 @@ import Protolude hiding (Handler)
 type DbHandler = ExceptT Error SQL.Transaction
 
 data QueryResult
-  = DbResult      DbActionPlan ResultSet
+  = DbCrudResult  CrudPlan ResultSet
+  | DbCallResult  CallReadPlan  ResultSet
   | MaybeDbResult InspectPlan  (Maybe (TablesMap, RoutineMap, Maybe Text))
+  | NoDbResult    InfoPlan
 
-actionQuery :: ActionPlan -> AppConfig -> ApiRequest -> PgVersion -> SchemaCache -> DbHandler QueryResult
+-- TODO This function needs to be free from IO, only App.hs should do IO
+runQuery :: AppState.AppState -> AppConfig -> AuthResult -> ApiRequest -> ActionPlan -> SchemaCache -> PgVersion -> Bool -> (Observation -> IO ()) -> ExceptT Error IO QueryResult
+runQuery _ _ _ _ (NoDb x) _ _ _ _ = pure $ NoDbResult x
+runQuery appState config AuthResult{..} apiReq (Db plan) sCache pgVer authenticated observer = do
+  dbResp <- lift $ do
+    let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
+    AppState.usePool appState config (transaction isoLvl txMode $ runExceptT dbHandler) observer
 
-actionQuery (Db plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ = do
+  resp <-
+    liftEither . mapLeft Error.PgErr $
+      mapLeft (Error.PgError authenticated) dbResp
+
+  liftEither resp
+  where
+    prepared = configDbPreparedStatements config
+    isoLvl = planIsoLvl config authRole plan
+    txMode = planTxMode plan
+    dbHandler = do
+        setPgLocals plan config authClaims authRole apiReq
+        runPreReq config
+        actionQuery plan config apiReq pgVer sCache
+
+planTxMode :: DbActionPlan -> SQL.Mode
+planTxMode (DbCrud x)  = pTxMode x
+planTxMode (DbCall x)  = crTxMode x
+planTxMode (MaybeDb x) = ipTxmode x
+
+planIsoLvl :: AppConfig -> ByteString -> DbActionPlan -> SQL.IsolationLevel
+planIsoLvl AppConfig{configRoleIsoLvl} role actPlan = case actPlan of
+  DbCall CallReadPlan{crProc} -> fromMaybe roleIsoLvl $ pdIsoLvl crProc
+  _                           -> roleIsoLvl
+  where
+    roleIsoLvl = HM.findWithDefault SQL.ReadCommitted role configRoleIsoLvl
+
+actionQuery :: DbActionPlan -> AppConfig -> ApiRequest -> PgVersion -> SchemaCache -> DbHandler QueryResult
+
+actionQuery (DbCrud plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ = do
   let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan
   resultSet <-
      lift . SQL.statement mempty $
@@ -85,37 +127,37 @@ actionQuery (Db plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{i
         configDbPreparedStatements
   failNotSingular wrMedia resultSet
   optionalRollback conf apiReq
-  DbResult plan <$> resultSetWTotal conf apiReq resultSet countQuery
+  DbCrudResult plan <$> resultSetWTotal conf apiReq resultSet countQuery
 
-actionQuery (Db plan@MutateReadPlan{mrMutation=MutationCreate, ..}) conf apiReq _ _ = do
+actionQuery (DbCrud plan@MutateReadPlan{mrMutation=MutationCreate, ..}) conf apiReq _ _ = do
   resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf
   failNotSingular mrMedia resultSet
   optionalRollback conf apiReq
-  pure $ DbResult plan resultSet
+  pure $ DbCrudResult plan resultSet
 
-actionQuery (Db plan@MutateReadPlan{mrMutation=MutationUpdate, ..}) conf apiReq@ApiRequest{iPreferences=Preferences{..}, ..} _ _ = do
+actionQuery (DbCrud plan@MutateReadPlan{mrMutation=MutationUpdate, ..}) conf apiReq@ApiRequest{iPreferences=Preferences{..}, ..} _ _ = do
   resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf
   failNotSingular mrMedia resultSet
   failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
   failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
   optionalRollback conf apiReq
-  pure $ DbResult plan resultSet
+  pure $ DbCrudResult plan resultSet
 
-actionQuery (Db plan@MutateReadPlan{mrMutation=MutationSingleUpsert, ..}) conf apiReq _ _ = do
+actionQuery (DbCrud plan@MutateReadPlan{mrMutation=MutationSingleUpsert, ..}) conf apiReq _ _ = do
   resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf
   failPut resultSet
   optionalRollback conf apiReq
-  pure $ DbResult plan resultSet
+  pure $ DbCrudResult plan resultSet
 
-actionQuery (Db plan@MutateReadPlan{mrMutation=MutationDelete, ..}) conf apiReq@ApiRequest{iPreferences=Preferences{..}, ..} _ _ = do
+actionQuery (DbCrud plan@MutateReadPlan{mrMutation=MutationDelete, ..}) conf apiReq@ApiRequest{iPreferences=Preferences{..}, ..} _ _ = do
   resultSet <- writeQuery mrReadPlan mrMutatePlan mrMedia mrHandler apiReq conf
   failNotSingular mrMedia resultSet
   failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
   failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
   optionalRollback conf apiReq
-  pure $ DbResult plan resultSet
+  pure $ DbCrudResult plan resultSet
 
-actionQuery (Db plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} pgVer _ = do
+actionQuery (DbCall plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} pgVer _ = do
   resultSet <-
     lift . SQL.statement mempty $
       Statements.prepareCall
@@ -131,7 +173,7 @@ actionQuery (Db plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPre
   optionalRollback conf apiReq
   failNotSingular crMedia resultSet
   failExceedsMaxAffectedPref (preferMaxAffected,preferHandling) resultSet
-  pure $ DbResult plan resultSet
+  pure $ DbCallResult plan resultSet
 
 actionQuery (MaybeDb plan@InspectPlan{ipSchema=tSchema}) AppConfig{..} _ pgVer sCache =
   lift $ case configOpenApiMode of
@@ -239,8 +281,8 @@ optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} = do
       preferTransaction == Just Rollback
 
 -- | Set transaction scoped settings
-setPgLocals :: ActionPlan -> AppConfig -> KM.KeyMap JSON.Value -> BS.ByteString -> ApiRequest -> DbHandler ()
+setPgLocals :: DbActionPlan -> AppConfig -> KM.KeyMap JSON.Value -> BS.ByteString -> ApiRequest -> DbHandler ()
-setPgLocals actPlan AppConfig{..} claims role ApiRequest{..} = lift $
+setPgLocals dbActPlan 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
@@ -260,9 +302,9 @@ setPgLocals actPlan AppConfig{..} claims role ApiRequest{..} = lift $
     searchPathSql =
       let schemas = escapeIdentList (iSchema : configDbExtraSearchPath) in
       setConfigWithConstantName ("search_path", schemas)
-    funcSettings = case actPlan of
+    funcSettings = case dbActPlan of
-      Db CallReadPlan{crProc} -> pdFuncSettings crProc
+      DbCall CallReadPlan{crProc} -> pdFuncSettings crProc
-      _                       -> mempty
+      _                           -> mempty
 
 -- | Runs the pre-request function.
 runPreReq :: AppConfig -> DbHandler ()

src/PostgREST/Response.hs

@@ -5,10 +5,7 @@
 {-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE RecordWildCards #-}
 module PostgREST.Response
-  ( infoIdentResponse
+  ( actionResponse
-  , infoProcResponse
-  , infoRootResponse
-  , actionResponse
   , PgrstResponse(..)
   ) where
 
@@ -38,7 +35,9 @@ import PostgREST.ApiRequest.Preferences  (PreferRepresentation (..),
 import PostgREST.ApiRequest.QueryParams  (QueryParams (..))
 import PostgREST.Config                  (AppConfig (..))
 import PostgREST.MediaType               (MediaType (..))
-import PostgREST.Plan                    (DbActionPlan (..),
+import PostgREST.Plan                    (CallReadPlan (..),
+                                          CrudPlan (..),
+                                          InfoPlan (..),
                                           InspectPlan (..))
 import PostgREST.Plan.MutatePlan         (MutatePlan (..))
 import PostgREST.Query                   (QueryResult (..))
@@ -63,9 +62,9 @@ data PgrstResponse = PgrstResponse {
 , pgrstBody    :: LBS.ByteString
 }
 
-actionResponse :: QueryResult -> QualifiedIdentifier -> ApiRequest -> (Text, Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse
+actionResponse :: QueryResult -> ApiRequest -> (Text, Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse
 
-actionResponse (DbResult WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly} resultSet) identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ =
+actionResponse (DbCrudResult WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly, crudQi=identifier} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ =
   case resultSet of
     RSStandard{..} -> do
       let
@@ -94,7 +93,7 @@ actionResponse (DbResult WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly} result
     RSPlan plan ->
       Right $ PgrstResponse HTTP.status200 (contentTypeHeaders wrMedia ctxApiRequest) $ LBS.fromStrict plan
 
-actionResponse (DbResult MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, mrMedia} resultSet) QualifiedIdentifier{..} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} _ _ _ _ _ = case resultSet of
+actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, mrMedia, crudQi=QualifiedIdentifier{..}} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} _ _ _ _ _ = case resultSet of
   RSStandard{..} -> do
     let
       pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;}
@@ -134,7 +133,7 @@ actionResponse (DbResult MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan,
   RSPlan plan ->
     Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
 
-actionResponse (DbResult MutateReadPlan{mrMutation=MutationUpdate, mrMedia} resultSet) _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
+actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationUpdate, mrMedia} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
   RSStandard{..} -> do
     let
       contentRangeHeader =
@@ -156,7 +155,7 @@ actionResponse (DbResult MutateReadPlan{mrMutation=MutationUpdate, mrMedia} resu
   RSPlan plan ->
     Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
 
-actionResponse (DbResult MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia} resultSet) _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
+actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
   RSStandard {..} -> do
     let
       prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling preferTimezone Nothing []
@@ -176,7 +175,7 @@ actionResponse (DbResult MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia
   RSPlan plan ->
     Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
 
-actionResponse (DbResult MutateReadPlan{mrMutation=MutationDelete, mrMedia} resultSet) _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
+actionResponse (DbCrudResult MutateReadPlan{mrMutation=MutationDelete, mrMedia} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} _ _ _ _ _ = case resultSet of
   RSStandard {..} -> do
     let
       contentRangeHeader =
@@ -198,7 +197,7 @@ actionResponse (DbResult MutateReadPlan{mrMutation=MutationDelete, mrMedia} resu
   RSPlan plan ->
     Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
 
-actionResponse (DbResult CallReadPlan{crMedia, crInvMthd=invMethod, crProc=proc} resultSet) _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ = case resultSet of
+actionResponse (DbCallResult CallReadPlan{crMedia, crInvMthd=invMethod, crProc=proc} resultSet) ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} _ _ _ _ _ = case resultSet of
   RSStandard {..} -> do
     let
       (status, contentRange) =
@@ -225,14 +224,12 @@ actionResponse (DbResult CallReadPlan{crMedia, crInvMthd=invMethod, crProc=proc}
   RSPlan plan ->
     Right $ PgrstResponse HTTP.status200 (contentTypeHeaders crMedia ctxApiRequest) $ LBS.fromStrict plan
 
-actionResponse (MaybeDbResult InspectPlan{ipHdrsOnly=headersOnly} body) _ _ versions conf sCache schema negotiatedByProfile =
+actionResponse (MaybeDbResult InspectPlan{ipHdrsOnly=headersOnly} body) _ versions conf sCache schema negotiatedByProfile =
   Right $ PgrstResponse HTTP.status200
     (MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile))
     (maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode versions conf sCache x y z) body)
 
-
+actionResponse (NoDbResult (RelInfoPlan identifier)) _ _ _ sCache _ _ =
-infoIdentResponse :: QualifiedIdentifier -> SchemaCache -> Either Error.Error PgrstResponse
-infoIdentResponse identifier sCache = do
   case HM.lookup identifier (dbTables sCache) of
     Just tbl -> respondInfo $ allowH tbl
     Nothing  -> Left $ Error.ApiRequestError ApiRequestTypes.NotFound
@@ -246,12 +243,11 @@ infoIdentResponse identifier sCache = do
           ["PATCH" | tableUpdatable table] ++
           ["DELETE" | tableDeletable table]
 
-infoProcResponse :: Routine -> Either Error.Error PgrstResponse
+actionResponse (NoDbResult (RoutineInfoPlan CallReadPlan{crProc=proc})) _ _ _ _ _ _
-infoProcResponse proc | pdVolatility proc == Volatile = respondInfo "OPTIONS,POST"
+  | pdVolatility proc == Volatile = respondInfo "OPTIONS,POST"
-                      | otherwise                     = respondInfo "OPTIONS,GET,HEAD,POST"
+  | otherwise                     = respondInfo "OPTIONS,GET,HEAD,POST"
 
-infoRootResponse :: Either Error.Error PgrstResponse
+actionResponse (NoDbResult SchemaInfoPlan) _ _ _ _ _ _ = respondInfo "OPTIONS,GET,HEAD"
-infoRootResponse = respondInfo "OPTIONS,GET,HEAD"
 
 respondInfo :: ByteString -> Either Error.Error PgrstResponse
 respondInfo allowHeader =