2 files changed, 27 insertions(+), 8 deletions(-)

M src/LogParser/Cache.hs
M test/CacheSpec.hs

@@ 12,6 12,7 @@ module LogParser.Cache
   , cacheLookup
   , cacheLookup'
   , assertCacheSize
+  , assertCacheMetrics
   )
 where
 


@@ 183,3 184,16 @@ assertCacheSize sz cache = do
     throwIO (AssertionFailed $ "Hashes in the data store and age list don't match")
   when (not . Set.null $ Map.foldl' Set.intersection Set.empty dataAge) $
     throwIO (AssertionFailed $ "Duplicate elements in the age list")
+
+assertCacheMetrics :: Double -> [(Text,Double)] -> Double -> Cache a -> IO ()
+assertCacheMetrics _ _ _ (Cache _) = throwIO (AssertionFailed $ "Uninstrumented cache")
+assertCacheMetrics popExp qExp evExp (InstrumentedCache CM{metricPopulation,metricQueries,metricEvictions} _) = do
+  popVal <- getGauge metricPopulation
+  qVals <- Map.fromList <$> getVectorWith metricQueries getCounter
+  evVal <- getCounter metricEvictions
+  when (popVal /= popExp) $
+    throwIO (AssertionFailed $ "Expected population gauge of " <> show popExp <> " but got " <> show popVal)
+  forM_ qExp $ \(lbl,expect) -> when (Just expect /= Map.lookup lbl qVals) $
+    throwIO (AssertionFailed $ "Expected query counter of " <> show expect <> " for label " <> show lbl <> " but got " <> show (Map.lookup lbl qVals))
+  when (evVal /= evExp) $
+    throwIO (AssertionFailed $ "Expected eviction counter of " <> show evExp <> " but got " <> show evVal)

@@ 1,3 1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module CacheSpec (spec) where
 
 import Control.Concurrent


@@ 20,45 21,49 @@ spec = do
   describe "cache" $ do
     it "retrieves items" $
       ( do
-          c <- emptyCache Nothing nominalDay 1
-          i <- cacheInsert' now "foo" c
+          c <- emptyCache (Just "") nominalDay 1
+          i <- cacheInsert' now ("foo" :: String) c
           cacheLookup' now i c
             <* assertCacheSize 1 c
+            <* assertCacheMetrics 1 [("hit",1)] 0 c
       )
       `shouldReturn`
       Just "foo"
 
     it "prunes based on size" $
       ( do
-          c <- emptyCache Nothing nominalDay 2
-          i1 <- cacheInsert' now "foo" c
+          c <- emptyCache (Just "") nominalDay 2
+          i1 <- cacheInsert' now ("foo" :: String) c
           i2 <- cacheInsert' (nowPlus 1)  "bar" c
           i3 <- cacheInsert' (nowPlus 2) "baz" c
           mapM (\i -> cacheLookup' (nowPlus 3) i c) [i1, i2, i3]
             <* assertCacheSize 2 c
+            <* assertCacheMetrics 2 [("hit",2),("miss",1)] 1 c
       )
       `shouldReturn`
       [Nothing, Just "bar", Just "baz"]
 
     it "prunes based on time" $
       ( do
-          c <- emptyCache Nothing (secondsToNominalDiffTime 3) 5
-          i1 <- cacheInsert' now "foo" c
+          c <- emptyCache (Just "") (secondsToNominalDiffTime 3) 5
+          i1 <- cacheInsert' now ("foo" :: String) c
           i2 <- cacheInsert' (nowPlus 2) "bar" c
           mapM (\i -> cacheLookup' (nowPlus 4) i c) [i1, i2]
             <* assertCacheSize 1 c
+            <* assertCacheMetrics 1 [("hit",1),("miss",1)] 1 c
       )
       `shouldReturn`
       [Nothing, Just "bar"]
 
     it "refreshes the timeout" $
       ( do
-          c <- emptyCache Nothing (secondsToNominalDiffTime 4) 5
-          i1 <- cacheInsert' now "foo" c
+          c <- emptyCache (Just "") (secondsToNominalDiffTime 4) 5
+          i1 <- cacheInsert' now ("foo" :: String) c
           i2 <- cacheInsert' (nowPlus 1) "bar" c
           r1 <- cacheLookup' (nowPlus 3) i1 c
           (r1:) <$> mapM (\i -> cacheLookup' (nowPlus 6) i c) [i1,i2]
             <* assertCacheSize 1 c
+            <* assertCacheMetrics 1 [("hit",2),("miss",1)] 1 c
       )
       `shouldReturn`
       [Just "foo", Just "foo", Nothing]