Michał KłeczekandSteve Chavez
5d4f82d70f
Emit a dedicated PoolFlushed observation when the DB pool is released during schema cache reload.
52 lines
2.1 KiB
Haskell
52 lines
2.1 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE MonadComprehensions #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Observation.SchemaCacheSpec where
|
|
|
|
import Network.Wai (Application)
|
|
import ObsHelper
|
|
import qualified PostgREST.AppState as AppState
|
|
import PostgREST.Config (configDbSchemas)
|
|
import PostgREST.Observation
|
|
import Protolude
|
|
import Test.Hspec (SpecWith, describe, it)
|
|
import Test.Hspec.Wai (getState)
|
|
|
|
spec :: SpecWith (SpecState, Application)
|
|
spec = describe "Server started with metrics enabled" $ do
|
|
|
|
it "Should emit PoolFlushed, SchemaCacheQueriedObs and SchemaCacheLoadedObs when schema cache is reloaded" $ do
|
|
SpecState{specAppState = appState, specObsChan} <- getState
|
|
let waitFor = waitForObs specObsChan
|
|
|
|
liftIO $ do
|
|
AppState.schemaCacheLoader appState
|
|
|
|
waitFor (1 * sec) "PoolFlushed" $ \x -> [ o | o@PoolFlushed <- pure x ]
|
|
waitFor (1 * sec) "SchemaCacheQueriedObs" $ \x -> [ o | o@SchemaCacheQueriedObs{} <- pure x ]
|
|
waitFor (1 * sec) "SchemaCacheLoadedObs" $ \x -> [ o | o@SchemaCacheLoadedObs{} <- pure x ]
|
|
|
|
|
|
it "Should flush pool multiple times when schema reloading retries" $ do
|
|
SpecState{specAppState = appState, specObsChan} <- getState
|
|
let waitFor = waitForObs specObsChan
|
|
|
|
liftIO $ do
|
|
AppState.getConfig appState >>= \cfg -> do
|
|
AppState.putConfig appState $ cfg { configDbSchemas = pure "bad_schema" }
|
|
AppState.schemaCacheLoader appState
|
|
|
|
waitFor (1 * sec) "PoolFlushed 1" $ \x -> [ o | o@PoolFlushed <- pure x ]
|
|
waitFor (1 * sec) "SchemaCacheErrorObs" $ \x -> [ o | o@SchemaCacheErrorObs{} <- pure x ]
|
|
|
|
-- Restore configuration
|
|
AppState.putConfig appState cfg
|
|
|
|
-- Wait for 2 seconds so that retry can happen
|
|
waitFor (2 * sec) "PoolFlushed 2" $ \x -> [ o | o@PoolFlushed <- pure x ]
|
|
waitFor (1 * sec) "SchemaCacheQueriedObs" $ \x -> [ o | o@SchemaCacheQueriedObs{} <- pure x ]
|
|
waitFor (1 * sec) "SchemaCacheLoadedObs" $ \x -> [ o | o@SchemaCacheLoadedObs{} <- pure x ]
|
|
|
|
where
|
|
sec = 1000000
|