refactor: Remove unnecessary lazy initialization of stateLogDebouncePoolTimeout

stateLogDebouncePoolTimeout is an MVar initialized on the first logging of PoolAcqTimeoutObs. The code in logWithDebounce has race condition that could lead to creation of multiple debouncers.

This change simplifies logic by getting rid of lazy initialization of debouncer.
This commit is contained in:
Michał Kłeczek
2026-02-15 13:14:10 -05:00
committed by Steve Chavez
parent d6816d8d2a
commit ca96328142
+15 -23
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
{-| {-|
Module : PostgREST.Logger Module : PostgREST.Logger
Description : Logging based on the Observation.hs module. Access logs get sent to stdout and server diagnostic get sent to stderr. Description : Logging based on the Observation.hs module. Access logs get sent to stdout and server diagnostic get sent to stderr.
@@ -39,29 +40,21 @@ import Protolude
data LoggerState = LoggerState data LoggerState = LoggerState
{ stateGetZTime :: IO ZonedTime -- ^ Time with time zone used for logs { stateGetZTime :: IO ZonedTime -- ^ Time with time zone used for logs
, stateLogDebouncePoolTimeout :: MVar (IO ()) -- ^ Logs with a debounce , stateLogDebouncePoolTimeout :: IO () -- ^ Logs with a debounce
} }
init :: IO LoggerState init :: IO LoggerState
init = do init = mdo
let
oneSecond = 1000000
loggerState = LoggerState zTime debouncePoolTimeout
zTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime } zTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
LoggerState zTime <$> newEmptyMVar debouncePoolTimeout <- mkDebounce defaultDebounceSettings
{ debounceAction = logWithZTime loggerState $ observationMessage PoolAcqTimeoutObs
logWithDebounce :: LoggerState -> IO () -> IO () , debounceFreq = 5*oneSecond
logWithDebounce loggerState action = do , debounceEdge = leadingEdge -- logs at the start and the end
debouncer <- tryReadMVar $ stateLogDebouncePoolTimeout loggerState }
case debouncer of pure loggerState
Just d -> d
Nothing -> do
newDebouncer <-
let oneSecond = 1000000 in
mkDebounce defaultDebounceSettings
{ debounceAction = action
, debounceFreq = 5*oneSecond
, debounceEdge = leadingEdge -- logs at the start and the end
}
putMVar (stateLogDebouncePoolTimeout loggerState) newDebouncer
newDebouncer
-- 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
middleware :: LogLevel -> (Wai.Request -> Maybe BS.ByteString) -> Wai.Middleware middleware :: LogLevel -> (Wai.Request -> Maybe BS.ByteString) -> Wai.Middleware
@@ -88,10 +81,9 @@ shouldLogResponse logLevel = case logLevel of
-- All observations are logged except some that depend on the log-level -- All observations are logged except some that depend on the log-level
observationLogger :: LoggerState -> LogLevel -> ObservationHandler observationLogger :: LoggerState -> LogLevel -> ObservationHandler
observationLogger loggerState logLevel obs = case obs of observationLogger loggerState logLevel obs = case obs of
o@PoolAcqTimeoutObs -> do PoolAcqTimeoutObs -> do
when (logLevel >= LogError) $ do when (logLevel >= LogError) $
logWithDebounce loggerState $ stateLogDebouncePoolTimeout loggerState
logWithZTime loggerState $ observationMessage o
o@(QueryErrorCodeHighObs _) -> do o@(QueryErrorCodeHighObs _) -> do
when (logLevel >= LogError) $ do when (logLevel >= LogError) $ do
logWithZTime loggerState $ observationMessage o logWithZTime loggerState $ observationMessage o