test(spec): Move metrics state helpers from JwtCacheSpec to SpecHelpers

Refactoring: State validation helpers used in JwtCacheSpec moved to SpecHelper
to make them available in other Spec modules.

test/spec/Feature/Auth/JwtCacheSpec.hs

@@ -13,17 +13,13 @@ where
 import Network.Wai (Application)
 
 import Network.HTTP.Types
-import Test.Hspec         (Expectation, SpecWith, describe, it,
-                           shouldBe)
+import Test.Hspec         (SpecWith, describe, it)
 import Test.Hspec.Wai
 
-import Data.String                     (String)
-import PostgREST.Metrics               (MetricsState (..))
-import Prometheus                      (getCounter)
+import PostgREST.Metrics   (MetricsState (..))
 import Protolude
 import SpecHelper
-import Test.Hspec.Expectations.Contrib (annotate)
-import Test.Hspec.Wai.JSON             (json)
+import Test.Hspec.Wai.JSON (json)
 
 spec :: SpecWith (MetricsState, Application)
 spec = describe "Server started with JWT and metrics enabled" $ do
@@ -143,25 +139,8 @@ spec = describe "Server started with JWT and metrics enabled" $ do
       *> request methodGet "/authors_only" [jwt3] ""
 
   where
-      counterToInt = second (fmap (round @Double @Int) . getCounter)
-      expectCounters = stateCheck . fmap (\(g, h) -> StateCheck (counterToInt . g) (flip shouldBe . h))
       genToken = authHeaderJWT . generateJWT
-      requests = (,) (getF @"jwtCacheRequests")
-      hits = (,) (getF @"jwtCacheHits")
-      evictions = (,) (getF @"jwtCacheEvictions")
-
-
--- should be moved to helpers???
-getF :: forall s r a. (KnownSymbol s, HasField s r a) => r -> (String, a)
-getF r = (symbolVal (Proxy @s), getField @s r)
-
-data StateCheck st = forall a. (Show a, Eq a) => StateCheck (st -> (String, WaiSession st a)) (a -> a -> Expectation)
-
-stateCheck :: (Traversable t) => t (StateCheck st) -> WaiSession st a -> WaiSession st ()
-stateCheck checks act = do
-  metrics <- getState
-  expectations <- traverse (\(StateCheck g expect) -> let (msg, m) = g metrics in m >>= createExpectation msg m . expect) checks
-  void act
-  sequenceA_ expectations
-  where
-    createExpectation msg metrics expect = pure $ metrics >>= liftIO . annotate msg . expect
+      requests = expectCounter @"jwtCacheRequests"
+      hits = expectCounter @"jwtCacheHits"
+      evictions = expectCounter @"jwtCacheEvictions"
+      expectCounters = checkState

test/spec/SpecHelper.hs

@@ -1,4 +1,10 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE AllowAmbiguousTypes       #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts          #-}
+{-# LANGUAGE RankNTypes                #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+{-# LANGUAGE TupleSections             #-}
+{-# LANGUAGE TypeApplications          #-}
 module SpecHelper where
 
 import           Control.Lens           ((^?))
@@ -36,8 +42,10 @@ import PostgREST.Config                  (AppConfig (..),
                                           OpenAPIMode (..),
                                           parseSecret)
 import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
+import Prometheus                        (Counter, getCounter)
 import Protolude                         hiding (get, toS)
 import Protolude.Conv                    (toS)
+import Test.Hspec.Expectations.Contrib   (annotate)
 
 filterAndMatchCT :: BS.ByteString -> MatchHeader
 filterAndMatchCT val = MatchHeader $ \headers _ ->
@@ -346,3 +354,29 @@ getInsertDataForTiobePlsTable rows =
 
 readFixtureFile :: FilePath -> BL.ByteString
 readFixtureFile file = unsafePerformIO $ BL.readFile $ "test/spec/fixtures/" <> file
+
+-- state check helpers
+
+data StateCheck st m = forall a. StateCheck (st -> (String, m a)) (a -> a -> Expectation)
+
+stateCheck :: (Show a, Eq a) => (c -> m a) -> (st -> (String, c)) -> (a -> a) -> StateCheck st m
+stateCheck extractValue extractComponent expect = StateCheck (second extractValue . extractComponent) (flip shouldBe . expect)
+
+expectField :: forall s st a c m. (KnownSymbol s, Show a, Eq a, HasField s st c) => (c -> m a) -> (a -> a) -> StateCheck st m
+expectField extractValue = stateCheck extractValue ((symbolVal (Proxy @s),) . getField @s)
+
+checkState :: (Traversable t) => t (StateCheck st (WaiSession st)) -> WaiSession st b -> WaiSession st ()
+checkState checks act = getState >>= flip (`checkState'` checks) act
+
+checkState' :: (Traversable t, MonadIO m) => st -> t (StateCheck st m) -> m b -> m ()
+checkState' initialState checks act = do
+  expectations <- traverse (\(StateCheck g expect) -> let (msg, m) = g initialState in m >>= createExpectation msg m . expect) checks
+  void act
+  sequenceA_ expectations
+  where
+    createExpectation msg metrics expect = pure $ metrics >>= liftIO . annotate msg . expect
+
+expectCounter :: forall s st m. (KnownSymbol s, HasField s st Counter, MonadIO m) => (Int -> Int) -> StateCheck st m
+expectCounter = expectField @s intCounter
+  where
+    intCounter = ((round @Double @Int) <$>) . getCounter