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 LambdaCase #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE RecursiveDo #-}
|
||||||
|
|
||||||
module PostgREST.AppState
|
module PostgREST.AppState
|
||||||
( AppState
|
( AppState
|
||||||
@@ -45,7 +46,6 @@ import PostgREST.Version (prettyVersion)
|
|||||||
|
|
||||||
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
|
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
|
||||||
updateAction)
|
updateAction)
|
||||||
import Control.Debounce
|
|
||||||
import Control.Retry (RetryPolicy, RetryStatus (..), capDelay,
|
import Control.Retry (RetryPolicy, RetryStatus (..), capDelay,
|
||||||
exponentialBackoff, retrying,
|
exponentialBackoff, retrying,
|
||||||
rsPreviousDelay)
|
rsPreviousDelay)
|
||||||
@@ -117,15 +117,23 @@ init conf@AppConfig{configLogLevel, configDbPoolSize} = do
|
|||||||
pool <- initPool conf observer
|
pool <- initPool conf observer
|
||||||
initWithPool pool conf loggerState metricsState observer --{ stateSocketREST = sock, stateSocketAdmin = adminSock}
|
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 :: 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
|
appState <- AppState pool
|
||||||
<$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step
|
<$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step
|
||||||
<*> newIORef Nothing
|
<*> newIORef Nothing
|
||||||
<*> newSchemaCacheStatus
|
<*> newSchemaCacheStatus
|
||||||
<*> newIORef False
|
<*> newIORef False
|
||||||
<*> pure (pure ())
|
<*> simpleDebounce (retryingSchemaCacheLoad appState *> threadDelay 100000) -- 100ms cooldown
|
||||||
<*> newIORef conf
|
<*> newIORef conf
|
||||||
<*> mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
|
<*> mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
|
||||||
<*> myThreadId
|
<*> myThreadId
|
||||||
@@ -136,15 +144,7 @@ initWithPool pool conf loggerState metricsState observer = do
|
|||||||
<*> pure loggerState
|
<*> pure loggerState
|
||||||
<*> pure metricsState
|
<*> pure metricsState
|
||||||
|
|
||||||
deb <-
|
return appState
|
||||||
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}
|
|
||||||
|
|
||||||
destroy :: AppState -> IO ()
|
destroy :: AppState -> IO ()
|
||||||
destroy = destroyPool
|
destroy = destroyPool
|
||||||
|
|||||||
Reference in New Issue
Block a user