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.
This commit is contained in:
Robert Vollmert
2022-08-02 09:24:14 +02:00
committed by Robert
parent 401b98c5b4
commit 1d15060c63
+8 -9
View File
@@ -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 $