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.

postgrest.cabal

@@ -55,6 +55,7 @@ library
                       PostgREST.Client
                       PostgREST.Config
                       PostgREST.Config.Database
+                      PostgREST.Debounce
                       PostgREST.Config.JSPath
                       PostgREST.Config.PgVersion
                       PostgREST.Config.Proxy

src/PostgREST/AppState.hs

@@ -62,6 +62,7 @@ import PostgREST.Config.Database         (queryDbSettings,
                                           queryRoleSettings)
 import PostgREST.Config.PgVersion        (PgVersion (..),
                                           minimumPgVersion)
+import PostgREST.Debounce                (makeDebouncer)
 import PostgREST.SchemaCache             (SchemaCache (..),
                                           querySchemaCache,
                                           showSummary)
@@ -117,20 +118,6 @@ init conf@AppConfig{configLogLevel, configDbPoolSize} = do
   pool <- initPool conf 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 pool conf loggerState metricsState observer = mdo
 

src/PostgREST/Debounce.hs

@@ -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

src/PostgREST/Logger.hs

@@ -16,7 +16,6 @@ module PostgREST.Logger
 import           Control.AutoUpdate                (defaultUpdateSettings,
                                                     mkAutoUpdate,
                                                     updateAction)
-import           Control.Debounce
 import qualified Data.ByteString.Char8             as BS
 import qualified Data.Text.Encoding                as T
 import qualified Hasql.Decoders                    as HD
@@ -34,6 +33,7 @@ import Network.HTTP.Types.Status (Status, status400, status500)
 import System.IO.Unsafe          (unsafePerformIO)
 
 import PostgREST.Config      (LogLevel (..), Verbosity (..))
+import PostgREST.Debounce    (makeDebouncer)
 import PostgREST.Observation
 import PostgREST.Query       (MainQuery (..))
 
@@ -58,11 +58,8 @@ init = mdo
     oneSecond = 1000000
     loggerState = LoggerState zTime debouncePoolTimeout
   zTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
-  debouncePoolTimeout <- mkDebounce defaultDebounceSettings
-          { debounceAction = logWithZTime loggerState $ observationMessages PoolAcqTimeoutObs
-          , debounceFreq = 5*oneSecond
-          , debounceEdge = leadingEdge -- logs at the start and the end
-          }
+  debouncePoolTimeout <- makeDebouncer $
+    logWithZTime loggerState (observationMessages PoolAcqTimeoutObs) *> threadDelay (5 * oneSecond)
   pure loggerState
 
 -- TODO stop using this middleware to reuse the same "observer" pattern for all our logs