Skip to content

Commit abfcb63

Browse files
mkleczekmkleczek
committed
refactor(test): provide means to validate metrics and observations
DISCLAIMER: This commit was authored entirely by a human without the assistance of LLMs. Some helpers are provided for introspecting metrics already (used in JWT cache tests). This change provides facilities to additionally validate emited Observation events. A new Spec module is also implemented, adding basic tests of schema cache reloading - their main goal is to excercise the new infrastructure.
1 parent ae7d4d2 commit abfcb63

7 files changed

Lines changed: 195 additions & 28 deletions

File tree

‎postgrest.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -307,6 +307,7 @@ test-suite observability
307307
main-is: Main.hs
308308
other-modules: ObsHelper
309309
Observation.JwtCache
310+
Observation.MetricsSpec
310311
build-depends: base >= 4.9 && < 4.20
311312
, base64-bytestring >= 1 && < 1.3
312313
, bytestring >= 0.10.8 && < 0.13
@@ -321,6 +322,7 @@ test-suite observability
321322
, postgrest
322323
, prometheus-client >= 1.1.1 && < 1.2.0
323324
, protolude >= 0.3.1 && < 0.4
325+
, text >= 1.2.2 && < 2.2
324326
, wai >= 3.2.1 && < 3.3
325327
ghc-options: -threaded -O0 -Werror -Wall -fwarn-identities
326328
-fno-spec-constr -optP-Wno-nonportable-include-path

‎src/PostgREST/AppState.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ module PostgREST.AppState
1515
, getJwtCacheState
1616
, init
1717
, initWithPool
18+
, putConfig -- For tests TODO refactoring
1819
, putNextListenerDelay
1920
, putSchemaCache
2021
, putPgVersion

