cardano-tracer: Add functionality to run cardano-tracer as a library, with shut-down functionality and internal/user messaging.

Signed-off-by: Baldur Blöndal <[email protected]>

Author: Icelandjack

cardano-tracer/CHANGELOG.md

@@ -1,5 +1,9 @@
 # ChangeLog
 
+## NEXT
+* Cardano-tracer library functionality, allows shutting down and sending signals to running
+  instances through channels.
+
 ## 0.3.5 (October, 2025)
 * Updated to `ekg-forward-1.0`, `ouroboros-network-0.22.3`, `ouroboros-network-api-0.16` and `ouroboros-network-0.22.3`.
 * Updated metric names

cardano-tracer/app/cardano-tracer.hs

@@ -1,14 +1,23 @@
-import           Cardano.Tracer.CLI (TracerParams, parseTracerParams)
+{-# LANGUAGE OverloadedRecordDot #-}
+
+import           Cardano.Tracer.CLI (TracerParams(..), parseTracerParams)
+import           Cardano.Tracer.MetaTrace
 import           Cardano.Tracer.Run (runCardanoTracer)
 
+import           Data.Functor (void)
 import           Data.Version (showVersion)
 import           Options.Applicative
 
 import           Paths_cardano_tracer (version)
 
 main :: IO ()
-main =
-  runCardanoTracer =<< customExecParser (prefs showHelpOnEmpty) tracerInfo
+main = void do
+  tracerParams :: TracerParams
+     <- customExecParser (prefs showHelpOnEmpty) tracerInfo
+  trace :: Trace IO TracerTrace <-
+    -- Default `Nothing' severity filter to Info.
+    mkTracerTracer $ SeverityF (tracerParams.logSeverity <|> Just Info)
+  runCardanoTracer trace tracerParams
 
 tracerInfo :: ParserInfo TracerParams
 tracerInfo = info
@@ -21,7 +30,9 @@ tracerInfo = info
 
 versionOption :: Parser (a -> a)
 versionOption = infoOption
-  (showVersion version)
-  (long "version" <>
-   short 'v' <>
-   help "Show version")
+  do showVersion version
+  do mconcat
+       [ long  "version"
+       , short 'v'
+       , help  "Show version"
+       ]

cardano-tracer/bench/cardano-tracer-bench.hs

@@ -19,6 +19,7 @@ import           Control.Concurrent.Extra (newLock)
 #if RTVIEW
 import           Control.Concurrent.STM.TVar (newTVarIO)
 #endif
+import           Control.Concurrent.Chan.Unagi (newChan)
 import           Control.DeepSeq
 import qualified Data.List.NonEmpty as NE
 import           Data.Time.Clock (UTCTime, getCurrentTime)
@@ -63,6 +64,8 @@ main = do
 
   tracer <- mkTracerTracer $ SeverityF $ Just Warning
 
+  (inChan, _outChan) <- newChan
+
   let tracerEnv :: TracerConfig -> HandleRegistry -> TracerEnv
       tracerEnv config handleRegistry = TracerEnv
         { teConfig                = config
@@ -74,6 +77,7 @@ main = do
         , teDPRequestors          = dpRequestors
         , teProtocolsBrake        = protocolsBrake
         , teTracer                = tracer
+        , teInChan                = inChan
         , teReforwardTraceObjects = \_-> pure ()
         , teRegistry              = handleRegistry
         , teStateDir              = Nothing

cardano-tracer/cardano-tracer.cabal

@@ -200,6 +200,7 @@ library
                       , trace-dispatcher ^>= 2.10.0
                       , trace-forward ^>= 2.3.0
                       , trace-resources ^>= 0.2.4
+                      , unagi-chan
                       , wai ^>= 3.2
                       , warp ^>= 3.4
                       , yaml
@@ -294,6 +295,7 @@ library demo-acceptor-lib
   exposed-modules:      Cardano.Tracer.Test.Acceptor
 
   build-depends:        bytestring
+                      , QuickCheck
                       , cardano-tracer
                       , containers
                       , extra
@@ -306,9 +308,9 @@ library demo-acceptor-lib
                       , text
                       , trace-dispatcher
                       , trace-forward
+                      , unagi-chan
                       , vector
                       , vector-algorithms
-                      , QuickCheck
 
 executable demo-acceptor
   import:               project-config
@@ -452,12 +454,13 @@ benchmark cardano-tracer-bench
     build-depends:      stm <2.5.2 || >=2.5.3
   build-depends:        cardano-tracer
                       , criterion
-                      , directory
                       , deepseq
+                      , directory
                       , extra
                       , filepath
                       , time
                       , trace-dispatcher
+                      , unagi-chan
 
   ghc-options:          -threaded
                         -rtsopts

cardano-tracer/src/Cardano/Tracer/Acceptors/Run.hs

@@ -14,6 +14,7 @@ import           Cardano.Tracer.Utils
 import           Cardano.Logging.Types (TraceObject)
 import qualified Cardano.Logging.Types as Net
 
+import           Control.Concurrent.Chan.Unagi (dupChan)
 import           Control.Concurrent.Async (forConcurrently_)
 import           "contra-tracer" Control.Tracer (Tracer, contramap, nullTracer, stdoutTracer)
 import qualified Data.List.NonEmpty as NE
@@ -33,20 +34,28 @@ import qualified Trace.Forward.Protocol.TraceObject.Type as TOF
 --   1. Server mode, when the tracer accepts connections from any number of nodes.
 --   2. Client mode, when the tracer initiates connections to specified number of nodes.
 runAcceptors :: TracerEnv -> TracerEnvRTView -> IO ()
-runAcceptors tracerEnv@TracerEnv{teTracer} tracerEnvRTView = do
+runAcceptors tracerEnv@TracerEnv{teTracer, teInChan = inChan} tracerEnvRTView = do
   traceWith teTracer $ TracerStartedAcceptors network
   case network of
-    AcceptAt howToConnect ->
+    AcceptAt howToConnect -> let
       -- Run one server that accepts connections from the nodes.
-      runInLoop
-        (runAcceptorsServer tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect))
-        verbosity howToConnect initialPauseInSec
-    ConnectTo localSocks ->
+
+      action :: IO ()
+      action = do
+        dieOnShutdown =<< dupChan inChan
+        runAcceptorsServer tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect)
+
+      in runInLoop action verbosity howToConnect initialPauseInSec
+    ConnectTo localSocks -> do
       -- Run N clients that initiate connections to the nodes.
-      forConcurrently_ (NE.nub localSocks) \howToConnect ->
-        runInLoop
-          (runAcceptorsClient tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect))
-          verbosity howToConnect initialPauseInSec
+      forConcurrently_ (NE.nub localSocks) \howToConnect -> let
+
+        action :: IO ()
+        action = runAcceptorsClient tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect)
+
+        in do
+          dieOnShutdown =<< dupChan inChan
+          runInLoop action verbosity howToConnect initialPauseInSec
  where
   TracerConfig{network, ekgRequestFreq, verbosity, ekgRequestFull} = teConfig tracerEnv
   ekgUseFullRequests = fromMaybe False ekgRequestFull