refactor: Simplify schema cache loading triggering logic
DISCLAIMER: This commit was authored entirely by a human without the assistance of LLMs. Using debouncer to trigger schema cache loading makes it difficult to understand when exactly it is triggered.
This commit is contained in:
committed by
Steve Chavez
parent
ff068aa1b7
commit
a4c1d945ee
+12
-12
@@ -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
|
||||
<*> newSchemaCacheStatus
|
||||
<*> 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
|
||||
|
||||
Reference in New Issue
Block a user