refactor: add Query.hs module

* add readQuery
* add createQuery
* update query
* single upsert query
* delete query
* invoke query
* open api query

postgrest.cabal

@@ -56,6 +56,7 @@ library
                       PostgREST.Middleware
                       PostgREST.MediaType
                       PostgREST.OpenAPI
+                      PostgREST.Query
                       PostgREST.Query.QueryBuilder
                       PostgREST.Query.SqlFragment
                       PostgREST.Query.Statements

src/PostgREST/App.hs

@@ -27,24 +27,19 @@ import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
                                  setServerName)
 import System.Posix.Types       (FileMode)
 
-import qualified Data.HashMap.Strict             as HM
+import qualified Data.HashMap.Strict        as HM
-import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
+import qualified Hasql.Transaction.Sessions as SQL
-import qualified Hasql.Transaction               as SQL
+import qualified Network.Wai                as Wai
-import qualified Hasql.Transaction.Sessions      as SQL
+import qualified Network.Wai.Handler.Warp   as Warp
-import qualified Network.Wai                     as Wai
-import qualified Network.Wai.Handler.Warp        as Warp
 
 import qualified PostgREST.Admin                    as Admin
 import qualified PostgREST.AppState                 as AppState
 import qualified PostgREST.Auth                     as Auth
 import qualified PostgREST.Cors                     as Cors
-import qualified PostgREST.DbStructure              as DbStructure
 import qualified PostgREST.Error                    as Error
 import qualified PostgREST.Logger                   as Logger
 import qualified PostgREST.Middleware               as Middleware
-import qualified PostgREST.Query.QueryBuilder       as QueryBuilder
+import qualified PostgREST.Query                    as Query
-import qualified PostgREST.Query.Statements         as Statements
-import qualified PostgREST.RangeQuery               as RangeQuery
 import qualified PostgREST.Request.ApiRequest       as ApiRequest
 import qualified PostgREST.Request.DbRequestBuilder as ReqBuilder
 import qualified PostgREST.Request.MutateQuery      as MutateRequest
@@ -54,28 +49,23 @@ import qualified PostgREST.Response                 as Response
 import PostgREST.AppState                (AppState)
 import PostgREST.Auth                    (AuthResult (..))
 import PostgREST.Config                  (AppConfig (..),
-                                          LogLevel (..),
+                                          LogLevel (..))
-                                          OpenAPIMode (..))
 import PostgREST.Config.PgVersion        (PgVersion (..))
 import PostgREST.DbStructure             (DbStructure (..))
 import PostgREST.DbStructure.Identifiers (FieldName,
                                           QualifiedIdentifier (..),
                                           Schema)
-import PostgREST.DbStructure.Proc        (ProcDescription (..),
+import PostgREST.DbStructure.Proc        (ProcDescription (..))
-                                          ProcVolatility (..))
 import PostgREST.DbStructure.Table       (Table (..))
 import PostgREST.Error                   (Error)
 import PostgREST.MediaType               (MTPlanAttrs (..),
                                           MediaType (..))
-import PostgREST.Query.Statements        (ResultSet (..))
+import PostgREST.Query                   (DbHandler)
 import PostgREST.Request.ApiRequest      (Action (..),
                                           ApiRequest (..),
                                           InvokeMethod (..),
                                           Mutation (..), Target (..))
-import PostgREST.Request.Preferences     (PreferCount (..),
+import PostgREST.Request.Preferences     (PreferRepresentation (..))
-                                          PreferParameters (..),
-                                          PreferRepresentation (..),
-                                          shouldCount)
 import PostgREST.Request.ReadQuery       (ReadRequest, fstFieldNames)
 import PostgREST.Version                 (prettyVersion)
 import PostgREST.Workers                 (connectionWorker, listener)
@@ -93,13 +83,10 @@ data RequestContext = RequestContext
 
 type Handler = ExceptT Error
 
-type DbHandler = Handler SQL.Transaction
-
 type SignalHandlerInstaller = AppState -> IO()
 
 type SocketRunner = Warp.Settings -> Wai.Application -> FileMode -> FilePath -> IO()
 
