Sync to match master

Author: Icelandjack

cardano-node/cardano-node.cabal

@@ -214,7 +214,7 @@ library
                       , time
                       , trace-dispatcher ^>= 2.10.0
                       , trace-forward ^>= 2.3.0
-                      , trace-resources ^>= 0.2.4
+                      , trace-resources ^>= 0.2.3
                       , tracer-transformers
                       , transformers
                       , transformers-except

cardano-tracer/CHANGELOG.md

@@ -1,10 +1,5 @@
 # ChangeLog
 
-## NEXT
-
-* Cardano-tracer library functionality, allows shutting down and sending signals to running
-  instances through channels.
-
 ## 0.3.4 (July, 2025)
 * Forwarding protocol supports connections over TCP socket, in addition to Unix domain sockets.
 

cardano-tracer/app/cardano-tracer.hs

@@ -1,23 +1,14 @@
-{-# LANGUAGE OverloadedRecordDot #-}
-
-import           Cardano.Tracer.CLI (TracerParams(..), parseTracerParams)
-import           Cardano.Tracer.MetaTrace
+import           Cardano.Tracer.CLI (TracerParams, parseTracerParams)
 import           Cardano.Tracer.Run (runCardanoTracer)
 
-import           Data.Functor (void)
 import           Data.Version (showVersion)
 import           Options.Applicative
 
 import           Paths_cardano_tracer (version)
 
 main :: IO ()
-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
+main =
+  runCardanoTracer =<< customExecParser (prefs showHelpOnEmpty) tracerInfo
 
 tracerInfo :: ParserInfo TracerParams
 tracerInfo = info
@@ -30,9 +21,7 @@ tracerInfo = info
 
 versionOption :: Parser (a -> a)
 versionOption = infoOption
-  do showVersion version
-  do mconcat
-       [ long  "version"
-       , short 'v'
-       , help  "Show version"
-       ]
+  (showVersion version)
+  (long "version" <>
+   short 'v' <>
+   help "Show version")

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

@@ -19,7 +19,6 @@ 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)
@@ -64,8 +63,6 @@ main = do
 
   tracer <- mkTracerTracer $ SeverityF $ Just Warning
 
-  (inChan, _outChan) <- newChan
-
   let tracerEnv :: TracerConfig -> HandleRegistry -> TracerEnv
       tracerEnv config handleRegistry = TracerEnv
         { teConfig                = config
@@ -77,7 +74,6 @@ main = do
         , teDPRequestors          = dpRequestors
         , teProtocolsBrake        = protocolsBrake
         , teTracer                = tracer
-        , teInChan                = inChan
         , teReforwardTraceObjects = \_-> pure ()
         , teRegistry              = handleRegistry
         , teStateDir              = Nothing

cardano-tracer/cardano-tracer.cabal

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

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

@@ -14,7 +14,6 @@ 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
@@ -34,28 +33,20 @@ 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, teInChan = inChan} tracerEnvRTView = do
+runAcceptors tracerEnv@TracerEnv{teTracer} tracerEnvRTView = do
   traceWith teTracer $ TracerStartedAcceptors network
   case network of
-    AcceptAt howToConnect -> let
+    AcceptAt howToConnect ->
       -- Run one server that accepts connections from the nodes.
-
-      action :: IO ()
-      action = do
-        dieOnShutdown =<< dupChan inChan
-        runAcceptorsServer tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect)
-
-      in runInLoop action verbosity howToConnect initialPauseInSec
-    ConnectTo localSocks -> do
+      runInLoop
+        (runAcceptorsServer tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect))
+        verbosity howToConnect initialPauseInSec
+    ConnectTo localSocks ->
       -- Run N clients that initiate connections to the nodes.
-      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
+      forConcurrently_ (NE.nub localSocks) \howToConnect ->
+        runInLoop
+          (runAcceptorsClient tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect))
+          verbosity howToConnect initialPauseInSec
  where
   TracerConfig{network, ekgRequestFreq, verbosity, ekgRequestFull} = teConfig tracerEnv
   ekgUseFullRequests = fromMaybe False ekgRequestFull

cardano-tracer/src/Cardano/Tracer/Environment.hs

@@ -1,24 +1,11 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
 
 module Cardano.Tracer.Environment
   ( TracerEnv (..)
   , TracerEnvRTView (..)
-  , RawMessage (..)
-  , InternalMessage (..)
-  , Tag (..)
-  , CardanoTracerMessage
-  , onRawMessage
-  , onInternal
-  , onUser
-  , blockUntilShutdown
-  , dieOnShutdown
-  , forever'tilShutdown
   ) where
 
 import           Cardano.Logging.Types
