From 5929bd4d2b6ae49b3ef55e757a8d1aa929bde9f7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Nicklisch-Franken?= Date: Mon, 1 Sep 2025 09:25:17 -0500 Subject: [PATCH 1/2] First running testcase --- cabal.project | 5 ++ .../Cardano/Logging/Prometheus/TCPServer.hs | 25 ++++--- ...trace-dispatcher-prometheus-simple-test.hs | 68 +++++++++++++++++++ trace-dispatcher/trace-dispatcher.cabal | 45 ++++++++++-- 4 files changed, 128 insertions(+), 15 deletions(-) create mode 100644 trace-dispatcher/test/trace-dispatcher-prometheus-simple-test.hs diff --git a/cabal.project b/cabal.project index 25874410b4e..1e47164859e 100644 --- a/cabal.project +++ b/cabal.project @@ -32,6 +32,11 @@ packages: trace-resources trace-forward +source-repository-package + type: git + location: https://github.com/jutaro/cardano-prometheus-tracker.git + tag: af73c6217850ac6bf07ad26d8faa985f391eddf3 + -- Needed when cross compiling extra-packages: alex diff --git a/trace-dispatcher/src/Cardano/Logging/Prometheus/TCPServer.hs b/trace-dispatcher/src/Cardano/Logging/Prometheus/TCPServer.hs index 8073dcb0160..1f5ad345392 100644 --- a/trace-dispatcher/src/Cardano/Logging/Prometheus/TCPServer.hs +++ b/trace-dispatcher/src/Cardano/Logging/Prometheus/TCPServer.hs @@ -1,15 +1,16 @@ -- | Run a simple Prometheus TCP server, responding *only* to the '/metrics' URL with current Node metrics -module Cardano.Logging.Prometheus.TCPServer (runPrometheusSimple) where +module Cardano.Logging.Prometheus.TCPServer (spawnPrometheusSimple, runPrometheusSimple) where import Cardano.Logging.Prometheus.Exposition (renderExpositionFromSample) import Cardano.Logging.Prometheus.NetworkRun -import Control.Concurrent.Async (async, link) +import Control.Concurrent.Async (Async, async, link) import qualified Control.Exception as E import Control.Monad (when) import Data.ByteString (ByteString) import Data.ByteString.Builder import qualified Data.ByteString.Char8 as BC +import Data.Functor (($>)) import Data.Int (Int64) import Data.List (find, intersperse) import Data.Text.Lazy (Text) @@ -23,16 +24,22 @@ import System.Metrics as EKG (Store, sampleAll) import System.Posix.Types (EpochTime) import System.PosixCompat.Time (epochTime) - --- Will provide a 'Just errormessage' iff creating the Prometheus server failed -runPrometheusSimple :: EKG.Store -> (Bool, Maybe HostName, PortNumber) -> IO (Maybe String) -runPrometheusSimple ekgStore (noSuffixes, mHost, portNo) = +spawnPrometheusSimple :: EKG.Store -> (Bool, Maybe HostName, PortNumber) -> IO (Either String (Async ())) +spawnPrometheusSimple ekgStore (noSuffixes, mHost, portNo) = E.try createRunner >>= \case - Left (E.SomeException e) -> pure (Just $ E.displayException e) - Right runner -> async runner >>= link >> pure Nothing + Left (E.SomeException e) -> pure (Left $ E.displayException e) + Right runner -> Right <$> async runner where getCurrentExposition = renderExpositionFromSample noSuffixes <$> sampleAll ekgStore - createRunner = mkTCPServerRunner (defaultRunParams "PrometheusSimple") mHost portNo (serveAccepted getCurrentExposition) + createRunner = + putStrLn ("Port Number: " <> show portNo) >> + mkTCPServerRunner (defaultRunParams "PrometheusSimple") mHost portNo (serveAccepted getCurrentExposition) + +-- Will provide a 'Just errormessage' iff creating the Prometheus server failed +runPrometheusSimple :: EKG.Store -> (Bool, Maybe HostName, PortNumber) -> IO (Maybe String) +runPrometheusSimple ekgStore args = spawnPrometheusSimple ekgStore args >>= \case + Left err -> pure $ Just err + Right as -> link as $> Nothing -- serves an incoming connection; will release socket upon remote close, inactivity timeout or runRecvMaxSize bytes received serveAccepted :: IO Text -> TimeoutServer () diff --git a/trace-dispatcher/test/trace-dispatcher-prometheus-simple-test.hs b/trace-dispatcher/test/trace-dispatcher-prometheus-simple-test.hs new file mode 100644 index 00000000000..3301cf9d039 --- /dev/null +++ b/trace-dispatcher/test/trace-dispatcher-prometheus-simple-test.hs @@ -0,0 +1,68 @@ +import Cardano.Logging (metricsFormatter) +import Cardano.Logging.Configuration (configureTracers) +import Cardano.Logging.Prometheus.TCPServer (spawnPrometheusSimple) +import Cardano.Logging.Trace (traceWith) +import Cardano.Logging.Tracer.EKG (ekgTracer) +import Cardano.Logging.Types + +import Control.Concurrent (threadDelay) +import Control.Concurrent.Async (cancel) +import Control.Monad (unless) +import Data.Aeson +import qualified Data.Map.Internal as Map +import Data.Text (pack) +import Network.HTTP.Client (defaultManagerSettings, newManager) +import Network.HTTP.PrometheusTracker (scrapeOnce) +import Network.HTTP.PrometheusTracker.Types (MetricsMap (MM), MetricsValue (MVDouble)) +import System.Exit (die) +import System.Metrics (newStore) +import System.Posix.Signals + +newtype Measure = Measure Int + +instance LogFormatting Measure where + forMachine _dtal (Measure count) = + mconcat + [ "count" .= String (pack $ show count) + ] + asMetrics (Measure count) = + [ DoubleM "measure" (fromIntegral count)] + +instance MetaTrace Measure where + namespaceFor (Measure _count) = Namespace [] ["Count"] + severityFor (Namespace [] ["Count"]) _ = Just Info + privacyFor (Namespace [] ["Count"]) _ = Just Public + documentFor (Namespace [] ["Count"]) = Just "A counter" + metricsDocFor (Namespace [] ["Count"]) = + [("count", "an integer")] + allNamespaces = [Namespace [] ["Count"]] + +{- Thread #1: + - Run the prometheus simple server + - Trace a metric + - Spawn Thread #2 + - Wait + + Thread #2: + - Scape the metrics + - Ensure that we see the expected metric and its value in the list +-} +main :: IO () +main = do + store <- newStore + let host = "localhost" + let port = 9090 + Right metricsServerThread <- spawnPrometheusSimple store (True, Just host, port) + pretracer <- ekgTracer emptyTraceConfig store + let tracer = metricsFormatter pretracer :: Trace IO Measure + confState <- emptyConfigReflection + configureTracers confState emptyTraceConfig [tracer] + traceWith tracer (Measure 42) + _ <- installHandler sigTERM (Catch (cancel metricsServerThread)) Nothing + manager <- newManager defaultManagerSettings + _ <- threadDelay (3 * 1000000) + MM metricsMap <- scrapeOnce manager ("http://" <> host <> ":" <> show port <> "/metrics") + MVDouble value <- maybe (die "'measure' metric not found in the scape list") pure (Map.lookup "measure" metricsMap) + unless (value == 42) $ die ("Unexpected value: " <> show value) + putStrLn "Got correct metric value ✔" + cancel metricsServerThread diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index 6b6da149118..e61340567c4 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -98,6 +98,34 @@ library else build-depends: unix +test-suite trace-dispatcher-prometheus-simple-test + import: project-config + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: trace-dispatcher-prometheus-simple-test.hs + build-depends: base >=4.12 && <5 + , aeson + , async + , bytestring + , containers + , deepseq + , ekg-core + , generic-data + , hostname + , http-client == 0.7.19 + , stm + , tasty + , tasty-hunit + , tasty-quickcheck + , text + , time + , trace-dispatcher + , unordered-containers + , utf8-string + , unix + , yaml + , QuickCheck + , cardano-prometheus-tracker test-suite trace-dispatcher-test import: project-config @@ -109,35 +137,40 @@ test-suite trace-dispatcher-test Cardano.Logging.Test.Config Cardano.Logging.Test.Tracer Cardano.Logging.Test.Script - Cardano.Logging.Test.Unit.TestObjects Cardano.Logging.Test.Unit.Aggregation - Cardano.Logging.Test.Unit.Trivial - Cardano.Logging.Test.Unit.Routing - Cardano.Logging.Test.Unit.EKG Cardano.Logging.Test.Unit.Configuration Cardano.Logging.Test.Unit.DataPoint - Cardano.Logging.Test.Unit.FrequencyLimiting Cardano.Logging.Test.Unit.Documentation + Cardano.Logging.Test.Unit.EKG + Cardano.Logging.Test.Unit.FrequencyLimiting + Cardano.Logging.Test.Unit.PrometheusSimple + Cardano.Logging.Test.Unit.Routing + Cardano.Logging.Test.Unit.TestObjects + Cardano.Logging.Test.Unit.Trivial build-depends: base >=4.12 && <5 , aeson + , async , bytestring , containers , deepseq , ekg-core , generic-data , hostname - , text + , http-client == 0.7.19 , stm , tasty , tasty-hunit , tasty-quickcheck + , text , time , trace-dispatcher , unordered-containers , utf8-string + , unix , yaml , QuickCheck + , cardano-prometheus-tracker benchmark trace-dispatcher-bench From 8d779399bbd064d347424245f14815b189364e57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Nicklisch-Franken?= Date: Mon, 8 Sep 2025 08:51:56 -0500 Subject: [PATCH 2/2] Review changes Minimize cabal dependencies Handle unavailable port nix | cabal.project: bump CHaP and cardano-automation Use unix-compat with tests --- cabal.project | 7 +---- flake.lock | 15 ++++++---- flake.nix | 1 + .../Cardano/Logging/Prometheus/TCPServer.hs | 25 ++++++---------- ...trace-dispatcher-prometheus-simple-test.hs | 20 +++++++------ trace-dispatcher/trace-dispatcher.cabal | 30 +++++++------------ 6 files changed, 41 insertions(+), 57 deletions(-) diff --git a/cabal.project b/cabal.project index 1e47164859e..d7ffd548b58 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2025-06-24T21:06:59Z - , cardano-haskell-packages 2025-09-18T12:21:32Z + , cardano-haskell-packages 2025-10-07T11:20:00Z packages: cardano-node @@ -32,11 +32,6 @@ packages: trace-resources trace-forward -source-repository-package - type: git - location: https://github.com/jutaro/cardano-prometheus-tracker.git - tag: af73c6217850ac6bf07ad26d8faa985f391eddf3 - -- Needed when cross compiling extra-packages: alex diff --git a/flake.lock b/flake.lock index 088771904d5..5f8a68675b8 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1758727647, - "narHash": "sha256-J0PlznW05SByIJZvP90JvFMvnHsP+Rs/qwLogpConI4=", + "lastModified": 1759837865, + "narHash": "sha256-g8SMcVN1v51Muz6a+xJkB92mPx1jsg+sjHKvQ3Wj/jY=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "bbf172e0d11e3842e543df101dee223f05a2332e", + "rev": "9a46cacd941c108492cd4cee5d29735e8cd8ee65", "type": "github" }, "original": { @@ -104,6 +104,9 @@ "cardano-automation": { "inputs": { "flake-utils": "flake-utils", + "hackageNix": [ + "hackageNix" + ], "haskellNix": [ "haskellNix" ], @@ -112,11 +115,11 @@ ] }, "locked": { - "lastModified": 1750923974, - "narHash": "sha256-PXB1aro2KalRw6OZkcbICl6Ge7HB4yEl5O3epm9VZl8=", + "lastModified": 1759830003, + "narHash": "sha256-j5C9yqLzvOEfNcxBUP9QA2baIhWsk0vcLGrbpxCvND8=", "owner": "input-output-hk", "repo": "cardano-automation", - "rev": "64bf80a78102787790bac96075ef4109ff7de36e", + "rev": "d2017cf99d9c98b0acb4383d03ecfa8f9fdc2aac", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index 922bde27b5d..8a74b4b182e 100644 --- a/flake.nix +++ b/flake.nix @@ -10,6 +10,7 @@ cardano-automation = { url = "github:input-output-hk/cardano-automation"; inputs = { + hackageNix.follows = "hackageNix"; haskellNix.follows = "haskellNix"; nixpkgs.follows = "nixpkgs"; }; diff --git a/trace-dispatcher/src/Cardano/Logging/Prometheus/TCPServer.hs b/trace-dispatcher/src/Cardano/Logging/Prometheus/TCPServer.hs index 1f5ad345392..8073dcb0160 100644 --- a/trace-dispatcher/src/Cardano/Logging/Prometheus/TCPServer.hs +++ b/trace-dispatcher/src/Cardano/Logging/Prometheus/TCPServer.hs @@ -1,16 +1,15 @@ -- | Run a simple Prometheus TCP server, responding *only* to the '/metrics' URL with current Node metrics -module Cardano.Logging.Prometheus.TCPServer (spawnPrometheusSimple, runPrometheusSimple) where +module Cardano.Logging.Prometheus.TCPServer (runPrometheusSimple) where import Cardano.Logging.Prometheus.Exposition (renderExpositionFromSample) import Cardano.Logging.Prometheus.NetworkRun -import Control.Concurrent.Async (Async, async, link) +import Control.Concurrent.Async (async, link) import qualified Control.Exception as E import Control.Monad (when) import Data.ByteString (ByteString) import Data.ByteString.Builder import qualified Data.ByteString.Char8 as BC -import Data.Functor (($>)) import Data.Int (Int64) import Data.List (find, intersperse) import Data.Text.Lazy (Text) @@ -24,22 +23,16 @@ import System.Metrics as EKG (Store, sampleAll) import System.Posix.Types (EpochTime) import System.PosixCompat.Time (epochTime) -spawnPrometheusSimple :: EKG.Store -> (Bool, Maybe HostName, PortNumber) -> IO (Either String (Async ())) -spawnPrometheusSimple ekgStore (noSuffixes, mHost, portNo) = - E.try createRunner >>= \case - Left (E.SomeException e) -> pure (Left $ E.displayException e) - Right runner -> Right <$> async runner - where - getCurrentExposition = renderExpositionFromSample noSuffixes <$> sampleAll ekgStore - createRunner = - putStrLn ("Port Number: " <> show portNo) >> - mkTCPServerRunner (defaultRunParams "PrometheusSimple") mHost portNo (serveAccepted getCurrentExposition) -- Will provide a 'Just errormessage' iff creating the Prometheus server failed runPrometheusSimple :: EKG.Store -> (Bool, Maybe HostName, PortNumber) -> IO (Maybe String) -runPrometheusSimple ekgStore args = spawnPrometheusSimple ekgStore args >>= \case - Left err -> pure $ Just err - Right as -> link as $> Nothing +runPrometheusSimple ekgStore (noSuffixes, mHost, portNo) = + E.try createRunner >>= \case + Left (E.SomeException e) -> pure (Just $ E.displayException e) + Right runner -> async runner >>= link >> pure Nothing + where + getCurrentExposition = renderExpositionFromSample noSuffixes <$> sampleAll ekgStore + createRunner = mkTCPServerRunner (defaultRunParams "PrometheusSimple") mHost portNo (serveAccepted getCurrentExposition) -- serves an incoming connection; will release socket upon remote close, inactivity timeout or runRecvMaxSize bytes received serveAccepted :: IO Text -> TimeoutServer () diff --git a/trace-dispatcher/test/trace-dispatcher-prometheus-simple-test.hs b/trace-dispatcher/test/trace-dispatcher-prometheus-simple-test.hs index 3301cf9d039..e226402c421 100644 --- a/trace-dispatcher/test/trace-dispatcher-prometheus-simple-test.hs +++ b/trace-dispatcher/test/trace-dispatcher-prometheus-simple-test.hs @@ -1,12 +1,11 @@ import Cardano.Logging (metricsFormatter) import Cardano.Logging.Configuration (configureTracers) -import Cardano.Logging.Prometheus.TCPServer (spawnPrometheusSimple) +import Cardano.Logging.Prometheus.TCPServer (runPrometheusSimple) import Cardano.Logging.Trace (traceWith) import Cardano.Logging.Tracer.EKG (ekgTracer) import Cardano.Logging.Types import Control.Concurrent (threadDelay) -import Control.Concurrent.Async (cancel) import Control.Monad (unless) import Data.Aeson import qualified Data.Map.Internal as Map @@ -14,9 +13,8 @@ import Data.Text (pack) import Network.HTTP.Client (defaultManagerSettings, newManager) import Network.HTTP.PrometheusTracker (scrapeOnce) import Network.HTTP.PrometheusTracker.Types (MetricsMap (MM), MetricsValue (MVDouble)) -import System.Exit (die) +import System.Exit (die, exitSuccess) import System.Metrics (newStore) -import System.Posix.Signals newtype Measure = Measure Int @@ -44,7 +42,7 @@ instance MetaTrace Measure where - Wait Thread #2: - - Scape the metrics + - Scrape the metrics - Ensure that we see the expected metric and its value in the list -} main :: IO () @@ -52,17 +50,21 @@ main = do store <- newStore let host = "localhost" let port = 9090 - Right metricsServerThread <- spawnPrometheusSimple store (True, Just host, port) + runPrometheusSimple store (True, Just host, port) >>= handleSpawn pretracer <- ekgTracer emptyTraceConfig store let tracer = metricsFormatter pretracer :: Trace IO Measure confState <- emptyConfigReflection configureTracers confState emptyTraceConfig [tracer] traceWith tracer (Measure 42) - _ <- installHandler sigTERM (Catch (cancel metricsServerThread)) Nothing manager <- newManager defaultManagerSettings _ <- threadDelay (3 * 1000000) MM metricsMap <- scrapeOnce manager ("http://" <> host <> ":" <> show port <> "/metrics") MVDouble value <- maybe (die "'measure' metric not found in the scape list") pure (Map.lookup "measure" metricsMap) unless (value == 42) $ die ("Unexpected value: " <> show value) - putStrLn "Got correct metric value ✔" - cancel metricsServerThread + putStrLn "Got correct metric value ✔" where + + handleSpawn :: Maybe String -> IO () + handleSpawn Nothing = pure () + handleSpawn (Just err) = do + putStrLn $ "Couldn't spawn prometheus-simple server!\n" <> err + exitSuccess diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index e61340567c4..e2d4637b16e 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -105,27 +105,19 @@ test-suite trace-dispatcher-prometheus-simple-test main-is: trace-dispatcher-prometheus-simple-test.hs build-depends: base >=4.12 && <5 , aeson - , async - , bytestring + , cardano-prometheus-tracker , containers - , deepseq , ekg-core - , generic-data - , hostname - , http-client == 0.7.19 - , stm - , tasty - , tasty-hunit - , tasty-quickcheck + , http-client , text - , time , trace-dispatcher - , unordered-containers - , utf8-string - , unix - , yaml - , QuickCheck - , cardano-prometheus-tracker + + ghc-options: + -threaded + -Wunused-packages + + if !(os(linux) || os(darwin) || os(freebsd)) + buildable: False test-suite trace-dispatcher-test import: project-config @@ -143,7 +135,6 @@ test-suite trace-dispatcher-test Cardano.Logging.Test.Unit.Documentation Cardano.Logging.Test.Unit.EKG Cardano.Logging.Test.Unit.FrequencyLimiting - Cardano.Logging.Test.Unit.PrometheusSimple Cardano.Logging.Test.Unit.Routing Cardano.Logging.Test.Unit.TestObjects Cardano.Logging.Test.Unit.Trivial @@ -157,7 +148,6 @@ test-suite trace-dispatcher-test , ekg-core , generic-data , hostname - , http-client == 0.7.19 , stm , tasty , tasty-hunit @@ -167,7 +157,7 @@ test-suite trace-dispatcher-test , trace-dispatcher , unordered-containers , utf8-string - , unix + , unix-compat , yaml , QuickCheck , cardano-prometheus-tracker