-
 run :: SignalHandlerInstaller -> Maybe SocketRunner -> AppState -> IO ()
 run installHandlers maybeRunWithSocket appState = do
   conf@AppConfig{..} <- AppState.getConfig appState
@@ -198,7 +185,7 @@ postgrestResponse appState conf@AppConfig{..} maybeDbStructure jsonDbS pgVer Aut
   if iAction apiRequest == ActionInfo then
     pure $ Response.infoResponse (iTarget apiRequest) dbStructure
   else
-    runDbHandler appState (txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements .
+    runDbHandler appState (Query.txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements .
       Middleware.optionalRollback conf apiRequest $
         Middleware.runPgLocals conf authClaims authRole (handleRequest . ctx) apiRequest jsonDbS pgVer
 
@@ -241,49 +228,10 @@ handleRead headersOnly identifier context@RequestContext{..} = do
   req <- liftEither $ readRequest identifier context
   bField <- binaryField context req
 
-  let
+  (resultSet, total) <- Query.readQuery req ctxConfig ctxApiRequest bField
-    ApiRequest{..} = ctxApiRequest
-    AppConfig{..} = ctxConfig
-    countQuery = QueryBuilder.readRequestToCountQuery req
-
-  resultSet <-
-     lift . SQL.statement mempty $
-      Statements.prepareRead
-        (QueryBuilder.readRequestToQuery req)
-        (if iPreferCount == Just EstimatedCount then
-           -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
-           QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
-         else
-           countQuery
-        )
-        (shouldCount iPreferCount)
-        iAcceptMediaType
-        bField
-        configDbPreparedStatements
-
-  failNotSingular iAcceptMediaType resultSet
-  total <- readTotal ctxConfig ctxApiRequest resultSet countQuery
 
   pure $ Response.readResponse headersOnly identifier ctxApiRequest total resultSet
 
-readTotal :: AppConfig -> ApiRequest -> ResultSet -> SQL.Snippet -> DbHandler (Maybe Int64)
-readTotal _ _ RSPlan{} _ = pure Nothing
-readTotal AppConfig{..} ApiRequest{..} RSStandard{rsTableTotal=tableTotal} countQuery =
-  case iPreferCount of
-    Just PlannedCount ->
-      explain
-    Just EstimatedCount ->
-      if tableTotal > (fromIntegral <$> configDbMaxRows) then
-        max tableTotal <$> explain
-      else
-        return tableTotal
-    _ ->
-      return tableTotal
-  where
-    explain =
-      lift . SQL.statement mempty . Statements.preparePlanRows countQuery $
-        configDbPreparedStatements
-
 handleCreate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
 handleCreate identifier context@RequestContext{..} = do
   let
@@ -293,120 +241,50 @@ handleCreate identifier context@RequestContext{..} = do
       else mempty
 
   (mutateReq, readReq) <- liftEither $ writeRequest MutationCreate identifier context pkCols
-  resultSet <- writeQuery mutateReq readReq True pkCols context
 
-  failNotSingular iAcceptMediaType resultSet
+  resultSet <- Query.createQuery mutateReq readReq pkCols ctxApiRequest ctxConfig
 
   pure $ Response.createResponse identifier pkCols ctxApiRequest resultSet
 
 handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
-handleUpdate identifier context@(RequestContext _ _ ctxApiRequest@ApiRequest{..} _) = do
+handleUpdate identifier context@(RequestContext ctxConfig _ ctxApiRequest _) = do
   (mutateReq, readReq) <- liftEither $ writeRequest MutationUpdate identifier context mempty
-  resultSet <- writeQuery mutateReq readReq False mempty context
+  resultSet <- Query.updateQuery mutateReq readReq ctxApiRequest ctxConfig
-  failNotSingular iAcceptMediaType resultSet
-  failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
-
   pure $ Response.updateResponse ctxApiRequest resultSet
 
 handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response
-handleSingleUpsert identifier context@(RequestContext _ ctxDbStructure ctxApiRequest _) = do
+handleSingleUpsert identifier context@(RequestContext ctxConfig ctxDbStructure ctxApiRequest _) = do
   let pkCols = maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
   (mutateReq, readReq) <- liftEither $ writeRequest MutationSingleUpsert identifier context pkCols
-  resultSet <- writeQuery mutateReq readReq False pkCols context
+  resultSet <- Query.singleUpsertQuery mutateReq readReq ctxApiRequest ctxConfig
-  failPut resultSet
   pure $ Response.singleUpsertResponse ctxApiRequest resultSet
 
--- Makes sure the querystring pk matches the payload pk
--- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
--- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.
--- If this condition is not satisfied then nothing is inserted,
--- check the WHERE for INSERT in QueryBuilder.hs to see how it's done
-failPut :: ResultSet -> DbHandler ()
-failPut RSPlan{} = pure ()
-failPut RSStandard{rsQueryTotal=queryTotal} =
-  when (queryTotal /= 1) $ do
-    lift SQL.condemn
-    throwError Error.PutMatchingPkError
-
 handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
-handleDelete identifier context@(RequestContext _ _ ctxApiRequest@ApiRequest{..} _) = do
+handleDelete identifier context@(RequestContext ctxConfig _ ctxApiRequest _) = do
   (mutateReq, readReq) <- liftEither $ writeRequest MutationDelete identifier context mempty
-  resultSet <- writeQuery mutateReq readReq False mempty context
+  resultSet <- Query.deleteQuery mutateReq readReq ctxApiRequest ctxConfig
-  failNotSingular iAcceptMediaType resultSet
-  failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
-
   pure $ Response.deleteResponse ctxApiRequest resultSet
 
 handleInvoke :: InvokeMethod -> ProcDescription -> RequestContext -> DbHandler Wai.Response
 handleInvoke invMethod proc context@RequestContext{..} = do
   let
-    ApiRequest{..} = ctxApiRequest
-
     identifier =
       QualifiedIdentifier
         (pdSchema proc)
         (fromMaybe (pdName proc) $ Proc.procTableName proc)
 
-  req <- liftEither $ readRequest identifier context
+  readReq <- liftEither $ readRequest identifier context
-  bField <- binaryField context req
+  bField <- binaryField context readReq
+  let callReq = ReqBuilder.callRequest proc ctxApiRequest readReq
 
-  let callReq = ReqBuilder.callRequest proc ctxApiRequest req
+  resultSet <- Query.invokeQuery proc callReq readReq ctxApiRequest bField ctxConfig
 
-  resultSet <-
-    lift . SQL.statement mempty $
-      Statements.prepareCall
-        (Proc.procReturnsScalar proc)
-        (Proc.procReturnsSingle proc)
-        (QueryBuilder.requestToCallProcQuery callReq)
-        (QueryBuilder.readRequestToQuery req)
-        (QueryBuilder.readRequestToCountQuery req)
-        (shouldCount iPreferCount)
-        iAcceptMediaType
-        (iPreferParameters == Just MultipleObjects)
-        bField
-        (configDbPreparedStatements ctxConfig)
-
-  failNotSingular iAcceptMediaType resultSet
   pure $ Response.invokeResponse invMethod proc ctxApiRequest resultSet
 
 handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response
-handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest ctxPgVersion) = do
+handleOpenApi headersOnly tSchema (RequestContext conf dbStructure apiRequest pgVer) = do
-  body <-
+  oaiResult <- Query.openApiQuery dbStructure pgVer conf tSchema
-    lift $ case configOpenApiMode of
+  pure $ Response.openApiResponse headersOnly oaiResult conf dbStructure $ iProfile apiRequest
-      OAFollowPriv ->
-        Just <$> ((,,)
-           <$> SQL.statement [tSchema] (DbStructure.accessibleTables ctxPgVersion configDbPreparedStatements)
-           <*> SQL.statement tSchema (DbStructure.accessibleProcs ctxPgVersion configDbPreparedStatements)
-           <*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements))
-      OAIgnorePriv ->
-        Just <$> ((,,)
-              (HM.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ DbStructure.dbTables dbStructure)
-              (HM.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ DbStructure.dbProcs dbStructure)
-          <$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements))
-      OADisabled ->
-        pure Nothing
-
-  pure $ Response.openApiResponse headersOnly body conf dbStructure $ iProfile apiRequest
-
-txMode :: ApiRequest -> SQL.Mode
-txMode ApiRequest{..} =
-  case (iAction, iTarget) of
-    (ActionRead _, _) ->
-      SQL.Read
-    (ActionInfo, _) ->
-      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
 
 writeRequest :: Mutation -> QualifiedIdentifier -> RequestContext -> [FieldName] -> Either Error (MutateRequest.MutateRequest, ReadRequest)
 writeRequest mutation identifier@QualifiedIdentifier{..} context@RequestContext{..} pkCols = do
