Skip to content

Commit

Permalink
refactor: AppState.usePool for App
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
robx committed Aug 2, 2022
1 parent 401b98c commit 1d15060
Showing 1 changed file with 8 additions and 9 deletions.
17 changes: 8 additions & 9 deletions src/PostgREST/App.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 <-
Expand All @@ -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 $
Expand Down

0 comments on commit 1d15060

Please sign in to comment.