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:
committed by
Steve Chavez
parent
f4fc29855e
commit
381e12efa2
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user