-import           Cardano.Logging.Resources.Types (ResourceStats)
 import           Cardano.Tracer.Configuration
 #if RTVIEW
 import           Cardano.Tracer.Handlers.Notifications.Types
@@ -29,13 +16,10 @@ import           Cardano.Tracer.Handlers.State.TraceObjects
 import           Cardano.Tracer.MetaTrace
 import           Cardano.Tracer.Types
 
-import           Control.Concurrent (myThreadId)
-import           Control.Exception (AsyncException(ThreadKilled), throwTo)
-import           Control.Concurrent.Chan.Unagi (InChan, OutChan, readChan)
 import           Control.Concurrent.Extra (Lock)
 import           Data.Text (Text)
 import           Data.Text.Lazy.Builder (Builder)
-import           Data.Kind (Type)
+
 
 -- | Environment for all functions.
 data TracerEnv = TracerEnv
@@ -52,7 +36,6 @@ data TracerEnv = TracerEnv
   , teRegistry              :: !HandleRegistry
   , teStateDir              :: !(Maybe FilePath)
   , teMetricsHelp           :: ![(Text, Builder)]
-  , teInChan                :: !(InChan (CardanoTracerMessage ()))
   }
 
 #if RTVIEW
@@ -68,46 +51,3 @@ data TracerEnvRTView = TracerEnvRTView
 #else
 data TracerEnvRTView = TracerEnvRTView
 #endif
-
-type CardanoTracerMessage userMsg = RawMessage InternalMessage userMsg
-
-type RawMessage :: Type -> Type -> Type
-data RawMessage internal user
-  = Shutdown
-  | InternalMessage internal
-  | UserMessage     user
-
-blockUntilShutdown :: OutChan (RawMessage internal user) -> IO ()
-blockUntilShutdown outChan = go where
-  go :: IO ()
-  go = readChan outChan >>= \case
-         Shutdown -> pure ()
-         _        -> go
-
-onRawMessage :: (internal -> IO ()) -> (user -> IO ()) -> OutChan (RawMessage internal user) -> IO ()
-onRawMessage internalAction userAction outChan =
-  readChan outChan >>= \case
-    Shutdown                 -> myThreadId >>= (`throwTo` ThreadKilled)
-    InternalMessage internal -> internalAction internal
-    UserMessage user         -> userAction user
-
-onInternal :: (internal -> IO ()) -> OutChan (RawMessage internal user) -> IO ()
-onInternal = (`onRawMessage` mempty)
-
-onUser :: (user -> IO ()) -> OutChan (RawMessage internal user) -> IO ()
-onUser = (mempty `onRawMessage`)
-
-data InternalMessage where
-  ResourceMessage :: Tag ex -> (ex -> IO ()) -> InternalMessage
-
-data Tag a where
-  TagResource :: Tag (ResourceStats, Trace IO TracerTrace)
-
-dieOnShutdown :: OutChan (RawMessage internal user) -> IO ()
-dieOnShutdown = onRawMessage mempty mempty
-
-forever'tilShutdown :: OutChan (RawMessage internal user) -> IO () -> IO ()
-forever'tilShutdown outChan action = do
-  readChan outChan >>= \case
-    Shutdown -> pure ()
-    _        -> action *> forever'tilShutdown outChan action

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs

@@ -6,17 +6,16 @@ module Cardano.Tracer.Handlers.Logs.Rotator
   ) where
 
 import           Cardano.Tracer.Configuration
