refactor: remove usage of Control.Debounce

This change replaces usage of Control.Debounce in Logger with makeDebouncer function extracted from AppState to a new module PostgREST.Debounce.
This commit is contained in:
Michał Kłeczek
2026-04-10 12:22:08 -05:00
committed by Steve Chavez
parent f4fc29855e
commit 381e12efa2
4 changed files with 24 additions and 20 deletions
+1
View File
@@ -55,6 +55,7 @@ library
PostgREST.Client PostgREST.Client
PostgREST.Config PostgREST.Config
PostgREST.Config.Database PostgREST.Config.Database
PostgREST.Debounce
PostgREST.Config.JSPath PostgREST.Config.JSPath
PostgREST.Config.PgVersion PostgREST.Config.PgVersion
PostgREST.Config.Proxy PostgREST.Config.Proxy
+1 -14
View File
@@ -62,6 +62,7 @@ import PostgREST.Config.Database (queryDbSettings,
queryRoleSettings) queryRoleSettings)
import PostgREST.Config.PgVersion (PgVersion (..), import PostgREST.Config.PgVersion (PgVersion (..),
minimumPgVersion) minimumPgVersion)
import PostgREST.Debounce (makeDebouncer)
import PostgREST.SchemaCache (SchemaCache (..), import PostgREST.SchemaCache (SchemaCache (..),
querySchemaCache, querySchemaCache,
showSummary) showSummary)
@@ -117,20 +118,6 @@ init conf@AppConfig{configLogLevel, configDbPoolSize} = do
pool <- initPool conf observer pool <- initPool conf observer
initWithPool pool conf loggerState metricsState observer initWithPool pool conf loggerState metricsState observer
-- Make a new debouncer action. An internal "worker" thread runs forever ensuring "action" runs when the "trigger" is called. The "action" is only executed once over a burst of calls.
makeDebouncer :: IO () -> IO (IO ())
makeDebouncer action = do
flag <- newEmptyMVar
let worker = forever $ do
takeMVar flag
action
let trigger = void $ tryPutMVar flag ()
void $ forkIO worker
pure trigger
initWithPool :: SQL.Pool -> AppConfig -> Logger.LoggerState -> Metrics.MetricsState -> ObservationHandler -> IO AppState initWithPool :: SQL.Pool -> AppConfig -> Logger.LoggerState -> Metrics.MetricsState -> ObservationHandler -> IO AppState
initWithPool pool conf loggerState metricsState observer = mdo initWithPool pool conf loggerState metricsState observer = mdo
+19
View File
@@ -0,0 +1,19 @@
module PostgREST.Debounce
( makeDebouncer) where
import Protolude
-- | Make a new debouncer action. An internal "worker" thread runs forever
-- ensuring "action" runs when the "trigger" is called. The "action" is only
-- executed once over a burst of calls.
makeDebouncer :: IO () -> IO (IO ())
makeDebouncer action = do
flag <- newEmptyMVar
let worker = forever $ do
takeMVar flag
action
trigger = void $ tryPutMVar flag ()
void $ forkIO worker
pure trigger
+3 -6
View File
@@ -16,7 +16,6 @@ module PostgREST.Logger
import Control.AutoUpdate (defaultUpdateSettings, import Control.AutoUpdate (defaultUpdateSettings,
mkAutoUpdate, mkAutoUpdate,
updateAction) updateAction)
import Control.Debounce
import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS
import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding as T
import qualified Hasql.Decoders as HD import qualified Hasql.Decoders as HD
@@ -34,6 +33,7 @@ import Network.HTTP.Types.Status (Status, status400, status500)
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import PostgREST.Config (LogLevel (..), Verbosity (..)) import PostgREST.Config (LogLevel (..), Verbosity (..))
import PostgREST.Debounce (makeDebouncer)
import PostgREST.Observation import PostgREST.Observation
import PostgREST.Query (MainQuery (..)) import PostgREST.Query (MainQuery (..))
@@ -58,11 +58,8 @@ init = mdo
oneSecond = 1000000 oneSecond = 1000000
loggerState = LoggerState zTime debouncePoolTimeout loggerState = LoggerState zTime debouncePoolTimeout
zTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime } zTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
debouncePoolTimeout <- mkDebounce defaultDebounceSettings debouncePoolTimeout <- makeDebouncer $
{ debounceAction = logWithZTime loggerState $ observationMessages PoolAcqTimeoutObs logWithZTime loggerState (observationMessages PoolAcqTimeoutObs) *> threadDelay (5 * oneSecond)
, debounceFreq = 5*oneSecond
, debounceEdge = leadingEdge -- logs at the start and the end
}
pure loggerState pure loggerState
-- TODO stop using this middleware to reuse the same "observer" pattern for all our logs -- TODO stop using this middleware to reuse the same "observer" pattern for all our logs