From 1d15060c63a75ccd00b10d030b58b5605faf871e Mon Sep 17 00:00:00 2001
From: Robert Vollmert <rob@vllmrt.net>
Date: Mon, 1 Aug 2022 11:32:56 +0200
Subject: [PATCH] refactor: AppState.usePool for App

This is a bit ugly, it would be a bit nicer to just pass
'AppState.usePool appState' but then the types get messy.
Or we could introduce our own 'Pool' wrapper type.
---
 src/PostgREST/App.hs | 17 ++++++++---------
 1 file changed, 8 insertions(+), 9 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index c5322100a2..973af53f14 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -31,7 +31,6 @@ import qualified Data.ByteString.Lazy            as LBS
 import qualified Data.HashMap.Strict             as HM
 import qualified Data.Set                        as S
 import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
-import qualified Hasql.Pool                      as SQL
 import qualified Hasql.Transaction               as SQL
 import qualified Hasql.Transaction.Sessions      as SQL
 import qualified Network.HTTP.Types.Header       as HTTP
@@ -168,7 +167,7 @@ postgrest logLevel appState connWorker =
         let
           eitherResponse :: IO (Either Error Wai.Response)
           eitherResponse =
-            runExceptT $ postgrestResponse conf maybeDbStructure jsonDbS pgVer (AppState.getPool appState) authResult req
+            runExceptT $ postgrestResponse appState conf maybeDbStructure jsonDbS pgVer authResult req
 
         response <- either Error.errorResponseFor identity <$> eitherResponse
         -- Launch the connWorker when the connection is down.  The postgrest
@@ -186,15 +185,15 @@ addRetryHint shouldAdd appState response = do
   return $ Wai.mapResponseHeaders (\hs -> if shouldAdd then h:hs else hs) response
 
 postgrestResponse
-  :: AppConfig
+  :: AppState.AppState
+  -> AppConfig
   -> Maybe DbStructure
   -> ByteString
   -> PgVersion
-  -> SQL.Pool
   -> AuthResult
   -> Wai.Request
   -> Handler IO Wai.Response
-postgrestResponse conf@AppConfig{..} maybeDbStructure jsonDbS pgVer pool AuthResult{..} req = do
+postgrestResponse appState conf@AppConfig{..} maybeDbStructure jsonDbS pgVer AuthResult{..} req = do
   body <- lift $ Wai.strictRequestBody req
 
   dbStructure <-
@@ -213,15 +212,15 @@ postgrestResponse conf@AppConfig{..} maybeDbStructure jsonDbS pgVer pool AuthRes
   if iAction apiRequest == ActionInfo then
     handleInfo (iTarget apiRequest) (ctx apiRequest)
   else
-    runDbHandler pool (txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements .
+    runDbHandler appState (txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements .
       Middleware.optionalRollback conf apiRequest $
         Middleware.runPgLocals conf authClaims authRole (handleRequest . ctx) apiRequest jsonDbS pgVer
 
-runDbHandler :: SQL.Pool -> SQL.Mode -> Bool -> Bool -> DbHandler a -> Handler IO a
-runDbHandler pool mode authenticated prepared handler = do
+runDbHandler :: AppState.AppState -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
+runDbHandler appState mode authenticated prepared handler = do
   dbResp <-
     let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
-    lift . SQL.use pool . transaction SQL.ReadCommitted mode $ runExceptT handler
+    lift . AppState.usePool appState . transaction SQL.ReadCommitted mode $ runExceptT handler
 
   resp <-
     liftEither . mapLeft Error.PgErr $