@@ -414,36 +292,6 @@ writeRequest mutation identifier@QualifiedIdentifier{..} context@RequestContext{
   mutateReq <- ReqBuilder.mutateRequest mutation qiSchema qiName ctxApiRequest pkCols readReq
   pure (mutateReq, readReq)
 
-writeQuery :: MutateRequest.MutateRequest -> ReadRequest -> Bool -> [Text] -> RequestContext -> DbHandler ResultSet
-writeQuery mutateReq readReq isInsert pkCols RequestContext{..} = do
-  lift . SQL.statement mempty $
-    Statements.prepareWrite
-      (QueryBuilder.readRequestToQuery readReq)
-      (QueryBuilder.mutateRequestToQuery mutateReq)
-      isInsert
-      (iAcceptMediaType ctxApiRequest)
-      (iPreferRepresentation ctxApiRequest)
-      pkCols
-      (configDbPreparedStatements ctxConfig)
-
--- |
--- Fail a response if a single JSON object was requested and not exactly one
--- was found.
-failNotSingular :: MediaType -> ResultSet -> DbHandler ()
-failNotSingular _ RSPlan{} = pure ()
-failNotSingular mediaType RSStandard{rsQueryTotal=queryTotal} =
-  when (mediaType == MTSingularJSON && queryTotal /= 1) $ do
-    lift SQL.condemn
-    throwError $ Error.singularityError queryTotal
-
-failsChangesOffLimits :: Maybe Integer -> ResultSet -> DbHandler ()
-failsChangesOffLimits _ RSPlan{} = pure ()
-failsChangesOffLimits Nothing _  = pure ()
-failsChangesOffLimits (Just maxChanges) RSStandard{rsQueryTotal=queryTotal} =
-  when (queryTotal > fromIntegral maxChanges) $ do
-    lift SQL.condemn
-    throwError $ Error.OffLimitsChangesError queryTotal maxChanges
-
 returnsScalar :: ApiRequest.Target -> Bool
 returnsScalar (TargetProc proc _) = Proc.procReturnsScalar proc
 returnsScalar _                   = False

src/PostgREST/Query.hs

@@ -0,0 +1,216 @@
+{-# LANGUAGE RecordWildCards #-}
+module PostgREST.Query
+  ( createQuery
+  , deleteQuery
+  , invokeQuery
+  , openApiQuery
+  , readQuery
+  , singleUpsertQuery
+  , txMode
+  , updateQuery
+  , DbHandler
+  ) where
+
+import qualified Data.HashMap.Strict             as HM
+import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
+import qualified Hasql.Transaction               as SQL
+import qualified Hasql.Transaction.Sessions      as SQL
+
+import qualified PostgREST.DbStructure         as DbStructure
+import qualified PostgREST.DbStructure.Proc    as Proc
+import qualified PostgREST.Error               as Error
+import qualified PostgREST.Query.QueryBuilder  as QueryBuilder
+import qualified PostgREST.Query.Statements    as Statements
+import qualified PostgREST.RangeQuery          as RangeQuery
+import qualified PostgREST.Request.MutateQuery as MutateRequest
+import qualified PostgREST.Request.Types       as ApiRequestTypes
+
+import PostgREST.Config                  (AppConfig (..),
+                                          OpenAPIMode (..))
+import PostgREST.Config.PgVersion        (PgVersion (..))
+import PostgREST.DbStructure             (DbStructure (..))
+import PostgREST.DbStructure.Identifiers (FieldName,
+                                          QualifiedIdentifier (..),
+                                          Schema)
+import PostgREST.DbStructure.Proc        (ProcDescription (..),
+                                          ProcVolatility (..),
+                                          ProcsMap)
+import PostgREST.DbStructure.Table       (TablesMap)
+import PostgREST.Error                   (Error)
+import PostgREST.MediaType               (MediaType (..))
+import PostgREST.Query.Statements        (ResultSet (..))
+import PostgREST.Request.ApiRequest      (Action (..),
+                                          ApiRequest (..),
+                                          InvokeMethod (..),
+                                          Target (..))
+import PostgREST.Request.Preferences     (PreferCount (..),
+                                          PreferParameters (..),
+                                          shouldCount)
+import PostgREST.Request.ReadQuery       (ReadRequest)
+
+import Protolude hiding (Handler)
+
+type DbHandler = ExceptT Error SQL.Transaction
+
+readQuery :: ReadRequest -> AppConfig -> ApiRequest -> Maybe FieldName -> DbHandler (ResultSet, Maybe Int64)
+readQuery req conf@AppConfig{..} apiReq@ApiRequest{..} bField = do
+  let countQuery = QueryBuilder.readRequestToCountQuery req
+  resultSet <-
+     lift . SQL.statement mempty $
+      Statements.prepareRead
+        (QueryBuilder.readRequestToQuery req)
+        (if iPreferCount == Just EstimatedCount then
+           -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
+           QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
+         else
+           countQuery
+        )
+        (shouldCount iPreferCount)
+        iAcceptMediaType
+        bField
+        configDbPreparedStatements
+  failNotSingular iAcceptMediaType resultSet
+  total <- readTotal conf apiReq resultSet countQuery
+  pure (resultSet, total)
+
+readTotal :: AppConfig -> ApiRequest -> ResultSet -> SQL.Snippet -> DbHandler (Maybe Int64)
+readTotal _ _ RSPlan{} _ = pure Nothing
+readTotal AppConfig{..} ApiRequest{..} RSStandard{rsTableTotal=tableTotal} countQuery =
+  case iPreferCount of
+    Just PlannedCount ->
+      explain
+    Just EstimatedCount ->
+      if tableTotal > (fromIntegral <$> configDbMaxRows) then
+        max tableTotal <$> explain
+      else
+        return tableTotal
+    _ ->
+      return tableTotal
+  where
+    explain =
+      lift . SQL.statement mempty . Statements.preparePlanRows countQuery $
+        configDbPreparedStatements
+
+createQuery :: MutateRequest.MutateRequest -> ReadRequest -> [FieldName] -> ApiRequest -> AppConfig -> DbHandler ResultSet
+createQuery mutateReq readReq pkCols apiReq@ApiRequest{..} conf = do
+  resultSet <- writeQuery mutateReq readReq True pkCols apiReq conf
+  failNotSingular iAcceptMediaType resultSet
+  pure resultSet
+
+updateQuery :: MutateRequest.MutateRequest -> ReadRequest -> ApiRequest -> AppConfig -> DbHandler ResultSet
+updateQuery mutateReq readReq apiReq@ApiRequest{..} conf = do
+  resultSet <- writeQuery mutateReq readReq False mempty apiReq conf
+  failNotSingular iAcceptMediaType resultSet
+  failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
+  pure resultSet
+
+singleUpsertQuery :: MutateRequest.MutateRequest -> ReadRequest -> ApiRequest -> AppConfig -> DbHandler ResultSet
+singleUpsertQuery mutateReq readReq apiReq conf = do
+  resultSet <- writeQuery mutateReq readReq False mempty apiReq conf
+  failPut resultSet
+  pure resultSet
+
+-- Makes sure the querystring pk matches the payload pk
+-- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
+-- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.
+-- If this condition is not satisfied then nothing is inserted,
+-- check the WHERE for INSERT in QueryBuilder.hs to see how it's done
+failPut :: ResultSet -> DbHandler ()
+failPut RSPlan{} = pure ()
+failPut RSStandard{rsQueryTotal=queryTotal} =
+  when (queryTotal /= 1) $ do
+    lift SQL.condemn
+    throwError Error.PutMatchingPkError
+
+deleteQuery :: MutateRequest.MutateRequest -> ReadRequest -> ApiRequest -> AppConfig -> DbHandler ResultSet
+deleteQuery mutateReq readReq apiReq@ApiRequest{..} conf = do
+  resultSet <- writeQuery mutateReq readReq False mempty apiReq conf
+  failNotSingular iAcceptMediaType resultSet
+  failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
+  pure resultSet
+
+invokeQuery :: ProcDescription -> ApiRequestTypes.CallRequest -> ReadRequest -> ApiRequest -> Maybe FieldName -> AppConfig -> DbHandler ResultSet
+invokeQuery proc callReq readReq ApiRequest{..} bField AppConfig{..} = do
+  resultSet <-
+    lift . SQL.statement mempty $
+      Statements.prepareCall
+        (Proc.procReturnsScalar proc)
+        (Proc.procReturnsSingle proc)
+        (QueryBuilder.requestToCallProcQuery callReq)
+        (QueryBuilder.readRequestToQuery readReq)
+        (QueryBuilder.readRequestToCountQuery readReq)
+        (shouldCount iPreferCount)
+        iAcceptMediaType
+        (iPreferParameters == Just MultipleObjects)
+        bField
+        configDbPreparedStatements
+
+  failNotSingular iAcceptMediaType resultSet
+  pure resultSet
+
+openApiQuery :: DbStructure -> PgVersion -> AppConfig -> Schema -> DbHandler (Maybe (TablesMap, ProcsMap, Maybe Text))
+openApiQuery dbStructure pgVer AppConfig{..} tSchema =
+  lift $ case configOpenApiMode of
+    OAFollowPriv ->
+      Just <$> ((,,)
+         <$> SQL.statement [tSchema] (DbStructure.accessibleTables pgVer configDbPreparedStatements)
+         <*> SQL.statement tSchema (DbStructure.accessibleProcs pgVer configDbPreparedStatements)
+         <*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements))
+    OAIgnorePriv ->
+      Just <$> ((,,)
+            (HM.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ DbStructure.dbTables dbStructure)
+            (HM.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ DbStructure.dbProcs dbStructure)
+        <$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements))
+    OADisabled ->
+      pure Nothing
+
+txMode :: ApiRequest -> SQL.Mode
+txMode ApiRequest{..} =
+  case (iAction, iTarget) of
+    (ActionRead _, _) ->
+      SQL.Read
+    (ActionInfo, _) ->
+      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 :: MutateRequest.MutateRequest -> ReadRequest -> Bool -> [Text] -> ApiRequest -> AppConfig  -> DbHandler ResultSet
+writeQuery mutateReq readReq isInsert pkCols apiReq conf = do
+  lift . SQL.statement mempty $
+    Statements.prepareWrite
+      (QueryBuilder.readRequestToQuery readReq)
+      (QueryBuilder.mutateRequestToQuery mutateReq)
+      isInsert
+      (iAcceptMediaType apiReq)
+      (iPreferRepresentation apiReq)
+      pkCols
+      (configDbPreparedStatements conf)
+
+-- |
+-- Fail a response if a single JSON object was requested and not exactly one
+-- was found.
+failNotSingular :: MediaType -> ResultSet -> DbHandler ()
+failNotSingular _ RSPlan{} = pure ()
+failNotSingular mediaType RSStandard{rsQueryTotal=queryTotal} =
+  when (mediaType == MTSingularJSON && queryTotal /= 1) $ do
+    lift SQL.condemn
+    throwError $ Error.singularityError queryTotal
+
+failsChangesOffLimits :: Maybe Integer -> ResultSet -> DbHandler ()
+failsChangesOffLimits _ RSPlan{} = pure ()
+failsChangesOffLimits Nothing _  = pure ()
+failsChangesOffLimits (Just maxChanges) RSStandard{rsQueryTotal=queryTotal} =
+  when (queryTotal > fromIntegral maxChanges) $ do
+    lift SQL.condemn
+    throwError $ Error.OffLimitsChangesError queryTotal maxChanges
+