-import           Cardano.Tracer.Environment (TracerEnv (..), forever'tilShutdown)
+import           Cardano.Tracer.Environment
 import           Cardano.Tracer.Handlers.Logs.Utils (createOrUpdateEmptyLog, getTimeStampFromLog,
                    isItLog)
 import           Cardano.Tracer.MetaTrace
 import           Cardano.Tracer.Types (HandleRegistry, HandleRegistryKey, NodeName)
 import           Cardano.Tracer.Utils (showProblemIfAny, readRegistry)
 
 import           Control.Concurrent.Async (forConcurrently_)
-import           Control.Concurrent.Chan.Unagi (dupChan)
 import           Control.Concurrent.Extra (Lock)
-import           Control.Monad (forM_, unless, when)
+import           Control.Monad (forM_, forever, unless, when)
 import           Control.Monad.Extra (whenJust, whenM)
 import           Data.Foldable (for_)
 import           Data.List (nub, sort)
@@ -34,40 +33,38 @@ import           System.Time.Extra (sleep)
 
 -- | Runs rotation mechanism for the log files.
 runLogsRotator :: TracerEnv -> IO ()
-runLogsRotator tracerEnv@TracerEnv { teConfig = TracerConfig{rotation}, teTracer } = do
-  whenJust rotation \rot -> do
+runLogsRotator TracerEnv
+  { teConfig = TracerConfig{rotation, verbosity, logging}
+  , teCurrentLogLock
+  , teTracer
+  , teRegistry
+  } = do
+  whenJust rotation \rotParams -> do
     traceWith teTracer TracerStartedLogRotator
-    launchRotator tracerEnv rot
-
-launchRotator
-  :: TracerEnv
-  -> RotationParams
-  -> IO ()
-launchRotator tracerEnv rot@RotationParams{rpFrequencySecs} = do
-  whenNonEmpty loggingParamsForFiles do
-    outChan <- dupChan teInChan
-    forever'tilShutdown outChan do
-      showProblemIfAny verbosity do
-        forM_ loggingParamsForFiles \loggingParam -> do
-          checkRootDir teCurrentLogLock teRegistry rot loggingParam
-      sleep (fromIntegral rpFrequencySecs)
-  where
-  whenNonEmpty :: Applicative f => [a] -> f () -> f ()
-  whenNonEmpty = unless . null
-
-  TracerEnv
-    { teConfig = TracerConfig{verbosity, logging}
-    , teCurrentLogLock
-    , teRegistry
-    , teInChan
-    } = tracerEnv
-
+    launchRotator loggingParamsForFiles rotParams verbosity teRegistry teCurrentLogLock
+ where
   loggingParamsForFiles :: [LoggingParams]
   loggingParamsForFiles = nub (NE.filter filesOnly logging)
 
   filesOnly :: LoggingParams -> Bool
   filesOnly LoggingParams{logMode} = logMode == FileMode
 
+launchRotator
+  :: [LoggingParams]
+  -> RotationParams
+  -> Maybe Verbosity
+  -> HandleRegistry
+  -> Lock
+  -> IO ()
+launchRotator [] _ _ _ _ = return ()
+launchRotator loggingParamsForFiles
+              rotParams@RotationParams{rpFrequencySecs} verb registry currentLogLock =
+  forever do
+    showProblemIfAny verb do
+      forM_ loggingParamsForFiles \loggingParam -> do
+        checkRootDir currentLogLock registry rotParams loggingParam
+    sleep $ fromIntegral rpFrequencySecs
+
 -- | All the logs with 'TraceObject's received from particular node
 --   will be stored in a separate subdirectory in the root directory.
 --

cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs

@@ -14,8 +14,6 @@ import           Cardano.Tracer.Types
 
 import           Prelude hiding (head)
 
-import           Control.Concurrent.Async (race_)
-import           Control.Concurrent.Chan.Unagi (OutChan, dupChan)
 import           Data.ByteString as ByteString (ByteString, isInfixOf)
 import           Data.ByteString.Builder (stringUtf8)
 import qualified Data.Text as T
@@ -41,26 +39,19 @@ runMonitoringServer
   -> Endpoint -- ^ (web page with list of connected nodes, EKG web page).
   -> IO RouteDictionary
   -> IO ()
-runMonitoringServer TracerEnv{teTracer, teInChan = inChan} endpoint computeRoutes_autoUpdate = do
+runMonitoringServer TracerEnv{teTracer} endpoint computeRoutes_autoUpdate = do
   -- Pause to prevent collision between "Listening"-notifications from servers.
   sleep 0.2
   traceWith teTracer TracerStartedMonitoring
     { ttMonitoringEndpoint = endpoint
     , ttMonitoringType     = "list"
     }
   dummyStore <- EKG.newStore
-  outChan    <- dupChan inChan
-
-  let run :: IO ()
-      run = runSettings (setEndpoint endpoint defaultSettings) $
-              renderEkg dummyStore outChan computeRoutes_autoUpdate
-
-  race_ run (blockUntilShutdown outChan)
-
-renderEkg :: EKG.Store -> OutChan (CardanoTracerMessage ()) -> IO RouteDictionary -> Application
-renderEkg dummyStore outChan computeRoutes_autoUpdate request send = do
-  dieOnShutdown outChan
+  runSettings (setEndpoint endpoint defaultSettings) do
+    renderEkg dummyStore computeRoutes_autoUpdate
 
+renderEkg :: EKG.Store -> IO RouteDictionary -> Application
+renderEkg dummyStore computeRoutes_autoUpdate request send = do
   routeDictionary :: RouteDictionary <-
     computeRoutes_autoUpdate