refactor: move debounceLogAcquisitionTimeout

Move it to AppState
This commit is contained in:
steve-chavez
2023-06-06 14:41:37 -05:00
committed by Steve Chavez
parent 54b9a0b8b3
commit 9a19dff83e
2 changed files with 9 additions and 9 deletions
+2 -7
View File
@@ -20,7 +20,7 @@ module PostgREST.App
import Control.Monad.Except (liftEither) import Control.Monad.Except (liftEither)
import Data.Either.Combinators (mapLeft, whenLeft) import Data.Either.Combinators (mapLeft)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.String (IsString (..)) import Data.String (IsString (..))
import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort, import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
@@ -28,7 +28,6 @@ import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
import System.Posix.Types (FileMode) import System.Posix.Types (FileMode)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import qualified Hasql.Pool as SQL
import qualified Hasql.Transaction.Sessions as SQL import qualified Hasql.Transaction.Sessions as SQL
import qualified Network.Wai as Wai import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp as Warp
@@ -158,11 +157,7 @@ runDbHandler :: AppState.AppState -> Maybe Text -> SQL.Mode -> Bool -> Bool -> D
runDbHandler appState isoLvl mode authenticated prepared handler = do runDbHandler appState isoLvl mode authenticated prepared handler = do
dbResp <- lift $ do dbResp <- lift $ do
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
res <- AppState.usePool appState . transaction (toIsolationLevel isoLvl) mode $ runExceptT handler AppState.usePool appState . transaction (toIsolationLevel isoLvl) mode $ runExceptT handler
whenLeft res (\case
SQL.AcquisitionTimeoutUsageError -> AppState.debounceLogAcquisitionTimeout appState -- this can happen rapidly for many requests, so we debounce
_ -> pure ())
return res
resp <- resp <-
liftEither . mapLeft Error.PgErr $ liftEither . mapLeft Error.PgErr $
+7 -2
View File
@@ -18,7 +18,6 @@ module PostgREST.AppState
, putSchemaCache , putSchemaCache
, putPgVersion , putPgVersion
, usePool , usePool
, debounceLogAcquisitionTimeout
, loadSchemaCache , loadSchemaCache
, reReadConfig , reReadConfig
, connectionWorker , connectionWorker
@@ -27,6 +26,7 @@ module PostgREST.AppState
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import Data.Either.Combinators (whenLeft)
import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding as T
import Hasql.Connection (acquire) import Hasql.Connection (acquire)
import qualified Hasql.Notifications as SQL import qualified Hasql.Notifications as SQL
@@ -140,7 +140,12 @@ initPool AppConfig{..} =
-- | Run an action with a database connection. -- | Run an action with a database connection.
usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a) usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a)
usePool AppState{..} = SQL.use statePool usePool AppState{..} x = do
res <- SQL.use statePool x
whenLeft res (\case
SQL.AcquisitionTimeoutUsageError -> debounceLogAcquisitionTimeout -- this can happen rapidly for many requests, so we debounce
_ -> pure ())
return res
-- | Flush the connection pool so that any future use of the pool will -- | Flush the connection pool so that any future use of the pool will
-- use connections freshly established after this call. -- use connections freshly established after this call.