diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index a96e49fa2..e276fe2df 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecursiveDo #-} module PostgREST.AppState ( AppState @@ -45,7 +46,6 @@ import PostgREST.Version (prettyVersion) import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction) -import Control.Debounce import Control.Retry (RetryPolicy, RetryStatus (..), capDelay, exponentialBackoff, retrying, rsPreviousDelay) @@ -117,15 +117,23 @@ init conf@AppConfig{configLogLevel, configDbPoolSize} = do pool <- initPool conf observer initWithPool pool conf loggerState metricsState observer --{ stateSocketREST = sock, stateSocketAdmin = adminSock} +simpleDebounce :: IO () -> IO (IO ()) +simpleDebounce act = do + flag <- newEmptyMVar + void $ forkIO $ forever $ do + takeMVar flag + act + pure (void $ tryPutMVar flag ()) + initWithPool :: SQL.Pool -> AppConfig -> Logger.LoggerState -> Metrics.MetricsState -> ObservationHandler -> IO AppState -initWithPool pool conf loggerState metricsState observer = do +initWithPool pool conf loggerState metricsState observer = mdo appState <- AppState pool <$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step <*> newIORef Nothing <*> newIORef SCPending <*> newIORef False - <*> pure (pure ()) + <*> simpleDebounce (retryingSchemaCacheLoad appState *> threadDelay 100000) -- 100ms cooldown <*> newIORef conf <*> mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime } <*> myThreadId @@ -136,15 +144,7 @@ initWithPool pool conf loggerState metricsState observer = do <*> pure loggerState <*> pure metricsState - deb <- - let decisecond = 100000 in - mkDebounce defaultDebounceSettings - { debounceAction = retryingSchemaCacheLoad appState - , debounceFreq = decisecond - , debounceEdge = leadingEdge -- runs the worker at the start and the end - } - - return appState { debouncedSCacheLoader = deb} + return appState destroy :: AppState -> IO () destroy = destroyPool