Fix metrics names and tags.

lolepezy · Feb 11, 2022 · 2640779 · 2640779
1 parent e653401
commit 2640779
Show file tree

Hide file tree

Showing 5 changed files with 33 additions and 23 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -238,6 +238,7 @@ createAppContext cliOptions@CLIOptions{..} logger derivedLogLevel = do
                 & #lmdbSizeMb .~ lmdbRealSize            
                 & #localExceptions .~ localExceptions    
                 & #logLevel .~ derivedLogLevel                
+                & maybeSet #metricsPrefix (convert <$> metricsPrefix)
     }
 
     logInfoM logger [i|Created application context: #{appContext ^. typed @Config}|]
@@ -518,7 +519,10 @@ data CLIOptions wrapped = CLIOptions {
         "Timebox for one TA validation in seconds (default is 1 hours, i.e. 3600 seconds).",
 
     noRrdp :: wrapped ::: Bool <?> "Do not fetch RRDP repositories (default is false)",
-    noRsync :: wrapped ::: Bool <?> "Do not fetch rsync repositories (default is false)"
+    noRsync :: wrapped ::: Bool <?> "Do not fetch rsync repositories (default is false)",
+
+    metricsPrefix :: wrapped ::: Maybe String <?> 
+        "Prefix for Prometheus metrics (default is 'rpki_prover')."
 
 } deriving (Generic)
 

diff --git a/src/RPKI/Config.hs b/src/RPKI/Config.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StrictData #-}
 
 module RPKI.Config where
@@ -12,7 +12,8 @@ import Codec.Serialise
 import GHC.Conc
 import Numeric.Natural
 import Data.Int
-import Data.Word
+import Data.Text (Text)
+import Data.Word ( Word16 )
 
 import Data.Hourglass
 import Data.Maybe (fromMaybe)
@@ -48,7 +49,8 @@ data Config = Config {
         storageCompactionInterval :: Seconds,
         lmdbSizeMb                :: Size,
         localExceptions           :: [FilePath],
-        logLevel                  :: LogLevel
+        logLevel                  :: LogLevel,
+        metricsPrefix             :: Text
     } 
     deriving stock (Show, Eq, Ord, Generic)
     deriving anyclass (Serialise)
@@ -187,7 +189,8 @@ defaultConfig = Config {
     storageCompactionInterval = Seconds $ 60 * 60 * 24,
     lmdbSizeMb                = Size $ 32 * 1024,
     localExceptions = [],
-    logLevel = defaultsLogLevel
+    logLevel = defaultsLogLevel,
+    metricsPrefix = "rpki_prover_"
 }
 
 defaultRtrConfig :: RtrConfig

diff --git a/src/RPKI/Http/HttpServer.hs b/src/RPKI/Http/HttpServer.hs
@@ -27,7 +27,6 @@ import qualified Data.Map.Monoidal.Strict         as MonoidalMap
 import           Data.Text                       (Text)
 
 import           RPKI.AppContext
-import           RPKI.Config
 import           RPKI.AppTypes
 import           RPKI.AppState
 import           RPKI.Domain

diff --git a/src/RPKI/Metrics/Prometheus.hs b/src/RPKI/Metrics/Prometheus.hs
@@ -24,6 +24,7 @@ import           GHC.Generics
 
 import           Prometheus
 import           Prometheus.Metric.GHC
+import           RPKI.Config
 import           RPKI.Domain
 import           RPKI.Reporting
 import           RPKI.Metrics.Metrics
@@ -33,36 +34,40 @@ data PrometheusMetrics = PrometheusMetrics {
         rrdpCode        :: Vector Text Gauge,
         downloadTime    :: Vector Text Gauge,
         vrpCounter      :: Vector Text Gauge,
-        uniqueVrpNumber :: Vector Text Gauge,
+        vrpCounterPerRepo :: Vector Text Gauge,
+        uniqueVrpNumber   :: Vector Text Gauge,
         validObjectNumberPerTa   :: Vector (Text, Text) Gauge,
         validObjectNumberPerRepo :: Vector (Text, Text) Gauge
     }
     deriving (Generic)
 
 
-createPrometheusMetrics :: MonadIO m => m PrometheusMetrics
-createPrometheusMetrics = do
+createPrometheusMetrics :: MonadIO m => Config -> m PrometheusMetrics
+createPrometheusMetrics Config {..} = do
 
     void $ register ghcMetrics
 
     rrdpCode <- register
             $ vector ("url" :: Text)
-            $ gauge (Info "rpki_prover_rrdp_http_code" "HTTP code of the RRDP response")
+            $ gauge (Info (metricsPrefix <> "rrdp_http_code") "HTTP code of the RRDP response")
     downloadTime <- register
             $ vector ("url" :: Text)
-            $ gauge (Info "rpki_prover_download_time" "Time of downloading repository (ms)")
+            $ gauge (Info (metricsPrefix <> "download_time") "Time of downloading repository (ms)")
     vrpCounter <- register
             $ vector ("trustanchor" :: Text)
-            $ gauge (Info "rpki_prover_vrp_number" "Number of original VRPs")
+            $ gauge (Info (metricsPrefix <> "vrp_total") "Number of original VRPs")
+    vrpCounterPerRepo <- register
+            $ vector ("repository" :: Text)
+            $ gauge (Info (metricsPrefix <> "vrp_total") "Number of original VRPs")            
     uniqueVrpNumber <- register
             $ vector ("trustanchor" :: Text)
-            $ gauge (Info "rpki_prover_unique_vrp_number" "Number of unique VRPs")
+            $ gauge (Info (metricsPrefix <> "unique_vrp_total") "Number of unique VRPs")
     validObjectNumberPerTa <- register
             $ vector ("trustanchor", "type")
-            $ gauge (Info "rpki_prover_object_number" "Number of valid objects of different types per TA")
+            $ gauge (Info (metricsPrefix <> "object_total") "Number of valid objects of different types per TA")
     validObjectNumberPerRepo <- register
             $ vector ("repository", "type")
-            $ gauge (Info "rpki_prover_object_number" "Number of valid objects of different types per repository")
+            $ gauge (Info (metricsPrefix <> "object_total") "Number of valid objects of different types per repository")
 
     pure $ PrometheusMetrics {..}
 
@@ -84,18 +89,17 @@ updatePrometheus rm@RawMetric {..} PrometheusMetrics {..} = do
     let grouped = groupedValidationMetric rm
 
     forM_ (MonoidalMap.toList $ grouped ^. #byTa) $ \(TaName name, metric) ->
-        setObjectMetricsPerUrl validObjectNumberPerTa name metric True
+        setObjectMetricsPerUrl validObjectNumberPerTa name metric True vrpCounter
     forM_ (MonoidalMap.toList $ grouped ^. #byRepository) $ \(rpkiUrl, metric) -> 
-        setObjectMetricsPerUrl validObjectNumberPerRepo (unURI $ getURL rpkiUrl) metric False
-
-  where
-
+        setObjectMetricsPerUrl validObjectNumberPerRepo (unURI $ getURL rpkiUrl) 
+            metric False vrpCounterPerRepo
+  where      
     setValidObjects prometheusVector url tag count = withLabel prometheusVector (url, tag)
             $ flip setGauge
             $ fromIntegral $ unCount count
 
-    setObjectMetricsPerUrl prometheusVector url metric setUniqueVRPs = do
-        withLabel vrpCounter url $ flip setGauge $ fromIntegral $ unCount $ metric ^. #vrpCounter
+    setObjectMetricsPerUrl prometheusVector url metric setUniqueVRPs vrpCounter' = do
+        withLabel vrpCounter' url $ flip setGauge $ fromIntegral $ unCount $ metric ^. #vrpCounter
 
         when setUniqueVRPs $ withLabel uniqueVrpNumber url $ 
             flip setGauge $ fromIntegral $ unCount $ metric ^. #uniqueVrpNumber

diff --git a/src/RPKI/Workflow.hs b/src/RPKI/Workflow.hs
@@ -68,7 +68,7 @@ runWorkflow appContext@AppContext {..} tals = do
     rtrServer <- initRtrIfNeeded
 
     -- Initialise prometheus metrics here
-    prometheusMetrics <- createPrometheusMetrics
+    prometheusMetrics <- createPrometheusMetrics config
 
     -- Run threads that periodicallly generate tasks and one thread that 
     -- executes the tasks. Tasks are put into the queue after having been