‎src/PostgREST/Observation.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE DeriveGeneric #-}
12
{-|
23
Module : PostgREST.Observation
34
Description : This module holds an Observation type which is the core of Observability for PostgREST.
@@ -56,6 +57,7 @@ data Observation
5657
| JwtCacheEviction
5758
| TerminationUnixSignalObs Text
5859
| WarpErrorObs Text
60+
deriving (Generic)
5961

6062
data ObsFatalError = ServerAuthError | ServerPgrstBug | ServerError42P05 | ServerError08P01
6163

‎test/observability/Main.hs‎

Lines changed: 21 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -15,39 +15,54 @@ import qualified PostgREST.Metrics as Metrics
1515
import PostgREST.SchemaCache (querySchemaCache)
1616

1717
import qualified Observation.JwtCache
18+
import qualified Observation.MetricsSpec
1819

1920
import ObsHelper
20-
import Protolude hiding (toList, toS)
21+
import PostgREST.Observation (Observation (HasqlPoolObs))
22+
import Protolude hiding (toList, toS)
2123
import Test.Hspec
2224

2325
main :: IO ()
2426
main = do
27+
poolChan <- newChan
28+
-- make sure poolChan is not growing indefinitely
29+
-- start a thread that drains the channel
30+
-- this is necessary because test cases operate on
31+
-- copies so poolChan is never read from
32+
void $ forkIO $ forever $ readChan poolChan
33+
metricsState <- Metrics.init (configDbPoolSize testCfg)
2534
pool <- P.acquire $ P.settings
2635
[ P.size 3
2736
, P.acquisitionTimeout 10
2837
, P.agingTimeout 60
2938
, P.idlenessTimeout 60
3039
, P.staticConnectionSettings (toUtf8 $ configDbUri testCfg)
40+
-- make sure metrics are updated and pool observations published to poolChan
41+
, P.observationHandler $ (writeChan poolChan <> Metrics.observationMetrics metricsState) . HasqlPoolObs
3142
]
3243

3344
actualPgVersion <- either (panic . show) id <$> P.use pool (queryPgVersion False)
3445

3546
-- cached schema cache so most tests run fast
3647
baseSchemaCache <- loadSCache pool testCfg
3748
loggerState <- Logger.init
38-
metricsState <- Metrics.init (configDbPoolSize testCfg)
3949

4050
let
41-
initApp sCache st config = do
42-
appState <- AppState.initWithPool pool config loggerState metricsState (Metrics.observationMetrics metricsState)
51+
initApp sCache config = do
52+
-- duplicate poolChan as a starting point
53+
obsChan <- dupChan poolChan
54+
stateObsChan <- newObsChan obsChan
55+
appState <- AppState.initWithPool pool config loggerState metricsState (Metrics.observationMetrics metricsState <> writeChan obsChan)
4356
AppState.putPgVersion appState actualPgVersion
4457
AppState.putSchemaCache appState (Just sCache)
45-
return (st, postgrest (configLogLevel config) appState (pure ()))
58+
return (SpecState appState metricsState stateObsChan, postgrest (configLogLevel config) appState (pure ()))
4659

4760
-- Run all test modules
4861
hspec $ do
49-
before (initApp baseSchemaCache metricsState testCfgJwtCache) $
62+
before (initApp baseSchemaCache testCfgJwtCache) $
5063
describe "Observation.JwtCacheObs" Observation.JwtCache.spec
64+
before (initApp baseSchemaCache testCfg) $
65+
describe "Feature.MetricsSpec" Observation.MetricsSpec.spec
5166

5267
where
5368
loadSCache pool conf =

‎test/observability/ObsHelper.hs‎

Lines changed: 99 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -1,31 +1,41 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE DeriveAnyClass #-}
23
{-# LANGUAGE ExistentialQuantification #-}
34
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE FlexibleInstances #-}
6+
{-# LANGUAGE RankNTypes #-}
47
{-# LANGUAGE ScopedTypeVariables #-}
58
{-# LANGUAGE TupleSections #-}
69
{-# LANGUAGE TypeApplications #-}
10+
{-# LANGUAGE TypeOperators #-}
711
module ObsHelper where
812

9-
import qualified Data.ByteString.Base64 as B64 (decodeLenient)
10-
import qualified Data.ByteString.Char8 as BS
11-
import qualified Data.ByteString.Lazy as BL
12-
import qualified Jose.Jwa as JWT
13-
import qualified Jose.Jws as JWT
14-
import qualified Jose.Jwt as JWT
15-
16-
import PostgREST.Config (AppConfig (..), JSPathExp (..),
17-
LogLevel (..), OpenAPIMode (..),
18-
Verbosity (..), parseSecret)
19-
20-
import Data.List.NonEmpty (fromList)
21-
import Data.String (String)
22-
import Prometheus (Counter, getCounter)
23-
import Test.Hspec.Expectations.Contrib (annotate)
24-
25-
import Network.HTTP.Types
26-
import Protolude
27-
import Test.Hspec
28-
import Test.Hspec.Wai
13+
import qualified Data.ByteString as BS
14+
import qualified Data.ByteString.Base64 as B64
15+
import qualified Data.ByteString.Lazy as BL
16+
import qualified Data.List as DL
17+
import Data.List.NonEmpty (fromList)
18+
import Data.String (String)
19+
import qualified Data.Text as T
20+
import qualified Jose.Jwa as JWT
21+
import qualified Jose.Jws as JWT
22+
import qualified Jose.Jwt as JWT
23+
import Network.HTTP.Types
24+
import qualified PostgREST.AppState as AppState
25+
import PostgREST.Config (AppConfig (..),
26+
JSPathExp (..),
27+
LogLevel (..),
28+
OpenAPIMode (..),
29+
Verbosity (..),
30+
parseSecret)
31+
import qualified PostgREST.Metrics as Metrics
32+
import PostgREST.Observation (Observation (..))
33+
import Prometheus (Counter, getCounter)
34+
import Protolude hiding (get, toS)
35+
import System.Timeout (timeout)
36+
import Test.Hspec
37+
import Test.Hspec.Expectations.Contrib (annotate)
38+
import Test.Hspec.Wai
2939

3040

3141
baseCfg :: AppConfig
@@ -133,3 +143,72 @@ expectCounter :: forall s st m. (KnownSymbol s, HasField s st Counter, MonadIO m
133143
expectCounter = expectField @s intCounter
134144
where
135145
intCounter = ((round @Double @Int) <$>) . getCounter
146+
147+
data TimeoutException = TimeoutException deriving (Show, Exception)
148+
149+
accumulateUntilTimeout :: Int -> (s -> a -> s) -> s -> IO a -> IO s
150+
accumulateUntilTimeout t f start act = do
151+
tid <- myThreadId
152+
-- mask to make sure TimeoutException is not thrown before starting the loop
153+
mask $ \unmask -> do
154+
-- start timeout thread unmasking exceptions
155+
ttid <- forkIOWithUnmask ($ (threadDelay t *> throwTo tid TimeoutException))
156+
-- unmask effect
157+
unmask (fix (\loop accum -> (act >>= loop . f accum) `onTimeout` pure accum) start)
158+
-- make sure we catch timeout if happens before entering the loop
159+
`onTimeout` pure start
160+
-- make sure timer thread is killed on other exceptions
161+
-- so that it won't throw TimeoutException later
162+
`onException` killThread ttid
163+
where
164+
onTimeout m a = m `catch` \TimeoutException -> a
165+
166+
data ObsChan = ObsChan (Chan Observation) (Chan Observation)
167+
168+
newObsChan :: Chan Observation -> IO ObsChan
169+
newObsChan = fmap <$> ObsChan <*> dupChan
170+
171+
-- read messages from copy chan and once condition is met drain original to the same point
172+
-- upon timeout report error and messages remaining in the original chan
173+
-- that way we report messages since last successful read
174+
waitForObs :: HasCallStack => ObsChan -> Int -> Text -> (Observation -> Maybe a) -> IO ()
175+
waitForObs (ObsChan orig copy) t msg f =
176+
timeout t (readUntil copy *> readUntil orig) >>= maybe failTimeout mempty
177+
where
178+
failTimeout = takeUntilTimeout decisecond (readChan orig)
179+
>>= expectationFailure . DL.unlines . fmap show . (failureMessageHeader :) . fmap obsDiagMessage
180+
failureMessageHeader = "Timeout waiting for " <> msg <> " at " <> loc <> ". Remaining observations:"
181+
readUntil = void . untilM (pure . not . null . f) . readChan
182+
loc = fromMaybe "(unknown)" . head $ (T.pack . prettySrcLoc . snd <$> getCallStack callStack)
183+
-- execute effectful computation until result meets provided condition
184+
untilM cond m = fix $ \loop -> m >>= \a -> ifM (cond a) (pure a) loop
185+
-- duplicate the provided channel and construct wairFor function binding both channels
186+
-- accumulate effecful computation results into a list for specified time
187+
takeUntilTimeout t' = fmap reverse . accumulateUntilTimeout t' (flip (:)) []
188+
obsDiagMessage (HasqlPoolObs o) = show o
189+
obsDiagMessage o@(DBListenStart host port name channel) = constrName o <> show (host, port, name, channel)
190+
obsDiagMessage o = constrName o
191+
decisecond = 100000
192+
193+
data SpecState = SpecState {
194+
specAppState :: AppState.AppState,
195+
specMetrics :: Metrics.MetricsState,
196+
specObsChan :: ObsChan
197+
}
198+
199+
-- helpers used to produce observation diagnostics in waitForObs
200+
constrName :: (HasConstructor (Rep a), Generic a)=> a -> Text
201+
constrName = genericConstrName . from
202+
203+
class HasConstructor f where
204+
genericConstrName :: f x -> Text
205+
206+
instance HasConstructor f => HasConstructor (D1 c f) where
207+
genericConstrName (M1 x) = genericConstrName x
208+
209+
instance (HasConstructor x, HasConstructor y) => HasConstructor (x :+: y) where
210+
genericConstrName (L1 l) = genericConstrName l
211+
genericConstrName (R1 r) = genericConstrName r
212+
213+
instance Constructor c => HasConstructor (C1 c f) where
214+
genericConstrName = T.pack . conName

‎test/observability/Observation/JwtCache.hs‎

Lines changed: 16 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE NamedFieldPuns #-}
23
{-# LANGUAGE TypeApplications #-}
34
module Observation.JwtCache where
45

@@ -13,9 +14,11 @@ import PostgREST.Metrics (MetricsState (..))
1314
import Protolude
1415
import Test.Hspec.Wai.JSON (json)
1516

16-
spec :: SpecWith (MetricsState, Application)
17+
spec :: SpecWith (SpecState, Application)
1718
spec = describe "Server started with JWT and metrics enabled" $ do
1819
it "Should not have JWT in cache" $ do
20+
expectCounters <- checkState' . specMetrics <$> getState
21+
1922
let auth = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe1"}|]
2023

2124
expectCounters
@@ -27,6 +30,8 @@ spec = describe "Server started with JWT and metrics enabled" $ do
2730
request methodGet "/authors_only" [auth] "" `shouldRespondWith` 200
2831

2932
it "Should have JWT in cache" $ do
33+
expectCounters <- checkState' . specMetrics <$> getState
34+
3035
let auth = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe2"}|]
3136

3237
expectCounters
@@ -39,6 +44,8 @@ spec = describe "Server started with JWT and metrics enabled" $ do
3944
*> request methodGet "/authors_only" [auth] "" `shouldRespondWith` 200
4045

4146
it "Should not cache invalid JWTs" $ do
47+
expectCounters <- checkState' . specMetrics <$> getState
48+
4249
let auth = authHeaderJWT "some random bytes"
4350

4451
expectCounters
@@ -51,6 +58,8 @@ spec = describe "Server started with JWT and metrics enabled" $ do
5158
*> request methodGet "/authors_only" [auth] "" `shouldRespondWith` 401
5259

5360
it "Should cache expired JWTs" $ do
61+
expectCounters <- checkState' . specMetrics <$> getState
62+
5463
let auth = genToken [json|{"exp": 1, "role": "postgrest_test_author", "id": "jdoe2"}|]
5564

5665
expectCounters
@@ -63,6 +72,8 @@ spec = describe "Server started with JWT and metrics enabled" $ do
6372
*> request methodGet "/authors_only" [auth] "" `shouldRespondWith` 401
6473

6574
it "Should evict entries from the JWT cache (jwt cache max is 2)" $ do
75+
expectCounters <- checkState' . specMetrics <$> getState
76+
6677
let jwt1 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe3"}|]
6778
jwt2 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe4"}|]
6879
jwt3 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe5"}|]
@@ -82,6 +93,8 @@ spec = describe "Server started with JWT and metrics enabled" $ do
8293
*> request methodGet "/authors_only" [jwt3] ""
8394

8495
it "Should not evict entries from the JWT cache in FIFO order" $ do
96+
expectCounters <- checkState' . specMetrics <$> getState
97+
8598
let jwt1 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe6"}|]
8699
jwt2 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe7"}|]
87100
jwt3 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe8"}|]
@@ -108,6 +121,8 @@ spec = describe "Server started with JWT and metrics enabled" $ do
108121
-- The test case was added based on coverage report
109122
-- showing this scenario was not covered by previous tests
110123
it "Should evict entries even though all were hit" $ do
124+
expectCounters <- checkState' . specMetrics <$> getState
125+
111126
let jwt1 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe9"}|]
112127
jwt2 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe10"}|]
113128
jwt3 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe11"}|]
@@ -135,4 +150,3 @@ spec = describe "Server started with JWT and metrics enabled" $ do
135150
requests = expectCounter @"jwtCacheRequests"
136151
hits = expectCounter @"jwtCacheHits"
137152
evictions = expectCounter @"jwtCacheEvictions"
138-
expectCounters = checkState

‎test/observability/Observation/MetricsSpec.hs‎

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,54 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE FlexibleContexts #-}
3+
{-# LANGUAGE MonadComprehensions #-}
4+
{-# LANGUAGE NamedFieldPuns #-}
5+
{-# LANGUAGE TypeApplications #-}
6+
7+
module Observation.MetricsSpec where
8+
9+
import Data.List (lookup)
10+
import Network.Wai (Application)
11+
import ObsHelper
12+
import qualified PostgREST.AppState as AppState
13+
import PostgREST.Config (AppConfig (configDbSchemas))
14+
import qualified PostgREST.Metrics as Metrics
15+
import PostgREST.Observation
16+
import Prometheus (getCounter, getVectorWith)
17+
import Protolude
18+
import Test.Hspec (SpecWith, describe, it)
19+
import Test.Hspec.Wai (getState)
20+
21+
spec :: SpecWith (SpecState, Application)
22+
spec = describe "Server started with metrics enabled" $ do
23+
it "Should update pgrst_schema_cache_loads_total[SUCCESS]" $ do
24+
SpecState{specAppState = appState, specMetrics = metrics, specObsChan} <- getState
25+
let waitFor = waitForObs specObsChan
26+
27+
liftIO $ checkState' metrics [
28+
schemaCacheLoads "SUCCESS" (+1)
29+
] $ do
30+
AppState.schemaCacheLoader appState
31+
waitFor (1 * sec) "SchemaCacheLoadedObs" $ \x -> [ o | o@(SchemaCacheLoadedObs{}) <- pure x]
32+
33+
it "Should update pgrst_schema_cache_loads_total[ERROR]" $ do
34+
SpecState{specAppState = appState, specMetrics = metrics, specObsChan} <- getState
35+
let waitFor = waitForObs specObsChan
36+
37+
liftIO $ checkState' metrics [
38+
schemaCacheLoads "FAIL" (+1),
39+
schemaCacheLoads "SUCCESS" (+1)
40+
] $ do
41+
AppState.getConfig appState >>= \prev -> do
42+
AppState.putConfig appState $ prev { configDbSchemas = pure "bad_schema" }
43+
AppState.schemaCacheLoader appState
44+
waitFor (1 * sec) "SchemaCacheErrorObs" $ \x -> [ o | o@(SchemaCacheErrorObs{}) <- pure x]
45+
AppState.putConfig appState prev
46+
47+
-- wait up to 2 secs so that retry can happen
48+
waitFor (2 * sec) "SchemaCacheLoadedObs" $ \x -> [ o | o@(SchemaCacheLoadedObs{}) <- pure x]
49+
50+
where
51+
-- prometheus-client api to handle vectors is convoluted
52+
schemaCacheLoads label = expectField @"schemaCacheLoads" $
53+
fmap (maybe (0::Int) round . lookup label) . (`getVectorWith` getCounter)
54+
sec = 1000000

0 commit comments

Comments
 (0)