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